MathgeomGLS

1
unit Graf.Parser1d;
2
// This parser is used only for y = f(x) 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

16
type
17
  TFuncDef = class
18
  public
19
    function DefName: string; virtual; abstract;
20
    function Eval(x: extended): extended; virtual; abstract;
21
  end;
22

23
  TVarDef = class
24
  public
25
    VarName: string;
26
    Value: extended;
27
  end;
28

29
  TCalculus = class
30
  public
31
    function Eval: extended; virtual; abstract;
32
  end;
33

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

57
  TConst = class(TCalculus)
58
    constructor Create(c: extended);
59
  public
60
    function Eval: extended; override;
61
  private
62
    Val: extended;
63
  end;
64

65
  TVar = class(TCalculus)
66
  public
67
    constructor Create(v: TVarDef);
68
    function Eval: extended; override;
69
  protected
70
    Def: TVarDef;
71
  end;
72

73
  TFunc = class(TCalculus)
74
    constructor Create(v: TCalculus; f: TFuncDef);
75
    destructor Destroy; override;
76
  public
77
    function Eval: extended; override;
78
  protected
79
    Variable: TCalculus;
80
    Def: TFuncDef;
81
  end;
82

83
  TOperator = class(TCalculus)
84
    constructor Create(c1, c2: TCalculus);
85
    destructor Destroy; override;
86
  public
87
  protected
88
    e1, e2: TCalculus;
89
  end;
90

91
  TMinus = class(TOperator)
92
  public
93
    function Eval: extended; override;
94
  end;
95

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

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

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

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

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

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

126
  TAbs = class(TFuncDef)
127
  public
128
    function DefName: string; override;
129
    function Eval(x: extended): extended; override;
130
  end;
131

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

312
function ScanText(const s: string): string;
313
function ParseAndEvaluate(const aText: string; var e: byte): extended;
314

315
//================================================================
316
implementation
317
//================================================================
318

319
uses
320
  faGraf1D;
321

322
// TCalculus Class
323
constructor TConst.Create(c: extended);
324
begin
325
  Val := c;
326
end;
327

328
function TConst.Eval: extended;
329
begin
330
  Result := Val;
331
end;
332

333
constructor TVar.Create(v: TVarDef);
334
begin
335
  Def := v;
336
end;
337

338
function TVar.Eval: extended;
339
begin
340
  Result := Def.value;
341
end;
342

343
constructor TFunc.Create(v: TCalculus; f: TFuncDef);
344
begin
345
  Variable := v;
346
  Def := f;
347
end;
348

349
destructor TFunc.Destroy;
350
begin
351
  Variable.Free;
352
end;
353

354
function TFunc.Eval: extended;
355
begin
356
  Result := Def.Eval(Variable.Eval);
357
end;
358

359
constructor TOperator.Create(c1, c2: TCalculus);
360
begin
361
  e1 := c1;
362
  e2 := c2;
363
end;
364

365
destructor TOperator.Destroy;
366
begin
367
  e1.Free;
368
  e2.Free;
369
end;
370
{ TCalculus Class }
371

372
{ TFxParser }
373
constructor TFxParser.Create(x: extended);
374
begin
375
  inherited Create;
376
  FunctionList := TList.Create;
377
  VariableList := TList.Create;
378

379
  ConstructLists;
380

381
  VarX := TVarDef.Create;
382
  VarX.VarName := 'x';
383
  VarX.Value := x;
384
  addVar(VarX);
385
end;
386

387
destructor TFxParser.Destroy;
388
begin
389
  ClearLists;
390
  inherited Destroy;
391
end;
392

393
function TFxParser.FunctionOf(i: integer): TFuncDef;
394
begin
395
  Result := TFuncDef(FunctionList.Items[i]);
396
end;
397

398
function TFxParser.VariableOf(i: integer): TVarDef;
399
begin
400
  Result := TVarDef(VariableList.Items[i]);
401
end;
402

403
function TFxParser.CheckBrackets(const s: string): Boolean;
404
var
405
  i, j, c1, c2: integer;
406

407
begin
408
  c1 := 0;
409
  c2 := 0;
