MathgeomGLS

1
unit uParser;
2
{ This parser is used only for z = f(x,y) heightfield 3D graphs }
3

4
interface
5

6
uses
7
  System.Classes,
8
  System.Math,
9
  System.SysUtils;
10

11
const
12
  Pi: extended = 3.1415926535897932385;
13
  PiOn2: extended = 1.5707963267948966192;
14
  twoPi: extended = 6.2831853071795864769;
15
  PiOn180: extended = 0.017453292519943296;
16

17
  ParseSet: Set of Char =
18
           [' ', '!', '(', ')', '*', '+', '-', '.', ',', '/', '0'..'9',
19
            'A'..'E', 'G'..'I', 'L', 'N'..'U', 'X', 'Y', '^', '`', #8];
20

21
type
22
  TFuncDef = class
23
  public
24
    function DefName: string; virtual; abstract;
25
    function Eval(x: extended): extended; virtual; abstract;
26
  end;
27

28
  TVarDef = class
29
  public
30
    VarName: string;
31
    Value: extended;
32
  end;
33

34
  TCalculus = class
35
  public
36
    function Eval: extended; virtual; abstract;
37
  end;
38

39
  TfxyParser = class(TObject)
40
    constructor Create(x, y: extended);
41
    destructor Destroy; override;
42
  private
43
    FunctionList: TList;
44
    VariableList: TList;
45
    function FunctionOf(i: integer): TFuncDef;
46
    function VariableOf(i: integer): TVarDef;
47
    function CheckBrackets(const s: string): Boolean;
48
    function CompileExpresion(const s: string; var Error: byte): TCalculus;
49
    function FactorCompile(const s: string; var Error: byte): TCalculus;
50
    function SimpleCompile(const s: string; var Error: byte): TCalculus;
51
    procedure ClearLists;
52
  public
53
    VarX, VarY: TVarDef;
54
    Calculus: TCalculus;
55
    ErrorByte: byte;
56
    function Compile(s: string; var Error: byte): TCalculus;
57
    procedure AddVar(v: TVarDef);
58
    procedure ConstructLists;
59
  end;
60

61
  TConst = class(TCalculus)
62
    constructor Create(c: extended);
63
  public
64
    function Eval: extended; override;
65
  private
66
    Val: extended;
67
  end;
68

69
  TVar = class(TCalculus)
70
  public
71
    constructor Create(v: TVarDef);
72
    function Eval: extended; override;
73
  protected
74
    Def: TVarDef;
75
  end;
76

77
  TFunc = class(TCalculus)
78
    constructor Create(v: TCalculus; f: TFuncDef);
79
    destructor Destroy; override;
80
  public
81
    function Eval: extended; override;
82
  protected
83
    Variable: TCalculus;
84
    Def: TFuncDef;
85
  end;
86

87
  TOperator = class(TCalculus)
88
    constructor Create(c1, c2: TCalculus);
89
    destructor Destroy; override;
90
  public
91
  protected
92
    e1, e2: TCalculus;
93
  end;
94

95
  TMinus = class(TOperator)
96
  public
97
    function Eval: extended; override;
98
  end;
99

100
  TSum = class(TOperator)
101
  public
102
    function Eval: extended; override;
103
  end;
104

105
  TProduct = class(TOperator)
106
  public
107
    function Eval: extended; override;
108
  end;
109

110
  TDivision = class(TOperator)
111
  public
112
    function Eval: extended; override;
113
  end;
114

115
  TPower = class(TOperator)
116
  public
117
    function Eval: extended; override;
118
  end;
119

120
  TFactorial = class(TOperator)
121
  public
122
    function Eval: extended; override;
123
  end;
124

125
  TDegToRad = class(TOperator)
126
  public
127
    function Eval: extended; override;
128
  end;
129

130
  TAbs = class(TFuncDef)
131
  public
132
    function DefName: string; override;
133
    function Eval(x: extended): extended; override;
134
  end;
135

136
  TInt = class(TFuncDef)
137
  public
138
    function DefName: string; override;
139
    function Eval(x: extended): extended; override;
140
  end;
141

142
  TRound = class(TFuncDef)
143
  public
144
    function DefName: string; override;
145
    function Eval(x: extended): extended; override;
146
  end;
147

148
  TSqr = class(TFuncDef)
149
  public
150
    function DefName: string; override;
151
    function Eval(x: extended): extended; override;
152
  end;
153

154
  TSqrt = class(TFuncDef)
155
  public
156
    function DefName: string; override;
157
    function Eval(x: extended): extended; override;
158
  end;
159

160
  TSin = class(TFuncDef)
161
  public
162
    function DefName: string; override;
163
    function Eval(x: extended): extended; override;
164
  end;
165

166
  TCos = class(TFuncDef)
167
  public
168
    function DefName: string; override;
169
    function Eval(x: extended): extended; override;
170
  end;
171

172
  TTan = class(TFuncDef)
173
  public
174
    function DefName: string; override;
175
    function Eval(x: extended): extended; override;
176
  end;
177

178
  TCsc = class(TFuncDef)
179
  public
180
    function DefName: string; override;
181
    function Eval(x: extended): extended; override;
182
  end;
183

184
  TSec = class(TFuncDef)
185
  public
186
    function DefName: string; override;
187
    function Eval(x: extended): extended; override;
188
  end;
189

190
  TCot = class(TFuncDef)
191
  public
192
    function DefName: string; override;
193
    function Eval(x: extended): extended; override;
194
  end;
195

196
  TArcSin = class(TFuncDef)
197
  public
198
    function DefName: string; override;
199
    function Eval(x: extended): extended; override;
200
  end;
201

202
  TArcCos = class(TFuncDef)
203
  public
204
    function DefName: string; override;
205
    function Eval(x: extended): extended; override;
206
  end;
207

208
  TArcTan = class(TFuncDef)
209
  public
210
    function DefName: string; override;
211
    function Eval(x: extended): extended; override;
212
  end;
213

214
  TArcCsc = class(TFuncDef)
215
  public
216
    function DefName: string; override;
217
    function Eval(x: extended): extended; override;
218
  end;
219

220
  TArcSec = class(TFuncDef)
221
  public
222
    function DefName: string; override;
223
    function Eval(x: extended): extended; override;
224
  end;
225

226
  TArcCot = class(TFuncDef)
227
  public
228
    function DefName: string; override;
229
    function Eval(x: extended): extended; override;
230
  end;
231

232
  TLn = class(TFuncDef)
233
  public
234
    function DefName: string; override;
235
    function Eval(x: extended): extended; override;
236
  end;
237

238
  TExp = class(TFuncDef)
239
  public
240
    function DefName: string; override;
241
    function Eval(x: extended): extended; override;
242
  end;
243

244
  TExp1 = class(TFuncDef)
245
  public
246
    function DefName: string; override;
247
    function Eval(x: extended): extended; override;
248
  end;
249

250
  TLog10 = class(TFuncDef)
251
  public
252
    function DefName: string; override;
253
    function Eval(x: extended): extended; override;
254
  end;
255

256
  TLog2 = class(TFuncDef)
257
  public
258
    function DefName: string; override;
259
    function Eval(x: extended): extended; override;
260
  end;
261

262
  TSinh = class(TFuncDef)
263
  public
264
    function DefName: string; override;
265
    function Eval(x: extended): extended; override;
266
  end;
267

268
  TCosh = class(TFuncDef)
269
  public
270
    function DefName: string; override;
271
    function Eval(x: extended): extended; override;
272
  end;
273

274
  TTanh = class(TFuncDef)
275
  public
276
    function DefName: string; override;
277
    function Eval(x: extended): extended; override;
278
  end;
279

280
  TCsch = class(TFuncDef)
281
  public
282
    function DefName: string; override;
283
    function Eval(x: extended): extended; override;
284
  end;
285

286
  TSech = class(TFuncDef)
287
  public
288
    function DefName: string; override;
289
    function Eval(x: extended): extended; override;
290
  end;
291

292
  TCoth = class(TFuncDef)
293
  public
294
    function DefName: string; override;
295
    function Eval(x: extended): extended; override;
296
  end;
297

298
  TArcSinh = class(TFuncDef)
299
  public
300
    function DefName: string; override;
301
    function Eval(x: extended): extended; override;
302
  end;
303

304
  TArcCosh = class(TFuncDef)
305
  public
306
    function DefName: string; override;
307
    function Eval(x: extended): extended; override;
308
  end;
309

310
  TArcTanh = class(TFuncDef)
311
  public
312
    function DefName: string; override;
313
    function Eval(x: extended): extended; override;
314
  end;
315

316
  TArcCsch = class(TFuncDef)
317
  public
318
    function DefName: string; override;
319
    function Eval(x: extended): extended; override;
320
  end;
321

322
  TArcSech = class(TFuncDef)
323
  public
324
    function DefName: string; override;
325
    function Eval(x: extended): extended; override;
326
  end;
327

328
  TArcCoth = class(TFuncDef)
329
  public
330
    function DefName: string; override;
331
    function Eval(x: extended): extended; override;
332
  end;
333

334
function ScanText(const s: string): string;
335
function ParseAndEvaluate(const aText: string; var e: byte): extended;
336
function ParseEvaluateFxy(const aVarX, aVarY: extended;
337
                          const aText: string; var e: byte): extended;
338

339
//=====================================================================
340
implementation
341
//=====================================================================
342

343
uses
344
  uGlobal,
345
  fPlot3D;
346

347
{ TCalculus Class }
348
constructor TConst.Create(c: extended);
349
begin
350
  Val := c;
351
end;
352

353
function TConst.Eval: extended;
354
begin
355
  Result := Val;
356
end;
357

358
constructor TVar.Create(v: TVarDef);
359
begin
360
  Def := v;
361
end;
362

363
function TVar.Eval: extended;
364
begin
365
  Result := Def.value;
366
end;
367

368
constructor TFunc.Create(v: TCalculus; f: TFuncDef);
369
begin
370
  Variable := v;
371
  Def := f;
372
end;
373

374
destructor TFunc.Destroy;
375
begin
376
  Variable.Free;
377
end;
378

379
function TFunc.Eval: extended;
380
begin
381
  Result := Def.Eval(Variable.Eval);
382
end;
383

384
constructor TOperator.Create(c1, c2: TCalculus);
385
begin
386
  e1 := c1;
387
  e2 := c2;
388
end;
389

390
destructor TOperator.Destroy;
391
begin
392
  e1.Free;
393
  e2.Free;
394
end;
395
{ TCalculus Class }
396

397
{ TfxyParser }
398
constructor TfxyParser.Create(x, y: extended);
399
begin
400
  inherited Create;
401
  FunctionList := TList.Create;
402
  VariableList := TList.Create;
403

404
  ConstructLists;
405

406
  VarX := TVarDef.Create;
407
  VarX.VarName := 'x';
408
  VarX.Value := x;
409
  addVar(VarX);
410

411
  VarY := TVarDef.Create;
412
  VarY.VarName := 'y';
413
  VarY.Value := y;
414
  addVar(VarY);
415
end;
416

417
destructor TfxyParser.Destroy;
418
begin
419
  ClearLists;
420
  inherited Destroy;
421
end;
422

423
function TfxyParser.FunctionOf(i: integer): TFuncDef;
424
begin
425
  Result := TFuncDef(FunctionList.Items[i]);
426
end;
427

428
function TfxyParser.VariableOf(i: integer): TVarDef;
429
begin
430
  Result := TVarDef(VariableList.Items[i]);
431
end;
432

433
function TfxyParser.CheckBrackets(const s: string): Boolean;
434
var
435
  i, j, c1, c2: integer;
436

437
begin
438
  c1 := 0;
439
  c2 := 0;
440
  i := 1;
441
  j := Length(s);
442
  while i <= j do
443
  begin
444
    if s[i] = '(' then Inc(c1);
445
    if s[i] = ')' then Inc(c2);
446
    Inc(i);
447
  end;
448
  Result := c1 = c2;
449
end;
450

451
function TfxyParser.CompileExpresion(const s: string; var Error: byte): TCalculus;
452
var
453
  i: integer;
454
  e1: byte;
455
  e2: byte;
456
  c1, c2: TCalculus;
457

458
begin
459
  if s = '' then
460
  begin
461
    Error := 3;
462
    Result := nil;
463
    Exit;
464
  end;
465

466
  if not CheckBrackets(s) then
467
  begin
468
    Error := 1;
469
    Result := nil;
470
    Exit;
471
  end;
472

473
 {----- -factor -----}
474
  if s[1] = '-' then
475
  begin
476
    c1 := FactorCompile(copy(s, 2, length(s)-1), e1);
477
    if e1 = 0 then
478
    begin
479
      c2 := TConst.Create(0);
480
      Result := TMinus.Create(c2, c1);
481
      Error := 0;
482
      Exit;
483
    end;
484
  end;
485

486
 {----- exp+factor -----}
487
 {----- exp-factor -----}
488
 {----- exp!factor -----}
489
 {----- exp�factor -----}
490
  for i := length(s) downto 1 do
491
  begin
492
    case s[i] of
493
 '+': begin
494
        c1 := CompileExpresion(copy(s, 1, i -1), e1);
495
        if e1 = 0 then
496
        begin
497
          c2 := FactorCompile(copy(s, i +1, length(s) -i), e2);
498
          if e2 = 0 then
499
          begin
500
            Result := TSum.Create(c1, c2);
501
            Error := 0;
502
            Exit;
503
          end
504
          else c1.Free;
505
        end;
506
      end;
507
 '-': begin
508
        c1 := CompileExpresion(copy(s, 1, i -1), e1);
509
        if e1 = 0 then
510
        begin
511
          c2 := FactorCompile(copy(s, i +1, length(s) -i), e2);
512
          if e2 = 0 then
513
          begin
514
            Result := TMinus.Create(c1, c2);
515
            Error := 0;
516
            Exit;
517
          end
518
          else c1.Free;
519
        end;
520
      end;
521
 '!': begin
522
        c1 := CompileExpresion(copy(s, 1, i -1), e1);
523
        if e1 = 0 then
524
        begin
525
          c2 := FactorCompile(copy(s, 1, i -1), e2);
526
          if e2 = 0 then
527
          begin
528
            Result := TFactorial.Create(c1, c2);
529
            Error := 0;
530
            Exit;
531
          end
532
          else c1.Free;
533
        end;
534
      end;
535
 '�': begin
536
        c1 := CompileExpresion(copy(s, 1, i -1), e1);
537
        if e1 = 0 then
538
        begin
539
          c2 := FactorCompile(copy(s, 1, i -1), e2);
540
          if e2 = 0 then
541
          begin
542
            Result := TDegToRad.Create(c1, c2);
543
            Error := 0;
544
            Exit;
545
          end
546
          else c1.Free;
547
        end;
548
      end;
549
    end;  { case s[i] of... }
550
  end;  { for i := length(s) downto 1 do... }
551
  Result := FactorCompile(s, Error);
552
end;
553

554
function TfxyParser.FactorCompile(const s: string; var Error: byte): TCalculus;
555
var
556
  i: integer;
557
  e1, e2: byte;
558
  c1, c2: TCalculus;
559

560
begin
561
  if s = '' then
562
  begin
563
    Error := 3;
564
    Result := nil;
565
    Exit;
566
  end;
567

568
  if not CheckBrackets(s) then
569
  begin
570
    Error := 1;
571
    Result := nil;
572
    Exit;
573
  end;
574

575
 {----- factor*simple -----}
576
 {----- factor/simple -----}
577
  for i := length(s) downto 1 do
578
  begin
579
    case s[i] of
580
 '*': begin
581
        c1 := FactorCompile(copy(s, 1, i -1), e1);
582
        if e1 = 0 then
583
        begin
584
          c2 := SimpleCompile(copy(s, i +1, length(s) -i), e2);
585
          if e2 = 0 then
586
          begin
587
            Result := TProduct.Create(c1, c2);
588
            Error := 0;
589
            Exit;
590
          end
591
          else c1.Free;
592
        end;
593
      end;
594
 '/': begin
595
        c1 := FactorCompile(copy(s, 1, i -1), e1);
596
        if e1 = 0 then
597
        begin
598
          c2 := SimpleCompile(copy(s, i +1, length(s) -i), e2);
599
          if e2 = 0 then
600
          begin
601
            Result := TDivision.Create(c1, c2);
602
            Error := 0;
603
            Exit;
604
          end
605
          else c1.Free;
606
        end;
607
      end;
608
    end;  { case s[i] of... }
609
  end;  { for i := length(s) downto 1 do... }
610
  Result := SimpleCompile(s, Error);
611
end;
612

613
function TfxyParser.SimpleCompile(const s: string; var Error: byte): TCalculus;
614
var
615
  i: integer;
616
  e1, e2: byte;
617
  c1, c2: TCalculus;
618
  d: extended;
619

620
begin
621
  if s = '' then
622
  begin
623
    Error := 3;
624
    Result := nil;
625
    Exit;
626
  end;
627

628
  if not CheckBrackets(s) then
629
  begin
630
    Error := 1;
631
    Result := nil;
632
    Exit;
633
  end;
634

635
 {----- const -----}
636
  Val(s, d, i);
637
  if i = 0 then
638
  begin
639
    Result := TConst.Create(d);
640
    Error := 0;
641
    Exit;
642
  end;
643

644
 {----- (exp) -----}
645
  if (s[1] = '(') and (s[length(s)] = ')') then
646
  begin
647
    c1 := CompileExpresion(copy(s, 2, length(s)-2), e1);
648
    if e1 = 0 then
649
    begin
650
      Result := c1;
651
      Error := 0;
652
      Exit;
653
    end;
654
  end;
655

656
 {----- VarName -----}
657
  for i := 0 to VariableList.Count -1 do
658
  begin
659
    if s = VariableOf(i).VarName then
660
    begin
661
      Result := TVar.Create(VariableOf(i));
662
      Error := 0;
663
      Exit;
664
    end;
665
  end;
666

667
 {----- DefNameFunc(exp) -----}
668
  for i := 0 to FunctionList.Count -1 do
669
  begin
670
    if (Pos(FunctionOf(i).DefName + '(', s) = 1) and (s[length(s)] = ')')
671
    then
672
    begin
673
      c1 := CompileExpresion(copy(s, length(FunctionOf(i).DefName) +2,
674
                         length(s) - length(FunctionOf(i).DefName) -2), e1);
675
      if e1 = 0 then
676
      begin
677
        Result := TFunc.Create(c1, FunctionOf(i));
678
        Error := 0;
679
        Exit;
680
      end;
681
    end;
682
  end;
683

684
 {----- simple^simple -----}
685
  for i := 1 to length(s) do
686
  begin
687
    case s[i] of
688
 '^': begin
689
        c1 := SimpleCompile(copy(s, 1, i -1), e1);
690
        if e1 = 0 then
691
        begin
692
          c2 := SimpleCompile(copy(s, i +1, length(s) -i), e2);
693
          if e2 = 0 then
694
          begin
695
            Result := TPower.Create(c1, c2);
696
            Error := 0;
697
            Exit;
698
          end
699
          else c1.Free;
700
        end;
701
      end;
702
    end;  { case s[i] of... }
703
  end;  { for i := 1 to length(s) do... }
704

705
  Error := 2;
706
  Result := nil;
707
end;
708

709
function TfxyParser.Compile(s: string; var Error: byte): TCalculus;
710
begin
711
  Result := CompileExpresion(s, Error);
712
end;
713

714
procedure TfxyParser.AddVar(v: TVarDef);
715
begin
716
  VariableList.Add(v);
717
end;
718

719
procedure TfxyParser.ConstructLists;
720
var
721
  v: TVarDef;
722
begin
723
  with FunctionList do
724
  begin
725
    Add(TAbs.Create);
726
    Add(TInt.Create);
727
    Add(TRound.Create);
728
    Add(TSqr.Create);
729
    Add(TSqrt.Create);
730
    Add(TSin.Create);
731
    Add(TCos.Create);
732
    Add(TTan.Create);
733
    Add(TCsc.Create);
734
    Add(TSec.Create);
735
    Add(TCot.Create);
736

737
    Add(TArcSin.Create);
738
    Add(TArcCos.Create);
739
    Add(TArcTan.Create);
740
    Add(TArcCsc.Create);
741
    Add(TArcSec.Create);
742
    Add(TArcCot.Create);
743

744
    Add(TLn.Create);
745
    Add(TExp.Create);
746
    Add(TExp1.Create);
747
    Add(TLog10.Create);
748
    Add(TLog2.Create);
749

750
    Add(TSinh.Create);
751
    Add(TCosh.Create);
752
    Add(TTanh.Create);
753
    Add(TCsch.Create);
754
    Add(TSech.Create);
755
    Add(TCoth.Create);
756

757
    Add(TArcSinh.Create);
758
    Add(TArcCosh.Create);
759
    Add(TArcTanh.Create);
760
    Add(TArcCsch.Create);
761
    Add(TArcSech.Create);
762
    Add(TArcCoth.Create);
763
  end;
764

765
  v := TVarDef.Create;
766
  v.VarName := 'pi';
767
  v.Value := Pi;
768
  VariableList.Add(v);
769
  v := TVarDef.Create;
770
  v.VarName := '2pi';
771
  v.Value := twoPi;
772
  VariableList.Add(v);
773
end;
774

775
procedure TfxyParser.ClearLists;
776
var
777
  i: integer;
778

779
begin
780
  for i := 0 to FunctionList.Count -1 do TFuncDef(FunctionList[i]).Free;
781
  FunctionList.Free;
782
  for i := 0 to VariableList.Count -1 do TVarDef(VariableList[i]).Free;
783
  VariableList.Free;
784
end;
785
{ TfxyParser }
786

787
{ TOperator Class }
788
function TMinus.Eval: extended;
789
begin
790
  Result := e1.Eval - e2.Eval;
791
end;
792

793
function TSum.Eval: extended;
794
begin
795
  Result := e1.Eval + e2.Eval;
796
end;
797

798
function TProduct.Eval: extended;
799
begin
800
  Result := e1.Eval * e2.Eval;
801
end;
802

803
function TDivision.Eval: extended;
804
begin
805
  if IsInfinite(e2.Eval) then Result := NaN else Result := e1.Eval/e2.Eval;
806
end;
807

808
function TPower.Eval: extended;
809
{ For fractional exponents or exponents greater than MaxInt,
810
  base must be greater than 0. }
811
begin
812
{ e1.Eval base/mantissa e2.Eval exponent }
813
  if e1.Eval = 0 then Result := 0 else Result := Power(e1.Eval, e2.Eval)
814
end;
815

816
function TFactorial.Eval: extended;
817
var
818
  i, j: integer;
819

820
begin
821
  j := round(e1.Eval);
822
  if (j < 0) or (j > 1754) then Result := 0.0
823
  else
824
  begin
825
    Result := 1.0;
826
    for i := 2 to j do Result := i*Result;
827
  end;
828
end;
829

830
function TDegToRad.Eval: extended;
831
begin
832
  Result := e1.Eval*PiOn180;
833
end;
834

835
function TAbs.DefName: string;
836
begin
837
  Result := 'abs';
838
end;
839

840
function TAbs.Eval(x: extended): extended;
841
begin
842
  Result := Abs(x);
843
end;
844

845
function TInt.DefName: string;
846
begin
847
  Result := 'int';
848
end;
849

850
function TInt.Eval(x: extended): extended;
851
begin
852
  Result := Int(x);
853
end;
854

855
function TRound.DefName: string;
856
begin
857
  Result := 'round';
858
end;
859

860
function TRound.Eval(x: extended): extended;
861
begin
862
  Result := round(x);
863
end;
864

865
function TSqr.DefName: string;
866
begin
867
  Result := 'sqr';
868
end;
869

870
function TSqr.Eval(x: extended): extended;
871
begin
872
  Result := Sqr(x);
873
end;
874

875
function TSqrt.DefName: string;
876
begin
877
  Result := 'sqrt';
878
end;
879

880
function TSqrt.Eval(x: extended): extended;
881
begin
882
  Result := Sqrt(x);
883
end;
884

885
function TSin.DefName: string;
886
begin
887
  Result := 'sin';
888
end;
889

890
function TSin.Eval(x: extended): extended;
891
begin
892
  Result := Sin(x);
893
end;
894

895
function TCos.DefName: string;
896
begin
897
  Result := 'cos';
898
end;
899

900
function TCos.Eval(x: extended): extended;
901
begin
902
  Result := Cos(x);
903
end;
904

905
function TTan.DefName: string;
906
begin
907
  Result := 'tan';
908
end;
909

910
function TTan.Eval(x: extended): extended;
911
begin
912
  Result := Tan(x);
913
end;
914

915
function TCsc.DefName: string;
916
begin
917
  Result := 'csc';
918
end;
919

920
function TCsc.Eval(x: extended): extended;
921
begin
922
  Result := Csc(x);
923
end;
924

925
function TSec.DefName: string;
926
begin
927
  Result := 'sec';
928
end;
929

930
function TSec.Eval(x: extended): extended;
931
begin
932
  Result := Sec(x);
933
end;
934

935
function TCot.DefName: string;
936
begin
937
  Result := 'cot';
938
end;
939

940
function TCot.Eval(x: extended): extended;
941
begin
942
  Result := Cot(x);
943
end;
944

945
function TArcSin.DefName: string;
946
begin
947
  Result := 'arcsin';
948
end;
949

950
function TArcSin.Eval(x: extended): extended;
951
begin
952
  Result := ArcSin(x);
953
end;
954

955
function TArcCos.DefName: string;
956
begin
957
  Result := 'arccos';
958
end;
959

960
function TArcCos.Eval(x: extended): extended;
961
begin
962
  Result := ArcCos(x);
963
end;
964

965
function TArcTan.DefName: string;
966
begin
967
  Result := 'arctan';
968
end;
969

970
function TArcTan.Eval(x: extended): extended;
971
begin
972
  Result := ArcTan(x);
973
end;
974

975
function TArcCsc.DefName: string;
976
begin
977
  Result := 'arccsc';
978
end;
979

980
function TArcCsc.Eval(x: extended): extended;
981
begin
982
  Result := ArcCsc(x);
983
end;
984

985
function TArcSec.DefName: string;
986
begin
987
  Result := 'arcsec';
988
end;
989

990
function TArcSec.Eval(x: extended): extended;
991
begin
992
  Result := ArcSec(x);
993
end;
994

995
function TArcCot.DefName: string;
996
begin
997
  Result := 'arccot';
998
end;
999

1000
function TArcCot.Eval(x: extended): extended;
1001
begin
1002
  Result := ArcCot(x);
1003
  if (Result > Pion2) or (Result < -Pion2)
1004
  then Result := NaN;
1005
end;
1006

1007
function TLn.DefName: string;
1008
begin
1009
  Result := 'ln';
1010
end;
1011

1012
function TLn.Eval(x: extended): extended;
1013
begin
1014
  Result := Ln(x);
1015
  if isNaN(Result) then
1016
  begin
1017
    case Sign(Result) of
1018
   -1:Result := NegInfinity;
1019
    0:Result := 0;
1020
    1:Result := Infinity;
1021
    end;
1022
  end;
1023
end;
1024

1025
function TExp.DefName: string;
1026
begin
1027
  Result := 'exp';
1028
end;
1029

1030
function TExp.Eval(x: extended): extended;
1031
begin
1032
  Result := Exp(x);
1033
end;
1034

1035
function TExp1.DefName: string;
1036
begin
1037
  Result := 'e^';
1038
end;
1039

1040
function TExp1.Eval(x: extended): extended;
1041
begin
1042
  Result := Exp(x);
1043
end;
1044

1045
function TLog10.DefName: string;
1046
begin
1047
  Result := 'log';
1048
end;
1049

1050
function TLog10.Eval(x: extended): extended;
1051
begin
1052
  Result := Log10(x);
1053
  if isNaN(Result) then
1054
  begin
1055
    case Sign(Result) of
1056
   -1:Result := NegInfinity;
1057
    0:Result := 0;
1058
    1:Result := Infinity;
1059
    end;
1060
  end;
1061
end;
1062

1063
function TLog2.DefName: string;
1064
begin
1065
  Result := 'log2';
1066
end;
1067

1068
function TLog2.Eval(x: extended): extended;
1069
begin
1070
  Result := Log2(x);
1071
  if isNaN(Result) then
1072
  begin
1073
    case Sign(Result) of
1074
   -1:Result := NegInfinity;
1075
    0:Result := 0;
1076
    1:Result := Infinity;
1077
    end;
1078
  end;
1079
end;
1080

1081
function TSinh.DefName: string;
1082
begin
1083
  Result := 'sinh';
1084
end;
1085

1086
function TSinh.Eval(x: extended): extended;
1087
begin
1088
  Result := Sinh(x);
1089
end;
1090

1091
function TCosh.DefName: string;
1092
begin
1093
  Result := 'cosh';
1094
end;
1095

1096
function TCosh.Eval(x: extended): extended;
1097
begin
1098
  Result := Cosh(x);
1099
end;
1100

1101
function TTanh.DefName: string;
1102
begin
1103
  Result := 'tanh';
1104
end;
1105

1106
function TTanh.Eval(x: extended): extended;
1107
begin
1108
  Result := Tanh(x);
1109
end;
1110

1111
function TCsch.DefName: string;
1112
begin
1113
  Result := 'csch';
1114
end;
1115

1116
function TCsch.Eval(x: extended): extended;
1117
begin
1118
  Result := Csch(x);
1119
end;
1120

1121
function TSech.DefName: string;
1122
begin
1123
  Result := 'sech';
1124
end;
1125

1126
function TSech.Eval(x: extended): extended;
1127
begin
1128
  Result := Sech(x);
1129
end;
1130

1131
function TCoth.DefName: string;
1132
begin
1133
  Result := 'coth';
1134
end;
1135

1136
function TCoth.Eval(x: extended): extended;
1137
begin
1138
  Result := Coth(x);
1139
end;
1140

1141
function TArcSinh.DefName: string;
1142
begin
1143
  Result := 'arcsinh';
1144
end;
1145

1146
function TArcSinh.Eval(x: extended): extended;
1147
begin
1148
  Result := ArcSinh(x);
1149
end;
1150

1151
function TArcCosh.DefName: string;
1152
begin
1153
  Result := 'arccosh';
1154
end;
1155

1156
function TArcCosh.Eval(x: extended): extended;
1157
begin
1158
  Result := ArcCosh(x);
1159
end;
1160

1161
function TArcTanh.DefName: string;
1162
begin
1163
  Result := 'arctanh';
1164
end;
1165

1166
function TArcTanh.Eval(x: extended): extended;
1167
begin
1168
  Result := ArcTanh(x)
1169
end;
1170

1171
function TArcCsch.DefName: string;
1172
begin
1173
  Result := 'arccsch';
1174
end;
1175

1176
function TArcCsch.Eval(x: extended): extended;
1177
begin
1178
  if x = 0 then Result := Infinity else Result := ArcCsch(x);
1179
{ it would seem that Delphi 7 personal calculates ArcCsch incorrectly }
1180
end;
1181

1182
function TArcSech.DefName: string;
1183
begin
1184
  Result := 'arcsech';
1185
end;
1186

1187
function TArcSech.Eval(x: extended): extended;
1188
begin
1189
  if x <= 0 then Result := Infinity else Result := ArcSech(x);
1190
end;
1191

1192
function TArcCoth.DefName: string;
1193
begin
1194
  Result := 'arccoth';
1195
end;
1196

1197
function TArcCoth.Eval(x: extended): extended;
1198
begin
1199
  if (x >= -1) and (x < 0) then Result := NegInfinity else
1200
  if (x > 0) and (x <= 1) then Result := Infinity else
1201
  if x = 0 then Result := NaN else Result := ArcCoth(x);
1202
end;
1203
{ TOperator Class }
1204

1205
function ScanText(const s: string): string;
1206
  function DropSpaces_Commas(const s: string): string;
1207
  var
1208
    i: integer;
1209

1210
  begin
1211
    Result := '';
1212
    for i := 1 to Length(s) do
1213
    if (s[i] <> ' ') and (s[i] <> ',') then Result := Result + s[i];
1214
  end;   { DropSpaces_Commas }
1215

1216
var
1217
  i, j: integer;
1218
  c0, c1, c2: char;
1219
  cc, ccc, isStr: string;
1220
  nostar: Boolean;
1221
  isExp: Boolean;
1222
  isLog: Boolean;
1223
  isPwr: Boolean;
1224
  t: string;
1225

1226
begin  { ScanText }
1227
  t := DropSpaces_Commas(s);
1228
  i := 1;
1229
  j := 1;
1230
  Result := t;
1231
  while i < Length(t) do
1232
  begin
1233
    c0 := UpCase(t[i]);
1234
    c1 := UpCase(t[i +1]);
1235
    if i < Length(t) - 1 then c2 := UpCase(t[i +2]) else c2 := #0;
1236

1237
    cc  := c0+c1;
1238
    ccc := c0+c1+c2;
1239

1240
    isExp := ccc = 'XP(';
1241
    isStr := '';
1242
    isLog := false;
1243

1244
    if (i > 3) and ((cc = '0(') or (cc = '2(')) then
1245
    begin
1246
      if cc = '0('
1247
      then isStr := UpperCase(Copy(t, i -4, 3))    { Log10 }
1248
      else isStr := UpperCase(Copy(t, i -3, 3));   { Log2 }
1249
      isLog := isStr = 'LOG';
1250
    end;
1251

1252
    isPwr := CharInSet(c0, ['+', '-', '0'..'9']) and (UpCase(c1) = 'E') and
1253
             CharInSet(c2, ['+', '-', '0'..'9']);
1254
    nostar := isExp or isLog or isPwr;
1255

1256
    if not nostar and
1257
      CharInSet(c0, ['X', 'Y', 'I', '0'..'9', ')']) and
1258
      CharInSet(c1, ['A'..'C', 'E', 'L', 'P', 'S', 'T', 'X', 'Y', '(']) then
1259
    begin
1260
      Insert('*', Result, i + j);
1261
      Inc(j);
1262
    end;
1263
    Inc(i);
1264
  end;
1265
end;   { ScanText }
1266

1267
function ParseAndEvaluate(const aText: string; var e: byte): extended;
1268
var
1269
  aParser: TfxyParser;
1270

1271
begin
1272
  aParser := TfxyParser.Create(0, 0);
1273
  with aParser do
1274
  begin
1275
    Calculus.Free;
1276
    ErrorByte := 0;
1277
    ViewForm.StatusBar.Panels[4].Text := '';
1278
    Calculus := Compile(AnsiLowerCase(aText), ErrorByte);
1279
    e := ErrorByte;
1280
    if ErrorByte > 0 then
1281
    begin
1282
      with ViewForm.StatusBar.Panels[4] do
1283
      case ErrorByte of
1284
      1:Text := 'Check Brackets for "'+ aText+'"';
1285
      2:Text := 'Unable to Parse "'+aText+'"';
1286
      end;
1287
      Result := 0;
1288
    end
1289
    else Result := Calculus.Eval;
1290
    Calculus.Free;
1291
    Calculus := nil;
1292
    Free;
1293
  end;
1294
end;
1295

1296
function ParseEvaluateFxy(const aVarX, aVarY: extended;
1297
                          const aText: string; var e: byte): extended;
1298
var
1299
  aParser: TfxyParser;
1300

1301
begin
1302
  aParser := TfxyParser.Create(0, 0);
1303
  with aParser do
1304
  begin
1305
    Calculus.Free;
1306
    ErrorByte := 0;
1307
    ViewForm.StatusBar.Panels[4].Text := '';
1308
    Calculus := Compile(AnsiLowerCase(aText), ErrorByte);
1309
    VarX.Value := aVarX;
1310
    VarY.Value := aVarY;
1311
    e := ErrorByte;
1312
    if ErrorByte > 0 then
1313
    begin
1314
      with ViewForm.StatusBar.Panels[4] do
1315
      case ErrorByte of
1316
      1:Text := 'Check Brackets for "'+ aText+'"';
1317
      2:Text := 'Unable to Parse "'+aText+'"';
1318
      end;
1319
      Result := 0;
1320
    end
1321
    else Result := Calculus.Eval;
1322
    Calculus.Free;
1323
    Calculus := nil;
1324
    Free;
1325
  end;
1326
end;
1327

1328
Initialization
1329
{ Avoids arithmetic exceptions in the above code }
1330
SetExceptionMask([exInvalidOp, exDenormalized, exZeroDivide,
1331
                  exOverflow, exUnderflow, exPrecision]);
1332

1333
end.
1334

1335