Betreff: Re: Equation Parser
Datum: Fri, 04 Sep 1998 02:11:55 -0700
Von: Yuri Pilipishin
Firma: JCM Group
An: newsserv@gu.kiev.ua
Foren: comp.lang.pascal.delphi.misc
Ben Crain wrote:
>
> I am new to Delphi, but with some experience in VB. I want to develop
> an application (in both VB & Delphi, until I decide which is better) in
> which the user enters a mathematical equation, presumably as a string
> (any arbitrary equation, using any of the standard mathematical
> operators : +,*,^, etc, and any of the standard functions: sin, exp,
> etc.). I need to take that string, convert it to a real function, and
> evaluate it.
Simple, but still useful solution, written originally in Turbo Pascal 3.0 (and
working with any version of Delphi as well). Examples of usage:
x := ExeFn('2+(x5*y)^2', 1, 4, 0,0);
..........
if not BadFn(Str, ['x', 'y', 't'])
then s := ExeFn(Str, 3, 7.777, 0, 0)
else WriteLn('Error in expression');
Please, write me if you need more explanation.
Sincerely,
Yuri Pilipishin
----------------------------------------------------
unit calcfn;
{ (c) 1991 Yuri Pilipisin }
interface
uses mathfns;
type charset=set of char;
function exefn(var f:string; x,y,z,t:real):real;
function badfn(var f:string; arguments:charset):boolean;
implementation
type tab=array[1..255]of byte;
var stack,stb:tab; oldfn:string; c:real; sp,i:integer;
procedure set_stb(var f:string);
begin
sp:=1;
for i:=1 to length(f) do
case f[i] of
'(': begin stack[sp]:=i;inc(sp) end;
')': begin dec(sp);stb[i]:=stack[sp] end
end;
oldfn:=f
end;
function exefn(var f:string; x,y,z,t:real):real;
function calc(p1,p2:byte):real;
var p:byte;
function found(ch:char):boolean;
begin
p:=p2;
while not((f[p]=ch)or(poldfn then set_stb(f);
exefn:=calc(1,length(f))
end;
const
operators=['+','-','*','/','^'];
func_num=17;
func:array [1..func_num] of string[6] =
('sin','cos','tg','ctg','sh','ch','th','cth','sgn','abs','-','ln','exp',
'arcsin','arccos','arcctg','arctg');
function badfn(var f:string; arguments:charset):boolean;
function fnok(p1,p2:byte):boolean;
var p:byte; ok:boolean;
function operator:boolean;
begin
p:=p2;
while not((f[p] in operators)or(pp2 then fnok:=false
else if p1=p2 then fnok:=f[p1] in (arguments+['0'..'9'])
else if (stb[p2]=p1)
and (f[p2]=')' ) then fnok:=fnok(p1+1,p2-1)
else if f[p1]=' ' then fnok:=fnok(p1+1,p2)
else if f[p2]=' ' then fnok:=fnok(p1,p2-1)
else if operator then fnok:=fnok(p1,p-1) and fnok(p+1,p2)
else if f[p1] in ['0'..'9']
then begin val(copy(f,p1,p2-p1+1),c,i);fnok:=(i=0) end
else if copy(f,p1,p2-p1+1)='pi' then fnok:=true
else begin
i:=0; ok:=false;
repeat
inc(i);
ok:=func[i]=copy(f,p1,length(func[i]))
until ok or (i=func_num);
fnok:=ok and fnok(p1+length(func[i]),p2)
end
end;
begin
set_stb(f);
badfn:=(sp<>1)or not fnok(1,length(f))
end;
end.
-------------------------------------------------------------------
unit mathfns;
interface
function power(a,b:real):real;
function tg (x:real):real;
function ctg (x:real):real;
function sc (x:real):real;
function csc (x:real):real;
function sh (x:real):real;
function ch (x:real):real;
function th (x:real):real;
function cth (x:real):real;
function sch (x:real):real;
function csch (x:real):real;
function arcsin (x:real):real;
function arccos (x:real):real;
function arctg (x:real):real;
function arcctg (x:real):real;
function sgn (x:real):real;
implementation
function power(a,b:real):real;
begin
if (a>0) and (b>=0) then power:=exp(a*ln(a))
else if b<0 then power:=1/power(a,-b)
else if a<0 then
begin
if frac(b/2)=0
then power:= power(-a,b)
else power:=-power(-a,b)
end
else power:=0; {a=0}
end;
function arcsin(x:real):real;
begin
arcsin:=arctan(x/sqrt(1-sqr(x)))
end;
function sgn(x:real):real;
begin
if x>0 then sgn:=1
else if x<0 then sgn:=-1
else sgn:=0
end;
function tg (x:real):real; begin tg:=sin(x)/cos(x) end;
function ctg (x:real):real; begin ctg:=1/tg(x) end;
function sc (x:real):real; begin sc:=1/cos(x) end;
function csc (x:real):real; begin csc:=1/sin(x) end;
function sh (x:real):real; begin sh:=(exp(x)-exp(-x))/2 end;
function ch (x:real):real; begin ch:=(exp(x)+exp(-x))/2 end;
function th (x:real):real; begin th:=sh(x)/ch(x) end;
function cth (x:real):real; begin cth:=1/th(x); end;
function sch (x:real):real; begin sch:=1/ch(x) end;
function csch (x:real):real; begin csch:=1/sh(x) end;
function arctg (x:real):real; begin arctg:=arctan(x) end;
function arcctg(x:real):real; begin arcctg:=pi/2-arctg(x) end;
function arccos(x:real):real; begin arccos:=pi/2-arcsin(x) end;
end.
(
geocities.com/SiliconValley/2926) (
geocities.com/SiliconValley)