MathgeomGLS
1333 строки · 25.6 Кб
1unit uParser;
2{ This parser is used only for z = f(x,y) heightfield 3D graphs }
3
4interface
5
6uses
7System.Classes,
8System.Math,
9System.SysUtils;
10
11const
12Pi: extended = 3.1415926535897932385;
13PiOn2: extended = 1.5707963267948966192;
14twoPi: extended = 6.2831853071795864769;
15PiOn180: extended = 0.017453292519943296;
16
17ParseSet: Set of Char =
18[' ', '!', '(', ')', '*', '+', '-', '.', ',', '/', '0'..'9',
19'A'..'E', 'G'..'I', 'L', 'N'..'U', 'X', 'Y', '^', '`', #8];
20
21type
22TFuncDef = class
23public
24function DefName: string; virtual; abstract;
25function Eval(x: extended): extended; virtual; abstract;
26end;
27
28TVarDef = class
29public
30VarName: string;
31Value: extended;
32end;
33
34TCalculus = class
35public
36function Eval: extended; virtual; abstract;
37end;
38
39TfxyParser = class(TObject)
40constructor Create(x, y: extended);
41destructor Destroy; override;
42private
43FunctionList: TList;
44VariableList: TList;
45function FunctionOf(i: integer): TFuncDef;
46function VariableOf(i: integer): TVarDef;
47function CheckBrackets(const s: string): Boolean;
48function CompileExpresion(const s: string; var Error: byte): TCalculus;
49function FactorCompile(const s: string; var Error: byte): TCalculus;
50function SimpleCompile(const s: string; var Error: byte): TCalculus;
51procedure ClearLists;
52public
53VarX, VarY: TVarDef;
54Calculus: TCalculus;
55ErrorByte: byte;
56function Compile(s: string; var Error: byte): TCalculus;
57procedure AddVar(v: TVarDef);
58procedure ConstructLists;
59end;
60
61TConst = class(TCalculus)
62constructor Create(c: extended);
63public
64function Eval: extended; override;
65private
66Val: extended;
67end;
68
69TVar = class(TCalculus)
70public
71constructor Create(v: TVarDef);
72function Eval: extended; override;
73protected
74Def: TVarDef;
75end;
76
77TFunc = class(TCalculus)
78constructor Create(v: TCalculus; f: TFuncDef);
79destructor Destroy; override;
80public
81function Eval: extended; override;
82protected
83Variable: TCalculus;
84Def: TFuncDef;
85end;
86
87TOperator = class(TCalculus)
88constructor Create(c1, c2: TCalculus);
89destructor Destroy; override;
90public
91protected
92e1, e2: TCalculus;
93end;
94
95TMinus = class(TOperator)
96public
97function Eval: extended; override;
98end;
99
100TSum = class(TOperator)
101public
102function Eval: extended; override;
103end;
104
105TProduct = class(TOperator)
106public
107function Eval: extended; override;
108end;
109
110TDivision = class(TOperator)
111public
112function Eval: extended; override;
113end;
114
115TPower = class(TOperator)
116public
117function Eval: extended; override;
118end;
119
120TFactorial = class(TOperator)
121public
122function Eval: extended; override;
123end;
124
125TDegToRad = class(TOperator)
126public
127function Eval: extended; override;
128end;
129
130TAbs = class(TFuncDef)
131public
132function DefName: string; override;
133function Eval(x: extended): extended; override;
134end;
135
136TInt = class(TFuncDef)
137public
138function DefName: string; override;
139function Eval(x: extended): extended; override;
140end;
141
142TRound = class(TFuncDef)
143public
144function DefName: string; override;
145function Eval(x: extended): extended; override;
146end;
147
148TSqr = class(TFuncDef)
149public
150function DefName: string; override;
151function Eval(x: extended): extended; override;
152end;
153
154TSqrt = class(TFuncDef)
155public
156function DefName: string; override;
157function Eval(x: extended): extended; override;
158end;
159
160TSin = class(TFuncDef)
161public
162function DefName: string; override;
163function Eval(x: extended): extended; override;
164end;
165
166TCos = class(TFuncDef)
167public
168function DefName: string; override;
169function Eval(x: extended): extended; override;
170end;
171
172TTan = class(TFuncDef)
173public
174function DefName: string; override;
175function Eval(x: extended): extended; override;
176end;
177
178TCsc = class(TFuncDef)
179public
180function DefName: string; override;
181function Eval(x: extended): extended; override;
182end;
183
184TSec = class(TFuncDef)
185public
186function DefName: string; override;
187function Eval(x: extended): extended; override;
188end;
189
190TCot = class(TFuncDef)
191public
192function DefName: string; override;
193function Eval(x: extended): extended; override;
194end;
195
196TArcSin = class(TFuncDef)
197public
198function DefName: string; override;
199function Eval(x: extended): extended; override;
200end;
201
202TArcCos = class(TFuncDef)
203public
204function DefName: string; override;
205function Eval(x: extended): extended; override;
206end;
207
208TArcTan = class(TFuncDef)
209public
210function DefName: string; override;
211function Eval(x: extended): extended; override;
212end;
213
214TArcCsc = class(TFuncDef)
215public
216function DefName: string; override;
217function Eval(x: extended): extended; override;
218end;
219
220TArcSec = class(TFuncDef)
221public
222function DefName: string; override;
223function Eval(x: extended): extended; override;
224end;
225
226TArcCot = class(TFuncDef)
227public
228function DefName: string; override;
229function Eval(x: extended): extended; override;
230end;
231
232TLn = class(TFuncDef)
233public
234function DefName: string; override;
235function Eval(x: extended): extended; override;
236end;
237
238TExp = class(TFuncDef)
239public
240function DefName: string; override;
241function Eval(x: extended): extended; override;
242end;
243
244TExp1 = class(TFuncDef)
245public
246function DefName: string; override;
247function Eval(x: extended): extended; override;
248end;
249
250TLog10 = class(TFuncDef)
251public
252function DefName: string; override;
253function Eval(x: extended): extended; override;
254end;
255
256TLog2 = class(TFuncDef)
257public
258function DefName: string; override;
259function Eval(x: extended): extended; override;
260end;
261
262TSinh = class(TFuncDef)
263public
264function DefName: string; override;
265function Eval(x: extended): extended; override;
266end;
267
268TCosh = class(TFuncDef)
269public
270function DefName: string; override;
271function Eval(x: extended): extended; override;
272end;
273
274TTanh = class(TFuncDef)
275public
276function DefName: string; override;
277function Eval(x: extended): extended; override;
278end;
279
280TCsch = class(TFuncDef)
281public
282function DefName: string; override;
283function Eval(x: extended): extended; override;
284end;
285
286TSech = class(TFuncDef)
287public
288function DefName: string; override;
289function Eval(x: extended): extended; override;
290end;
291
292TCoth = class(TFuncDef)
293public
294function DefName: string; override;
295function Eval(x: extended): extended; override;
296end;
297
298TArcSinh = class(TFuncDef)
299public
300function DefName: string; override;
301function Eval(x: extended): extended; override;
302end;
303
304TArcCosh = class(TFuncDef)
305public
306function DefName: string; override;
307function Eval(x: extended): extended; override;
308end;
309
310TArcTanh = class(TFuncDef)
311public
312function DefName: string; override;
313function Eval(x: extended): extended; override;
314end;
315
316TArcCsch = class(TFuncDef)
317public
318function DefName: string; override;
319function Eval(x: extended): extended; override;
320end;
321
322TArcSech = class(TFuncDef)
323public
324function DefName: string; override;
325function Eval(x: extended): extended; override;
326end;
327
328TArcCoth = class(TFuncDef)
329public
330function DefName: string; override;
331function Eval(x: extended): extended; override;
332end;
333
334function ScanText(const s: string): string;
335function ParseAndEvaluate(const aText: string; var e: byte): extended;
336function ParseEvaluateFxy(const aVarX, aVarY: extended;
337const aText: string; var e: byte): extended;
338
339//=====================================================================
340implementation
341//=====================================================================
342
343uses
344uGlobal,
345fPlot2D;
346
347{ TCalculus Class }
348constructor TConst.Create(c: extended);
349begin
350Val := c;
351end;
352
353function TConst.Eval: extended;
354begin
355Result := Val;
356end;
357
358constructor TVar.Create(v: TVarDef);
359begin
360Def := v;
361end;
362
363function TVar.Eval: extended;
364begin
365Result := Def.value;
366end;
367
368constructor TFunc.Create(v: TCalculus; f: TFuncDef);
369begin
370Variable := v;
371Def := f;
372end;
373
374destructor TFunc.Destroy;
375begin
376Variable.Free;
377end;
378
379function TFunc.Eval: extended;
380begin
381Result := Def.Eval(Variable.Eval);
382end;
383
384constructor TOperator.Create(c1, c2: TCalculus);
385begin
386e1 := c1;
387e2 := c2;
388end;
389
390destructor TOperator.Destroy;
391begin
392e1.Free;
393e2.Free;
394end;
395{ TCalculus Class }
396
397{ TfxyParser }
398constructor TfxyParser.Create(x, y: extended);
399begin
400inherited Create;
401FunctionList := TList.Create;
402VariableList := TList.Create;
403
404ConstructLists;
405
406VarX := TVarDef.Create;
407VarX.VarName := 'x';
408VarX.Value := x;
409addVar(VarX);
410
411VarY := TVarDef.Create;
412VarY.VarName := 'y';
413VarY.Value := y;
414addVar(VarY);
415end;
416
417destructor TfxyParser.Destroy;
418begin
419ClearLists;
420inherited Destroy;
421end;
422
423function TfxyParser.FunctionOf(i: integer): TFuncDef;
424begin
425Result := TFuncDef(FunctionList.Items[i]);
426end;
427
428function TfxyParser.VariableOf(i: integer): TVarDef;
429begin
430Result := TVarDef(VariableList.Items[i]);
431end;
432
433function TfxyParser.CheckBrackets(const s: string): Boolean;
434var
435i, j, c1, c2: integer;
436
437begin
438c1 := 0;
439c2 := 0;
440i := 1;
441j := Length(s);
442while i <= j do
443begin
444if s[i] = '(' then Inc(c1);
445if s[i] = ')' then Inc(c2);
446Inc(i);
447end;
448Result := c1 = c2;
449end;
450
451function TfxyParser.CompileExpresion(const s: string; var Error: byte): TCalculus;
452var
453i: integer;
454e1: byte;
455e2: byte;
456c1, c2: TCalculus;
457
458begin
459if s = '' then
460begin
461Error := 3;
462Result := nil;
463Exit;
464end;
465
466if not CheckBrackets(s) then
467begin
468Error := 1;
469Result := nil;
470Exit;
471end;
472
473{----- -factor -----}
474if s[1] = '-' then
475begin
476c1 := FactorCompile(copy(s, 2, length(s)-1), e1);
477if e1 = 0 then
478begin
479c2 := TConst.Create(0);
480Result := TMinus.Create(c2, c1);
481Error := 0;
482Exit;
483end;
484end;
485
486{----- exp+factor -----}
487{----- exp-factor -----}
488{----- exp!factor -----}
489{----- exp�factor -----}
490for i := length(s) downto 1 do
491begin
492case s[i] of
493'+': begin
494c1 := CompileExpresion(copy(s, 1, i -1), e1);
495if e1 = 0 then
496begin
497c2 := FactorCompile(copy(s, i +1, length(s) -i), e2);
498if e2 = 0 then
499begin
500Result := TSum.Create(c1, c2);
501Error := 0;
502Exit;
503end
504else c1.Free;
505end;
506end;
507'-': begin
508c1 := CompileExpresion(copy(s, 1, i -1), e1);
509if e1 = 0 then
510begin
511c2 := FactorCompile(copy(s, i +1, length(s) -i), e2);
512if e2 = 0 then
513begin
514Result := TMinus.Create(c1, c2);
515Error := 0;
516Exit;
517end
518else c1.Free;
519end;
520end;
521'!': begin
522c1 := CompileExpresion(copy(s, 1, i -1), e1);
523if e1 = 0 then
524begin
525c2 := FactorCompile(copy(s, 1, i -1), e2);
526if e2 = 0 then
527begin
528Result := TFactorial.Create(c1, c2);
529Error := 0;
530Exit;
531end
532else c1.Free;
533end;
534end;
535'�': begin
536c1 := CompileExpresion(copy(s, 1, i -1), e1);
537if e1 = 0 then
538begin
539c2 := FactorCompile(copy(s, 1, i -1), e2);
540if e2 = 0 then
541begin
542Result := TDegToRad.Create(c1, c2);
543Error := 0;
544Exit;
545end
546else c1.Free;
547end;
548end;
549end; { case s[i] of... }
550end; { for i := length(s) downto 1 do... }
551Result := FactorCompile(s, Error);
552end;
553
554function TfxyParser.FactorCompile(const s: string; var Error: byte): TCalculus;
555var
556i: integer;
557e1, e2: byte;
558c1, c2: TCalculus;
559
560begin
561if s = '' then
562begin
563Error := 3;
564Result := nil;
565Exit;
566end;
567
568if not CheckBrackets(s) then
569begin
570Error := 1;
571Result := nil;
572Exit;
573end;
574
575{----- factor*simple -----}
576{----- factor/simple -----}
577for i := length(s) downto 1 do
578begin
579case s[i] of
580'*': begin
581c1 := FactorCompile(copy(s, 1, i -1), e1);
582if e1 = 0 then
583begin
584c2 := SimpleCompile(copy(s, i +1, length(s) -i), e2);
585if e2 = 0 then
586begin
587Result := TProduct.Create(c1, c2);
588Error := 0;
589Exit;
590end
591else c1.Free;
592end;
593end;
594'/': begin
595c1 := FactorCompile(copy(s, 1, i -1), e1);
596if e1 = 0 then
597begin
598c2 := SimpleCompile(copy(s, i +1, length(s) -i), e2);
599if e2 = 0 then
600begin
601Result := TDivision.Create(c1, c2);
602Error := 0;
603Exit;
604end
605else c1.Free;
606end;
607end;
608end; { case s[i] of... }
609end; { for i := length(s) downto 1 do... }
610Result := SimpleCompile(s, Error);
611end;
612
613function TfxyParser.SimpleCompile(const s: string; var Error: byte): TCalculus;
614var
615i: integer;
616e1, e2: byte;
617c1, c2: TCalculus;
618d: extended;
619
620begin
621if s = '' then
622begin
623Error := 3;
624Result := nil;
625Exit;
626end;
627
628if not CheckBrackets(s) then
629begin
630Error := 1;
631Result := nil;
632Exit;
633end;
634
635{----- const -----}
636Val(s, d, i);
637if i = 0 then
638begin
639Result := TConst.Create(d);
640Error := 0;
641Exit;
642end;
643
644{----- (exp) -----}
645if (s[1] = '(') and (s[length(s)] = ')') then
646begin
647c1 := CompileExpresion(copy(s, 2, length(s)-2), e1);
648if e1 = 0 then
649begin
650Result := c1;
651Error := 0;
652Exit;
653end;
654end;
655
656{----- VarName -----}
657for i := 0 to VariableList.Count -1 do
658begin
659if s = VariableOf(i).VarName then
660begin
661Result := TVar.Create(VariableOf(i));
662Error := 0;
663Exit;
664end;
665end;
666
667{----- DefNameFunc(exp) -----}
668for i := 0 to FunctionList.Count -1 do
669begin
670if (Pos(FunctionOf(i).DefName + '(', s) = 1) and (s[length(s)] = ')')
671then
672begin
673c1 := CompileExpresion(copy(s, length(FunctionOf(i).DefName) +2,
674length(s) - length(FunctionOf(i).DefName) -2), e1);
675if e1 = 0 then
676begin
677Result := TFunc.Create(c1, FunctionOf(i));
678Error := 0;
679Exit;
680end;
681end;
682end;
683
684{----- simple^simple -----}
685for i := 1 to length(s) do
686begin
687case s[i] of
688'^': begin
689c1 := SimpleCompile(copy(s, 1, i -1), e1);
690if e1 = 0 then
691begin
692c2 := SimpleCompile(copy(s, i +1, length(s) -i), e2);
693if e2 = 0 then
694begin
695Result := TPower.Create(c1, c2);
696Error := 0;
697Exit;
698end
699else c1.Free;
700end;
701end;
702end; { case s[i] of... }
703end; { for i := 1 to length(s) do... }
704
705Error := 2;
706Result := nil;
707end;
708
709function TfxyParser.Compile(s: string; var Error: byte): TCalculus;
710begin
711Result := CompileExpresion(s, Error);
712end;
713
714procedure TfxyParser.AddVar(v: TVarDef);
715begin
716VariableList.Add(v);
717end;
718
719procedure TfxyParser.ConstructLists;
720var
721v: TVarDef;
722begin
723with FunctionList do
724begin
725Add(TAbs.Create);
726Add(TInt.Create);
727Add(TRound.Create);
728Add(TSqr.Create);
729Add(TSqrt.Create);
730Add(TSin.Create);
731Add(TCos.Create);
732Add(TTan.Create);
733Add(TCsc.Create);
734Add(TSec.Create);
735Add(TCot.Create);
736
737Add(TArcSin.Create);
738Add(TArcCos.Create);
739Add(TArcTan.Create);
740Add(TArcCsc.Create);
741Add(TArcSec.Create);
742Add(TArcCot.Create);
743
744Add(TLn.Create);
745Add(TExp.Create);
746Add(TExp1.Create);
747Add(TLog10.Create);
748Add(TLog2.Create);
749
750Add(TSinh.Create);
751Add(TCosh.Create);
752Add(TTanh.Create);
753Add(TCsch.Create);
754Add(TSech.Create);
755Add(TCoth.Create);
756
757Add(TArcSinh.Create);
758Add(TArcCosh.Create);
759Add(TArcTanh.Create);
760Add(TArcCsch.Create);
761Add(TArcSech.Create);
762Add(TArcCoth.Create);
763end;
764
765v := TVarDef.Create;
766v.VarName := 'pi';
767v.Value := Pi;
768VariableList.Add(v);
769v := TVarDef.Create;
770v.VarName := '2pi';
771v.Value := twoPi;
772VariableList.Add(v);
773end;
774
775procedure TfxyParser.ClearLists;
776var
777i: integer;
778
779begin
780for i := 0 to FunctionList.Count -1 do TFuncDef(FunctionList[i]).Free;
781FunctionList.Free;
782for i := 0 to VariableList.Count -1 do TVarDef(VariableList[i]).Free;
783VariableList.Free;
784end;
785{ TfxyParser }
786
787{ TOperator Class }
788function TMinus.Eval: extended;
789begin
790Result := e1.Eval - e2.Eval;
791end;
792
793function TSum.Eval: extended;
794begin
795Result := e1.Eval + e2.Eval;
796end;
797
798function TProduct.Eval: extended;
799begin
800Result := e1.Eval * e2.Eval;
801end;
802
803function TDivision.Eval: extended;
804begin
805if IsInfinite(e2.Eval) then Result := NaN else Result := e1.Eval/e2.Eval;
806end;
807
808function TPower.Eval: extended;
809{ For fractional exponents or exponents greater than MaxInt,
810base must be greater than 0. }
811begin
812{ e1.Eval base/mantissa e2.Eval exponent }
813if e1.Eval = 0 then Result := 0 else Result := Power(e1.Eval, e2.Eval)
814end;
815
816function TFactorial.Eval: extended;
817var
818i, j: integer;
819
820begin
821j := round(e1.Eval);
822if (j < 0) or (j > 1754) then Result := 0.0
823else
824begin
825Result := 1.0;
826for i := 2 to j do Result := i*Result;
827end;
828end;
829
830function TDegToRad.Eval: extended;
831begin
832Result := e1.Eval*PiOn180;
833end;
834
835function TAbs.DefName: string;
836begin
837Result := 'abs';
838end;
839
840function TAbs.Eval(x: extended): extended;
841begin
842Result := Abs(x);
843end;
844
845function TInt.DefName: string;
846begin
847Result := 'int';
848end;
849
850function TInt.Eval(x: extended): extended;
851begin
852Result := Int(x);
853end;
854
855function TRound.DefName: string;
856begin
857Result := 'round';
858end;
859
860function TRound.Eval(x: extended): extended;
861begin
862Result := round(x);
863end;
864
865function TSqr.DefName: string;
866begin
867Result := 'sqr';
868end;
869
870function TSqr.Eval(x: extended): extended;
871begin
872Result := Sqr(x);
873end;
874
875function TSqrt.DefName: string;
876begin
877Result := 'sqrt';
878end;
879
880function TSqrt.Eval(x: extended): extended;
881begin
882Result := Sqrt(x);
883end;
884
885function TSin.DefName: string;
886begin
887Result := 'sin';
888end;
889
890function TSin.Eval(x: extended): extended;
891begin
892Result := Sin(x);
893end;
894
895function TCos.DefName: string;
896begin
897Result := 'cos';
898end;
899
900function TCos.Eval(x: extended): extended;
901begin
902Result := Cos(x);
903end;
904
905function TTan.DefName: string;
906begin
907Result := 'tan';
908end;
909
910function TTan.Eval(x: extended): extended;
911begin
912Result := Tan(x);
913end;
914
915function TCsc.DefName: string;
916begin
917Result := 'csc';
918end;
919
920function TCsc.Eval(x: extended): extended;
921begin
922Result := Csc(x);
923end;
924
925function TSec.DefName: string;
926begin
927Result := 'sec';
928end;
929
930function TSec.Eval(x: extended): extended;
931begin
932Result := Sec(x);
933end;
934
935function TCot.DefName: string;
936begin
937Result := 'cot';
938end;
939
940function TCot.Eval(x: extended): extended;
941begin
942Result := Cot(x);
943end;
944
945function TArcSin.DefName: string;
946begin
947Result := 'arcsin';
948end;
949
950function TArcSin.Eval(x: extended): extended;
951begin
952Result := ArcSin(x);
953end;
954
955function TArcCos.DefName: string;
956begin
957Result := 'arccos';
958end;
959
960function TArcCos.Eval(x: extended): extended;
961begin
962Result := ArcCos(x);
963end;
964
965function TArcTan.DefName: string;
966begin
967Result := 'arctan';
968end;
969
970function TArcTan.Eval(x: extended): extended;
971begin
972Result := ArcTan(x);
973end;
974
975function TArcCsc.DefName: string;
976begin
977Result := 'arccsc';
978end;
979
980function TArcCsc.Eval(x: extended): extended;
981begin
982Result := ArcCsc(x);
983end;
984
985function TArcSec.DefName: string;
986begin
987Result := 'arcsec';
988end;
989
990function TArcSec.Eval(x: extended): extended;
991begin
992Result := ArcSec(x);
993end;
994
995function TArcCot.DefName: string;
996begin
997Result := 'arccot';
998end;
999
1000function TArcCot.Eval(x: extended): extended;
1001begin
1002Result := ArcCot(x);
1003if (Result > Pion2) or (Result < -Pion2)
1004then Result := NaN;
1005end;
1006
1007function TLn.DefName: string;
1008begin
1009Result := 'ln';
1010end;
1011
1012function TLn.Eval(x: extended): extended;
1013begin
1014Result := Ln(x);
1015if isNaN(Result) then
1016begin
1017case Sign(Result) of
1018-1:Result := NegInfinity;
10190:Result := 0;
10201:Result := Infinity;
1021end;
1022end;
1023end;
1024
1025function TExp.DefName: string;
1026begin
1027Result := 'exp';
1028end;
1029
1030function TExp.Eval(x: extended): extended;
1031begin
1032Result := Exp(x);
1033end;
1034
1035function TExp1.DefName: string;
1036begin
1037Result := 'e^';
1038end;
1039
1040function TExp1.Eval(x: extended): extended;
1041begin
1042Result := Exp(x);
1043end;
1044
1045function TLog10.DefName: string;
1046begin
1047Result := 'log';
1048end;
1049
1050function TLog10.Eval(x: extended): extended;
1051begin
1052Result := Log10(x);
1053if isNaN(Result) then
1054begin
1055case Sign(Result) of
1056-1:Result := NegInfinity;
10570:Result := 0;
10581:Result := Infinity;
1059end;
1060end;
1061end;
1062
1063function TLog2.DefName: string;
1064begin
1065Result := 'log2';
1066end;
1067
1068function TLog2.Eval(x: extended): extended;
1069begin
1070Result := Log2(x);
1071if isNaN(Result) then
1072begin
1073case Sign(Result) of
1074-1:Result := NegInfinity;
10750:Result := 0;
10761:Result := Infinity;
1077end;
1078end;
1079end;
1080
1081function TSinh.DefName: string;
1082begin
1083Result := 'sinh';
1084end;
1085
1086function TSinh.Eval(x: extended): extended;
1087begin
1088Result := Sinh(x);
1089end;
1090
1091function TCosh.DefName: string;
1092begin
1093Result := 'cosh';
1094end;
1095
1096function TCosh.Eval(x: extended): extended;
1097begin
1098Result := Cosh(x);
1099end;
1100
1101function TTanh.DefName: string;
1102begin
1103Result := 'tanh';
1104end;
1105
1106function TTanh.Eval(x: extended): extended;
1107begin
1108Result := Tanh(x);
1109end;
1110
1111function TCsch.DefName: string;
1112begin
1113Result := 'csch';
1114end;
1115
1116function TCsch.Eval(x: extended): extended;
1117begin
1118Result := Csch(x);
1119end;
1120
1121function TSech.DefName: string;
1122begin
1123Result := 'sech';
1124end;
1125
1126function TSech.Eval(x: extended): extended;
1127begin
1128Result := Sech(x);
1129end;
1130
1131function TCoth.DefName: string;
1132begin
1133Result := 'coth';
1134end;
1135
1136function TCoth.Eval(x: extended): extended;
1137begin
1138Result := Coth(x);
1139end;
1140
1141function TArcSinh.DefName: string;
1142begin
1143Result := 'arcsinh';
1144end;
1145
1146function TArcSinh.Eval(x: extended): extended;
1147begin
1148Result := ArcSinh(x);
1149end;
1150
1151function TArcCosh.DefName: string;
1152begin
1153Result := 'arccosh';
1154end;
1155
1156function TArcCosh.Eval(x: extended): extended;
1157begin
1158Result := ArcCosh(x);
1159end;
1160
1161function TArcTanh.DefName: string;
1162begin
1163Result := 'arctanh';
1164end;
1165
1166function TArcTanh.Eval(x: extended): extended;
1167begin
1168Result := ArcTanh(x)
1169end;
1170
1171function TArcCsch.DefName: string;
1172begin
1173Result := 'arccsch';
1174end;
1175
1176function TArcCsch.Eval(x: extended): extended;
1177begin
1178if x = 0 then Result := Infinity else Result := ArcCsch(x);
1179{ it would seem that Delphi 7 personal calculates ArcCsch incorrectly }
1180end;
1181
1182function TArcSech.DefName: string;
1183begin
1184Result := 'arcsech';
1185end;
1186
1187function TArcSech.Eval(x: extended): extended;
1188begin
1189if x <= 0 then Result := Infinity else Result := ArcSech(x);
1190end;
1191
1192function TArcCoth.DefName: string;
1193begin
1194Result := 'arccoth';
1195end;
1196
1197function TArcCoth.Eval(x: extended): extended;
1198begin
1199if (x >= -1) and (x < 0) then Result := NegInfinity else
1200if (x > 0) and (x <= 1) then Result := Infinity else
1201if x = 0 then Result := NaN else Result := ArcCoth(x);
1202end;
1203{ TOperator Class }
1204
1205function ScanText(const s: string): string;
1206function DropSpaces_Commas(const s: string): string;
1207var
1208i: integer;
1209
1210begin
1211Result := '';
1212for i := 1 to Length(s) do
1213if (s[i] <> ' ') and (s[i] <> ',') then Result := Result + s[i];
1214end; { DropSpaces_Commas }
1215
1216var
1217i, j: integer;
1218c0, c1, c2: char;
1219cc, ccc, isStr: string;
1220nostar: Boolean;
1221isExp: Boolean;
1222isLog: Boolean;
1223isPwr: Boolean;
1224t: string;
1225
1226begin { ScanText }
1227t := DropSpaces_Commas(s);
1228i := 1;
1229j := 1;
1230Result := t;
1231while i < Length(t) do
1232begin
1233c0 := UpCase(t[i]);
1234c1 := UpCase(t[i +1]);
1235if i < Length(t) - 1 then c2 := UpCase(t[i +2]) else c2 := #0;
1236
1237cc := c0+c1;
1238ccc := c0+c1+c2;
1239
1240isExp := ccc = 'XP(';
1241isStr := '';
1242isLog := false;
1243
1244if (i > 3) and ((cc = '0(') or (cc = '2(')) then
1245begin
1246if cc = '0('
1247then isStr := UpperCase(Copy(t, i -4, 3)) { Log10 }
1248else isStr := UpperCase(Copy(t, i -3, 3)); { Log2 }
1249isLog := isStr = 'LOG';
1250end;
1251
1252isPwr := CharInSet(c0, ['+', '-', '0'..'9']) and (UpCase(c1) = 'E') and
1253CharInSet(c2, ['+', '-', '0'..'9']);
1254nostar := isExp or isLog or isPwr;
1255
1256if not nostar and
1257CharInSet(c0, ['X', 'Y', 'I', '0'..'9', ')']) and
1258CharInSet(c1, ['A'..'C', 'E', 'L', 'P', 'S', 'T', 'X', 'Y', '(']) then
1259begin
1260Insert('*', Result, i + j);
1261Inc(j);
1262end;
1263Inc(i);
1264end;
1265end; { ScanText }
1266
1267function ParseAndEvaluate(const aText: string; var e: byte): extended;
1268var
1269aParser: TfxyParser;
1270
1271begin
1272aParser := TfxyParser.Create(0, 0);
1273with aParser do
1274begin
1275Calculus.Free;
1276ErrorByte := 0;
1277FormPlot2D.StatusBar.Panels[4].Text := '';
1278Calculus := Compile(AnsiLowerCase(aText), ErrorByte);
1279e := ErrorByte;
1280if ErrorByte > 0 then
1281begin
1282with FormPlot2D.StatusBar.Panels[4] do
1283case ErrorByte of
12841:Text := 'Check Brackets for "'+ aText+'"';
12852:Text := 'Unable to Parse "'+aText+'"';
1286end;
1287Result := 0;
1288end
1289else Result := Calculus.Eval;
1290Calculus.Free;
1291Calculus := nil;
1292Free;
1293end;
1294end;
1295
1296function ParseEvaluateFxy(const aVarX, aVarY: extended;
1297const aText: string; var e: byte): extended;
1298var
1299aParser: TfxyParser;
1300
1301begin
1302aParser := TfxyParser.Create(0, 0);
1303with aParser do
1304begin
1305Calculus.Free;
1306ErrorByte := 0;
1307FormPlot2D.StatusBar.Panels[4].Text := '';
1308Calculus := Compile(AnsiLowerCase(aText), ErrorByte);
1309VarX.Value := aVarX;
1310VarY.Value := aVarY;
1311e := ErrorByte;
1312if ErrorByte > 0 then
1313begin
1314with FormPlot2D.StatusBar.Panels[4] do
1315case ErrorByte of
13161:Text := 'Check Brackets for "'+ aText+'"';
13172:Text := 'Unable to Parse "'+aText+'"';
1318end;
1319Result := 0;
1320end
1321else Result := Calculus.Eval;
1322Calculus.Free;
1323Calculus := nil;
1324Free;
1325end;
1326end;
1327
1328Initialization
1329{ Avoids arithmetic exceptions in the above code }
1330SetExceptionMask([exInvalidOp, exDenormalized, exZeroDivide,
1331exOverflow, exUnderflow, exPrecision]);
1332
1333end.
1334
1335