410
  i := 1;
411
  j := Length(s);
412
  while i <= j do
413
  begin
414
    if s[i] = '(' then Inc(c1);
415
    if s[i] = ')' then Inc(c2);
416
    Inc(i);
417
  end;
418
  Result := c1 = c2;
419
end;
420

421
function TFxParser.CompileExpresion(const s: string; var Error: byte): TCalculus;
422
var
423
  i: integer;
424
  e1: byte;
425
  e2: byte;
426
  c1, c2: TCalculus;
427

428
begin
429
  if s = '' then
430
  begin
431
    Error := 3;
432
    Result := nil;
433
    Exit;
434
  end;
435

436
  if not CheckBrackets(s) then
437
  begin
438
    Error := 1;
439
    Result := nil;
440
    Exit;
441
  end;
442

443
 {----- -factor -----}
444
  if s[1] = '-' then
445
  begin
446
    c1 := FactorCompile(copy(s, 2, length(s)-1), e1);
447
    if e1 = 0 then
448
    begin
449
      c2 := TConst.Create(0);
450
      Result := TMinus.Create(c2, c1);
451
      Error := 0;
452
      Exit;
453
    end;
454
  end;
455

456
 {----- exp+factor -----}
457
 {----- exp-factor -----}
458
 {----- exp!factor -----}
459
 {----- exp�factor -----}
460
  for i := length(s) downto 1 do
461
  begin
462
    case s[i] of
463
 '+': begin
464
        c1 := CompileExpresion(copy(s, 1, i -1), e1);
465
        if e1 = 0 then
466
        begin
467
          c2 := FactorCompile(copy(s, i +1, length(s) -i), e2);
468
          if e2 = 0 then
469
          begin
470
            Result := TSum.Create(c1, c2);
471
            Error := 0;
472
            Exit;
473
          end
474
          else c1.Free;
475
        end;
476
      end;
477
 '-': begin
478
        c1 := CompileExpresion(copy(s, 1, i -1), e1);
479
        if e1 = 0 then
480
        begin
481
          c2 := FactorCompile(copy(s, i +1, length(s) -i), e2);
482
          if e2 = 0 then
483
          begin
484
            Result := TMinus.Create(c1, c2);
485
            Error := 0;
486
            Exit;
487
          end
488
          else c1.Free;
489
        end;
490
      end;
491
 '!': begin
492
        c1 := CompileExpresion(copy(s, 1, i -1), e1);
493
        if e1 = 0 then
494
        begin
495
          c2 := FactorCompile(copy(s, 1, i -1), e2);
496
          if e2 = 0 then
497
          begin
498
            Result := TFactorial.Create(c1, c2);
499
            Error := 0;
500
            Exit;
501
          end
502
          else c1.Free;
503
        end;
504
      end;
505
 '�': begin
506
        c1 := CompileExpresion(copy(s, 1, i -1), e1);
507
        if e1 = 0 then
508
        begin
509
          c2 := FactorCompile(copy(s, 1, i -1), e2);
510
          if e2 = 0 then
511
          begin
512
            Result := TDegToRad.Create(c1, c2);
513
            Error := 0;
514
            Exit;
515
          end
516
          else c1.Free;
517
        end;
518
      end;
519
    end;  { case s[i] of... }
520
  end;  { for i := length(s) downto 1 do... }
521
  Result := FactorCompile(s, Error);
522
end;
523

524
function TFxParser.FactorCompile(const s: string; var Error: byte): TCalculus;
525
var
526
  i: integer;
527
  e1, e2: byte;
528
  c1, c2: TCalculus;
529

530
begin
531
  if s = '' then
532
  begin
533
    Error := 3;
534
    Result := nil;
535
    Exit;
536
  end;
537

538
  if not CheckBrackets(s) then
539
  begin
540
    Error := 1;
541
    Result := nil;
542
    Exit;
543
  end;
544

545
 {----- factor*simple -----}
546
 {----- factor/simple -----}
547
  for i := length(s) downto 1 do
548
  begin
549
    case s[i] of
550
 '*': begin
551
        c1 := FactorCompile(copy(s, 1, i -1), e1);
