parse lisp formula function

General FreeBASIC programming questions.
Post Reply
bluatigro
Posts: 660
Joined: Apr 25, 2012 10:35
Location: netherlands

parse lisp formula function

Post by bluatigro »

this can be handy if you need a parse function
i do not know [ jet ] how to build a basic parse function

Code: Select all

'' bluatigro 6 dec 2018
'' parse lisp function

dim shared as string word( 1000 ) 
dim shared as integer wordtel
sub split( a as string )
  wordtel = 0
  while instr( a , " " ) <> 0
    word( wordtel ) = left( a , instr( a , " " ) - 1 )
    a = right( a , len( a ) - instr( a , " " ) )
    wordtel += 1
  wend
  if a <> "" then
    word( wordtel ) = a
    wordtel += 1
  end if
end sub 

function strisnumber( in as string ) as integer
  dim as integer i , bool = 1
  for i = 1 to len( in )
    if instr( ".0123456789" , mid( in , i , 1 ) ) = 0 then bool = 0
  next i
  return bool
end function

const as string letters = "XYZDEFGH"

function strisvar( in as string ) as integer
  return len( in ) = 1 and instr( letters , in )
end function
    
function parse( formula as string ) as string
  if formula = "" then return "error"
  on error goto iligal_calc
  while instr( formula , "]" )
    dim as integer einde = instr( formula , "]" )
    dim as integer begin = einde
    dim as string l , r
    while mid( formula , begin , 1 ) <> "["
      begin -= 1
    wend
    dim as string part = mid( formula , begin , einde - begin + 1 )
    split part
    dim as string sa , sb  , func
    dim as double da , db , ab
    func = word( 1 )
    sa = word( 2 )
    sb = word( 3 )
    da = val( sa )
    db = val( sb )
    select case func
      case "+"
        ab = da + db
      case "-"
        ab = da - db
      case "*"
        ab = da * db
      case "/"
        ab = da / db
      case "sqr"
        ab = sqr( da )
      case else
        return "error"
    end select
    l = left( formula , begin - 1 )
    r = right( formula , len( formula ) - einde )
    if instr( str( ab ) , "#" ) then return "error"
    formula = l + str( ab ) + r
  wend
  return formula
iligal_calc:
  return "error"
end function 
dim as string a , b , c , d , in
a = "[ + 7 [ - 2 3 ] ]" 
b = "[ * 4 [ / 6 5 ] ]"
c = "[ / 1 [ - 1 1 ] ]"
d = "[ sqr -1 0 ]"

print "[ word test ]"
dim as integer i
split a
for i = 0 to wordtel
  print i , word( i )
next i
input "[ word test end . push return . ]" ; in
print "[ parse test ]"
a = "[ + 7 [ - 2 3 ] ]" 
b = "[ * 4 [ / 6 5 ] ]"
c = "[ / 1 [ - 1 1 ] ]"
d = "[ sqr -1 0 ]"
print "formula a = " + a
print "parse a = " + parse( a )
print "formula b = " + b
print "parse b = " + parse( b )
print "formula c = " + c
print "parse c = " + parse( c )
print "formula d = " + d
print "parse d = " + parse( d )
input "[ end parse test . push return ]" ; in

bluatigro
Posts: 660
Joined: Apr 25, 2012 10:35
Location: netherlands

Re: parse lisp formula function

Post by bluatigro »

update :
i forgot the variable's

''inputvar( 1 ) = X

this is a proof of concept
can be enlarged whit what ever you come up whit

Code: Select all

 
dim shared as double inputvar( 9 )

function parse( formula as string ) as string
  if formula = "" then return "error"
  on error goto iligal_calc
  while instr( formula , "]" )
    dim as integer einde = instr( formula , "]" )
    dim as integer begin = einde
    dim as string l , r
    while mid( formula , begin , 1 ) <> "["
      begin -= 1
    wend
    dim as string part = mid( formula , begin , einde - begin + 1 )
    split part
    dim as string sa , sb  , func
    dim as double da , db , ab
    func = word( 1 )
    sa = word( 2 )
    sb = word( 3 )
    if strisnuber( sa ) then
      da = val( sa )
    else
      if strisvar( sa ) then
        da = inputvar( instr( letter , sa ) )
      else
        return "error"
      end if
    end if
    if strisnuber( sb ) then
      db = val( sb )
    else
      if strisvar( sb ) then
        db = inputvar( instr( letter , sb ) )
      else
        return "error"
      end if
    end if
    select case func
      case "+"
        ab = da + db
      case "-"
        ab = da - db
      case "*"
        ab = da * db
      case "/"
        ab = da / db
      case "sqr"
        ab = sqr( da )
      case else
        return "error"
    end select
    l = left( formula , begin - 1 )
    r = right( formula , len( formula ) - einde )
    if instr( str( ab ) , "#" ) then return "error"
    formula = l + str( ab ) + r
  wend
  return formula
iligal_calc:
  return "error"
end function 

Post Reply