MathgeomGLS

1
unit Graf.Parser2d;
2
(*
3
  This parser is used only for z = f(x,y) heightfield 3D graphs
4
*)
5

6
interface
7

8
uses
9
  System.Classes,
10
  System.Math,
11
  System.SysUtils;
12

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

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

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

30
  TVarDef = class
31
  public
32
    VarName: string;
33
    Value: extended;
34
  end;
35

36
  TCalculus = class
37
  public
38
    function Eval: extended; virtual; abstract;
39
  end;
40

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

341
// =====================================================================
342
implementation
343
// =====================================================================
344

345
uses
346
  Graf.Global2d,
347
  faGraf2d;
348

349
// TCalculus Class
350
constructor TConst.Create(c: extended);
351
begin
352
  Val := c;
353
end;
354

355
function TConst.Eval: extended;
356
begin
357
  Result := Val;
358
end;
359

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

365
function TVar.Eval: extended;
366
begin
367
  Result := Def.Value;
368
end;
369

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

376
destructor TFunc.Destroy;
377
begin
378
  Variable.Free;
379
end;
380

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

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

392
destructor TOperator.Destroy;
393
begin
394
  e1.Free;
395
  e2.Free;
396
end;
397

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

405
  ConstructLists;
406

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

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

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

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

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

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

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

454
function TfxyParser.CompileExpresion(const s: string; var Error: byte)
455
  : TCalculus;
456
var
457
  i: integer;
458
  e1: byte;
459
  e2: byte;
460
  c1, c2: TCalculus;
461

462
begin
463
  if s = '' then
464
  begin
465
    Error := 3;
466
    Result := nil;
467
    Exit;
468
  end;
469

470
  if not CheckBrackets(s) then
471
  begin
472
    Error := 1;
473
    Result := nil;
474
    Exit;
475
  end;
476

477
  // ----- -factor -----
478
  if s[1] = '-' then
479
  begin
480
    c1 := FactorCompile(copy(s, 2, Length(s) - 1), e1);
481
    if e1 = 0 then
482
    begin
483
      c2 := TConst.Create(0);
484
      Result := TMinus.Create(c2, c1);
485
      Error := 0;
486
      Exit;
487
    end;
488
  end;
489

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

566
function TfxyParser.FactorCompile(const s: string; var Error: byte): TCalculus;
567
var
568
  i: integer;
569
  e1, e2: byte;
570
  c1, c2: TCalculus;
571

572
begin
573
  if s = '' then
574
  begin
575
    Error := 3;
576
    Result := nil;
577
    Exit;
578
  end;
579

580
  if not CheckBrackets(s) then
581
  begin
582
    Error := 1;
583
    Result := nil;
584
    Exit;
585
  end;
586

587
  { ----- factor*simple ----- }
588
  { ----- factor/simple ----- }
589
  for i := Length(s) downto 1 do
590
  begin
591
    case s[i] of
592
      '*':
593
        begin
594
          c1 := FactorCompile(copy(s, 1, i - 1), e1);
595
          if e1 = 0 then
596
          begin
597
            c2 := SimpleCompile(copy(s, i + 1, Length(s) - i), e2);
598
            if e2 = 0 then
599
            begin
600
              Result := TProduct.Create(c1, c2);
601
              Error := 0;
602
              Exit;
603
            end
604
            else
605
              c1.Free;
606
          end;
607
        end;
608
      '/':
609
        begin
610
          c1 := FactorCompile(copy(s, 1, i - 1), e1);
611
          if e1 = 0 then
612
          begin
613
            c2 := SimpleCompile(copy(s, i + 1, Length(s) - i), e2);
614
            if e2 = 0 then
615
            begin
616
              Result := TDivision.Create(c1, c2);
617
              Error := 0;
618
              Exit;
619
            end
620
            else
621
              c1.Free;
622
          end;
623
        end;
624
    end; { case s[i] of... }
625
  end; { for i := length(s) downto 1 do... }
626
  Result := SimpleCompile(s, Error);
627
end;
628

629
function TfxyParser.SimpleCompile(const s: string; var Error: byte): TCalculus;
630
var
631
  i: integer;
632
  e1, e2: byte;
633
  c1, c2: TCalculus;
