ab.com コミュニティ https://www.activebasic.com/forum/ |
|
計算式を逆ポーランド記法の計算式に変える https://www.activebasic.com/forum/viewtopic.php?t=1191 |
ページ 1 / 1 |
作成者: | 卓漏 [ 2006年7月01日(土) 09:09 ] |
記事の件名: | 計算式を逆ポーランド記法の計算式に変える |
実例としては、計算式「1+2*3+4*(5-6)」を入れると、 逆ポーランド記法に変換した計算式「1,2,3,*,+,4,5,6,-,*,+」が戻ってきます。 また、計算式「(-1)*sin(2)」の場合は、計算式「-1,2,sin,*」が帰ってきます。 [ここをクリックすると内容が表示されます]
自分の方言(プログラムの書き方)の関係で、注釈文が少ない(むしろ書いていない)ので、スパゲッティプログラム化しています。コード: '[ActiveBasic 4.20] Function RevPoland(Expn As String) As String '* 逆ポーランド記法 * Dim I As Long Dim Num As String Dim Sg As String, SSg As String Dim Str As String For I = 1 To Len(Expn) Select Case Mid$(Expn, I, 1) Case "(" If Not Str = "" Then Sg = Str & "," & Sg Str = "" End If SSg = Sg & ":" & SSg Sg = "" Case ")" If 0 < Len(Sg) Then 'エラー回避 Num = Num & Str & "," & Left$(Sg, Len(Sg) - 1) Str = "" End If Sg = Left$(SSg, InStr(1, SSg, ":") - 1) SSg = Mid$(SSg, InStr(1, SSg, ":") + 1) Case "*", "/" Num = Num & Str & "," Str = "" Sg = Mid$(Expn, I, 1) & "," & Sg Case "+", "-" If (Num = "" Or Str = "") And Mid$(Expn, I, 1) = "-" Then Num = Num & Str & "-" Else Num = Num & Str & "," & Sg Sg = Mid$(Expn, I, 1) & "," End If Str = "" Case Else Str = Str & Mid$(Expn, I, 1) End Select Next I RevPoland = Num & Str & "," & Left$(Sg, Len(Sg) - 1) End Function そのうち、注釈文を追加して、虫退治も行ったプログラムを公開します・・・・。 |
作成者: | mm [ 2007年4月21日(土) 15:39 ] |
記事の件名: | re 計算式を逆ポーランド記法の計算式に変える |
((5+7)*(4-2))-15*6/(3+1) を 入力すると 5,7,+,4,2,-,*-15,6,3,1,+,/,* が、返ってきました。 5,7,+,4,2,-,*,15,6,*,3,1,+,/,- となって欲しいのです。 |
作成者: | 淡幻星 [ 2007年10月14日(日) 02:10 ] |
記事の件名: | クラス化して、実数&変数&関数対応にしてみました。 |
お世話になっております。 クラス化してみました。 変数&実数&関数対応しています。 ※関数は、関数認識テーブルにセットしたものだけが有効です。 逆ポーランド記法の取出しには、こちらのキューを使っています。 クラス定義はこちら [ここをクリックすると内容が表示されます]
# ちなみに、「((5+7)*(4-2))-15*6/(3+1)」で試してみると、コード: /* 二分木法を用いて、通常の計算式を逆ポーランド記法に変換するクラス。 Sub SetFunctionList( ppszFunctionList As *BytePtr ) ・・・数式の中で、関数として認識する文字列配列(関数認識テーブル)を格納する。 ppszFunctionList[0] = "cos"の格納先ポインタ ppszFunctionList[1] = "sin" 〃 ppszFunctionList[2] = "func" 〃 ppszFunctionList[3] = NULL '配列の終端には、NULLを格納すること。 ※関数を利用しない場合は、呼び出す必要は無い。 利用する場合には、SetNumericalFormula()の実行前に呼び出す必要がある。 Sub SetNumericalFormula( pszExp As BytePtr ) ・・・通常表記の数式文字列を指定すると、逆ポーランド記法に分解して内部で保持する。 出力にはTraverseTreeToQueue()を用いる。 利用できる演算子は以下。 +, -, *, /, ^, (), 上記で指定した関数 Function TraverseTreeToQueue( pobjQueue As *StrQueue ) As Char ・・・SetNumericalFormula()に指定した数式の逆ポーランド表記を、 キューに格納した形で取り出す。キューの先頭が逆ポーランド表記の先頭に対応する。 なお、関数は[ *cos ]という形で、一文字の演算子と一緒出力される。 参考URL http://smdn.invisiblefulmoon.net/ikimas ... olish.html */ Type StrCalcNode pzExpression As BytePtr pzFunc As BytePtr pLeft As *StrCalcNode pRight As *StrCalcNode End Type Class StringCalc_ReversePolishNotation hHeap As HANDLE pstRoot As *StrCalcNode ppszFuncList As *BytePtr '木構造の使用するメモリを解放する。 Sub ClearTree() ClearTree_Sub( pstRoot ) End Sub Sub ClearTree_Sub( ByRef pstNode As *StrCalcNode ) If( pstNode=NULL )Then Exit Sub End If HeapFree( hHeap, 0, pstNode->pzExpression ) If( NULL<>pstNode->pzFunc )Then HeapFree( hHeap, 0, pstNode->pzFunc ) End If ClearTree_Sub( pstNode->pLeft ) ClearTree_Sub( pstNode->pRight ) pstNode = NULL End Sub Public Sub StringCalc_ReversePolishNotation() hHeap = HeapCreate( 0, 0, 0 ) pstRoot = NULL ppszFuncList = HeapAlloc( hHeap, HEAP_ZERO_MEMORY, SizeOf(BytePtr) ) ppszFuncList[0] = NULL End Sub Sub ~StringCalc_ReversePolishNotation() If( pstRoot<>NULL )Then ClearTree() End If HeapDestroy( hHeap ) End Sub '関数として認識するリストを設定する。 Sub SetFunctionList( ppszFunctionList As *BytePtr ) ppszFuncList = ppszFunctionList End Sub Sub SetNumericalFormula( pszExp As BytePtr ) '前回の結果を破棄する処理をここに。=木構造を破棄 If( pstRoot<>NULL )Then ClearTree() End If '木構造の根 pstRoot = HeapAlloc( hHeap, HEAP_ZERO_MEMORY, SizeOf(StrCalcNode) ) As *StrCalcNode '式をコピー pstRoot->pzExpression = HeapAlloc( hHeap, HEAP_ZERO_MEMORY, lstrlen(pszExp)+1 ) As BytePtr lstrcpy( pstRoot->pzExpression, pszExp ) '式中のスペースを削除 RemoveExpressionSpace( pstRoot->pzExpression ) '式を木構造へと分割 DivideExpression( pstRoot ) End Sub Private '式を木構造へと分割 Function DivideExpression( pstNode As *StrCalcNode ) As Long Dim iPosOperator As Long Dim pLeftExp As *StrCalcNode Dim pRightExp As *StrCalcNode Dim nLen As Long Dim pMark As BytePtr Dim nFunc As Long Dim pszFunc As BytePtr '根にNULLが指定された場合 If( NULL=pstNode )Then DivideExpression = 0 Exit Sub End If '最低優先順位の演算子の位置を取得 iPosOperator = GetLowestPriorityOperatorPos( pstNode->pzExpression ) '演算子が見つからない場合 If( iPosOperator=-1 )Then DivideExpression = -1 Exit Sub End If '節を作成 pLeftExp = HeapAlloc( hHeap, HEAP_ZERO_MEMORY, SizeOf(StrCalcNode) ) As *StrCalcNode pRightExp = HeapAlloc( hHeap, HEAP_ZERO_MEMORY, SizeOf(StrCalcNode) ) As *StrCalcNode '左オペランド pLeftExp->pzExpression = HeapAlloc( hHeap, HEAP_ZERO_MEMORY, iPosOperator+1 ) As BytePtr memcpy( pLeftExp->pzExpression, pstNode->pzExpression, iPosOperator ) pLeftExp->pzExpression[ iPosOperator ] = NULL 'オペランドを正規化 RemoveExpressionBracket( pLeftExp->pzExpression ) 'オペランドを木構造へ分割 DivideExpression( pLeftExp ) '右オペランド '※関数が演算子の後ろについていたら、それを外す(外して別途記録する)。 pMark = pstNode->pzExpression + iPosOperator + 1 '演算子の右脇を指すポインタ nFunc = 0 While( ppszFuncList[nFunc]<>NULL ) pszFunc = ppszFuncList[nFunc] If( 0=memcmp( pMark, pszFunc, lstrlen(pszFunc) ) )Then '認識関数リストに一致。 pstNode->pzFunc = HeapAlloc( hHeap, HEAP_ZERO_MEMORY, lstrlen(pszFunc)+1 ) As BytePtr lstrcpy( pstNode->pzFunc, pszFunc ) '「節」の、関数処理メンバに格納 pMark += lstrlen( pszFunc ) '関数部分を外す(右へポインタを移動) Exit While End If nFunc++ Wend nLen = lstrlen( pMark ) pRightExp->pzExpression = HeapAlloc( hHeap, HEAP_ZERO_MEMORY, nLen+1 ) As BytePtr memcpy( pRightExp->pzExpression, pMark, nLen ) pRightExp->pzExpression[ nLen ] = NULL 'オペランドを正規化 RemoveExpressionBracket( pRightExp->pzExpression ) 'オペランドを木構造へ分割 DivideExpression( pRightExp ) '節の値としてオペレータを入れる pstNode->pzExpression[0] = pstNode->pzExpression[ iPosOperator ] pstNode->pzExpression[1] = NULL '根の節の左右に式への参照を設定 pstNode->pLeft = pLeftExp pstNode->pRight = pRightExp End Function 'もっとも低い優先順位を持つ演算子の位置を取得する。 Function GetLowestPriorityOperatorPos( pszExp As BytePtr ) As Long Dim nPriorityMax As Long Dim nPosCurr As Long Dim nPosTemp As Long Dim nPriorityCurr As Long Dim nPriorityTemp As Long Dim nBracketDepth As Long nPriorityMax = 100000 nPosCurr = 0 nPosTemp = -1 nPriorityCurr = nPriorityMax nPriorityTemp = nPriorityMax nBracketDepth = 0 While( pszExp[ nPosCurr ]<>NULL ) '優先順位の取得、括弧の深度算出 nPriorityCurr = nPriorityMax Select Case pszExp[ nPosCurr ] Case 61 '=[=] nPriorityCurr = 1 Case 43 '=[+] nPriorityCurr = 2 Case 45 '=[-] nPriorityCurr = 2 Case 42 '=[*] nPriorityCurr = 3 Case 47 '=[/] nPriorityCurr = 3 Case 94 '=[^] nPriorityCurr = 4 Case 40 '=[(] nBracketDepth++ Case 41 '=[)] nBracketDepth-- End Select '括弧深度により優先順位を高める nPriorityCurr += nBracketDepth*10 '今の優先順位より低い/同等の優先順位の演算子を見つけた場合 If( nPriorityCurr <= nPriorityTemp )Then nPosTemp = nPosCurr nPriorityTemp = nPriorityCurr End If nPosCurr++ Wend If( nPriorityTemp=nPriorityMax )Then '優先度が、初期値よりも一度も下がらなかったら、-1を返却。 GetLowestPriorityOperatorPos = -1 Else GetLowestPriorityOperatorPos = nPosTemp End If End Function '式中の最も外側の括弧対を取り除く Sub RemoveExpressionBracket( pszExp As BytePtr ) Dim nLen As Long Dim nBracketDepth As Long Dim nPos As Long If( pszExp=NULL )Then Exit Sub End If nLen = lstrlen( pszExp ) '括弧対が存在しない場合 If( pszExp[0]<>40 or pszExp[nLen-1]<>41 )Then '=[(],[)] Exit Sub End If '最も外側に対応する括弧が存在するかを確認する nBracketDepth = 1 nPos = 1 While( pszExp[nPos+1]<>NULL ) nBracketDepth += 1 and (pszExp[nPos]=40) '=[(] nBracketDepth -= 1 and (pszExp[nPos]=41) '=[)] '一番外側の括弧が閉じられたら If( nBracketDepth=0 )Then Exit Sub End If nPos++ Wend '最も外側の括弧対を削除する nPos = 0 While( pszExp[nPos+2]<>NULL ) pszExp[ nPos ] = pszExp[ nPos+1 ] nPos++ Wend pszExp[ nPos ] = NULL '多重括弧対が存在するか確認 RemoveExpressionBracket( pszExp ) End Sub '式中のスペースを削除 Sub RemoveExpressionSpace( pszExp As BytePtr ) Dim pIn As BytePtr Dim pOut As BytePtr If( pszExp=NULL )Then Exit Sub End If pIn = pszExp pOut = pIn While( pIn[0]<>NULL ) pIn += 1 and (pIn[0]=32) '32=[ ] pOut[0] = pIn[0] pIn++ pOut++ Wend pOut[0] = NULL End Sub '木構造をトラバースする。 '後行順序訪問を行うことで逆ポーランド記法での表記を、キューへ出力。 Sub TraverseTree( pstNode As *StrCalcNode, pobjQueue As *StrQueue ) If( pstNode=NULL )Then Exit Sub End If TraverseTree( pstNode->pLeft, pobjQueue ) '※先に左からトラバースするのがポイント。 TraverseTree( pstNode->pRight, pobjQueue ) If( pstNode->pzFunc<>NULL )Then '「演算子(一文字と規定)+関数」の形式で出力 pobjQueue->Push( MakeStr( pstNode->pzExpression ) + MakeStr( pstNode->pzFunc ) ) Else pobjQueue->Push( pstNode->pzExpression ) End If End Sub Public '保持している逆ポーランド記法を、キューに格納する形で出力する。 Function TraverseTreeToQueue( pobjQueue As *StrQueue ) As Char If( pstRoot=NULL )Then TraverseTreeToQueue = FALSE Else TraverseTree( pstRoot, pobjQueue ) TraverseTreeToQueue = TRUE End If End Function End Class # ちゃんと「5,7,+,4,2,-,*,15,6,*,3,1,+,/,- 」の順になります。 【具体的な使用例】 カッコを含む実数の四則算を行う。関数は今回は考慮しない。 [ここをクリックすると内容が表示されます]
関数まで考慮した計算例は後日に余力がありましたら、また。。。コード: #N88BASIC Dim obj As StringCalc_ReversePolishNotation Dim objQ As StrQueue Dim strIn As String Dim xOut As Double strIn = "10.3+50-5*2/(10-2)" '計算すべき数式 obj.SetNumericalFormula( strIn ) obj.TraverseTreeToQueue( VarPtr(objQ) ) Calc_ReversePolish( VarPtr(objQ), xOut ) Print xOut '計算結果の出力 '終了を待機 Input strIn End '逆ポーランド法の項が、先頭から順に格納されたキューオブジェクトを計算する。 '成功すると、TRUEが返却され、計算値がxResultに格納される。失敗時はFALSEが返却される。 '※関数については考慮してないので、必要に応じて拡張のこと。 Function Calc_ReversePolish( pobjQueue As *StrQueue, ByRef xResult As Double ) As Char Dim strBuf As String Dim pMark As BytePtr Dim objStk As StrStack Dim strR As String Dim strL As String Dim xRlt As Double While( pobjQueue->GetItemCount()>0 ) strBuf = pobjQueue->GetOld() If( 0<InStr( 1, strBuf, "(" ) or 0<InStr( 1, strBuf, ")" ) )Then 'エラー:あるはずの無い括弧が含まれていた。=未定義の関数が使われている。 Calc_ReversePolish = FALSE Exit Function End If pobjQueue->Pop() pMark = StrPtr( strBuf ) Select Case pMark[0] Case 43 '=[+] strR = objStk.GetLast() objStk.Pop() strL = objStk.GetLast() objStk.Pop() xRlt = Val( strL ) + Val( strR ) strBuf = Str$( xRlt ) Case 45 '=[-] strR = objStk.GetLast() objStk.Pop() strL = objStk.GetLast() objStk.Pop() xRlt = Val( strL ) - Val( strR ) strBuf = Str$( xRlt ) Case 42 '=[*] strR = objStk.GetLast() objStk.Pop() strL = objStk.GetLast() objStk.Pop() xRlt = Val( strL ) * Val( strR ) strBuf = Str$( xRlt ) Case 47 '=[/] strR = objStk.GetLast() objStk.Pop() strL = objStk.GetLast() objStk.Pop() xRlt = Val( strL ) / Val( strR ) strBuf = Str$( xRlt ) Case 94 '=[^] strR = objStk.GetLast() objStk.Pop() strL = objStk.GetLast() objStk.Pop() xRlt = Val( strL )^Val( strR ) strBuf = Str$( xRlt ) End Select objStk.Push( strBuf ) Wend '計算成功 xResult = Val( objStk.GetLast() ) Calc_ReversePolish = TRUE End Function (関数を考慮して逆ポーランドへ変換は出来るが、その先の計算部分が未対応) →2009.1.18 関数に対応したコード(Calc_ReversePolishのみ修正)をコチラのスレッドに記載しました。 |
ページ 1 / 1 | 全ての表示時間は UTC+09:00 です |
Powered by phpBB® Forum Software © phpBB Limited https://www.phpbb.com/ |