سوال: الگوریتم لهستانی

نقل قول:

نوشته شده توسط black_hole

باسلام.
من این موضوع رو توی تالارها سرچ کردم ولی جوابی پیدا نکردم برای همین دوباره سوال میکنم.
الگوریتم لهستانی چیه من میخوام اطلاعاتی در موردش داشته باشم ولی موارد پیدا شده با سرچ گوگل به زبان انگلیسی که من زیاد وارد نیستم .به فارسی هم چیزی پیدا نکردم. لطفا اگر منبع فارسی سراغ دارید ممنون میشم راهنمایی کنید.
باتشکر از اساتید....:خجالت:

اين كد رو من حدود 9 يا 8 سال قبل نوشتم اگر بهينه نيست خودت اصلاح كنش
اين رو دادم كه ايده بگيري

unit postfix;

interface

uses farsi_no,tools;

const

     max=50;

     no:set of char=['0'..'9','.','x','X'];

     fa:set of char=['€','پ','‚','ƒ','„','…','†','‡','ˆ'  ,'‰'];

     op:set of char=['^','*','/','+','-'];

     op_lavel:string[5]='^/*+-';

type

   TStack=array [1..20] of string[15];

   TPostFix=array [1..max] of string[15];

Var

     total:byte;

     _ashar:byte;

function f(fx:string;x:real):real;

procedure find_function(var fx:string;x:real);

procedure PostFixed(f:TStack;Size:Byte;var postfixed:TPostFix);

function ptest(s:string):boolean;

implementation

var

   stack,ps:tstack;

   top:byte;

   i,j:byte;

function full(s:tstack):boolean;

begin

     full:=(top=max);

end;

function empty(s:tstack):boolean;

begin

        empty:=(top=0);

end;

function push(item:string;var s:tstack):boolean;

begin

        if not full(s) then begin

           inc(top);

           s[top]:=item;

           push:=true;

        end else push:=false;

end;

function pop(var s:tstack):string;

begin

        if not empty(s) then begin

           pop:=s[top];

           dec(top);

        end else pop:='';

end;

function ptest(s:string):boolean;

var

   temp:boolean;

   l:byte;

begin

     l:=length(s);

     temp:=true;

     for i:=1 to l do begin

         if s[i]='(' then

               push(s[i],ps);

         if s[i]=')' then

            if pop(ps)='' then

               temp:=false;

     end;

     if empty(ps) and temp then

        temp:=true

     else

         temp:=false;

     ptest:=temp;

end;

function len(Post:TPostFix):byte;

var i:byte;

begin

     i:=0;

     while Post[i+1]<>'' do

           inc(i);

     len:=i;

end;

Function Operand(Var Postf:TPostFix;oper:char;position:byte):Real;

var

   result,a,b:real;

   i,l,code:integer;

begin

    result:=0;

    case oper of

         '^':begin

                  result:=1;

                  val(PostF[position-1],a,code);

                  val(PostF[position-2],b,code);

                  result:=power(b,a);

         end;

         '*':begin

                  val(PostF[position-2],a,code);

                  val(PostF[position-1],b,code);

                  result:=a*b;

         end;

         '/':begin

                  val(PostF[position-2],a,code);

                  val(PostF[position-1],b,code);

                  result:=a/b;

         end;

         '+':begin

                  val(PostF[position-2],a,code);

                  val(PostF[position-1],b,code);

                  result:=a+b;

         end;

         '-':begin

                  val(PostF[position-2],a,code);

                  val(PostF[position-1],b,code);

                  result:=a-b;

         end;

    end;

    str(result:ToTal:_Ashar,PostF[position-2]);

    l:=len(PostF);

    for i:=position to l do

        PostF[(i+1)-2]:=PostF[i+1];

    while PostF[l]<>'' do begin

          PostF[l]:='';

          inc(l);

    end;

    Operand:=result;

end;

function greater(op1,op2:string):boolean;

begin

     greater:=(pos(op1,op_lavel)<=pos(op2,op_lavel));

end;

procedure PostFixed(f:TStack;Size:Byte;var postfixed:TPostFix);

var

   Temp:TPostFix;

   j,oldi:integer;

   ashar,end_fx:boolean;

begin

   j:=1;

   i:=1;

   ashar:=false;

   end_fx:=false;

   for i:=1 to max do

       temp[i]:='';

   i:=1;

   while (i<=Size) do begin

         if (f[i][1] in op) then begin

            if empty(stack) then

               push(f[i],stack)

            else begin

                 while (not empty(stack)) and (greater(stack[top],f[i])) do begin

                       Temp[j]:=Temp[j]+pop(stack);

                       inc(j);

                 end;

                 push(f[i],stack);

            end;

         end;

         if f[i][1] in no then begin

            Temp[j]:=f[i];

            inc(j);

         end;

         inc(i);

   end;

   j:=len(temp)+1;

   while not empty(stack) do begin

         Temp[j]:=Temp[j]+pop(stack);

         inc(j);

   end;

   PostFixed:=Temp;

end;

procedure find_function(var fx:string;x:real);

var

   temp:string[25];

   i,j,k:integer;

   s:real;

   ss:string[5];

