unit KifErtelmezo;
interface
uses Math, SysUtils;
type
PKfAtom=^TKfAtom;
TKfAtom=object
Parent: PKfAtom;
Op1,Op2: PKfAtom;
Constructor Create;
Destructor Destroy; virtual;
Function GetValue: Single; virtual;
end;
PErtek=^TErtek;
TErtek=object(TKfAtom)
Value: Single;
Constructor Create(Valu:single);
Function GetValue: Single; virtual;
end;
PPlusMinus=^TPlusMinus;
TPlusMinus=object(TKfAtom)
mode: Boolean;
Constructor Create(amode: Boolean);
Function GetValue: Single; virtual;
end;
PSzorOszt=^TSzorOszt;
TSzorOszt=object(TPlusMinus)
Function GetValue: Single; virtual;
end;
PFX=^TFX;
TFX=object(TKfAtom)
mode: Byte;
Constructor Create(amode: Byte);
Function GetValue: Single; virtual;
end;
TRefTable=record
Count: Byte;
Data: Array[1..255] of Record
Name: Char;
Value: Double;
end;
end;
PKif=^TKif;
TKif=object
FirstAtom: PKfAtom;
Refs: TRefTable;
Pnt: PKif;
Constructor Create(PointR:PKif);
Destructor Destroy;
Function WhereIs(name:char):byte;
Function GetValue: Single; virtual;
Function AssignCV(name:char;value:single):boolean; virtual;
Function DelCV(name:char;value:single):boolean; virtual;
Function ChangeValue(name:char;newvalue:single):boolean; virtual;
Procedure SetExp(s: String; var P: PKfAtom; AParent: PKfAtom); virtual;
end;
PRef=^TRef;
TRef=object(TKfAtom)
Value: Single;
Name: Char;
Kif: PKif;
Constructor Create(aname: Char; PointR:PKif);
Function GetValue: Single; virtual;
Procedure Refresh; virtual;
end;
Const
fxSin = 1;
fxCos = 2;
fxTan = 3;
fxSqr = 4;
fxSqrt = 5;
fxLog = 6;
fxExp = 7;
fxAbs = 8;
fxRnd = 9;
fxRand = 10;
fxMod = 11;
fxDiv = 12;
fxArcCos = 13;
fxArcSin = 14;
fxCotan = 15;
fxCosh = 16;
fxSinh = 17;
fxTanh = 18;
fxArcCosh = 19;
fxArcSinh = 20;
fxArcTanh = 21;
fxLog10 = 22;
fxLog2 = 23;
fxLogN = 24;
fxPower = 25;
precedencia:array [1..5] of char = ('+','-','*','/','^');
fxStrings:array [1..24] of string = ('sin','cos','tan','sqr','sqrt',
'log','exp','abs','rnd','rand',
'mod','div','arccos','arcsin',
'cotan','cosh','sinh','tanh',
'arccosh','arcsinh','arctanh',
'log10','log2','logN');
implementation
{ TKfAtom }
constructor TKfAtom.Create;
begin
parent:=nil;
op1:=nil;
op2:=nil;
end;
destructor TKfAtom.Destroy;
begin
if op1<>nil then op1^.Destroy;
if op2<>nil then op2^.Destroy;
end;
function TKfAtom.GetValue: Single;
begin
end;
{ TErtek }
constructor TErtek.Create(valu:single);
begin
Value:=Valu;
end;
function TErtek.GetValue: Single;
begin
Getvalue:=Value;
end;
{ TPlusMinus }
constructor TPlusMinus.Create(amode: Boolean);
begin
mode:=amode;
end;
function TPlusMinus.GetValue: Single;
begin
if (op1<>nil) and (op2<>nil) then
begin
if mode then GetValue:=op1^.GetValue+op2^.GetValue
else GetValue:=op1^.GetValue-op2^.GetValue;
end
else
if (op1=nil) and (op2<>nil) and (not mode) then Getvalue:=-op2^.GetValue
else Getvalue:=0;
end;
{ TSzorOszt }
function TSzorOszt.GetValue: Single;
begin
if (op1<>nil) and (op2<>nil) then
begin
if mode then GetValue:=op1^.GetValue*op2^.GetValue
else GetValue:=op1^.GetValue/op2^.GetValue;
end
else Getvalue:=0;
end;
{ TFX }
constructor TFX.Create(amode: Byte);
begin
mode:=amode;
end;
function TFX.GetValue: Single;
begin
if op1<>nil then
begin
case mode of
fxSin: Getvalue:=sin(op1^.GetValue);
fxCos: Getvalue:=cos(op1^.GetValue);
fxTan: Getvalue:=tan(op1^.Getvalue);
fxSqr: Getvalue:=sqr(op1^.GetValue);
fxSqrt: Getvalue:=sqrt(op1.GetValue);
fxExp: Getvalue:=exp(op1^.GetValue);
fxAbs: Getvalue:=abs(op1^.GetValue);
fxRnd: Getvalue:=round(op1^.GetValue);
fxArcCos: Getvalue:=arccos(op1^.GetValue);
fxArcSin: Getvalue:=arcsin(op1^.GetValue);
fxCotan: Getvalue:=cotan(op1^.GetValue);
fxCosh: Getvalue:=cosh(op1^.GetValue);
fxSinh: Getvalue:=sinh(op1^.GetValue);
fxTanh: Getvalue:=tanh(op1^.GetValue);
fxArcCosh: Getvalue:=arccosh(op1^.GetValue);
fxArcSinh: Getvalue:=arcsinh(op1^.GetValue);
fxArcTanh: Getvalue:=arctanh(op1^.GetValue);
fxLog10: Getvalue:=log10(op1^.GetValue);
fxLog2: Getvalue:=log2(op1^.GetValue);
fxPower: Getvalue:=power(op1^.GetValue,op2^.GetValue);
end;
end
else Getvalue:=0;
end;
{ ... }
function DelSpcPlusMinus(s:string):string;
begin
s:=trim(s);
While pos('+-',s)<>0 do s:=Copy(s,1,pos('+-',s)-1)+'-'+Copy(s,pos('+-',s)+2,255);
While pos('-+',s)<>0 do s:=Copy(s,1,pos('-+',s)-1)+'-'+Copy(s,pos('+-',s)+2,255);
While pos('--',s)<>0 do s:=Copy(s,1,pos('--',s)-1)+'+'+Copy(s,pos('--',s)+2,255);
While pos('++',s)<>0 do s:=Copy(s,1,pos('++',s)-1)+'+'+Copy(s,pos('++',s)+2,255);
DelSpcPlusMinus:=s;
end;
function DelZarojel(s:string):string;
var i,count:integer;
begin
while (s[1]='(') and (s[length(s)]=')') do
begin
i:=1;
count:=0;
while i<>length(s) do
begin
case s[i] of
'(':inc(count);
')':dec(count);
end;
if (count=0) and (i<>length(s)) then break;
inc(i);
end;
if (i=length(s)) and (count=0) then s:=copy(s,2,length(s)-2);
end;
DelZarojel:=s;
end;
{ //.... }
{ TRef }
constructor TRef.Create(aname: Char; PointR:PKif);
begin
Kif:=PointR;
name:=aname;
end;
procedure TRef.Refresh;
var i:byte;
megvan:boolean;
begin
megvan:=false;
i:=1;
while (not megvan) and (i<Kif^.Refs.Count+1) do
begin
if Kif^.Refs.Data[i].Name=name then
begin
megvan:=true;
value:=Kif^.Refs.Data[i].value;
break;
end;
inc(i);
end;
end;
function TRef.GetValue: Single;
begin
Refresh;
GetValue:=Value;
end;
{ TKif }
function TKif.WhereIs(name: char): byte;
var megvan:boolean;
i:byte;
begin
while (not megvan) and (i<Refs.Count+1) do
begin
if Refs.Data[i].Name=name then
begin
megvan:=true;
break;
end;
inc(i);
end;
if megvan then WhereIs:=i-1 else WhereIs:=0;
end;
function TKif.AssignCV(name: char; value: single): boolean;
begin
end;
function TKif.ChangeValue(name: char; newvalue: single): boolean;
begin
end;
constructor TKif.Create(PointR:PKif);
begin
FirstAtom:=nil;
Pnt:=PointR;
Refs.Count:=0;
end;
function TKif.DelCV(name: char; value: single): boolean;
begin
end;
destructor TKif.Destroy;
begin
if FirstAtom<>nil then FirstAtom^.Destroy;
end;
function TKif.GetValue: Single;
begin
if FirstAtom<>nil then GetValue:=FirstAtom^.GetValue else GetValue:=0;
end;
procedure TKif.SetExp(s: String; var P: PKfAtom; AParent: PKfAtom);
var i,j,zjel:integer;
prec:byte;
megvan:boolean;
begin
s:=DelZarojel(DelSpcPlusMinus(s));
j:=0;
prec:=1;
megvan:=false;
while (prec<6) and (not megvan) do
begin
zjel:=0;
i:=1;
while (not megvan) and (i<length(s)+1) do
begin
case s[i] of
'(': inc(zjel);
')': dec(zjel);
end;
if (s[i]=precedencia[prec]) and (zjel=0) then
begin
megvan:=true;
break;
end;
inc(i);
end;
inc(prec);
end;
if megvan then
begin
case prec-1 of
1: p:=New(PPlusMinus, Create(false));
2: p:=New(PPlusMinus, Create(true));
3: p:=New(PSzorOszt, Create(false));
4: p:=New(PSzorOszt, Create(true));
5: p:=New(PFX, Create(fxPower));
end;
p^.parent:=aparent;
SetExp(copy(s,1,i-1),p^.op1,p);
SetExp(copy(s,i-1,length(s)-i-1),p^.op2,p);
end else
begin
if length(s)=1 then
for i:=1 to Refs.Count do
If Refs.Data[i].Name=s then
begin
p:=New(PRef, Create(Refs.Data[i].Name,Pnt));
p^.parent:=aparent;
megvan:=true;
break;
end;
if not megvan then
begin
val(s,i,j);
if j=0 then
begin
p:=New(PErtek, Create(i));
p^.parent:=aparent;
megvan:=true;
end else
begin
i:=1;
while (not megvan) and (i<25) do
begin
if pos(lowercase(fxStrings[i]),lowercase(s))=1 then
begin
case i of
fxSin,fxCos,fxTan,fxSqr,
fxLog,fxExp,fxAbs,fxRnd:
begin
s:=copy(s,4,length(s)-5);
p:=New(PFX, Create(i));
p^.parent:=aparent;
p^.Op2:=nil;
SetExp(s,p^.op1,p);
end;
fxSqrt, fxRand, fxCosh, fxSinh,
fxTanh, fxLog2:
begin
s:=copy(s,5,length(s)-6);
p:=New(PFX, Create(i));
p^.parent:=aparent;
p^.Op2:=nil;
SetExp(s,p^.op1,p);
end;
fxArcCos, fxArcSin:
begin
s:=copy(s,7,length(s)-8);
p:=New(PFX, Create(i));
p^.parent:=aparent;
p^.Op2:=nil;
SetExp(s,p^.op1,p);
end;
fxCotan, fxLog10:
begin
s:=copy(s,6,length(s)-7);
p:=New(PFX, Create(i));
p^.parent:=aparent;
p^.Op2:=nil;
SetExp(s,p^.op1,p);
end;
fxArcCosh, fxArcSinh, fxArcTanh:
begin
s:=copy(s,8,length(s)-9);
p:=New(PFX, Create(i));
p^.parent:=aparent;
p^.Op2:=nil;
SetExp(s,p^.op1,p);
end;
fxLogN:;
end;
break;
end;
inc(i);
end;
end;
end;
end;
end;
end.