作成者 |
メッセージ |
|
|
お世話になっております。
クラス化してみました。
変数&実数&関数対応しています。
※関数は、関数認識テーブルにセットしたものだけが有効です。
逆ポーランド記法の取出しには、 こちらのキューを使っています。
クラス定義はこちら [ここをクリックすると内容が表示されます] [ここをクリックすると非表示にします]コード: /*
二分木法を用いて、通常の計算式を逆ポーランド記法に変換するクラス。
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のみ修正)を コチラのスレッドに記載しました。
お世話になっております。
クラス化してみました。 変数&実数&関数対応しています。 ※関数は、関数認識テーブルにセットしたものだけが有効です。
逆ポーランド記法の取出しには、[url=http://www.activebasic.com/forum/viewtopic.php?t=49]こちら[/url]のキューを使っています。 [hide=クラス定義はこちら][code]/* 二分木法を用いて、通常の計算式を逆ポーランド記法に変換するクラス。
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/ikimasshoy/cpp/polish.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[/code][/hide] # ちなみに、「((5+7)*(4-2))-15*6/(3+1)」で試してみると、 # ちゃんと「5,7,+,4,2,-,*,15,6,*,3,1,+,/,- 」の順になります。
【具体的な使用例】 カッコを含む実数の四則算を行う。関数は今回は考慮しない。 [hide][code]#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[/code][/hide]
関数まで考慮した計算例は後日に余力がありましたら、また。。。 (関数を考慮して逆ポーランドへ変換は出来るが、その先の計算部分が未対応)
→2009.1.18 関数に対応したコード(Calc_ReversePolishのみ修正)を[url=http://www.activebasic.com/forum/viewtopic.php?p=10432#10432]コチラのスレッド[/url]に記載しました。
|
|
|
投稿記事 |
Posted: 2007年10月14日(日) 02:10 |
|
|
|
|
|
((5+7)*(4-2))-15*6/(3+1)
を
入力すると
5,7,+,4,2,-,*-15,6,3,1,+,/,*
が、返ってきました。
5,7,+,4,2,-,*,15,6,*,3,1,+,/,-
となって欲しいのです。
((5+7)*(4-2))-15*6/(3+1) を 入力すると 5,7,+,4,2,-,*-15,6,3,1,+,/,* が、返ってきました。
5,7,+,4,2,-,*,15,6,*,3,1,+,/,-
となって欲しいのです。
|
|
|
投稿記事 |
Posted: 2007年4月21日(土) 15:39 |
|
|
|
|
|
実例としては、計算式「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
自分の方言(プログラムの書き方)の関係で、注釈文が少ない(むしろ書いていない)ので、スパゲッティプログラム化しています。
そのうち、注釈文を追加して、虫退治も行ったプログラムを公開します・・・・。
実例としては、計算式「1+2*3+4*(5-6)」を入れると、 逆ポーランド記法に変換した計算式「1,2,3,*,+,4,5,6,-,*,+」が戻ってきます。 また、計算式「(-1)*sin(2)」の場合は、計算式「-1,2,sin,*」が帰ってきます。
[hide] [code] '[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 [/code] [/hide]
自分の方言(プログラムの書き方)の関係で、注釈文が少ない(むしろ書いていない)ので、スパゲッティプログラム化しています。 そのうち、注釈文を追加して、虫退治も行ったプログラムを公開します・・・・。
|
|
|
投稿記事 |
Posted: 2006年7月01日(土) 09:09 |
|
|
|
|