552
        if e1 = 0 then
553
        begin
554
          c2 := SimpleCompile(copy(s, i +1, length(s) -i), e2);
555
          if e2 = 0 then
556
          begin
557
            Result := TProduct.Create(c1, c2);
558
            Error := 0;
559
            Exit;
560
          end
561
          else c1.Free;
562
        end;
563
      end;
564
 '/': begin
565
        c1 := FactorCompile(copy(s, 1, i -1), e1);
566
        if e1 = 0 then
567
        begin
568
          c2 := SimpleCompile(copy(s, i +1, length(s) -i), e2);
569
          if e2 = 0 then
570
          begin
571
            Result := TDivision.Create(c1, c2);
572
            Error := 0;
573
            Exit;
574
          end
575
          else c1.Free;
576
        end;
577
      end;
578
    end;  { case s[i] of... }
579
  end;  { for i := length(s) downto 1 do... }
580
  Result := SimpleCompile(s, Error);
581
end;
582

583
function TFxParser.SimpleCompile(const s: string; var Error: byte): TCalculus;
584
var
585
  i: integer;
586
  e1, e2: byte;
587
  c1, c2: TCalculus;
588
  d: extended;
589

590
begin
591
  if s = '' then
592
  begin
593
    Error := 3;
594
    Result := nil;
595
    Exit;
596
  end;
597

598
  if not CheckBrackets(s) then
599
  begin
600
    Error := 1;
601
    Result := nil;
602
    Exit;
603
  end;
604

605
 {----- const -----}
606
  Val(s, d, i);
607
  if i = 0 then
608
  begin
609
    Result := TConst.Create(d);
610
    Error := 0;
611
    Exit;
612
  end;
613

614
 {----- (exp) -----}
615
  if (s[1] = '(') and (s[length(s)] = ')') then
616
  begin
617
    c1 := CompileExpresion(copy(s, 2, length(s)-2), e1);
618
    if e1 = 0 then
619
    begin
620
      Result := c1;
621
      Error := 0;
622
      Exit;
623
    end;   
624
  end;
625

626
 {----- VarName -----}
627
  for i := 0 to VariableList.Count -1 do
628
  begin
629
    if s = VariableOf(i).VarName then
630
    begin
631
      Result := TVar.Create(VariableOf(i));
632
      Error := 0;
633
      Exit;
634
    end;
635
  end;
636

637
 {----- DefNameFunc(exp) -----}
638
  for i := 0 to FunctionList.Count -1 do
639
  begin
640
    if (Pos(FunctionOf(i).DefName + '(', s) = 1) and (s[length(s)] = ')')
641
    then
642
    begin
643
      c1 := CompileExpresion(copy(s, length(FunctionOf(i).DefName) +2,
644
                         length(s) - length(FunctionOf(i).DefName) -2), e1);
645
      if e1 = 0 then
646
      begin
647
        Result := TFunc.Create(c1, FunctionOf(i));
648
        Error := 0;
649
        Exit;
650
      end;
651
    end;
652
  end;
653

654
 {----- simple^simple -----}
655
  for i := 1 to length(s) do
656
  begin
657
    case s[i] of
658
 '^': begin
659
        c1 := SimpleCompile(copy(s, 1, i -1), e1);
660
        if e1 = 0 then
661
        begin
662
          c2 := SimpleCompile(copy(s, i +1, length(s) -i), e2);
663
          if e2 = 0 then
664
          begin
665
            Result := TPower.Create(c1, c2);
666
            Error := 0;
667
            Exit;
668
          end
669
          else c1.Free;
670
        end;
671
      end;
672
    end;  { case s[i] of... }
673
  end;  { for i := 1 to length(s) do... }
674

675
  Error := 2;
676
  Result := nil;
677
end;
678

679
procedure TFxParser.Substitute(var s: string);
680
var
681
  t: string;
682
  i: integer;
683

684
begin       
685
  t := '';
686
  for i := 1 to Length(s) do
687
  if s[i] <> ' ' then if s[i] = '�' then t := t + 'x' else t := t + s[i];
688
  s := t;
689
end;
690

