>   

restart;
with(StringTools):

>   

Operators:={"+","-","*","/","^"}; Separators:=Operators union {",", "(", ")"}; Functions1:={"abs","sqrt","ln","exp","sin","cos","tan","ceil","trunc","floor"};
Functions2:={"min","max"}; Functions:=Functions1 union Functions2;

>   

ch:=x->(exp(x)+exp(-x))/2;
#fonction utilisateur à une variable (cosinus hyperbolique de x)  
logbase:=(a,x)->ln(x)/ln(a);  
#fonction utilisateur à 2 variables (log en base a de x)
UserFunctions1:={"ch"}; UserFunctions2:={"logbase"}; UserFunctions:=UserFunctions1 union UserFunctions2;

>   

Prec:=table(["+" = 1, "-" = 1, "*"=2, "/"=2, "^"=3]);
for k in Functions do Prec[k]:=3 od: for k in UserFunctions do Prec[k]:=3 od:

>   

Prec["+"], Prec["/"], Prec["sqrt"], Prec["logbase"];

>   

Assoc:=table(["+" = left, "-" = left, "*"=left, "/"=left, "^"=right]);

>   

Assoc["+"],Assoc["^"];

>   

RemoveChar:=proc(c::string,s::string)
local k,t:
   t:="":
   for k to length(s) do
     if s[k]<>c then t:=cat(t,s[k]) end if   
   end do;
   t
end proc:
 

>   

RemoveChar(" ","To be or not to be");

>   

GetInteger:=proc(s::string,n::nonnegint)
global indx;
local intg,n1;
if IsDigit(s[n]) then
  n1:=n; indx:=n:
  intg:=Ord(s[n1])-Ord("0");
  while s[n1+1]<>"" and IsDigit(s[n1+1]) do
    n1:=n1+1: indx:=indx+1: intg:=10*intg+Ord(s[n1])-Ord("0") end do;
    print(`GetInteger integer`=intg);
intg
else error "number expected at position " || n end if  
end proc:
 

>   

s:="abc+012345.67E-04*x": GetInteger(s,5);  

>   

GetNumber:=proc(s::string,n::nonnegint)
global indx;
local intg1,intg2,intg3,n1;
n1:=n; indx:=n:
intg1:=GetInteger(s,n1):
n1:=indx: intg2:=0: intg3:=0:
if s[n1+1]="." then
   if IsDigit(s[n1+2]) then n1:=n1+2: intg2:=GetInteger(s,n1): n1:=indx: end if
end if;
if s[n1+1]="e" or s[n1+1]="E" then
  if s[n1+2]="-" and IsDigit(s[n1+3]) then
    n1:=n1+3: intg3:=GetInteger(s,n1): intg3:=-intg3
  elif s[n1+2]="+" and IsDigit(s[n1+3]) then
    n1:=n1+3: intg3:=GetInteger(s,n1)
  else
    if IsDigit(s[n1+2]) then
       n1:=n1+2: intg3:=GetInteger(s,n1)
    end if  
  end if:
end if;
(intg1+intg2/10.^length(intg2))*10.^intg3
end proc:
 

>   

s:="abc-123.45E-02": GetNumber(s,5);

>   

GetIdentifier:=proc(s::string,n::nonnegint)
global indx;
local n1,ch;
  n1:=n; indx:=n: ch:=s[n]:
  while s[n1+1]<>"" and IsAlphaNumeric(s[n1+1]) do
     n1:=n1+1: indx:=indx+1: ch:=cat(ch,s[n1])
  end do;
ch
end proc:
 

>   

s:="125-abc1+012345.67E-04*x": GetIdentifier(s,5);

>   

GetFunction1:=proc(s::string)
global Functions1;
local i;
  if member(s,Functions1,'i') then i else 0 end if;
end proc:
 

>   

GetFunction2:=proc(s::string)
global Functions2;
local i;
  if member(s,Functions2,'i') then i else 0 end if;
end proc:
 

>   

GetUserFunction1:=proc(s::string)
global UserFunctions1;
local i;
  if member(s,UserFunctions1,'i') then i else 0 end if;
end proc:
 

>   

GetUserFunction2:=proc(s::string)
global UserFunctions2;
local i;
  if member(s,UserFunctions2,'i') then i else 0 end if;
end proc:
 

>   

PushBinaryOperator:=proc(c,t1,t2)
global st;
print(`PushBinaryOperator `,c,t1,t2);
if member(c,Operators) then
  stack[push](convert(c,name)(t1,t2),st)
else error "unknown binary operator: " || c
end if
end proc:
 

>   

PushUnaryOperator:=proc(c,t)
global st;
print(`PushUnaryOperator `,c,t);
if c="+" then stack[push](t,st)
elif c="-" then stack[push](-t,st);
else error "unknown unary operator: " || c
end if
end proc:
 

>   

PushOpd:=proc(nb)
global indx,st;
  print(`PushOpd `,nb);
  if nb="" or nb=NULL then error "missing operand at position " || indx end if;
  if type(nb,numeric) then stack[push](nb,st) else stack[push](parse(nb),st) end if
end proc:
 

>   

PushFunction1:=proc(n,t)
global st,Functions1;
local fn;
 fn:=convert(Functions1[n],name): print(`PushFunction1 `,fn,t); stack[push](fn(t),st)
end proc:
 

>   

