Kod: Tümünü seç
Contributor: COLIN LAMARRE
{$S-}
{$M 65520,0,655360}
{$N+}
{ Cal.pas by Colin Lamarre, 1991
Email: lamarre@vir.com
This program calculates a formula using recursion.
}
const
digits : set of char = ['0'..'9', '.', 'E'];
var
answer : extended;
rcal : string;
print : boolean;
i : integer;
procedure error(cal : string; var i : integer);
begin
if print then
begin
writeln(copy(cal, i - 5, 10) + ' error.');
print := false;
end;
i := length(cal) + 1;
end;
function clean(var toupper : string) : boolean;
var
i, l, r : integer;
t : string;
begin
print := true;
t := '';
l := 0;
r := 0;
for i := 1 to length(toupper) do
if toupper[i] <> ' ' then
begin
t := t + upcase(toupper[i]);
if toupper[i] = '(' then
l := l + 1;
if toupper[i] = ')' then
r := r + 1;
end;
if r <> l then
begin
writeln('Missing brackets');
clean := false;
end
else
begin
if t = '' then
toupper := '0'
else
toupper := t;
clean := true;
end;
end;
function fstr(x : extended) : string;
var
s : string;
begin
str(x:1:9, s);
if s[1] = ' ' then
delete(s, 1, 1);
fstr := s;
end;
function fval(s : string) : extended;
var
x : extended;
code : integer;
begin
val(s, x, code);
fval := x;
end;
function prevnum(var temp : string; i : integer) : extended;
var
oldi : integer;
begin
oldi := i;
while ((temp[i] in digits) or ((temp[i - 1] = 'E') and (temp[i] in ['+', '-']))) and (i >= 1) do
dec(i);
if (temp[i] in ['+', '-']) and ((i = 1) or (temp[i - 1] in ['+', '-', '*', '/'])) then
dec(i);
prevnum := fval(copy(temp, i + 1, oldi - i));
delete(temp, i + 1, oldi - i);
end;
function signs(cal : string; var i : integer) : integer;
var
sign : integer;
begin
sign := 1;
repeat
if cal[i] = '-' then
begin
sign := sign * -1;
inc(i);
end
else
if cal[i] = '+' then
inc(i);
until not(cal[i] in ['-', '+']);
signs := sign;
end;
function nextnum(cal : string; var i : integer) : extended;
var
temp : string;
sign : integer;
begin
temp := '';
sign := signs(cal, i);
while (cal[i] in digits) and (i <= length(cal)) do
begin
temp := temp + cal[i];
inc(i);
if (cal[i - 1] = 'E') and (cal[i] in ['+', '-']) then
begin
temp := temp + cal[i];
inc(i);
end;
end;
nextnum := sign * fval(temp);
end;
function getbrackets(cal : string; var i : integer) : string;
var
count : integer;
temp : string;
begin
count := 1;
temp := '';
repeat
inc(i);
if cal[i] = '(' then
count := count + 1;
if cal[i] = ')' then
count := count - 1;
temp := temp + cal[i];
until (cal[i] = ')') and (count = 0);
delete(temp, length(temp), 1);
inc(i);
getbrackets := temp;
end;
function doadd(temp : string) : extended;
var
i : integer;
tot : extended;
begin
i := 1;
tot := nextnum(temp, i);
repeat
inc(i);
case temp[i - 1] of
'+' : tot := tot + nextnum(temp, i);
'-' : tot := tot - nextnum(temp, i);
end;
until i > length(temp);
doadd := tot;
end;
function domuls(cal : string) : extended;
var
i, sign : integer;
temp, s : string;
begin
i := 1;
temp := '';
repeat
case cal[i] of
'+', '-' : begin
temp := temp + cal[i];
inc(i);
end;
'*' : begin
inc(i);
sign := signs(cal, i);
if cal[i] in digits then
begin
s := fstr(sign * prevnum(temp, length(temp)) * nextnum(cal,i));
temp := temp + s;
end
else
if cal[i] = '(' then
begin
s := fstr(sign * prevnum(temp, length(temp)) * domuls(getbrackets(cal, i)));
temp := temp + s;
end
else
error(cal, i);
end;
'/' : begin
inc(i);
sign := signs(cal, i);
if cal[i] in digits then
begin
s := fstr(sign * prevnum(temp, length(temp)) / nextnum(cal, i));
temp := temp + s;
end
else
if cal[i] = '(' then
begin
s := fstr(prevnum(temp, length(temp)) / (sign * domuls(getbrackets(cal, i))));
temp := temp + s;
end
else
error(cal, i);
end;
'0'..'9', '.' : while (cal[i] in digits) and (i <= length(cal)) do
begin
temp := temp + cal[i];
inc(i);
if (cal[i - 1] = 'E') and (cal[i] in ['+', '-']) then
begin
temp := temp + cal[i];
inc(i);
end;
end;
'(' : temp := temp + fstr(domuls(getbrackets(cal, i)));
else
error(cal, i);
end;
until i > length(cal);
domuls := doadd(temp);
end;
function dopowers(cal : string) : string;
var
i, c : integer;
x, f : extended;
function fcnt(var cal : string; var i : integer) : integer;
var
j : integer;
begin
j := 0;
while cal[i] = '!' do
begin
inc(j);
dec(i);
end;
inc(i);
delete(cal, i, j);
fcnt := j;
end;
function fact(x : extended) : extended;
var
k, n : word;
ans : extended;
begin
ans := 1;
if x < 0 then
fact := ans / (x - x);
n := trunc(x);
for k := 2 to n do
ans := k * ans;
fact := ans;
end;
function getprev(var cal : string; var i : integer) : extended;
var
oldi, count : integer;
begin
dec(i);
oldi := i;
if cal[i] <> ')' then
begin
while ((cal[i] in digits) or ((cal[i - 1] = 'E') and (cal[i] in ['+', '-']))) and (i >= 1) do
dec(i);
if (cal[i] in ['+', '-']) and ((i = 1) or (cal[i - 1] in ['+', '-', '*', '/'])) then
dec(i);
getprev := fval(copy(cal, i + 1, oldi - i));
delete(cal, i + 1, oldi - i);
end
else
begin
count := 1;
while (cal[i] <> '(') and (count <> 0) and (i >= 1) do
begin
dec(i);
if cal[i] = ')' then
count := count + 1;
if cal[i] = '(' then
count := count - 1;
end;
getprev := domuls(dopowers(copy(cal, i + 1, oldi - i - 1)));
delete(cal, i, oldi - i + 1);
dec(i);
end;
end;
function getnext(var cal : string; i : integer) : extended;
var
oldi, sign, count : integer;
temp : string;
begin
oldi := i;
inc(i);
temp := '';
sign := signs(cal, i);
if cal[i] <> '(' then
begin
while (cal[i] in digits) and (i <= length(cal)) do
begin
temp := temp + cal[i];
inc(i);
if (cal[i - 1] = 'E') and (cal[i] in ['+', '-']) then
begin
temp := temp + cal[i];
inc(i);
end;
end;
getnext := sign * fval(temp);
delete(cal, oldi, i - oldi);
end
else
begin
count := 1;
temp := '';
repeat
inc(i);
if cal[i] = '(' then
count := count + 1;
if cal[i] = ')' then
count := count - 1;
temp := temp + cal[i];
until (cal[i] = ')') and (count = 0);
delete(temp, length(temp), 1);
getnext := sign * domuls(dopowers(temp));
delete(cal, oldi, i - oldi + 1);
end;
end;
begin
i := length(cal);
repeat
case cal[i] of
'^' : begin
x := getnext(cal, i);
if cal[i - 1] = '!' then
begin
dec(i);
c := fcnt(cal, i);
f := getprev(cal, i);
for c := 1 to c do
f := fact(f);
insert(fstr(exp(x * ln(f))), cal, i + 1);
end
else
insert(fstr(exp(x * ln(getprev(cal, i)))), cal, i + 1);
end;
'!' : begin
c := fcnt(cal, i);
f := getprev(cal, i);
for c := 1 to c do
f := fact(f);
insert(fstr(f), cal, i + 1);
end;
else
dec(i);
end;
until i < 1;
dopowers := cal;
end;
function dofuncs(cal : string) : string;
var
i : integer;
temp : string;
function next3 : string;
begin
next3 := cal[i + 1] + cal[i + 2] + cal[i + 3];
end;
function asin(ratio : extended) : extended;
begin
asin := arctan(ratio / sqrt((1 - ratio) * (1 + ratio)));
end;
function acos(ratio : extended) : extended;
begin
acos := arctan(sqrt((1 - ratio) * (1 + ratio)) / ratio);
end;
function atan(ratio : extended) : extended;
begin
atan := arctan(ratio);
end;
function tan(angle : extended) : extended;
begin
tan := sin(angle) / cos(angle);
end;
function cot(angle : extended) : extended;
begin
cot := cos(angle) / sin(angle);
end;
function log(x : extended) : extended;
begin
log := ln(x) / 2.302585093;
end;
begin
i := 1;
temp := '';
repeat
case cal[i] of
'+', '-',
'*', '/',
'(', ')',
'^', '!' : begin
temp := temp + cal[i];
inc(i);
end;
'S' : begin
if next3 = 'IN(' then
begin
inc(i, 3);
temp := temp + fstr(sin(domuls(dopowers(dofuncs(getbrackets(cal, i))))));
end
else
if next3 + cal[i + 4] = 'QRT(' then
begin
inc(i, 4);
temp := temp + fstr(sqrt(domuls(dopowers(dofuncs(getbrackets(cal, i))))));
end
else
error(cal, i);
end;
'C' : begin
if next3 = 'OS(' then
begin
inc(i, 3);
temp := temp + fstr(cos(domuls(dopowers(dofuncs(getbrackets(cal, i))))));
end
else
if next3 = 'OT(' then
begin
inc(i, 3);
temp := temp + fstr(cot(domuls(dopowers(dofuncs(getbrackets(cal, i))))));
end
else
error(cal, i);
end;
'T' : begin
if next3 = 'AN(' then
begin
inc(i, 3);
temp := temp + fstr(tan(domuls(dopowers(dofuncs(getbrackets(cal, i))))));
end
else
error(cal, i);
end;
'A' : begin
if next3 + cal[i + 4] = 'TAN(' then
begin
inc(i, 4);
temp := temp + fstr(atan(domuls(dopowers(dofuncs(getbrackets(cal, i))))));
end
else
if next3 + cal[i + 4] = 'COS(' then
begin
inc(i, 4);
temp := temp + fstr(acos(domuls(dopowers(dofuncs(getbrackets(cal, i))))));
end
else
if next3 + cal[i + 4] = 'SIN(' then
begin
inc(i, 4);
temp := temp + fstr(asin(domuls(dopowers(dofuncs(getbrackets(cal, i))))));
end
else
if next3 = 'BS(' then
begin
inc(i, 3);
temp := temp + fstr(abs(domuls(dopowers(dofuncs(getbrackets(cal, i))))));
end
else
error(cal, i);
end;
'L' : begin
if next3 = 'OG(' then
begin
inc(i, 3);
temp := temp + fstr(log(domuls(dopowers(dofuncs(getbrackets(cal, i))))));
end
else
if cal[i + 1] + cal[i + 2] = 'N(' then
begin
inc(i, 2);
temp := temp + fstr(ln(domuls(dopowers(dofuncs(getbrackets(cal, i))))));
end
else
error(cal, i);
end;
'E' : if next3 = 'XP(' then
begin
inc(i, 3);
temp := temp + fstr(exp(domuls(dopowers(dofuncs(getbrackets(cal, i))))));
end;
'P' : if cal[i + 1] = 'I' then
begin
inc(i, 2);
temp := temp + fstr(pi);
end
else
error(cal, i);
'0'..'9', '.' : while (cal[i] in digits) and (i <= length(cal)) do
begin
temp := temp + cal[i];
inc(i);
if (cal[i - 1] = 'E') and (cal[i] in ['+', '-']) then
begin
temp := temp + cal[i];
inc(i);
end;
end;
else
error(cal, i);
end;
until i > length(cal);
dofuncs := temp;
end;
begin
rcal := '';
for i := 1 to paramcount do
rcal := rcal + paramstr(i);
if clean(rcal) then
begin
answer := domuls(dopowers(dofuncs(rcal)));
if print then
writeln(answer:1:9);
end;
end.
HusoEditCalc tada kullanmıştım evet mükemmel çlışıyor