634
  d: extended;
635

636
begin
637
  if s = '' then
638
  begin
639
    Error := 3;
640
    Result := nil;
641
    Exit;
642
  end;
643

644
  if not CheckBrackets(s) then
645
  begin
646
    Error := 1;
647
    Result := nil;
648
    Exit;
649
  end;
650

651
  { ----- const ----- }
652
  Val(s, d, i);
653
  if i = 0 then
654
  begin
655
    Result := TConst.Create(d);
656
    Error := 0;
657
    Exit;
658
  end;
659

660
  { ----- (exp) ----- }
661
  if (s[1] = '(') and (s[Length(s)] = ')') then
662
  begin
663
    c1 := CompileExpresion(copy(s, 2, Length(s) - 2), e1);
664
    if e1 = 0 then
665
    begin
666
      Result := c1;
667
      Error := 0;
668
      Exit;
669
    end;
670
  end;
671

672
  { ----- VarName ----- }
673
  for i := 0 to VariableList.Count - 1 do
674
  begin
675
    if s = VariableOf(i).VarName then
676
    begin
677
      Result := TVar.Create(VariableOf(i));
678
      Error := 0;
679
      Exit;
680
    end;
681
  end;
682

683
  { ----- DefNameFunc(exp) ----- }
684
  for i := 0 to FunctionList.Count - 1 do
685
  begin
686
    if (Pos(FunctionOf(i).DefName + '(', s) = 1) and (s[Length(s)] = ')') then
687
    begin
688
      c1 := CompileExpresion(copy(s, Length(FunctionOf(i).DefName) + 2,
689
        Length(s) - Length(FunctionOf(i).DefName) - 2), e1);
690
      if e1 = 0 then
691
      begin
692
        Result := TFunc.Create(c1, FunctionOf(i));
693
        Error := 0;
694
        Exit;
695
      end;
696
    end;
697
  end;
698

699
  { ----- simple^simple ----- }
700
  for i := 1 to Length(s) do
701
  begin
702
    case s[i] of
703
      '^':
704
        begin
705
          c1 := SimpleCompile(copy(s, 1, i - 1), e1);
706
          if e1 = 0 then
707
          begin
708
            c2 := SimpleCompile(copy(s, i + 1, Length(s) - i), e2);
709
            if e2 = 0 then
710
            begin
711
              Result := TPower.Create(c1, c2);
712
              Error := 0;
713
              Exit;
714
            end
715
            else
716
              c1.Free;
717
          end;
718
        end;
719
    end; { case s[i] of... }
720
  end; { for i := 1 to length(s) do... }
721

722
  Error := 2;
723
  Result := nil;
724
end;
725

726
function TfxyParser.Compile(s: string; var Error: byte): TCalculus;
727
begin
728
  Result := CompileExpresion(s, Error);
729
end;
730

731
procedure TfxyParser.AddVar(v: TVarDef);
732
begin
733
  VariableList.Add(v);
734
end;
735

736
procedure TfxyParser.ConstructLists;
737
var
738
  v: TVarDef;
739
begin
740
  with FunctionList do
741
  begin
742
    Add(TAbs.Create);
743
    Add(TInt.Create);
744
    Add(TRound.Create);
745
    Add(TSqr.Create);
746
    Add(TSqrt.Create);
747
    Add(TSin.Create);
748
    Add(TCos.Create);
749
    Add(TTan.Create);
750
    Add(TCsc.Create);
751
    Add(TSec.Create);
752
    Add(TCot.Create);
753

754
    Add(TArcSin.Create);
755
    Add(TArcCos.Create);
756
    Add(TArcTan.Create);
757
    Add(TArcCsc.Create);
758
    Add(TArcSec.Create);
759
    Add(TArcCot.Create);
760

761
    Add(TLn.Create);
762
    Add(TExp.Create);
763
    Add(TExp1.Create);
764
    Add(TLog10.Create);
765
    Add(TLog2.Create);
766

767
    Add(TSinh.Create);
768
    Add(TCosh.Create);
769
    Add(TTanh.Create);
770
    Add(TCsch.Create);
771
    Add(TSech.Create);
772
    Add(TCoth.Create);
773

774
    Add(TArcSinh.Create);
