نوشته شده توسط
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);
الگوریتم لهستانی
پاسخ با نقل قول