begin

     for k:=1 to length(fx) do begin

         i:=0;

         temp:='';

         i:=pos('asin(',fx);

         if i>0 then begin

            j:=0;

            while fx[(i+4)+j]<>')' do

                  inc(j);

            temp:=copy(fx,i+5,j);

            s:=arctan(x/sqrt(1-sqr(x)));

            str(s:total:_ashar,ss);

            delete(fx,i,j+5);

            insert(ss,fx,i);

         end;

         temp:='';

         i:=pos('acos(',fx);

         if i>0 then begin

            j:=0;

            while fx[(i+4)+j]<>')' do

                  inc(j);

            temp:=copy(fx,i+5,j);

            s:=arctan(sqrt(1-sqr(x))/x);

            str(s:total:_ashar,ss);

            delete(fx,i,j+6);

            insert(ss,fx,i);

         end;



         i:=pos('sin(',fx);

         if i>0 then begin

            j:=0;

            while fx[(i+4)+j]<>')' do

                  inc(j);

            temp:=copy(fx,i+4,j);

            s:=sin(f(Temp,x));

            str(s:total:_ashar,ss);

            delete(fx,i,j+5);

            insert(ss,fx,i);

         end;

         temp:='';

         i:=pos('cos(',fx);

         if i>0 then begin

            j:=0;

            while fx[(i+4)+j]<>')' do

                  inc(j);

            temp:=copy(fx,i+4,j);

            s:=cos(f(Temp,x));

            str(s:total:_ashar,ss);

            delete(fx,i,j+5);

            insert(ss,fx,i);

         end;

         temp:='';

         i:=pos('tan(',fx);

         if i>0 then begin

            j:=0;

            while fx[(i+4)+j]<>')' do

                  inc(j);

            temp:=copy(fx,i+4,j);

            s:=sin(f(Temp,x))/cos(f(Temp,x));

            str(s:total:_ashar,ss);

            delete(fx,i,j+5);

            insert(ss,fx,i);

         end;

         temp:='';

         i:=pos('exp(',fx);

         if i>0 then begin

            j:=0;

            while fx[(i+4)+j]<>')' do

                  inc(j);

            temp:=copy(fx,i+4,j);

            s:=exp(f(Temp,x));

            str(s:total:_ashar,ss);

            delete(fx,i,j+5);

            insert(ss,fx,i);

         end;

         temp:='';

         i:=pos('log(',fx);

         if i>0 then begin

            j:=0;

            while fx[(i+4)+j]<>')' do

                  inc(j);

            temp:=copy(fx,i+4,j);

            if f(Temp,x) >= 1 then

               s:=ln(f(Temp,x))

            else

                s:=0;

            str(s:total:_ashar,ss);

            delete(fx,i,j+5);

            insert(ss,fx,i);

         end;

         temp:='';

         i:=pos('abs(',fx);

         if i>0 then begin

            j:=0;

            while fx[(i+4)+j]<>')' do

                  inc(j);

            temp:=copy(fx,i+4,j);

            s:=abs(f(Temp,x));

            str(s:total:_ashar,ss);

            delete(fx,i,j+5);

            insert(ss,fx,i);

         end;

         temp:='';

         i:=pos('sqrt(',fx);

         if i>0 then begin

            j:=0;

            while fx[(i+4)+j]<>')' do

                  inc(j);

            temp:=copy(fx,i+5,j);

            s:=sqrt(f(Temp,x));

            str(s:total:_ashar,ss);

            delete(fx,i,j+6);

            insert(ss,fx,i);

         end;

         temp:='';

         i:=pos('sqr(',fx);

         if i>0 then begin

            j:=0;

            while fx[(i+4)+j]<>')' do

                  inc(j);

            temp:=copy(fx,i+4,j);

            s:=sqr(f(Temp,x));

            str(s:total:_ashar,ss);

            delete(fx,i,j+5);

            insert(ss,fx,i);

         end;

     end;

end;

function f(fx:string;x:real):real;

var

   code,l:integer;

   temp,t:real;

   temp_post:TPostFix;

   Temp_Stack:TStack;

   str_temp:String;

begin

     for l:=1 to max do begin

         temp_post[l]:='';

         temp_stack[l]:='';

     end;

     code:=0;

     l:=0;

     t:=0;

     temp:=0;

     find_function(fx,x);

     str_temp:='';

     l:=1;

     for i:=1 to length(fx) do begin

         if not (fx[i] in op) then

            if fx[i] in fa then{dar halat asli neyaze be in IF nest

            vali, dar inja mejbor be gozashtan in IF shodam chera ke

            hafezeh nakhaste tagher mekonad, yane adad az EN be FA va

            bar aks tabdel meshavand}

               str(fa_to_en(fx[i]):total:_ashar,str_temp)

            else

                str_temp:=str_temp+fx[i]

         else begin

                 temp_stack[l]:=str_temp;

                 inc(l);

                 temp_stack[l]:=fx[i];

                 inc(l);

                 str_temp:='';

         end;

     end;

     temp_stack[l]:=str_temp;

     postfixed(Temp_Stack,l,temp_post);

     for i:=1 to len(Temp_post) do begin

         if upcase(Temp_post[i][1])='X' then

            Str(x:total:_ashar,Temp_post[i]);

     end;

     l:=len(Temp_post);

     i:=1;

     while i<=l do

         if Temp_post[i][1] in op then begin

            t:=Operand(Temp_post,Temp_post[i][1],i);

            dec(i);

         end else begin

             inc(i);

             l:=len(Temp_post);

         end;

     val(Temp_post[1],temp,code);

     f:=temp;

end;

begin

     total:=5;

     _ashar:=3;

end.

مثال :

fx:='cos(x^2)^3';

   x:=1;

   find_function(fx,x);

   postfix(fx,Str_PostFix);

   f(Str_PostFix,x):5:3);