07-14-2017, 08:09 AM

As i say on BPlus topic...sorry mark again i continue here

and as i said above PCP method require some sort of stack or table or list

as Ed explain ,and Ed thanks for that

and as i said above PCP method require some sort of stack or table or list

as Ed explain ,and Ed thanks for that

Code:

`' Simple expression evaluator utilizing precedence climbing.`

' Ed Davis - works with FreeBasic.

' test cases:

' 2*-3--4+-0.25 : returns -2.25

' 1 + 2 * (3 + (4 * 5 + 6 * 7 * 8) - 9) / 10 : returns 71

'screen setup

Const XMAX = 1200

Const YMAX = 720

ScreenRes XMAX, YMAX

Width XMAX\8, YMAX\16 ' Use 8*16 font

common shared as string eval_error, tok, input_str

const right_assoc=0, left_assoc=1

declare function associativity(op as string) as integer

declare function binary_prec(op as string) as integer

declare function evaluate(e as string) as double

declare function expr(p as integer) as double

declare function is_binary_operator(op as string) as integer

declare function is_digit(ch as string) as integer

declare function is_unary_operator(op as string) as boolean

declare function primary() as double

declare function unary_prec(op as string) as integer

declare sub next_tok

dim as string e 'the string to evaluate

dim as double r 'the number returned if eval successful

? "I am a simple EVALuator, I do operations in the same order as FreeBASIC:"

? "- (Negate), then: * / + -, in that order - see"

? "http://www.freebasic.net/wiki/wikka.php?wakka=OpPrecedence for reference."

? "You can also use parenthesis."

?

while 1

input "Enter a string to evaluate - spaces do not matter > "; e

if e = "" then end

r = evaluate(e)

if eval_error <> "" then print "Error: "; eval_error else print "Expression = "; r

?

wend

function evaluate(e as string) as double

input_str = e

next_tok()

return expr(0)

end function

'------ Parser routines ------------------------------------------------

' process binary operators

function expr(p as integer) as double

dim n as double

n = primary()

while is_binary_operator(tok) and binary_prec(tok) >= p

dim op as string

dim q as integer

dim n2 as double

op = tok

next_tok()

select case associativity(op)

case right_assoc : q = binary_prec(op)

case left_assoc : q = 1 + binary_prec(op)

end select

n2 = expr(q)

select case op

case "*": n = n * n2

case "/": if n2 = 0 then eval_error = "divide by 0" else n = n / n2

case "+": n = n + n2

case "-": n = n - n2

end select

wend

return n

end function

' process unary operators and operands

function primary() as double

dim op as string

dim n as double

if is_unary_operator(tok) then

op = tok

next_tok()

select case op

case "-" : n = -expr(unary_prec(op))

case "+" : n = expr(unary_prec(op))

end select

elseif tok = "(" then

next_tok()

n = expr(0)

if tok <> ")" then

print "expecting ')'"

else

next_tok()

end if

elseif is_digit(left(tok, 1)) then

n = val(tok)

next_tok()

else

eval_error = "syntax error: expecting a primary, but found: " & tok

n = 0

end if

return n

end function

'------ Expression helper routines -------------------------------------

function is_unary_operator(op as string) as boolean

return op = "+" or op = "-"

end function

' should be boolean, but compiler generates a "Type mismatch in..." if so.

function is_binary_operator(op as string) as integer

return instr("+-*/", op) > 0

end function

' as per: http://www.freebasic.net/wiki/wikka.php?wakka=OpPrecedence

function unary_prec(op as string) as integer

if op = "+" or op = "-" then return 50 else return 0

end function

' as per: http://www.freebasic.net/wiki/wikka.php?wakka=OpPrecedence

function binary_prec(op as string) as integer

select case op

case "*": return 40

case "/": return 40

case "+": return 30

case "-": return 30

case else: return 0

end select

end function

' as per: http://www.freebasic.net/wiki/wikka.php?wakka=OpPrecedence

function associativity(op as string) as integer

return left_assoc

end function

'------ Scanner --------------------------------------------------------

' find the next operator or operand in input_str, remove it, and store in tok

sub next_tok

tok = ""

input_str = trim(input_str)

while is_digit(left(input_str, 1)) or left(input_str, 1) = "."