691
function TFxParser.Compile(s: string; var Error: byte): TCalculus;
692
begin
693
  Substitute(s); { this will substitute x for � }
694
  Result := CompileExpresion(s, Error);
695
end;
696

697
procedure TFxParser.AddVar(v: TVarDef);
698
begin
699
  VariableList.Add(v);
700
end;
701

702
procedure TFxParser.ConstructLists;
703
var
704
  v: TVarDef;
705
begin
706
  with FunctionList do
707
  begin
708
    Add(TAbs.Create);
709
    Add(TSqr.Create);
710
    Add(TSqrt.Create);
711
    Add(TSin.Create);
712
    Add(TCos.Create);
713
    Add(TTan.Create);
714
    Add(TCsc.Create);
715
    Add(TSec.Create);
716
    Add(TCot.Create);
717

718
    Add(TArcSin.Create);
719
    Add(TArcCos.Create);
720
    Add(TArcTan.Create);
721
    Add(TArcCsc.Create);
722
    Add(TArcSec.Create);
723
    Add(TArcCot.Create);
724

725
    Add(TLn.Create);
726
    Add(TExp.Create);
727
    Add(TLog10.Create);
728
    Add(TLog2.Create);
729

730
    Add(TSinh.Create);
731
    Add(TCosh.Create);
732
    Add(TTanh.Create);
733
    Add(TCsch.Create);
734
    Add(TSech.Create);
735
    Add(TCoth.Create);
736

737
    Add(TArcSinh.Create);
738
    Add(TArcCosh.Create);
739
    Add(TArcTanh.Create);
740
    Add(TArcCsch.Create);
741
    Add(TArcSech.Create);
742
    Add(TArcCoth.Create);
743
  end;
744

745
  v := TVarDef.Create;
746
  v.VarName := 'pi';
747
  v.Value := Pi;
748
  VariableList.Add(v);
749
  v := TVarDef.Create;
750
  v.VarName := '2pi';
751
  v.Value := twoPi;
752
  VariableList.Add(v);
753
end;
754

755
procedure TFxParser.ClearLists;
756
var
757
  i: integer;
758

759
begin
760
  for i := 0 to FunctionList.Count -1 do TFuncDef(FunctionList[i]).Free;
761
  FunctionList.Free;
762
  for i := 0 to VariableList.Count -1 do TVarDef(VariableList[i]).Free;
763
  VariableList.Free;
764
end;
765
{ TFxParser }
766

767
{ TOperator Class }
768
function TMinus.Eval: extended;
769
var
770
  n1, n2: extended;
771

772
begin
773
  n1 := e1.Eval;
774
  n2 := e2.Eval;
775
  Result := n1 - n2;
776
end;
777

778
function TSum.Eval: extended;
779
var
780
  n1, n2: extended;
781

782
begin
783
  n1 := e1.Eval;
784
  n2 := e2.Eval;
785
  Result := n1 + n2;
786
end;
787

788
function TProduct.Eval: extended;
789
var
790
  n1, n2: extended;
791
begin
792
  n1 := e1.Eval;
793
  n2 := e2.Eval;
794
  Result := n1*n2;
795
end;
796

797
function TDivision.Eval: extended;
798
var
799
  n1, n2: extended;
800
begin
801
  n1 := e1.Eval;  { numerator }
802
  n2 := e2.Eval;  { deviser }
803

804
  if IsInfinite(n2) then
805
  begin
806
    Result := NaN;
807
    Exit;
808
  end;
809

810
  Result := n1/n2;
811
end;
812

813
function TPower.Eval: extended;
814
var
815
  b, e: extended;
816
{ For fractional exponents or exponents greater than MaxInt,
817
  base must be greater than 0. }
818
begin
819
  b := e1.Eval;  { base/mantissa }
820
  e := e2.Eval;  { exponent }
821
  if b = 0 then Result := 0 else Result := Power(b, e)
822
end;
823

824
function TFactorial.Eval: extended;
825
var
826
  i, j: integer;
827
begin
828
  j := round(e1.Eval);
829
  if (j < 0) or (j > 1754)
830
  then Result := 0.0
831
  else
