Hello,
Here is a simplified version of the Shunting Yard algorithm, used to convert a mathematical expression in infix notation to RPN (Reverse Polish Notation).
To make the code more readable, I didn't include support for variables or numbers of more than one character, and I also left out functions. I hope the idea behind the algorithm is visible though.
txt$ = "a*(b+c) - d^2*k"
print txt$
print ConvertToRPN(txt$, " ")
wait key
end
`Get the precedence of an operator
function GetPrecedence(operator$)
select operator$
case "" : exitfunction 0 : endcase
case "(" : exitfunction 0 : endcase
case ")" : exitfunction 0 : endcase
case "+" : exitfunction 1 : endcase : `Precedence of 1
case "-" : exitfunction 1 : endcase
case "*" : exitfunction 2 : endcase : `Precedence of 2
case "/" : exitfunction 2 : endcase
case "^" : exitfunction 3 : endcase : `Precedence of 3
endselect
endfunction 0 : `A default value (not used)
`1 = left associative
`2 = right associative
`0 = default (not an operator)
function GetLeftAssociative(operator$)
select operator$
case "" : exitfunction 0 : endcase
case "+" : exitfunction 1 : endcase
case "-" : exitfunction 1 : endcase
case "*" : exitfunction 1 : endcase
case "/" : exitfunction 1 : endcase
case "^" : exitfunction 2 : endcase
endselect
endfunction 0
`Some handy functions (self-explanatory)
function IsNumber(c$)
if asc(c$) <= asc("9") and asc(c$) >= asc("0") then exitfunction 1
endfunction 0
function IsCharacter(c$)
c$ = lower$(c$)
if asc(c$) <= asc("z") and asc(c$) >= asc("a") then exitfunction 1
endfunction 0
function IsOperator(c$)
if c$ = "+" or c$ = "-" then exitfunction 1
if c$ = "*" or c$ = "/" then exitfunction 1
if c$ = "^" then exitfunction 1
endfunction 0
function ConvertToRPN(e$, sep$)
ret$ = ""
`Remove all spaces from the expression
for i = 1 to len(e$)
if mid$(e$, i) = " " then e$ = left$(e$, i - 1) + right$(e$, len(e$) - i)
next i
`Create a stack
dim OpStack$(-1)
empty array OpStack$()
for i = 1 to len(e$)
`Get character
c$ = mid$(e$, i)
`If it's a number or character, directly add it to the output
if IsNumber(c$) = 1 or IsCharacter(c$) = 1 then ret$ = ret$ + c$ + sep$
`Check if it's an operator
if IsOperator(c$) = 1
`Empty the stack, depending on whether or not it's associative or not
if GetLeftAssociative(c$) = 1
`Pop from stack to output if precedence is lower or equal than the current one
if array count(OpStack$()) > -1
`s$ will contain the top of the stack if there is an item on the stack
s$ = OpStack$()
while GetPrecedence(c$) <= GetPrecedence(s$)
`Add it to the output
ret$ = ret$ + s$ + sep$
`If the stack still contains an item, then replace s$ with that item
remove from stack OpStack$()
if array count(OpStack$()) > -1 then s$ = OpStack$() else s$ = ""
endwhile
endif
else
if GetLeftAssociative(c$) = 2
`Same as left associative but "<" instead of "<="
if array count(OpStack$()) > -1
s$ = OpStack$()
while GetPrecedence(c$) < GetPrecedence(s$)
ret$ = ret$ + s$ + sep$
remove from stack OpStack$()
if array count(OpStack$()) > -1 then s$ = OpStack$() else s$ = ""
endwhile
endif
endif
endif
`Finally add the operator to the stack
add to stack OpStack$()
OpStack$() = c$
endif
`Left parenthesis: immediately add to stack
if c$ = "("
add to stack OpStack$()
OpStack$() = c$
endif
`Right parenthesis: pop from stack to output until a left parenthesis is found
if c$ = ")"
if array count(OpStack$()) > -1
s$ = OpStack$()
while s$ <> "("
ret$ = ret$ + OpStack$() + sep$
remove from stack OpStack$()
if array count(OpStack$()) > -1 then s$ = OpStack$() else s$ = "("
endwhile
endif
`Remove left parenthesis
if array count(OpStack$()) > -1 then remove from stack OpStack$()
endif
next i
`Clear the stack
while array count(OpStack$()) > -1
ret$ = ret$ + OpStack$() + sep$
remove from stack OpStack$()
endwhile
`Remove the last sep$
ret$ = left$(ret$, len(ret$) - len(sep$))
`Clear stack
undim OpStack$()
endfunction ret$
The great thing about this algorithm is that it's of the order O(n). Each character of the infix expression is only read once.
Cheers!
Sven B
