計算式を逆ポーランド記法の計算式に変える

メッセージ

卓漏 · #1 投稿記事 by 卓漏 » 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 · #2 投稿記事 by mm » 2007年4月21日(土) 15:39

((5+7)*(4-2))-15*6/(3+1)
を
入力すると
5,7,+,4,2,-,*-15,6,3,1,+,/,*
が、返ってきました。

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)」で試してみると、
# ちゃんと「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のみ修正）をコチラのスレッドに記載しました。

ab.com コミュニティ

計算式を逆ポーランド記法の計算式に変える

計算式を逆ポーランド記法の計算式に変える

re 計算式を逆ポーランド記法の計算式に変える

クラス化して、実数＆変数＆関数対応にしてみました。