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