Code archives/Algorithms/Shunting yard algorithm
This code has been declared by its author to be Public Domain code.
Download source code
| |||||
| viz. http://en.wikipedia.org/wiki/Shunting-yard_algorithm If you ever want to convert standard infix maths notation to postfix notation, like RPN. Also supports functions, because that was in the wikipedia description of the algorithm! | |||||
Type shuntingyard
Field in$
Field out$
Field ops$[][]
Field token$[]
Method parse$()
While in
nexttoken()
Select token[0]
Case "number"
output
Case "function"
push
Case ","
While ops[0][0]<>"("
pop
If token[0]<>"(" output
Wend
Case "("
push
Case ")"
While pop()<>"("
output
Wend
If ops[0][0]="function"
pop
output
EndIf
Default
If token[0][..2]="op"
Local otoken$[]=token
op=Int(token[0][2..])
While Len(ops) And ops[0][0][..2]="op" And Int(ops[0][0][2..])<op
pop
output
Wend
token=otoken
push
EndIf
End Select
Wend
While Len(ops)
pop
output
Wend
Return out
End Method
Method nexttoken()
Select Chr(in[0])
Case "0","1","2","3","4","5","6","7","8","9","0"
n=0
While n<Len(in) And in[n]>47 And in[n]<58
n:+1
Wend
token=["number",in[..n]]
in=in[n..]
Case "*","/"
token=["op1",in[..1]]
in=in[1..]
Case "+","-"
token=["op2",in[..1]]
in=in[1..]
Case "("
token=["(","("]
in=in[1..]
Case ")"
token=[")",")"]
in=in[1..]
Case ","
token=[",",","]
in=in[1..]
Default
n=0
While in[n]<>Asc("(")
n:+1
Wend
token=["function",in[..n]]
in=in[n..]
End Select
End Method
Method pop$()
token=ops[0]
ops=ops[1..]
Return token[0]
End Method
Method push()
ops=[token]+ops
End Method
Method output()
out:+token[1]+" "
End Method
End Type
Function shunt$(in$)
s:shuntingyard=New shuntingyard
s.in=in
Return s.parse()
End Function
While 1
Print shunt(Input())
Wend |
Comments
| ||
| Bah, I thought it was about trains when I read the title. |
| ||
| Where are the trains? |
| ||
| Thanks! Ive been looking for an algorithm like this for a small project of mine but I coulnt find it. |
| ||
| Warpy, you just solved time travel! |
| ||
Rewritten to separate out tokenising/shunting yard/evaluation steps:
Function tokenise$[][](in$)
Local tokens$[][]
i=0
While i<Len(in)
c=in[i]
Select c
Case 48,49,50,51,52,53,54,55,56,57 ' 0 - 9
s=i
i:+1
While i<Len(in) And in[i]>47 And in[i]<58
i:+1
Wend
If i<Len(in) And in[i]=46
i:+1
While i<Len(in) And in[i]>47 And in[i]<58
i:+1
Wend
n:Double=Float(in[s..i])
tokens:+[["number",String(n)]]
Else
tokens:+[["number",in[s..i]]]
EndIf
Case 42,43,45,47,94 ' * + - / ^
tokens:+[["op",Chr(c)]]
i:+1
Case 40 ' (
tokens:+[["(","("]]
i:+1
Case 41 ' )
tokens:+[[")",")"]]
i:+1
Case 44 ' ,
tokens:+[[",",","]]
i:+1
Case 32 ' space
i:+1
Default ' might be a name or an invalid character
If (c>64 And c<91) Or (c>96 And c<123)
s=i
While i<Len(in) And ((in[i]>64 And in[i]<91) Or (in[i]>96 And in[i]<123) Or (in[i]>47 And in[i]<58))
i:+1
Wend
name$=in[s..i]
tokens:+[["name",name]]
Else
Print "whoops "+Chr(c)
EndIf
End Select
Wend
' For i=0 To Len(tokens)-1
' Print tokens[i][0]+"~t~t"+tokens[i][1]
' Next
Return tokens
End Function
Function precedence(op$)
Select op
Case "^"
Return 1
Case "*","/"
Return 2
Case "+","-"
Return 3
End Select
End Function
Function shunt$[][](tokens$[][])
Local output$[][]
Local stack$[][]
Local t$[]
i=0
While i<Len(tokens)
t=tokens[i]
Select t[0]
Case "number"
output=[t]+output
Case "name"
If i<Len(tokens)-1 And tokens[i+1][0]="("
stack=[t]+stack
Else
output=[t]+output
EndIf
Case ","
li=0
While li<Len(stack) And stack[li][0]<>"("
output=[stack[li]]+output
li:+1
Wend
If li=Len(stack)
Print "whoops no ( matching comma "+String(i)
Else
stack=stack[li..]
EndIf
Case "op"
o1=precedence(t[1])
Print o1
While Len(stack) And stack[0][0]="op" And o1>=precedence(stack[0][1])
output=[stack[0]]+output
stack=stack[1..]
Wend
stack=[t]+stack
Case "("
stack=[t]+stack
Case ")"
li=0
While li<Len(stack) And stack[li][0]<>"("
output=[stack[li]]+output
li:+1
Wend
If li=Len(stack)
Print "whoops no ( matching ) "+String(i)
Else
stack=stack[li+1..]
If Len(stack)>0 And stack[0][0]="name"
output=[stack[0]]+output
stack=stack[1..]
EndIf
EndIf
End Select
i:+1
Wend
For i=0 To Len(stack)-1
If stack[i][0]="(" Or stack[i][0]=")"
Print "whoops mismatched parenthesis on stack"
Else
output=[stack[i]]+output
EndIf
Next
For i=0 To Len(output)/2-1
t=output[i]
output[i]=output[Len(output)-i-1]
output[Len(output)-i-1]=t
Next
' For i=0 To Len(output)-1
' Print output[i][0]+"~t~t"+output[i][1]
' Next
Return output
End Function
Function eval:Double(expr$[][],varnames$[],varvalues:Double[])
If Len(varnames)<>Len(varvalues)
Print "whoops not the same number of varnames as varvalues"
EndIf
Local stack:Double[]
Local t$[]
Local r:Double
For i=0 To Len(expr)-1
t=expr[i]
Select t[0]
Case "number"
stack=[Double(t[1])]+stack
Case "op"
If Len(stack)<2
Print "whoops need two things on stack to do op"
Return
EndIf
b:Double=stack[0]
a:Double=stack[1]
Select t[1]
Case "^"
r=a^b
Case "*"
r=a*b
Case "/"
r=a/b
Case "+"
r=a+b
Case "-"
r=a-b
End Select
stack=[r]+stack[2..]
Case "name"
Select t[1]
Case "ln"
a:Double=stack[0]
stack=stack[1..]
r=Log(a)
Case "sin"
a:Double=stack[0]
stack=stack[1..]
r=Sin(a)
Case "cos"
a:Double=stack[0]
stack=stack[1..]
r=Cos(a)
Case "e"
r=Exp(1)
Case "pi"
r=Pi
Case "f" 'function definition!
a:Double=stack[0]
stack=stack[1..]
r=eval(shunt(tokenise("superduper^2+1")),varnames+["superduper"],varvalues+[a])
Default
For j=0 To Len(varnames)-1
If varnames[j]=t[1]
r=varvalues[j]
Exit
EndIf
Next
End Select
stack=[r]+stack
End Select
Next
If Len(stack)<>1
Print "whoops "+String(Len(stack))+" things on stack"
Else
Return stack[0]
EndIf
End Function
Local tokens$[][]
Local stack$[][]
While 1
tokens=tokenise(Input())
Print "------------------------------"
stack=shunt(tokens)
Local varnames$[0]
Local varvalues:Double[0]
For i=0 To Len(stack)-1
If stack[i][0]="name"
Select stack[i][1]
Case "ln","cos","sin","e","pi"
Default
varnames:+[stack[i][1]]
varvalues:+[Rnd(1,2)]
Print stack[i][1]+"~t~t"+String(varvalues[Len(varvalues)-1])
End Select
EndIf
Next
Print eval(stack,varnames,varvalues)
Wend
|
| ||
| This is excellent. But something like "1 * -10" or "-1 * 10" doesn't work :(( - I get the message: "whoops need two things on stack to do op" But I have no idea how to solve this. Any ideas? D. |
| ||
Here you go.
Function tokenise$[][](in$)
Local tokens$[][]
i=0
While i<Len(in)
c=in[i]
Select c
Case 48,49,50,51,52,53,54,55,56,57 ' 0 - 9
s=i
i:+1
While i<Len(in) And in[i]>47 And in[i]<58
i:+1
Wend
If i<Len(in) And in[i]=46
i:+1
While i<Len(in) And in[i]>47 And in[i]<58
i:+1
Wend
n:Double=Float(in[s..i])
tokens:+[["number",String(n)]]
Else
tokens:+[["number",in[s..i]]]
EndIf
Case 42,43,45,47,94 ' * + - / ^
tokens:+[["op",Chr(c)]]
i:+1
Case 40 ' (
tokens:+[["(","("]]
i:+1
Case 41 ' )
tokens:+[[")",")"]]
i:+1
Case 44 ' ,
tokens:+[[",",","]]
i:+1
Case 32 ' space
i:+1
Default ' might be a name or an invalid character
If (c>64 And c<91) Or (c>96 And c<123)
s=i
While i<Len(in) And ((in[i]>64 And in[i]<91) Or (in[i]>96 And in[i]<123) Or (in[i]>47 And in[i]<58))
i:+1
Wend
name$=in[s..i]
tokens:+[["name",name]]
Else
Print "whoops "+Chr(c)
EndIf
End Select
Wend
' For i=0 To Len(tokens)-1
' Print tokens[i][0]+"~t~t"+tokens[i][1]
' Next
Return tokens
End Function
Function precedence(op$)
Select op
Case "^"
Return 1
Case "*","/"
Return 2
Case "+","-"
Return 3
End Select
End Function
Function arity(op$)
Select op
Case "-u","+u"
Return 1
Default
Return 2
End Select
End Function
Function shunt$[][](tokens$[][])
Local output$[][]
Local stack$[][]
Local t$[]
i=0
While i<Len(tokens)
t=tokens[i]
Select t[0]
Case "number"
output=[t]+output
Case "name"
If i<Len(tokens)-1 And tokens[i+1][0]="("
stack=[t]+stack
Else
output=[t]+output
EndIf
Case ","
li=0
While li<Len(stack) And stack[li][0]<>"("
output=[stack[li]]+output
li:+1
Wend
If li=Len(stack)
Print "whoops no ( matching comma "+String(i)
Else
stack=stack[li..]
EndIf
Case "op"
o1=precedence(t[1])
Print o1
If i=0 Or tokens[i-1][0]="(" Or tokens[i-1][0]=","
t[1]:+"u"
EndIf
While Len(stack) And stack[0][0]="op" And o1>=precedence(stack[0][1])
output=[stack[0]]+output
stack=stack[1..]
Wend
stack=[t]+stack
Case "("
stack=[t]+stack
Case ")"
li=0
While li<Len(stack) And stack[li][0]<>"("
output=[stack[li]]+output
li:+1
Wend
If li=Len(stack)
Print "whoops no ( matching ) "+String(i)
Else
stack=stack[li+1..]
If Len(stack)>0 And stack[0][0]="name"
output=[stack[0]]+output
stack=stack[1..]
EndIf
EndIf
End Select
i:+1
Wend
For i=0 To Len(stack)-1
If stack[i][0]="(" Or stack[i][0]=")"
Print "whoops mismatched parenthesis on stack"
Else
output=[stack[i]]+output
EndIf
Next
For i=0 To Len(output)/2-1
t=output[i]
output[i]=output[Len(output)-i-1]
output[Len(output)-i-1]=t
Next
' For i=0 To Len(output)-1
' Print output[i][0]+"~t~t"+output[i][1]
' Next
Return output
End Function
Function eval:Double(expr$[][],varnames$[],varvalues:Double[])
If Len(varnames)<>Len(varvalues)
Print "whoops not the same number of varnames as varvalues"
EndIf
Local stack:Double[]
Local t$[]
Local r:Double
For i=0 To Len(expr)-1
t=expr[i]
Select t[0]
Case "number"
stack=[Double(t[1])]+stack
Case "op"
ar = arity(t[1])
Print "op: "+t[1]+" ar: "+ar
If Len(stack)<ar
Print "whoops need "+ar+" things on stack to do op, got "+Len(stack)
Return
EndIf
Select t[1]
Case "^"
r=stack[1]^stack[0]
Case "*"
r=stack[1]*stack[0]
Case "/"
r=stack[1]/stack[0]
Case "+"
r=stack[1]+stack[0]
Case "-"
r=stack[1]-stack[0]
Case "+u"
r=stack[0]
Case "-u"
r=-stack[0]
End Select
stack=[r]+stack[ar..]
Case "name"
Select t[1]
Case "ln"
a:Double=stack[0]
stack=stack[1..]
r=Log(a)
Case "sin"
a:Double=stack[0]
stack=stack[1..]
r=Sin(a)
Case "cos"
a:Double=stack[0]
stack=stack[1..]
r=Cos(a)
Case "e"
r=Exp(1)
Case "pi"
r=Pi
Case "f" 'function definition!
a:Double=stack[0]
stack=stack[1..]
r=eval(shunt(tokenise("superduper^2+1")),varnames+["superduper"],varvalues+[a])
Default
For j=0 To Len(varnames)-1
If varnames[j]=t[1]
r=varvalues[j]
Exit
EndIf
Next
End Select
stack=[r]+stack
End Select
Next
If Len(stack)<>1
Print "whoops "+String(Len(stack))+" things on stack"
Else
Return stack[0]
EndIf
End Function
Local tokens$[][]
Local stack$[][]
While 1
tokens=tokenise(Input())
Print "------------------------------"
stack=shunt(tokens)
Local varnames$[0]
Local varvalues:Double[0]
For i=0 To Len(stack)-1
If stack[i][0]="name"
Select stack[i][1]
Case "ln","cos","sin","e","pi"
Default
varnames:+[stack[i][1]]
varvalues:+[Rnd(1,2)]
Print stack[i][1]+"~t~t"+String(varvalues[Len(varvalues)-1])
End Select
EndIf
Next
Print eval(stack,varnames,varvalues)
Wend
|
Code Archives Forum
   |