Const
Number : Set Of Char = ['0' .. '9','.'];
Amalgar1 : Set Of Char = ['+','-'];
Amalgar2 : Set Of Char = ['*','/'];
Amalgar3 : Set Of Char = ['^'];
type
model = (opp, clp, num, amal1, amal2, amal3);
model2 = (oopp, cclp, nnum, aamal,aaamal,aaaamal, none,ende);
Trec = Record
Amalvand : Real;
Amalgar : Char;
Modl : Model;
End;
Prec = ^TTrec;
TTrec = Record
Info : Trec;
Pred : Prec;
End;
var Top, Tempel,Tip : Prec;
Temp, S, Ebarat : String;
I, J : Integer;
Tt1, Tt2 : Model2;
Rec : TRec;
endnum : Real;
{-----------------------------------------------------------}
Function P_Pop(Var stru : Trec;var Rip : Prec) : Boolean;
Var Pech : Prec;
Begin
P_Pop := False;
If Rip <> Nil Then
Begin
Pech := Rip;
Rip := Rip^.Pred;
Stru := Pech^.Info;
P_Pop := True;
Dispose(Pech);
End;
End;
Procedure P_Push(stru : Trec;var Rip : Prec);
Var Pech : Prec;
Begin
Pech := Rip;
New(Rip);
Rip^.Pred := Pech;
Rip^.Info := Stru;
End;
Procedure Convert(var Rip : Prec);
Var Pech : PRec;
reco : Trec;
Begin
Tempel := Nil;
While P_Pop(Reco,Rip) Do
Begin
Pech := Tempel;
New(Tempel);
Tempel^.Pred := Pech;
Tempel^.Info := Reco;
End;
Rip := Tempel;
End;
Function Vil (S : String) : Real;
Var TST : Integer;
OSt : Real;
Begin
Val(S, OSt, TST);
Vil := OSt;
End;
{-------------------------------------------------------}
Procedure SetData;
Begin
Temp := Ebarat+'e';
Repeat {Length Ebarat}
I := 1;
S := '';
Tt1 := None;
Tt2 := None;
Repeat {Length Model}
If Temp[I] In Number Then Begin S := S + Temp[I]; Tt1 := nnum; End;
If Temp[I] In Amalgar1 Then Begin S := S + Temp[I]; Tt1 := aamal; End;
If Temp[I] In Amalgar2 Then Begin S := S + Temp[I]; Tt1 := aaamal; End;
If Temp[I] In Amalgar3 Then Begin S := S + Temp[I]; Tt1 := aaaamal; End;
If Temp[I] = '(' Then Begin S := S + '('; Tt1 := oopp; End;
If Temp[I] = ')' Then Begin S := S + ')'; Tt1 := cclp; End;
If Temp[I] = 'e' Then Begin S := S + 'e'; Tt1 := ende; End;
If (Tt1 <> Tt2) And (Tt2 = none) Then Tt2 := Tt1;
Inc(I);
Until (Tt1 <> Tt2) Or (I > Length(Temp));
Delete(S, Length(S), 1);
Delete(Temp, 1, Length(S));
Case Tt2 Of
aamal : Begin Rec.Amalgar := S[1]; Rec.Modl := amal1;Rec.Amalvand := 0; End;
aaamal : Begin Rec.Amalgar := S[1]; Rec.Modl := amal2;Rec.Amalvand := 0; End;
aaaamal : Begin Rec.Amalgar := S[1]; Rec.Modl := amal3;Rec.Amalvand := 0; End;
nnum : Begin Rec.Amalvand := Vil(S); Rec.Modl := num; Rec.Amalgar :=' '; End;
oopp : Begin Rec.Amalgar := '('; Rec.Modl := opp; Rec.Amalvand := 0; End;
cclp : Begin Rec.Amalgar := ')'; Rec.Modl := clp; Rec.Amalvand := 0; End;
End;
P_Push(Rec,Top);
Until Temp = 'e';
Rec.Amalgar := ')';Rec.Amalvand := 0; Rec.Modl :=clp; P_Push(Rec,Top);
Convert(Top); {poshte ro bar aks mikone.}
End;
{----------------------------------------------------------}
Procedure Amalgart(ebarat : trec);
Var
Tr : Trec;
begin
P_Pop(Tr, Tempel);
P_Push(Tr,Tempel);
while (tr.Modl >= Ebarat.Modl) Do
Begin
P_Pop(Tr,Tempel);
P_Push(Tr,Tip);
{-----------------------------------------}
P_Pop(Tr, Tempel);
P_Push(Tr,Tempel);
End;
P_Push(Ebarat, Tempel);
end;
{----------------------------------------------------------}
procedure closep;
Var
Tr : Trec;
a : boolean;
begin
a := P_Pop(Tr, Tempel);
if a then P_Push(Tr,Tempel);
while (tr.modl <> opp) Do
Begin
a := P_Pop(Tr, Tempel);
if a then P_Push(Tr,Tip);
{-----------------------------------------}
P_Pop(Tr, Tempel);
P_Push(Tr,Tempel);
End;
P_Pop(tr, Tempel);
end;
{----------------------------------------------------------}
Procedure Maqos;
Begin
Tempel := Nil;
Rec.Amalgar := '(';Rec.Amalvand := 0; Rec.Modl :=opp; P_Push(Rec,Tempel);
While P_Pop(Rec,Top) Do
Begin
Case Rec.Modl Of
amal1 : amalgart(rec);
amal2 : amalgart(rec);
amal3 : amalgart(rec);
num : P_Push(Rec, Tip);
opp : P_Push(Rec, Tempel);
clp : closep;
end;
End;
End;
{----------------------------------------------------------}
function tavan(n1,n2 : longint) : longint;
Var I, J : LongInt;
Jig, Natije : Longint;
begin
Natije := N1;
For J := 2 To n2 Do Begin Jig := 0;
fOR i := 1 tO n1 dO
Jig := jig + Natije;
Natije := Jig;
End;
Tavan := Trunc(Natije);
end;
{----------------------------------------------------------}
Procedure Mohaseb (N1, N2 : Real;Amal : Char);
Var Tr : Trec;
Begin
Case amal Of
'+' : Tr.amalvand := N1 + N2;
'-' : Tr.amalvand := N1 - N2;
'/' : Tr.amalvand := N1 / N2;
'*' : Tr.amalvand := N1 * N2;
'^' : Tr.amalvand := Tavan(Trunc(N1), Trunc(N2));
End;
Tr.modl := num;
tr.amalgar := ' ';
P_Push(Tr, Tempel);
End;
{----------------------------------------------------------}
Procedure Hesab ;
var
num1, num2 : real;
Tr : TRec;
Begin
Tempel := Nil;
While P_Pop(Rec, Tip) Do
Begin
Case Rec.Modl Of
amal1 : Begin P_Pop(Tr,Tempel);Num2:=Tr.Amalvand;P_Pop(Tr,Tempel );Num1:=Tr.Amalvand;Mohaseb(Num1,Num2,Rec.Amalgar) ;End;
amal2 : Begin P_Pop(Tr,Tempel);Num2:=Tr.Amalvand;P_Pop(Tr,Tempel );Num1:=Tr.Amalvand;Mohaseb(Num1,Num2,Rec.Amalgar) ;End;
amal3 : Begin P_Pop(Tr,Tempel);Num2:=Tr.Amalvand;P_Pop(Tr,Tempel );Num1:=Tr.Amalvand;Mohaseb(Num1,Num2,Rec.Amalgar) ;End;
num : P_Push(Rec, Tempel);
End;
End;
P_Pop(Rec,Tempel);
EndNum := Rec.Amalvand;
End;
{----------------------------------------------------------}
begin
Top := Nil;
Tempel := Nil;
Tip := Nil;
{--------------}
Writeln;
Write('Enter Ebarat : ');
readln(Ebarat);
{ebarat := '312/(25-6)*7^3'; = 5632.4210526}
{--------------}
SetData;
maqos;
convert(tip);
hesab;
writeln('Natije ',ebarat,' = ',endnum :0:20);
Readln;
end.
این فقط جواب رو نشون میده و توان هم داره.
عبارت تبدیل شده رو نشون نمیده چون اعداد چند رقمی هم قبول میکنه و در کنار هم قرار دادن اعداد چند رقمی نامناسبه.
البته صحت عبارت رو چک نمیکنه.
ولی خودم ازش خوشم اومد.
اگر خواستی بگو یه کاریش کنم عبارت تبدیل شده را هم نشون بده.فوقش با فاصله میشه دیگه.