832
  begin
833
    Result := 1.0;
834
    for i := 2 to j do Result := i*Result;
835
  end;
836
end;
837

838
function TDegToRad.Eval: extended;
839
begin
840
  Result := DegToRad(e1.Eval);
841
end;
842

843
function TAbs.DefName: string;
844
begin
845
  Result := 'abs';
846
end;
847

848
function TAbs.Eval(x: extended): extended;
849
begin
850
  Result := Abs(x);
851
end;
852

853
function TSqr.DefName: string;
854
begin
855
  Result := 'sqr';
856
end;
857

858
function TSqr.Eval(x: extended): extended;
859
begin
860
  Result := Sqr(x);
861
end;
862

863
function TSqrt.DefName: string;
864
begin
865
  Result := 'sqrt';
866
end;
867

868
function TSqrt.Eval(x: extended): extended;
869
begin
870
  Result := Sqrt(x);
871
end;
872

873
function TSin.DefName: string;
874
begin
875
  Result := 'sin';
876
end;
877

878
function TSin.Eval(x: extended): extended;
879
begin
880
  Result := Sin(x);
881
end;
882

883
function TCos.DefName: string;
884
begin
885
  Result := 'cos';
886
end;
887

888
function TCos.Eval(x: extended): extended;
889
begin
890
  Result := Cos(x);
891
end;
892

893
function TTan.DefName: string;
894
begin
895
  Result := 'tan';
896
end;
897

898
function TTan.Eval(x: extended): extended;
899
begin
900
  Result := Tan(x);
901
end;
902

903
function TCsc.DefName: string;
904
begin
905
  Result := 'csc';
906
end;
907

908
function TCsc.Eval(x: extended): extended;
909
begin
910
  Result := Csc(x);
911
end;
912

913
function TSec.DefName: string;
914
begin
915
  Result := 'sec';
916
end;
917

918
function TSec.Eval(x: extended): extended;
919
begin
920
  Result := Sec(x);
921
end;
922

923
function TCot.DefName: string;
924
begin
925
  Result := 'cot';
926
end;
927

928
function TCot.Eval(x: extended): extended;
929
begin
930
  Result := Cot(x);
931
end;
932

933
function TArcSin.DefName: string;
934
begin
935
  Result := 'arcsin';
936
end;
937

938
function TArcSin.Eval(x: extended): extended;
939
begin
940
  Result := ArcSin(x);
941
end;
942

943
function TArcCos.DefName: string;
944
begin
945
  Result := 'arccos';
946
end;
947

948
function TArcCos.Eval(x: extended): extended;
949
begin
950
  Result := ArcCos(x);
951
end;
952

953
function TArcTan.DefName: string;
954
begin
955
  Result := 'arctan';
956
end;
957

958
function TArcTan.Eval(x: extended): extended;
959
begin
960
  Result := ArcTan(x);
961
end;
962

963
function TArcCsc.DefName: string;
964
begin
965
  Result := 'arccsc';
966
end;
967

968
function TArcCsc.Eval(x: extended): extended;
969
begin
970
  Result := ArcCsc(x);
971
end;
972

973
function TArcSec.DefName: string;
974
begin
975
  Result := 'arcsec';
976
end;
977

978
function TArcSec.Eval(x: extended): extended;
979
begin
980
  Result := ArcSec(x);
981
end;
982

983
function TArcCot.DefName: string;
984
begin
985
  Result := 'arccot';
986
end;
987

988
function TArcCot.Eval(x: extended): extended;
989
begin
990
  Result := ArcCot(x);
991
  if (Result > Pion2) or (Result < -Pion2)
992
  then Result := NaN;
993
end;
994

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

1000
function TLn.Eval(x: extended): extended;
1001
begin
1002
  Result := Ln(x);
1003
  if isNaN(Result) then
1004
  begin
1005
    case Sign(Result) of
1006
   -1:Result := NegInfinity;
1007
    0:Result := 0;
1008
    1:Result := Infinity;
1009
    end;
1010
  end;
1011
end;
1012

1013
function TExp.DefName: string;
1014
begin
1015
  Result := 'exp';