775
    Add(TArcCosh.Create);
776
    Add(TArcTanh.Create);
777
    Add(TArcCsch.Create);
778
    Add(TArcSech.Create);
779
    Add(TArcCoth.Create);
780
  end;
781

782
  v := TVarDef.Create;
783
  v.VarName := 'pi';
784
  v.Value := Pi;
785
  VariableList.Add(v);
786
  v := TVarDef.Create;
787
  v.VarName := '2pi';
788
  v.Value := twoPi;
789
  VariableList.Add(v);
790
end;
791

792
procedure TfxyParser.ClearLists;
793
var
794
  i: integer;
795

796
begin
797
  for i := 0 to FunctionList.Count - 1 do
798
    TFuncDef(FunctionList[i]).Free;
799
  FunctionList.Free;
800
  for i := 0 to VariableList.Count - 1 do
801
    TVarDef(VariableList[i]).Free;
802
  VariableList.Free;
803
end; // TfxyParser
804

805
// TOperator Class
806
function TMinus.Eval: extended;
807
begin
808
  Result := e1.Eval - e2.Eval;
809
end;
810

811
function TSum.Eval: extended;
812
begin
813
  Result := e1.Eval + e2.Eval;
814
end;
815

816
function TProduct.Eval: extended;
817
begin
818
  Result := e1.Eval * e2.Eval;
819
end;
820

821
function TDivision.Eval: extended;
822
begin
823
  if IsInfinite(e2.Eval) then
824
    Result := NaN
825
  else
826
    Result := e1.Eval / e2.Eval;
827
end;
828

829
function TPower.Eval: extended;
830
{ For fractional exponents or exponents greater than MaxInt,
831
  base must be greater than 0. }
832
begin
833
  // e1.Eval base/mantissa e2.Eval exponent
834
  if e1.Eval = 0 then
835
    Result := 0
836
  else
837
    Result := Power(e1.Eval, e2.Eval)
838
end;
839

840
function TFactorial.Eval: extended;
841
var
842
  i, j: integer;
843

844
begin
845
  j := round(e1.Eval);
846
  if (j < 0) or (j > 1754) then
847
    Result := 0.0
848
  else
849
  begin
850
    Result := 1.0;
851
    for i := 2 to j do
852
      Result := i * Result;
853
  end;
854
end;
855

856
function TDegToRad.Eval: extended;
857
begin
858
  Result := e1.Eval * PiOn180;
859
end;
860

861
function TAbs.DefName: string;
862
begin
863
  Result := 'abs';
864
end;
865

866
function TAbs.Eval(x: extended): extended;
867
begin
868
  Result := Abs(x);
869
end;
870

871
function TInt.DefName: string;
872
begin
873
  Result := 'int';
874
end;
875

876
function TInt.Eval(x: extended): extended;
877
begin
878
  Result := Int(x);
879
end;
880

881
function TRound.DefName: string;
882
begin
883
  Result := 'round';
884
end;
885

886
function TRound.Eval(x: extended): extended;
887
begin
888
  Result := round(x);
889
end;
890

891
function TSqr.DefName: string;
892
begin
893
  Result := 'sqr';
894
end;
895

896
function TSqr.Eval(x: extended): extended;
897
begin
898
  Result := Sqr(x);
899
end;
900

901
function TSqrt.DefName: string;
902
begin
903
  Result := 'sqrt';
904
end;
905

906
function TSqrt.Eval(x: extended): extended;
907
begin
908
  Result := Sqrt(x);
909
end;
910

911
function TSin.DefName: string;
912
begin
913
  Result := 'sin';
914
end;
915

916
function TSin.Eval(x: extended): extended;
917
begin
918
  Result := Sin(x);
919
end;
920

921
function TCos.DefName: string;
922
begin
923
  Result := 'cos';
924
end;
925

926
function TCos.Eval(x: extended): extended;
927
begin
928
  Result := Cos(x);
929
end;
930

931
function TTan.DefName: string;
932
begin
933
  Result := 'tan';
934
end;
935

936
function TTan.Eval(x: extended): extended;
937
begin
938
  Result := Tan(x);
939
end;
940

941
function TCsc.DefName: string;
942
begin
943
  Result := 'csc';
944
end;
945

