diff options
Diffstat (limited to 'matheunit.pas')
| -rw-r--r-- | matheunit.pas | 172 |
1 files changed, 172 insertions, 0 deletions
diff --git a/matheunit.pas b/matheunit.pas index c728d29..f34f2b3 100644 --- a/matheunit.pas +++ b/matheunit.pas @@ -47,6 +47,7 @@ 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; kvs: tKnownValues; cbgv: tCallBackGetValue): extended; +function exprToBool(st: boolean; s: string; kvs: tKnownValues; cbgv: tCallBackGetValue): boolean; function formelnAuswerten(s: string; kvs: tKnownValues; cbgv: tCallBackGetValue): string; function knownValue(nam: string; val: extended): tKnownValue; @@ -538,6 +539,177 @@ begin result:=result*(2*byte(not neg)-1); end; +function simpleExprToBool(st: boolean; s: string; kvs: tKnownValues; cbgv: tCallBackGetValue): boolean; +var + i: longint; + t: string; +const + binOps: array[0..12] of string = + ('<=','>=','<>','≤','≥','=','≠','<','>',' in ','∈',' notIn ','∉'); +begin + s:=trim(s); + while (leftStr(s,1)='(') and (rightStr(s,1)=')') do + s:=trim(copy(s,2,length(s)-2)); + + if uppercase(s)='TRUE' then begin + result:=true; + exit; + end; + if uppercase(s)='FALSE' then begin + result:=false; + exit; + end; + + for i:=0 to length(binOps)-1 do + if pos(binOps[i],s)>0 then begin + t:=erstesArgument(s,binOps[i]); + case binOps[i] of + '≤','<=': result:=exprtofloat(st,t,kvs,cbgv)<=exprtofloat(st,s,kvs,cbgv); + '≥','>=': result:=exprtofloat(st,t,kvs,cbgv)>=exprtofloat(st,s,kvs,cbgv); + '=': + try + result:=exprtofloat(st,t,kvs,cbgv)=exprtofloat(st,s,kvs,cbgv); + except + result:=t=s; + end; + '≠','<>': + try + result:=exprtofloat(st,t,kvs,cbgv)<>exprtofloat(st,s,kvs,cbgv); + except + result:=t<>s; + end; + '<': result:=exprtofloat(st,t,kvs,cbgv)<exprtofloat(st,s,kvs,cbgv); + '>': result:=exprtofloat(st,t,kvs,cbgv)>exprtofloat(st,s,kvs,cbgv); + ' in ','∈': begin + result:=false; + while (s<>'') and not result do + result:=erstesArgument(s)=t; + end; + ' notIn ','∉': begin + result:=true; + while (s<>'') and result do + result:=erstesArgument(s)<>t; + end; + else + fehler('Operator '''+binOps[i]+''' ist nicht implementiert!'); + end{of case}; + exit; + end; + fehler(''''+s+''' ist kein gültiger logischer Ausdruck!'); +end; + +function exprToBool(st: boolean; s: string; kvs: tKnownValues; cbgv: tCallBackGetValue): boolean; +var + i,j,anz: longint; + operatoren, + ausdruecke: tIntPointArray; + werte: tBooleanArray; + klammernZahl: tLongintArray; +const + logOpsNamen: array[0..6] of string = + ('not ',' and ','&&',' or ','||',' xor ',' equiv '); + logOpsAktionen: array[0..6,boolean,boolean] of boolean = + (((true,false),(true,false)), // not (1. Argument ignoriert!) + ((false,false),(false,true)), // and + ((false,false),(false,true)), // && + ((false,true),(true,true)), // or + ((false,true),(true,true)), // || + ((false,true),(true,false)), // xor + ((true,false),(false,true))); // equiv + +begin + i:=1; + setlength(operatoren,0); + while i<=length(s) do begin + for j:=0 to length(logOpsNamen)-1 do + if copy(s,i,length(logOpsNamen[j]))=logOpsNamen[j] then begin + setlength(operatoren,length(operatoren)+1); + operatoren[length(operatoren)-1,'x']:=j; + operatoren[length(operatoren)-1,'y']:=i; + i:=i+length(logOpsNamen[j]); + break; + end; + inc(i); + end; + + setlength(ausdruecke,length(operatoren)+1); + setlength(klammernZahl,length(operatoren)+1); + + for i:=0 to length(ausdruecke)-1 do begin + if i=0 then + ausdruecke[i,'x']:=1 + else + ausdruecke[i,'x']:=operatoren[i-1,'y']+length(logOpsNamen[operatoren[i-1,'x']]); + if i=length(operatoren) then + ausdruecke[i,'y']:=length(s) + else + ausdruecke[i,'y']:=operatoren[i,'y']-1; + + anz:=0; + for j:=ausdruecke[i,'x'] to ausdruecke[i,'y'] do + if s[j]='(' then + inc(anz) + else if s[j]=')' then + dec(anz); + + klammernZahl[i]:=anz; + + while (anz<0) and (ausdruecke[i,'y']>=ausdruecke[i,'x']) do begin // zu viele schließende Klammern (am rechten Rand) + if s[ausdruecke[i,'y']]=')' then + inc(anz); + dec(ausdruecke[i,'y']); + end; + while (anz>0) and (ausdruecke[i,'y']>=ausdruecke[i,'x']) do begin // zu viele öffnende Klammern (am linken Rand) + if s[ausdruecke[i,'x']]='(' then + dec(anz); + inc(ausdruecke[i,'x']); + end; + if (ausdruecke[i,'y']<ausdruecke[i,'x']) and ((i=length(operatoren)) or (operatoren[i,'x']<>0)) then // das linke Argument von "not" darf leer sein + fehler('Klammerfehler in '''+s+''' ('+inttostr(ausdruecke[i,'y'])+'<'+inttostr(ausdruecke[i,'x'])+')!'); + end; + + anz:=0; + for i:=0 to length(klammernZahl)-1 do begin + anz:=anz+klammernZahl[i]; + if anz<0 then + fehler('zu viele oder zu zeitige schließende Klammern in '''+s+'''!'); + end; + if anz<>0 then + fehler('Klammern in '''+s+''' sind nicht ausgeglichen!'); + + setlength(werte,length(ausdruecke)); + for i:=0 to length(werte)-1 do + if (i=length(werte)-1) or (operatoren[i,'x']<>0) then // kein linkes Argument von "not" + werte[i]:=simpleExprToBool(st,copy(s,ausdruecke[i,'x'],ausdruecke[i,'y']-ausdruecke[i,'x']+1),kvs,cbgv) + else + werte[i]:=false; + setlength(ausdruecke,0); + i:=length(werte)-2; + while i>=0 do + if ((klammernZahl[i]>0) or (i=0)) and (klammernZahl[i+1]<=0) then begin + result:=true; + werte[i]:=logOpsAktionen[operatoren[i,'x'],werte[i],werte[i+1]]; + klammernZahl[i]:=klammernZahl[i]+klammernZahl[i+1]; + for j:=i+1 to length(operatoren)-1 do + operatoren[j-1]:=operatoren[j]; + for j:=i+2 to length(werte)-1 do begin + werte[j-1]:=werte[j]; + klammernZahl[j-1]:=klammernZahl[j]; + end; + setlength(operatoren,length(operatoren)-1); + setlength(werte,length(werte)-1); + setlength(klammernZahl,length(klammernZahl)-1); + if i>length(werte)-2 then + dec(i); + end + else + dec(i); + if length(werte)<>1 then + fehler('Kann kein Paar von öffnenden und schließenden Klammern in '''+s+''' mehr finden - das sollte eigentlich nicht passieren können!'); + + result:=werte[0]; +end; + function formelnAuswerten(s: string; kvs: tKnownValues; cbgv: tCallBackGetValue): string; var i,start,mitte, |