From 823e217670098264099da7efa91d87695884ac18 Mon Sep 17 00:00:00 2001 From: Erich Eckner Date: Fri, 24 Jul 2015 13:25:22 +0200 Subject: umstrukturierung von tKnownValueArray zu tKnownValues --- lowlevelunit.pas | 5 --- matheunit.pas | 119 ++++++++++++++++++++++++++++++++++++++++--------------- 2 files changed, 87 insertions(+), 37 deletions(-) diff --git a/lowlevelunit.pas b/lowlevelunit.pas index 4e8652d..8fc6fa0 100644 --- a/lowlevelunit.pas +++ b/lowlevelunit.pas @@ -34,11 +34,6 @@ type tKodierung = (kUnbekannt,k32BitSignedInteger); tWarnstufe = (wsStreng,wsLasch); tGenauigkeit = (gSingle,gExtended); - tKnownValue = record - name: string; - value: extended; - end; - tKnownValueArray = array of tKnownValue; function signSqr(x: extended): extended; inline; function mpfToStr(f: mpf_t): string; diff --git a/matheunit.pas b/matheunit.pas index 6df1e83..f3d3c82 100644 --- a/matheunit.pas +++ b/matheunit.pas @@ -10,6 +10,20 @@ uses type tCallBackGetValue = function(name: string): extended of object; tExprToFloat = function(syntaxtest: boolean; name: string): extended of object; + tKnownValue = record + name: string; + value: extended; + end; + tKnownValues = class + private + kvs: array of tKnownValue; + function finde(nam: string): longint; inline; + public + constructor create; + destructor destroy; override; + procedure add(val: tKnownValue); + function extract(nam: string; out val: extended): boolean; inline; + end; function plus(a,b: tExtPoint): tExtPoint; function durch(a: tExtPoint; b: extended): tExtPoint; @@ -26,11 +40,62 @@ procedure copyArray(i: tExtPointArray; out o: tExtPointArray); overload; procedure copyArray(i: tLongintArray; out o: tLongintArray); overload; procedure copyArray(i: tExtendedArray; out o: tExtendedArray); overload; function nullfunktion(x: extended): extended; -function exprtofloat(st: boolean; s: string; cbgv: tCallBackGetValue): extended; overload; -function exprtofloat(st: boolean; s: string; kvs: tKnownValueArray; cbgv: tCallBackGetValue): extended; overload; +function exprtofloat(st: boolean; s: string; kvs: tKnownValues; cbgv: tCallBackGetValue): extended; +function knownValue(nam: string; val: extended): tKnownValue; implementation +// tKnownValueArray ************************************************************ + +constructor tKnownValues.create; +begin + inherited create; + fillchar(kvs,sizeof(kvs),#0); +end; + +destructor tKnownValues.destroy; +begin + setlength(kvs,0); + inherited destroy; +end; + +function tKnownValues.finde(nam: string): longint; +var + i: longint; +begin + result:=-1; + for i:=0 to length(kvs)-1 do + if kvs[i].name=nam then begin + result:=i; + exit; + end; +end; + +procedure tKnownValues.add(val: tKnownValue); +var + i: longint; +begin + i:=finde(val.name); + if i<0 then begin + i:=length(kvs); + setlength(kvs,length(kvs)+1); + kvs[i].name:=val.name; + end; + kvs[i].value:=val.value; +end; + +function tKnownValues.extract(nam: string; out val: extended): boolean; +var + i: longint; +begin + i:=finde(nam); + result:=i>=0; + if result then + val:=kvs[i].value; +end; + +// allgemeine Funktionen ******************************************************* + function plus(a,b: tExtPoint): tExtPoint; var c: char; @@ -256,15 +321,7 @@ begin result:=0*x; end; -function exprtofloat(st: boolean; s: string; cbgv: tCallBackGetValue): extended; -var - kvs: tKnownValueArray; -begin - setlength(kvs,0); - result:=exprtofloat(st,s,kvs,cbgv); -end; - -function exprtofloat(st: boolean; s: string; kvs: tKnownValueArray; cbgv: tCallBackGetValue): extended; +function exprtofloat(st: boolean; s: string; kvs: tKnownValues; cbgv: tCallBackGetValue): extended; var i,j,k,l,m: longint; inv,neg,cbv: boolean; val1,val2: extended; @@ -289,7 +346,7 @@ begin end; end; k:=fktpos(fkt1[i],s); // erstes Zeichen des Funktionsnamens - val1:=exprtofloat(st,copy(s,m,j-m),cbgv); + val1:=exprtofloat(st,copy(s,m,j-m),kvs,cbgv); case i of 0: val1:=exp(val1); 1: val1:=sin(val1); @@ -319,8 +376,8 @@ begin end; end; k:=fktpos(fkt1[i],s); // erstes Zeichen des Funktionsnamens - val1:=exprtofloat(st,copy(s,m,l-m),cbgv); - val2:=exprtofloat(st,copy(s,l+1,j-l-1),cbgv); + val1:=exprtofloat(st,copy(s,m,l-m),kvs,cbgv); + val2:=exprtofloat(st,copy(s,l+1,j-l-1),kvs,cbgv); case i of 0: val1:=min(val1,val2); 1: val1:=max(val1,val2); @@ -339,7 +396,7 @@ begin end; end; s:=copy(s,1,pos('(',s)-1)+ - floattostr(exprtofloat(st,copy(s,pos('(',s)+1,i-pos('(',s)-1),cbgv))+ + floattostr(exprtofloat(st,copy(s,pos('(',s)+1,i-pos('(',s)-1),kvs,cbgv))+ copy(s,i+1,length(s)-i); end; if (binOpPos('+',s)>0) or (binOpPos('-',s)>0) then begin @@ -349,8 +406,8 @@ begin i:=min(binOpPos('+',s),binOpPos('-',s)); if i=0 then i:=max(binOpPos('+',s),binOpPos('-',s)); if i=0 then i:=length(s)+1; - if inv then result:=result-exprtofloat(st,copy(s,1,i-1),cbgv) - else result:=result+exprtofloat(st,copy(s,1,i-1),cbgv); + if inv then result:=result-exprtofloat(st,copy(s,1,i-1),kvs,cbgv) + else result:=result+exprtofloat(st,copy(s,1,i-1),kvs,cbgv); inv:=s[i-byte(i>length(s))]='-'; delete(s,1,i); until s=''; @@ -363,8 +420,8 @@ begin i:=min(binOpPos('*',s),binOpPos('/',s)); if i=0 then i:=max(binOpPos('*',s),binOpPos('/',s)); if i=0 then i:=length(s)+1; - if inv then result:=result/exprtofloat(st,copy(s,1,i-1),cbgv) - else result:=result*exprtofloat(st,copy(s,1,i-1),cbgv); + if inv then result:=result/exprtofloat(st,copy(s,1,i-1),kvs,cbgv) + else result:=result*exprtofloat(st,copy(s,1,i-1),kvs,cbgv); inv:=s[i-byte(i>length(s))]='/'; delete(s,1,i); until s=''; @@ -372,8 +429,8 @@ begin end; if binOpPos('^',s)>0 then begin i:=binOpPos('^',s); - result:=power(exprtofloat(st,copy(s,1,i-1),cbgv), - exprtofloat(st,copy(s,i+1,length(s)-i),cbgv)); + result:=power(exprtofloat(st,copy(s,1,i-1),kvs,cbgv), + exprtofloat(st,copy(s,i+1,length(s)-i),kvs,cbgv)); exit end; neg:=startetMit('-',s); @@ -381,17 +438,9 @@ begin for i:=1 to length(s) do cbv:=cbv or not (s[i] in ['0'..'9','.',',','e','E']); if not cbv then result:=strtofloat(s) - else begin - result:=nan; - for i:=0 to length(kvs)-1 do - if kvs[i].name=s then begin - result:=kvs[i].value; - break; - end; - if isNan(result) then begin - if st then result:=1 - else if assigned(cbgv) then result:=cbgv(s); - end; + else if not kvs.extract(s,result) then begin + if st then result:=1 + else if assigned(cbgv) then result:=cbgv(s); end; (* if s='np' then result:=params.np else if s='maxw' then result:=params.maxW @@ -408,5 +457,11 @@ begin result:=result*(2*byte(not neg)-1); end; +function knownValue(nam: string; val: extended): tKnownValue; +begin + result.name:=nam; + result.value:=val; +end; + end. -- cgit v1.2.3-70-g09d2