Home | Reviews | GUIpedia | Forum | Fun500

DickAlgebric expression parser
uses shunting yard algorithm, very simple only works with integers but easily modifyble for more. support parantheses () and * / + - ^ operators.


DEFINT A-Z DECLARE SUB push (s AS STRING) DECLARE FUNCTION pop$ () DIM SHARED stack(1000) AS STRING DIM SHARED length DEFINT A-Z s$ = "100 + (50+50) + (50*2) + 2^2^2" o$ = "" FOR i = 1 TO LEN(s$) c$ = MID$(s$, i, 1) IF ASC(c$) >= 48 AND ASC(c$) <= 57 THEN o$ = o$ + c$ ELSE SELECT CASE c$ CASE "+", "-" o$ = o$ + " " o2$ = stack(length) IF o2$ = "^" OR o2$ = "*" OR o2$ = "/" OR o2$ = "+" OR o2$ = "-" THEN o$ = o$ + pop$ END IF push c$ CASE "*", "/" o$ = o$ + " " o2$ = stack(length) IF o2$ = "^" OR o2$ = "*" OR o2$ = "/" THEN o$ = o$ + pop$ END IF push c$ CASE "^" o$ = o$ + " " push c$ 'brackets CASE "(" push c$ CASE ")" DO k$ = pop$ IF k$ = "(" THEN EXIT DO o$ = o$ + k$ LOOP END SELECT END IF NEXT FOR i = 1 TO length o$ = o$ + pop$ NEXT PRINT "RPN: "; o$ 'calculate RPN num$ = "" c$ = "" FOR i = 1 TO LEN(o$) c$ = MID$(o$, i, 1) IF ASC(c$) >= 48 AND ASC(c$) <= 57 THEN num$ = num$ + c$ ELSE IF num$ <> "" THEN push num$ num$ = "" SELECT CASE c$ CASE "+" push STR$(VAL(pop$) + VAL(pop$)) CASE "*" push STR$(VAL(pop$) * VAL(pop$)) CASE "-" k$ = pop$ push STR$(VAL(pop$) - VAL(k$)) CASE "/" k$ = pop$ push STR$(VAL(pop$) \ VAL(k$)) CASE "^" push STR$(VAL(pop$) ^ VAL(pop$)) END SELECT END IF NEXT PRINT s$ + "=" + pop$ SYSTEM FUNCTION pop$ length = length - 1 pop$ = stack(length + 1) END FUNCTION SUB push (s AS STRING) length = length + 1 stack(length) = s END SUB 		2012-04-084:06 AM
JasonRe:Algebric expression parser
instead of IF o2$ = "^" OR o2$ = "*" OR o2$ = "/" THEN you can use IF instr$("^*/", o2$) THEN		2012-04-089:22 AM
DickRe:Algebric expression parser
update, for freebasic, support sin,cos,tan,ln,unary minus,decimals, etc #lang "fblite" declare sub push(item as string) declare function pop() as string declare function makerpn(expression as string) as string declare function evalrpn(rpn as string, a as double, x as double) as string dim shared as string stack(1000) dim shared as integer stackindex = 0 dim in as string dim a as double cls do line input in in = rtrim(ltrim(in)) if in = "clear" then cls elseif left(in, 1) = "=" then a = val( evalrpn( makerpn(right(in, len(in)-1)), a, 0) ) ? "=";a end if loop until rtrim(in) = "quit" end sub push(item as string) stackindex += 1 stack(stackindex) = item end sub function pop() as string stackindex -= 1 pop = stack(stackindex+1) end function function makerpn(expression as string) as string dim as string rpn = "" dim as integer last = -1 dim as string temp dim c as byte dim o as byte ptr o = sadd(expression) for i = 0 to len(expression)-1 c = *(o+i) select case c case 97, 120, 46, 48 to 57 'a, x, . and 0 to 9 rpn += chr(c) last = 0 case 43, 45 '+, - rpn += " " if last then if c = 45 then push "_" else if stack(stackindex) = "_" or stack(stackindex) = "^" or _ stack(stackindex) = "+" or stack(stackindex) = "-" or _ stack(stackindex) = "*" or stack(stackindex) = "/" or _ stack(stackindex) = "s" or stack(stackindex) = "c" or _ stack(stackindex) = "t" or stack(stackindex) = "l" then rpn += pop() end if push chr(c) last = -1 end if case 42, 47 '*, / rpn += " " if stack(stackindex) = "_" or stack(stackindex) = "^" or _ stack(stackindex) = "*" or stack(stackindex) = "/" or _ stack(stackindex) = "s" or stack(stackindex) = "c" or _ stack(stackindex) = "t" or stack(stackindex) = "l" then rpn += pop() end if push chr(c) last = -1 case 94 '^ rpn += " " if stack(stackindex) = "_" or _ stack(stackindex) = "s" or stack(stackindex) = "c" or _ stack(stackindex) = "t" or stack(stackindex) = "l" then rpn += pop() end if push chr(c) last = -1 case 115 's o += 2 rpn += " " push chr(c) case 99 'c o += 2 rpn += " " push chr(c) case 116 't o += 2 rpn += " " push chr(c) case 108 'l o += 1 rpn += " " push chr(c) case 40 '( push "(" case 41 ') do while stackindex > 0 temp = pop() if temp = "(" then exit do rpn += temp loop end select next for i = 1 to stackindex rpn += pop() next makerpn = rpn end function function evalrpn(rpn as string, a as double, x as double) as string rpn += " " dim as string first dim as string num dim c as byte dim o as byte ptr o = sadd(rpn) for i = 0 to len(rpn)-1 c = *(o+i) select case c case 46, 48 to 57 '. and 0 to 9 num += chr(c) case else if num "" then push num num = "" end if select case c case 97 push str(a) case 120 push str(x) case 95 '_ push str( - val(pop()) ) case 43 '+ push str( val(pop()) + val(pop()) ) case 45 '- first = pop() push str( val(pop()) - val(first) ) case 42 '* push str( val(pop()) * val(pop()) ) case 47 '/ first = pop() push str( val(pop()) / val(first) ) case 94 '^ first = pop() push str( val(pop()) ^ val(first) ) case 115 's push str( sin(val(pop())) ) case 99 'c push str( cos(val(pop())) ) case 116 't push str( tan(val(pop())) ) case 108 'l push str( log(val(pop())) ) end select end select next evalrpn = pop() end function 		2012-08-127:06 PM

Code

2021 Brandon Cornell