درخواست کمک فوری-برنامه ماشین حساب در پاسکال

[sajjadrad]

با سلام به دوستان عزیز تر از جان

من می خوام یه برنامه بنویسم که یه ماشین حساب باشه بطوری که اولویت های داخل پرانتز رو رعایت کنه
مثل مثال زیر(مثلا ورودی زیر رو محاسبه کنه):
(2(3-1)/2)+(1*4(2-1) = ????
یعنی این ماشین حساب من هم چهار عمل اصلی رو انجام بده و هم اینکه بتونه داخل پارانتز رو حساب کنه...
من اومدم از آرایه char استفاده کردم اما راه خیلی طورانی میشه...



program test;
uses crt;
var
a:array[1..100]of char;
begin
i:=1;
j:=1;
read(a[i]);
while a[i]<>'=' do
if a[i]='(' then
begin
inc(i);
read(a[i]);
if ord(a[i])<58 then
begin
inc(i);
read(a[i]);
if ord(a[i])<58 then
b[j]:=a[i-1]*10+a[i]);
end;
....
....
....




اگه میشه یکی یه راه پیشنهاد کنه..

[دلفــي]

شما مي تونيد از روشهاي محاسباتي Infix, Postfix and Prefix استفاده كنيد

توضيح در مورد مطلب : http://www.cs.manchester.ac.uk/~pjj/cs2121/fix.html

[sajjadrad]

شما می تونید از روشهای محاسباتی Infix, Postfix and Prefix استفاده کنید

توضیح در مورد مطلب : http://www.cs.manchester.ac.uk/~pjj/cs2121/fix.htm (http://www.cs.manchester.ac.uk/~pjj/cs2121/fix.html)


