お世話になっております。
クラス化してみました。
変数&実数&関数対応しています。
※関数は、関数認識テーブルにセットしたものだけが有効です。
逆ポーランド記法の取出しには、
こちらのキューを使っています。
クラス定義はこちら [ここをクリックすると内容が表示されます] [ここをクリックすると非表示にします]コード: 全て選択
/*
二分木法を用いて、通常の計算式を逆ポーランド記法に変換するクラス。
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)」で試してみると、
# ちゃんと「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のみ修正)を
コチラのスレッドに記載しました。