946
function TCsc.Eval(x: extended): extended;
947
begin
948
  Result := Csc(x);
949
end;
950

951
function TSec.DefName: string;
952
begin
953
  Result := 'sec';
954
end;
955

956
function TSec.Eval(x: extended): extended;
957
begin
958
  Result := Sec(x);
959
end;
960

961
function TCot.DefName: string;
962
begin
963
  Result := 'cot';
964
end;
965

966
function TCot.Eval(x: extended): extended;
967
begin
968
  Result := Cot(x);
969
end;
970

971
function TArcSin.DefName: string;
972
begin
973
  Result := 'arcsin';
974
end;
975

976
function TArcSin.Eval(x: extended): extended;
977
begin
978
  Result := ArcSin(x);
979
end;
980

981
function TArcCos.DefName: string;
982
begin
983
  Result := 'arccos';
984
end;
985

986
function TArcCos.Eval(x: extended): extended;
987
begin
988
  Result := ArcCos(x);
989
end;
990

991
function TArcTan.DefName: string;
992
begin
993
  Result := 'arctan';
994
end;
995

996
function TArcTan.Eval(x: extended): extended;
997
begin
998
  Result := ArcTan(x);
999
end;
1000

1001
function TArcCsc.DefName: string;
1002
begin
1003
  Result := 'arccsc';
1004
end;
1005

1006
function TArcCsc.Eval(x: extended): extended;
1007
begin
1008
  Result := ArcCsc(x);
1009
end;
1010

1011
function TArcSec.DefName: string;
1012
begin
1013
  Result := 'arcsec';
1014
end;
1015

1016
function TArcSec.Eval(x: extended): extended;
1017
begin
1018
  Result := ArcSec(x);
1019
end;
1020

1021
function TArcCot.DefName: string;
1022
begin
1023
  Result := 'arccot';
1024
end;
1025

1026
function TArcCot.Eval(x: extended): extended;
1027
begin
1028
  Result := ArcCot(x);
1029
  if (Result > PiOn2) or (Result < -PiOn2) then
1030
    Result := NaN;
1031
end;
1032

1033
function TLn.DefName: string;
1034
begin
1035
  Result := 'ln';
1036
end;
1037

1038
function TLn.Eval(x: extended): extended;
1039
begin
1040
  Result := Ln(x);
1041
  if isNaN(Result) then
1042
  begin
1043
    case Sign(Result) of
1044
      - 1:
1045
        Result := NegInfinity;
1046
      0:
1047
        Result := 0;
1048
      1:
1049
        Result := Infinity;
1050
    end;
1051
  end;
1052
end;
1053

1054
function TExp.DefName: string;
1055
begin
1056
  Result := 'exp';
1057
end;
1058

1059
function TExp.Eval(x: extended): extended;
1060
begin
1061
  Result := Exp(x);
1062
end;
1063

1064
function TExp1.DefName: string;
1065
begin
1066
  Result := 'e^';
1067
end;
1068

1069
function TExp1.Eval(x: extended): extended;
1070
begin
1071
  Result := Exp(x);
1072
end;
1073

1074
function TLog10.DefName: string;
1075
begin
1076
  Result := 'log';
1077
end;
1078

1079
function TLog10.Eval(x: extended): extended;
1080
begin
1081
  Result := Log10(x);
1082
  if isNaN(Result) then
1083
  begin
1084
    case Sign(Result) of
1085
      - 1:
1086
        Result := NegInfinity;
1087
      0:
1088
        Result := 0;
1089
      1:
1090
        Result := Infinity;
1091
    end;
1092
  end;
1093
end;
1094

1095
function TLog2.DefName: string;
1096
begin
1097
  Result := 'log2';
1098
end;
1099

1100
function TLog2.Eval(x: extended): extended;
1101
begin
1102
  Result := Log2(x);
1103
  if isNaN(Result) then
1104
  begin
1105
    case Sign(Result) of
1106
      - 1:
1107
        Result := NegInfinity;
1108
      0:
1109
        Result := 0;
1110
      1:
1111
        Result := Infinity;
1112
    end;
1113
  end;
1114
end;
1115

1116
function TSinh.DefName: string;
1117
begin
1118
  Result := 'sinh';