tok = tok + left(input_str, 1)

input_str = mid(input_str, 2)

wend

if tok = "" then

if instr("()+-*/", left(input_str, 1)) > 0 then

tok = left(input_str, 1)

input_str = mid(input_str, 2)

elseif input_str <> "" then

eval_error = "unrecognized character: " & left(input_str, 1)

endif

endif

end sub

'------ General utility routines ---------------------------------------

function is_digit(ch as string) as integer

return ch >= "0" and ch <= "9"

end function

/////////// RECURSIVE DESCENT //////////////////////////////////////////////

' Simple expression evaluator utilizing recursive descent.

' Ed Davis - works with FreeBasic.

' test cases:

' 2*-3--4+-0.25 : returns -2.25

' 1 + 2 * (3 + (4 * 5 + 6 * 7 * 8) - 9) / 10 : returns 71

'screen setup

Const XMAX = 1200

Const YMAX = 720

ScreenRes XMAX, YMAX

Width XMAX\8, YMAX\16 ' Use 8*16 font

common shared as string eval_error, tok, input_str

const right_assoc=0, left_assoc=1

declare function evaluate(e as string) as double

declare function expr as double

declare function term as double

declare function factor as double

declare function is_digit(ch as string) as integer

declare sub next_tok

dim as string e 'the string to evaluate

dim as double r 'the number returned if eval successful

? "I am a simple EVALuator, I do operations in the same order as FreeBASIC:"

? "- (Negate), then: * / + -, in that order - see"

? "http://www.freebasic.net/wiki/wikka.php?wakka=OpPrecedence for reference."

? "You can also use parenthesis."

?

while 1

input "Enter a string to evaluate - spaces do not matter > "; e

if e = "" then end

r = evaluate(e)

if eval_error <> "" then print "Error: "; eval_error else print "Expression = "; r

?

wend

function evaluate(e as string) as double

input_str = e

next_tok()

return expr()

end function

'------ Parser routines ------------------------------------------------

function expr as double

dim n as double

n = term()

while tok = "+" or tok = "-"

dim op as string

dim n2 as double

op = tok

next_tok()

n2 = term()

select case op

case "+": n = n + n2

case "-": n = n - n2

end select

wend

return n

end function

function term as double

dim n as double

n = factor()

while tok = "*" or tok = "/"

dim op as string

dim n2 as double

op = tok

next_tok()

n2 = factor()

select case op

case "*": n = n * n2

case "/": if n2 = 0 then eval_error = "divide by 0" else n = n / n2

end select

wend

return n

end function

' process unary operators and operands

function factor() as double

dim op as string

dim n as double

if tok = "+" or tok = "-" then

op = tok

next_tok()

select case op

case "-" : n = -factor()

case "+" : n = factor()

end select

elseif tok = "(" then

next_tok()

n = expr()

if tok <> ")" then

print "expecting ')'"

else

next_tok()

end if

elseif is_digit(left(tok, 1)) then

n = val(tok)

next_tok()

else

eval_error = "syntax error: expecting a primary, but found: " & tok

n = 0

end if

return n

end function

'------ Scanner --------------------------------------------------------

' find the next operator or operand in input_str, remove it, and store in tok

sub next_tok

tok = ""

input_str = trim(input_str)

while is_digit(left(input_str, 1)) or left(input_str, 1) = "."

tok = tok + left(input_str, 1)

input_str = mid(input_str, 2)

wend

if tok = "" then

if instr("()+-*/", left(input_str, 1)) > 0 then

tok = left(input_str, 1)

input_str = mid(input_str, 2)

elseif input_str <> "" then

eval_error = "unrecognized character: " & left(input_str, 1)

endif

endif

end sub

'------ General utility routines ---------------------------------------

function is_digit(ch as string) as integer

return ch >= "0" and ch <= "9"

end function

basicPro forum:

http://basicpro.mipropia.com/smf/index.php

EU Radioboard forum:

http://euradioboard.createmybb3.com/index.php

AurelSoft main site:

http://aurelsoft.ucoz.com

http://basicpro.mipropia.com/smf/index.php

EU Radioboard forum:

http://euradioboard.createmybb3.com/index.php

AurelSoft main site:

http://aurelsoft.ucoz.com