1016
end;
1017

1018
function TExp.Eval(x: extended): extended;
1019
begin
1020
  Result := Exp(x);
1021
end;
1022

1023
function TLog10.DefName: string;
1024
begin
1025
  Result := 'log';
1026
end;
1027

1028
function TLog10.Eval(x: extended): extended;
1029
begin
1030
  Result := Log10(x);
1031
  if isNaN(Result) then
1032
  begin
1033
    case Sign(Result) of
1034
   -1:Result := NegInfinity;
1035
    0:Result := 0;
1036
    1:Result := Infinity;
1037
    end;
1038
  end;
1039
end;
1040

1041
function TLog2.DefName: string;
1042
begin
1043
  Result := 'log2';
1044
end;
1045

1046
function TLog2.Eval(x: extended): extended;
1047
begin
1048
  Result := Log2(x);
1049
  if isNaN(Result) then
1050
  begin
1051
    case Sign(Result) of
1052
   -1:Result := NegInfinity;
1053
    0:Result := 0;
1054
    1:Result := Infinity;
1055
    end;
1056
  end;
1057
end;
1058

1059
function TSinh.DefName: string;
1060
begin
1061
  Result := 'sinh';
1062
end;
1063

1064
function TSinh.Eval(x: extended): extended;
1065
begin
1066
  Result := Sinh(x);
1067
end;
1068

1069
function TCosh.DefName: string;
1070
begin
1071
  Result := 'cosh';
1072
end;
1073

1074
function TCosh.Eval(x: extended): extended;
1075
begin
1076
  Result := Cosh(x);
1077
end;
1078

1079
function TTanh.DefName: string;
1080
begin
1081
  Result := 'tanh';
1082
end;
1083

1084
function TTanh.Eval(x: extended): extended;
1085
begin
1086
  Result := Tanh(x);
1087
end;
1088

1089
function TCsch.DefName: string;
1090
begin
1091
  Result := 'csch';
1092
end;
1093

1094
function TCsch.Eval(x: extended): extended;
1095
begin
1096
  Result := Csch(x);
1097
end;
1098

1099
function TSech.DefName: string;
1100
begin
1101
  Result := 'sech';
1102
end;
1103

1104
function TSech.Eval(x: extended): extended;
1105
begin
1106
  Result := Sech(x);
1107
end;
1108

1109
function TCoth.DefName: string;
1110
begin
1111
  Result := 'coth';
1112
end;
1113

1114
function TCoth.Eval(x: extended): extended;
1115
begin
1116
  Result := Coth(x);
1117
end;
1118

1119
function TArcSinh.DefName: string;
1120
begin
1121
  Result := 'arcsinh';
1122
end;
1123

1124
function TArcSinh.Eval(x: extended): extended;
1125
begin
1126
  Result := ArcSinh(x);
1127
end;
1128

1129
function TArcCosh.DefName: string;
1130
begin
1131
  Result := 'arccosh';
1132
end;
1133

1134
function TArcCosh.Eval(x: extended): extended;
1135
begin
1136
  Result := ArcCosh(x);
1137
end;
1138

1139
function TArcTanh.DefName: string;
1140
begin
1141
  Result := 'arctanh';
1142
end;
1143

1144
function TArcTanh.Eval(x: extended): extended;
1145
begin
1146
  Result := ArcTanh(x)
1147
end;
1148

1149
function TArcCsch.DefName: string;
1150
begin
1151
  Result := 'arccsch';
1152
end;
1153

1154
function TArcCsch.Eval(x: extended): extended;
1155
begin
1156
  if x = 0 then Result := Infinity else Result := ArcCsch(x);
1157
{ it would seem that Delphi 7 personal calculates ArcCsch incorrectly }
1158
end;
1159

1160
function TArcSech.DefName: string;
1161
begin
1162
  Result := 'arcsech';
1163
end;
1164

1165
function TArcSech.Eval(x: extended): extended;
1166
begin
1167
  if x <= 0 then Result := Infinity else Result := ArcSech(x);
1168
end;
1169

1170
function TArcCoth.DefName: string;
1171
begin
1172
  Result := 'arccoth';
