unit CQParser;
interface
uses SysUtils, Math;
type
TOperation = (opAdd, opSub, opMul, opDiv, opPow, opConst);
// ******** classes for building the parsed formula as tree
TRNode =
class(TObject)
private
Fval: Double;
Fop : TOperation;
protected
subNodes:
array[0..1]
of TRNode;
public
function Solve: double;
constructor Create(val: Double);
overload;
constructor Create(op: TOperation);
overload;
end;
// ******** Main-Parser Class
TCQParser =
class(TObject)
private
FRootR: TRNode;
protected
procedure FlushTrees(
var nd: TRNode);
procedure TTR(s:
string;
var currentND: TRNode);
public
procedure Parse(formula:
string);
procedure Solve(
var result: double);
destructor Destroy;
override;
end;
implementation
(****************************** TRNode ****************************************)
constructor TRNode.Create(val: Double);
begin
inherited Create;
Fval := val;
Fop := opConst;
end;
constructor TRNode.Create(op: TOperation);
begin
inherited Create;
Fop := op;
end;
function TRNode.Solve: double;
begin
case Fop
of
opAdd : result := subNodes[0].Solve + subNodes[1].Solve;
opSub : result := subNodes[0].Solve - subNodes[1].Solve;
opMul : result := subNodes[0].Solve * subNodes[1].Solve;
opDiv : result := subNodes[0].Solve / subNodes[1].Solve;
opPow : result := Power(subNodes[0].Solve, subNodes[1].Solve);
else result := Fval;
end;
end;
(************** Parser begin **********************************)
destructor TCQParser.Destroy;
begin
FlushTrees(FRootR);
inherited Destroy;
end;
procedure TCQParser.FlushTrees(
var nd: TRNode);
begin
if Assigned(nd)
then
begin
FreeTree(nd.subNodes[0]);
FreeTree(nd.subNodes[1]);
FreeAndNil(nd);
end;
end;
procedure TCQParser.Parse(formula:
string);
begin
FlushTrees(FRootR);
FRootR := TRNode.Create;
TTR(formula, FRootR);
end;
procedure TCQParser.Solve(
var result: double);
begin
result := FRootR.Solve;
end;
(********* Helperfunctions *******************************)
//// Diese Funktionen vereinfachen lediglich das Suchen im String,
//// und das Zerteilen an einem Operator.
// pos0 finds the first symbol "c" in "s"
function pos0(
const c: char;
const s:
string): integer;
var k: Integer;
begin
z := 0;
for k:=length(s)
downto 1
do
begin
if (s[k]=c)
then
begin
result := k;
// hit
exit;
end;
end;
result := 0;
// nothing found
end;
function starting(
const s:
string;
const c: char):
string;
begin
result := copy(s,1,pos0(c,s)-1);
end;
function copyFrom(
const s:
string;
const i: integer):
string;
begin
result := copy(s,i,length(s)-i+1);
end;
function ending(
const s:
string;
const c: char):
string;
begin
result := copyFrom(s,pos0(c,s)+1);
end;
(********* actual parsing procedure **********************)
procedure TCQParser.TTR(s:
string;
var currentND: TRNode);
begin
// Leerzeichen entfernen
s := trim(s);
if s = '
'
then exit;
//// '+' ist Operand schwächster Bindung -> wird als erster geprüft
//// Wenn gefunden, dann die beiden Teilstrings um ihn herum WIEDER mit TTR parsen
//// (und TTR bekommt den Knoten mit, in den er die gefundene Info schreiben soll)
//// und einen Knoten anlegen, der '+'-Info enthält
if pos0('
+',s)>0
then
begin
currentND := TRNode.Create(opAdd);
TTR(starting(s,'
+'), currentND.subNodes[0]);
TTR(ending(s,'
+'), currentND.subNodes[1]);
exit;
end else
if pos0('
-',s)>0
then
begin
currentND := TRNode.Create(opSub);
TTR(starting(s,'
-'), currentND.subNodes[0]);
TTR(ending(s,'
-'), currentND.subNodes[1]);
exit;
end else
if pos0('
*',s)>0
then
begin
currentND := TRNode.Create(opMul);
TTR(starting(s,'
*'), currentND.subNodes[0]);
TTR(ending(s,'
*'), currentND.subNodes[1]);
exit;
end else
if pos0('
/',s)>0
then
begin
currentND := TRNode.Create(opDiv);
TTR(starting(s,'
/'), currentND.subNodes[0]);
TTR(ending(s,'
/'), currentND.subNodes[1]);
exit;
end else
if pos0('
^',s)>0
then
begin
currentND := TRNode.Create(opPow);
TTR(starting(s,'
^'), currentND.subNodes[0]);
TTR(ending(s,'
^'), currentND.subNodes[1]);
exit;
end else
//// Keinen Operator im String gefunden, also muss eine Zahl vorliegen. Knoten mit Zahl erstellen
//// und Ende der Rekursion (kein erneuter Aufruf von TTR)
begin
currentND := TRNode.Create(StrToFloat(s));
exit;
end;
end;
end.