1119
end;
1120

1121
function TSinh.Eval(x: extended): extended;
1122
begin
1123
  Result := Sinh(x);
1124
end;
1125

1126
function TCosh.DefName: string;
1127
begin
1128
  Result := 'cosh';
1129
end;
1130

1131
function TCosh.Eval(x: extended): extended;
1132
begin
1133
  Result := Cosh(x);
1134
end;
1135

1136
function TTanh.DefName: string;
1137
begin
1138
  Result := 'tanh';
1139
end;
1140

1141
function TTanh.Eval(x: extended): extended;
1142
begin
1143
  Result := Tanh(x);
1144
end;
1145

1146
function TCsch.DefName: string;
1147
begin
1148
  Result := 'csch';
1149
end;
1150

1151
function TCsch.Eval(x: extended): extended;
1152
begin
1153
  Result := Csch(x);
1154
end;
1155

1156
function TSech.DefName: string;
1157
begin
1158
  Result := 'sech';
1159
end;
1160

1161
function TSech.Eval(x: extended): extended;
1162
begin
1163
  Result := Sech(x);
1164
end;
1165

1166
function TCoth.DefName: string;
1167
begin
1168
  Result := 'coth';
1169
end;
1170

1171
function TCoth.Eval(x: extended): extended;
1172
begin
1173
  Result := Coth(x);
1174
end;
1175

1176
function TArcSinh.DefName: string;
1177
begin
1178
  Result := 'arcsinh';
1179
end;
1180

1181
function TArcSinh.Eval(x: extended): extended;
1182
begin
1183
  Result := ArcSinh(x);
1184
end;
1185

1186
function TArcCosh.DefName: string;
1187
begin
1188
  Result := 'arccosh';
1189
end;
1190

1191
function TArcCosh.Eval(x: extended): extended;
1192
begin
1193
  Result := ArcCosh(x);
1194
end;
1195

1196
function TArcTanh.DefName: string;
1197
begin
1198
  Result := 'arctanh';
1199
end;
1200

1201
function TArcTanh.Eval(x: extended): extended;
1202
begin
1203
  Result := ArcTanh(x)
1204
end;
1205

1206
function TArcCsch.DefName: string;
1207
begin
1208
  Result := 'arccsch';
1209
end;
1210

1211
function TArcCsch.Eval(x: extended): extended;
1212
begin
1213
  if x = 0 then
1214
    Result := Infinity
1215
  else
1216
    Result := ArcCsch(x);
1217
end;
1218

1219
function TArcSech.DefName: string;
1220
begin
1221
  Result := 'arcsech';
1222
end;
1223

1224
function TArcSech.Eval(x: extended): extended;
1225
begin
1226
  if x <= 0 then
1227
    Result := Infinity
1228
  else
1229
    Result := ArcSech(x);
1230
end;
1231

1232
function TArcCoth.DefName: string;
1233
begin
1234
  Result := 'arccoth';
1235
end;
1236

1237
function TArcCoth.Eval(x: extended): extended;
1238
begin
1239
  if (x >= -1) and (x < 0) then
1240
    Result := NegInfinity
1241
  else if (x > 0) and (x <= 1) then
1242
    Result := Infinity
1243
  else if x = 0 then
1244
    Result := NaN
1245
  else
1246
    Result := ArcCoth(x);
1247
end;
1248
// TOperator Class
1249

1250
function ScanText(const s: string): string;
1251
  function DropSpaces_Commas(const s: string): string;
1252
  var
1253
    i: integer;
1254

1255
  begin
1256
    Result := '';
1257
    for i := 1 to Length(s) do
1258
      if (s[i] <> ' ') and (s[i] <> ',') then
1259
        Result := Result + s[i];
1260
  end; // DropSpaces_Commas
1261

1262
var
1263
  i, j: integer;
1264
  c0, c1, c2: Char;
1265
  cc, ccc, isStr: string;
1266
  nostar: Boolean;
1267
  isExp: Boolean;
1268
  isLog: Boolean;
1269
  isPwr: Boolean;
1270
  t: string;
1271

1272
begin { ScanText }
1273
  t := DropSpaces_Commas(s);
1274
  i := 1;
1275
  j := 1;
1276
  Result := t;