PushFunction2:=proc(n,t1,t2)
global st,Functions2;
local fn;
  fn:=convert(Functions2[n],name): print(`PushFunction2 `,fn,t1,t2);
  stack[push](fn(t1,t2),st)
end proc:
 

>
   

PushUserFunction1:=proc(n,t)
global st,UserFunctions1;
local fn;
 fn:=convert(UserFunctions1[n],name): print(`PushUserFunction1 `,fn,t); stack[push](fn(t),st)
end proc:
 

>   

PushUserFunction2:=proc(n,t1,t2)
global st,UserFunctions2;
local fn;
  fn:=convert(UserFunctions2[n],name): print(`PushUserFunction2 `,fn,t1,t2);
  stack[push](fn(t1,t2),st)
end proc:
 

>   

Funct1:=proc(s::string, n::posint, user::truefalse)
global indx,st;
local top;
indx:=indx+1:
if s[indx]<>"(" then error "( expected at position " || indx else
  Expression(s):
  top:=stack[top](st): stack[pop](st):
  if user then PushUserFunction1(n,top) else PushFunction1(n,top) end if:
  indx:=indx+1:
  if s[indx]<>")" then error ") expected at position " || indx end if
end if:
end proc:
 

>   

Funct2:=proc(s::string, n::posint, user::truefalse)
global indx,st;
local top1,top2;
indx:=indx+1:
if s[indx]<>"(" then error "( expected at position " || indx else
  Expression(s):
  top1:=stack[top](st):
  if s[indx+1]<>"," then error ", expected at position " || indx else
    indx:=indx+1:
    Expression(s):
    top2:=stack[top](st): indx:=indx+1:
    if s[indx]<>")" then error ") expected at position " || indx end if;
    stack[pop](st): stack[pop](st):
    if user then PushUserFunction2(n,top1,top2) else PushFunction2(n,top1,top2) end if
  end if
end if
end proc:
 

>   

Fact:=proc(s::string)
global indx;
local id,f1,f2;
indx:=indx+1:
if IsAlpha(s[indx]) then
  id:=GetIdentifier(s,indx):
  f1:=GetFunction1(id):
  if f1>0 then Funct1(s,f1,false)
  else
    f2:=GetFunction2(id):
    if f2>0 then Funct2(s,f2,false) else
        f1:=GetUserFunction1(id):
        if f1>0 then Funct1(s,f1,true) else
          f2:=GetUserFunction2(id):
          if f2>0 then Funct2(s,f2,true) else PushOpd(id) end if;
        end if
    end if
  end if;
elif IsDigit(s[indx]) then
  PushOpd(GetNumber(s,indx))     
else
if s[indx]="(" then
     Expression(s):
     indx:=indx+1:  
     if s[indx]<>")" then error ") expected at position " || indx end if;
else error "missing operand or syntax error at position " || indx end if;
end if
end proc:
 

>   

SFact:=proc(s::string)
global indx,st;
local c,top1,top2;
if s[indx+1]="^" then
  indx:=indx+1: c:=s[indx]: Fact(s):
  top2:=stack[top](st): stack[pop](st):
  top1:=stack[top](st): stack[pop](st):
  PushBinaryOperator(c,top1,top2):
  SFact(s)
end if
end proc:
 

>   

Factor_:=proc(s::string)
  Fact(s): SFact(s)
end proc:

>  

Sf:=proc(s::string)
global indx,st;
local c,top1,top2;
if s[indx+1]="*" or s[indx+1]="/" then
  indx:=indx+1: c:=s[indx]: Factor_(s):
  top2:=stack[top](st): stack[pop](st):
  if c="/" and top2=0 then error "division by zero at position " || indx end if;
  top1:=stack[top](st): stack[pop](st):
  PushBinaryOperator(c,top1,top2):
  Sf(s)
end if
end proc:
 

>   

Term:=proc(s::string)
Factor_(s); Sf(s)
end proc:
 

>   

St:=proc(s::string)
global indx,st;
local c,top1,top2;
if s[indx+1]="+" or s[indx+1]="-" then
  indx:=indx+1: c:=s[indx]: Term(s):
  top2:=stack[top](st): stack[pop](st):
  top1:=stack[top](st): stack[pop](st):
  PushBinaryOperator(c,top1,top2):
  St(s)
end if
end proc:
 

>   

Expression:=proc(s::string)
global indx,st;
local c,top;
if s[indx+1]="+" or s[indx+1]="-" then
  indx:=indx+1: c:=s[indx]: Term(s):
  top:=stack[top](st): stack[pop](st):
  PushUnaryOperator(c,top):
  St(s)
else
  Term(s): St(s)
end if;
end proc:
 

>   

ExpressionAnalyzer:=proc(expr::string)
global indx,st;
local s,c,top;
indx:=0: st:=stack[new]();
s:=RemoveChar(" ",expr):
if s="" then error "nothing to parse" end if;
Expression(s);
if stack[depth](st)>1 then error "parse error in expression" end if;
stack[top](st)
end proc:
 

>  

ExpressionAnalyzer("       ");

>   

s:="  (5-2*max(ln(8)+1 , 7 / 5)) /(3+2^6  )  "; ExpressionAnalyzer(s); verif=evalf(parse(s));

>   

s:="a+b/max(ln(a^b),d)"; ExpressionAnalyzer(s);

>   

s:="-ch(4)-5*logbase(2,3)"; ExpressionAnalyzer(s);

>   

evalf(-cosh(4)-5*log[2](3)); # verification