سلام..ممنون سایت بهم کمک کرد اما نه اونطور که باید...اگه میشه یکم درمورد الگوریتم استفاده از اونا توضیح بدید..
در ضمن من تو نت یه پروژه پیداکردم اما ماشین حسابش خیلی حرفه ای یه...مثلا sin,cos,^ و اینا رو محاسبه می کنه...اگه میشه که محاسبه این عملگر ها رو پاک کرد حله...من این کارو کردم اما برنامه فوق حرفه ای نوشته شده...من فقط میخوام که عملگرهای *-/+ رو به همراه )( محاسبه کنه

کد برنامه:

program Calc;
const
maxString = 80;
bang = '!';
dot = '.';
minus = '-';
parOpen = '(';
parClose = ')';
plus = '+';
power = '^';
slash = '/';
space = ' ';
star = '*';
type
String2 = array [1..maxString] of char;
var
s : String;
i, len, width, dec : integer;
t, nul, tab : char;
sn, done : boolean;
procedure LowerCase (var s : String; len : integer);
var i : integer;
begin
for i := 1 to len do
if s[i] in ['A'..'Z'] then
s[i] := chr(ord(s[i]) + 32)
end; {LowerCase}
function IsDigit (c : char) : boolean;
begin
IsDigit := c in ['0'..'9', dot]
end; {IsDigit}
function ParseInt (var s : String; var i : integer) : integer;
var
n, sign : integer;
begin
while (s[i] = space) or (s[i] = tab) do i := i + 1;
if (s[i] = minus) then sign := -1
else sign := 1;
if (s[i] = plus) or (s[i] = minus) then i := i + 1;
n := 0;
while s[i] in ['0'..'9'] do begin
n := 10 * n + ord(s[i]) - ord('0');
i := i + 1
end;
ParseInt := sign * n
end; {ParseInt}
function ParseReal (var s : String; var i : integer) : real;
var
v : real; j, decimal, exponent : integer;
begin
while s[i] in [space, tab] do i := i + 1;
v := 0.0; decimal := 0; exponent := 0;
while (isdigit(s[i])) do begin {parse decimal number}
if s[i] = dot then decimal := i
else v := 10 * v + (ord(s[i]) - ord('0'));
i := i + 1;
end;
if decimal > 0 then
for j := 1 to (i - decimal - 1) do v := v / 10;
if s[i] = 'e' then begin {handle scientific notation}
i := i + 1;
exponent := ParseInt(s, i);
if exponent > 0 then
for j := 1 to exponent do v := v * 10
else if exponent < 0 then
for j := 1 to abs(exponent) do v := v / 10
end;
ParseReal := v
end; {ParseReal}
function DoDivision (x, y : real) : real;
begin
if y <> 0 then DoDivision := x / y
else begin
Writeln('Please don''t divide by zero!');
DoDivision := 0
end
end; {DoDivision}
function DoFactorial (x : real) : real;
var v : real; i, j : integer;
begin
v := 1; j := abs(trunc(x));
if (j = 0) or (j = 1) then DoFactorial := 1
else if j > 69 then Writeln('Arithemtic overflow.')
else for i := j downto 2 do v := v * i;
if x < 0 then DoFactorial := -v
else DoFactorial := v
end; {DoLn}
function DoLn (x : real) : real;
begin
if x > 0.0 then DoLn := ln(x)
else begin
Writeln('Natural log argument must be positive.');
DoLn := 0.0
end
end; {DoLn}
function DoPower (b, e : real) : real;
var p : integer; u, v : real;
begin
v := 1; u := b; p := trunc(e);
if ((e - p) < 0.00001) and (p > 0) then begin
{handle positive integral exponents}
while p > 0 do begin
while not odd(p) do begin
p := p div 2; u := sqr(u)
end;
p := p - 1; v := u * v
end;
DoPower := v
end
{else use natural logarithm}
else DoPower := exp(e * DoLn(b))
end; {Power}
function DoSqrt (x : real) : real;
begin
if x > 0.0 then DoSqrt := sqrt(x)
else begin
Writeln('Square root argument must be positive.');
DoSqrt := 0.0
end
end; {DoSqrt}
procedure SkipToken (var s : String; var i : integer);
begin
while s[i] in ['a'..'z'] do i := i + 1;
end; {SkipToken}
function SkipSpace (var s : String; var i : integer) : char;
begin
while (s[i] in [space, tab]) do i := i + 1;
SkipSpace := s[i]
end;
function Expression (var s : string; var i : integer) : real;
var v : real; t : char; j : integer;
function Term (var s : String; var i : integer) : real;
var v : real; t : char;
function Factor (var s : String; var i : integer) : real;
var v : real; t : char;
function Value (var s : String; var i : integer) : real;
var v : real; t : char;
begin
v := 0.0;
t := SkipSpace(s, i);
if t = parOpen then begin {nested expression}
i := i + 1;
v := Expression(s, i);
if (SkipSpace(s, i) = parClose) then i := i + 1
else Writeln('Missing parenthesis in expression.')
end
else if t = plus then begin {unary plus}
i := i + 1; v := Value(s, i)
end
else if t = minus then begin {unary minus}
i := i + 1; v := -Value(s, i)
end
else if IsDigit(t) then begin {real number}
v := ParseReal(s, i)
end
else if t in ['a','c','e','l','p','s','t'] then begin {function}
j := i; SkipToken(s, i);
if s[j] = 'a' then
if s[j+1] = 'b' then v := abs(Value(s, i))
else if s[j+1] = 't' then v := arctan(Value(s, i));
if s[j] = 'c' then v := cos(Value(s, i));
if s[j] = 'e' then
if s[j+1] = 'x' then v := exp(Value(s, i))
else v := exp(1); {e}
if s[j] = 'l' then v := DoLn(Value(s, i));
if s[j] = 'p' then v := 3.14159265358979;
if s[j] = 's' then
if s[j+1] = 'i' then v := sin(Value(s, i))
else if s[j+1] = 'q' then v := DoSqrt(Value(s, i));
if s[j] = 't' then begin
v := Value(s, i); v := sin(v)/cos(v)
end
end
else Writeln('Syntax error.');
Value := v
end; {Value}
begin
v := Value(s, i);
t := SkipSpace(s, i);
while t in [bang, power] do begin
i := i + 1;
case t of
bang: v := DoFactorial(v);
power: v := DoPower(v, Factor(s, i))
end;
t := SkipSpace(s, i)
end;
Factor := v
end; {Factor}
begin
v := Factor(s, i);
t := SkipSpace(s, i);
while t in [star, slash, power] do begin
i := i + 1;
case t of
star: v := v * Factor(s, i);
slash: v := DoDivision(v, Factor(s, i));
power: v := DoPower(v, Factor(s, i))
end;
t := SkipSpace(s, i)
end;
Term := v
end; {Term}
begin
v := Term(s, i);
t := SkipSpace(s, i);
while t in [plus, minus] do begin
i := i + 1;
case t of
plus: v := v + Term(s, i);
minus: v := v - Term(s, i)
end;
t := SkipSpace(s, i)
end;
Expression := v
end; {Expression}
function Length (var s : String) : integer;
var i : integer;
begin
i := maxString;
while (s[i] = space) and (i <> 1) do i := i - 1;
if (s[i] = space) and (i = 1) then i := 0;
Length := i;
end; {Length}
procedure SetDecimal (var s : String; var i, dec : integer);
begin
SkipToken(s, i);
dec := trunc(ParseReal(s, i));
if dec > 15 then dec := 15;
if dec < 0 then dec := 0;
Writeln('Decimal precision set to ', dec);
end; {SetDecimal}
procedure SetWidth (var s : String; var i, width : integer);
begin
SkipToken(s, i);
width := trunc(ParseReal(s, i));
if width > 80 then width := 80;
if width < 0 then width := 0;
Writeln('Decimal width set to ', width);
end; {SetWidth}
procedure SetNotation (var sn : boolean);
begin
sn := not(sn);
if sn then Writeln('Scientific notation on.')
else Writeln('Scientific notation off.')
end; {SetNotation}
procedure Format (var s : String; var i : integer);
begin
if sn then Writeln(Expression(s, i):width)
else Writeln(Expression(s, i):width:dec)
end; {Format}
function FileCheck : boolean;
begin
FileCheck := false;
{#a
jsr _mli
db $C4 ;Get_File_Info
dw finfo
bne fexit
ldy #5 ;result offset
lda #1 ;true
sta (_sp),y
fexit equ *
#}
end; {FileCheck}
{#a
fname str "calc.txt"
finfo db 10
dw fname
ds 15
#}
procedure Execute;
var s : String; i, len : integer; f : file of char;
begin
if FileCheck then begin
{ reset(f, 'calc.txt');
while not(eof(f)) do begin
i := 1;
repeat
s[i] := f^; i := i + 1; get(f)
until f^ = chr(13);
get(f);
s[i] := nul;
for i := 1 to i - 1 do Write(s[i]); Write(' = ');
i := 1;
t := SkipSpace(s, i);
Format(s, i)
end }
end
else Writeln('File "calc.txt" not found.')
end; {Execute}
procedure Help;
begin
Writeln;
Writeln;
Writeln(' +-----------------------+');
Writeln(' | Welcome to Calculator |');
Writeln(' +-----------------------+');
Writeln;
Writeln(' A scientific calculator by Jafari');
Writeln;
Writeln;
Writeln('Operators (increasing precedence):');
Writeln(' + , - , * , / , () ');
Writeln;
Writeln;
Writeln('Avalin addad ra neveshte sepas yeki az');
Writeln(' alamat haye fogh ra minevisim va bad');
Writeln(' adad dovom ra neveshte Enter mizanim');
Writeln;
Writeln;
Writeln('Mitavanim az parantez ham estefade konm');
Writeln(' che dar aval , va che dar vasat va akhar');
Writeln;
Writeln;
Writeln(' Quit |-> : Khoroj az barname ');
Writeln;
Writeln
end; {Help}
begin
{#a ; clear screen
stx _t
jsr $FC58
ldx _t
#}
nul := chr(0); tab := chr(9);
width := 12; dec:= 6; sn := false; done := false;
Help;
repeat
Write('> '); Readln(s);
len := Length(s);
s[len + 1] := nul; {terminate string}
if len > 0 then begin
LowerCase(s, len);
i := 1;
t := SkipSpace(s, i);
if t = 'd' then SetDecimal(s, i, dec)
else if t = 'h' then Help
else if t = 'n' then SetNotation(sn)
else if t = 'q' then done := true
else if t = 'w' then SetWidth(s, i, width)
else if t = 'x' then Execute
else Format(s, i)
end
until done
end. {Calc}