1277
  while i < Length(t) do
1278
  begin
1279
    c0 := UpCase(t[i]);
1280
    c1 := UpCase(t[i + 1]);
1281
    if i < Length(t) - 1 then
1282
      c2 := UpCase(t[i + 2])
1283
    else
1284
      c2 := #0;
1285

1286
    cc := c0 + c1;
1287
    ccc := c0 + c1 + c2;
1288

1289
    isExp := ccc = 'XP(';
1290
    isStr := '';
1291
    isLog := false;
1292

1293
    if (i > 3) and ((cc = '0(') or (cc = '2(')) then
1294
    begin
1295
      if cc = '0(' then
1296
        isStr := UpperCase(copy(t, i - 4, 3)) { Log10 }
1297
      else
1298
        isStr := UpperCase(copy(t, i - 3, 3)); { Log2 }
1299
      isLog := isStr = 'LOG';
1300
    end;
1301

1302
    isPwr := CharInSet(c0, ['+', '-', '0' .. '9']) and (UpCase(c1) = 'E') and
1303
      CharInSet(c2, ['+', '-', '0' .. '9']);
1304
    nostar := isExp or isLog or isPwr;
1305

1306
    if not nostar and CharInSet(c0, ['X', 'Y', 'I', '0' .. '9', ')']) and
1307
      CharInSet(c1, ['A' .. 'C', 'E', 'L', 'P', 'S', 'T', 'X', 'Y', '(']) then
1308
    begin
1309
      Insert('*', Result, i + j);
1310
      Inc(j);
1311
    end;
1312
    Inc(i);
1313
  end;
1314
end; // ScanText
1315

1316
function ParseAndEvaluate(const aText: string; var e: byte): extended;
1317
var
1318
  aParser: TfxyParser;
1319

1320
begin
1321
  aParser := TfxyParser.Create(0, 0);
1322
  with aParser do
1323
  begin
1324
    Calculus.Free;
1325
    ErrorByte := 0;
1326
    FormPlotStars.StatusBar.Panels[4].Text := '';
1327
    Calculus := Compile(AnsiLowerCase(aText), ErrorByte);
1328
    e := ErrorByte;
1329
    if ErrorByte > 0 then
1330
    begin
1331
      with FormPlotStars.StatusBar.Panels[4] do
1332
        case ErrorByte of
1333
          1:
1334
            Text := 'Check Brackets for "' + aText + '"';
1335
          2:
1336
            Text := 'Unable to Parse "' + aText + '"';
1337
        end;
1338
      Result := 0;
1339
    end
1340
    else
1341
      Result := Calculus.Eval;
1342
    Calculus.Free;
1343
    Calculus := nil;
1344
    Free;
1345
  end;
1346
end;
1347

1348
function ParseEvaluateFxy(const aVarX, aVarY: extended; const aText: string;
1349
  var e: byte): extended;
1350
var
1351
  aParser: TfxyParser;
1352

1353
begin
1354
  aParser := TfxyParser.Create(0, 0);
1355
  with aParser do
1356
  begin
1357
    Calculus.Free;
1358
    ErrorByte := 0;
1359
    FormPlotStars.StatusBar.Panels[4].Text := '';
1360
    Calculus := Compile(AnsiLowerCase(aText), ErrorByte);
1361
    VarX.Value := aVarX;
1362
    VarY.Value := aVarY;
1363
    e := ErrorByte;
1364
    if ErrorByte > 0 then
1365
    begin
1366
      with FormPlotStars.StatusBar.Panels[4] do
1367
        case ErrorByte of
1368
          1:
1369
            Text := 'Check Brackets for "' + aText + '"';
1370
          2:
1371
            Text := 'Unable to Parse "' + aText + '"';
1372
        end;
1373
      Result := 0;
1374
    end
1375
    else
1376
      Result := Calculus.Eval;
1377
    Calculus.Free;
1378
    Calculus := nil;
1379
    Free;
1380
  end;
1381
end;
1382

1383
initialization
1384

1385
// Avoids arithmetic exceptions in the above code
1386
SetExceptionMask([exInvalidOp, exDenormalized, exZeroDivide, exOverflow,
1387
  exUnderflow, exPrecision]);
1388

1389
end.
1390