1173
end;
1174

1175
function TArcCoth.Eval(x: extended): extended;
1176
begin
1177
  if (x >= -1) and (x < 0) then Result := NegInfinity else
1178
  if (x > 0) and (x <= 1) then Result := Infinity else
1179
  if x = 0 then Result := NaN else Result := ArcCoth(x);
1180
end;
1181
{ TOperator Class }
1182

1183
function ScanText(const s: string): string;
1184
  function DropSpaces_Commas(const s: string): string;
1185
  var
1186
    i: integer;
1187

1188
  begin
1189
    Result := '';
1190
    for i := 1 to Length(s) do
1191
    if (s[i] <> ' ') and (s[i] <> ',') then Result := Result + s[i];
1192
  end;   { DropSpaces_Commas }
1193

1194
var
1195
  i, j: integer;
1196
  c0, c1, c2: char;
1197
  cc, ccc, isStr: string;
1198
  nostar: Boolean;
1199
  isExp: Boolean;
1200
  isLog: Boolean;
1201
  isPwr: Boolean;
1202
  t: string;
1203

1204
begin  { ScanText }
1205
  t := DropSpaces_Commas(s);
1206
  i := 1;
1207
  j := 1;
1208
  Result := t;
1209
  while i < Length(t) do
1210
  begin
1211
    c0 := UpCase(t[i]);
1212
    c1 := UpCase(t[i +1]);
1213
    if i < Length(t) - 1 then c2 := UpCase(t[i +2]) else c2 := #0;
1214

1215
    cc  := c0+c1;
1216
    ccc := c0+c1+c2;
1217

1218
    isExp := ccc = 'XP(';
1219
    isStr := '';
1220
    isLog := false;
1221

1222
    if (i > 3) and ((cc = '0(') or (cc = '2(')) then
1223
    begin
1224
      if cc = '0('
1225
      then isStr := UpperCase(Copy(t, i -4, 3))    { Log10 }
1226
      else isStr := UpperCase(Copy(t, i -3, 3));   { Log2 }
1227
      isLog := isStr = 'LOG';
1228
    end;
1229

1230
    isPwr := CharInSet(c0, ['+', '-', '0'..'9']) and (UpCase(c1) = 'E') and
1231
             CharInSet(c2, ['+', '-', '0'..'9']);
1232
    nostar := isExp or isLog or isPwr;
1233

1234
    if not nostar and
1235
      CharInSet(c0, ['X', 'I', '0'..'9', ')']) and
1236
      CharInSet(c1, ['A'..'C', 'E', 'L', 'P', 'S', 'T', 'X', '�', '(']) then
1237
    begin
1238
      Insert('*', Result, i + j);
1239
      Inc(j);
1240
    end;
1241
    Inc(i);
1242
  end;
1243
end;   { ScanText }
1244

1245
function ParseAndEvaluate(const aText: string; var e: byte): extended;
1246
var
1247
  aParser: TFxParser;
1248

1249
begin
1250
  aParser := TFxParser.Create(0);
1251
  with aParser do
1252
  begin
1253
    Calculus.Free;
1254
    ErrorByte := 0;
1255
    MainForm.StatusBar.Panels[2].Text := '';
1256
    Calculus := Compile(AnsiLowerCase(aText), ErrorByte);
1257
    e := ErrorByte;
1258
    if ErrorByte > 0 then
1259
    begin
1260
      with MainForm.StatusBar.Panels[2] do
1261
      case ErrorByte of
1262
      1:Text := 'Check Brackets for "'+ aText+'"';
1263
      2:Text := 'Unable to Parse "'+aText+'"';
1264
      end;
1265
      Result := 0;
1266
    end
1267
    else Result := Calculus.Eval;
1268
    Calculus.Free;
1269
    Calculus := nil;
1270
    Free;
1271
  end;
1272
end;
1273

1274
Initialization
1275
{ Avoids arithmetic exceptions in the above code }
1276
SetExceptionMask([exInvalidOp, exDenormalized, exZeroDivide,
1277
                  exOverflow, exUnderflow, exPrecision]);
1278

1279
end.
1280

1281