View Issue Details

IDProjectCategoryView StatusLast Update
0036380FPCFCLpublic2019-12-04 15:30
ReporterwpAssigned ToMichael Van Canneyt 
PrioritynormalSeverityminorReproducibilityhave not tried
Status closedResolutionfixed 
Product VersionProduct Build 
Target VersionFixed in Version4.0.0 
Summary0036380: Feature Request: Extend FPExrpessionParser to allow functions with variable count of arguments
DescriptionFPExpressionParser implements aggregation functions "min()", "max()", "ave()", "count()". Their usage is a bit counter-intuitive, because it operates on a single variable and requires some coding to iterate through the values of the variable. It would be more straightforward if these functions could be called with a variable parameter list instead, i.e. "min(1,2,3,4,5)" -- instead of "min(x)" where code must be written so that x takes the values 1, 2, 3, 4, 5.

The source code of TFPExpressionParser contains a comment which hints for a possible solution: "Parse arguments. Negative is for variable number of arguments, where Abs(value) is the minimum number of arguments"

The provided patch introduces a new parameter type symbol '+' for the AddFunction method of TFPExprIdentifierDefs. Standing at the end of the type list it is intended to indicated that the preceding parameter type can be repeated without limit.

Example:
  parser.Identifiers.AddFunction('MinOf', 'F', 'F+', @ExprMinOf)
defines a user-defined function "MinOf()" which accepts an unlimited count of floating point arguments ('F+');

When the '+' symbol is found at the end of the list the function ExprIdentifer.ArgumentCount of the last argument returns a negative value which directs the scanner to continue reading arguments until the closing bracket is found.
Additional InformationAfter application of the patch the following test program works. It adds user-defined functions "MinOf", "MaxOf", "SumOf", "AveOf" and "StdDevOf" (of course, it would be nice if they would be added to the built-in category bcMath -- their name was chosen to avoid an naming conflict with the aggregate functions):

program project1;

uses
  math, fpexprpars;

var
  parser: TFpExpressionParser;

procedure ExprMaxOf(var Result: TFPExpressionResult; Const Args: TExprParameterArray);
var
  mx: Double;
  arg: TFPExpressionResult;
begin
  mx := -MaxDouble;
  for arg in Args do
    mx := math.Max(mx, ArgToFloat(arg));
  result.ResFloat:= mx;
end;

procedure ExprMinOf(var Result: TFPExpressionResult; Const Args: TExprParameterArray);
var
  mn: Double;
  arg: TFPExpressionResult;
begin
  mn := MaxDouble;
  for arg in Args do
    mn := math.Min(mn, ArgToFloat(arg));
  result.ResFloat:= mn;
end;

procedure ExprSumOf(var Result: TFPExpressionResult; Const Args: TExprParameterArray);
var
  sum: Double;
  arg: TFPExpressionResult;
begin
  sum := 0;
  for arg in Args do
    sum := sum + ArgToFloat(arg);
  Result.ResFloat := sum;
end;

procedure ExprAveOf(var Result: TFPExpressionResult; const Args: TExprParameterArray);
var
  sum: Double;
  arg: TFPExpressionResult;
begin
  if Length(Args) = 0 then
    raise EExprParser.Create('At least 1 value needed for calculation of average');
  sum := 0;
  for arg in Args do
    sum := sum + ArgToFloat(arg);
  Result.ResFloat := sum / Length(Args);
end;

procedure ExprStdDevOf(var Result: TFPExpressionResult; const Args: TExprParameterArray);
var
  sum, ave: Double;
  arg: TFPExpressionResult;
begin
  if Length(Args) < 2 then
    raise EExprParser.Create('At least 2 values needed for calculation of standard deviation');
  sum := 0;
  for arg in Args do
    sum := sum + ArgToFloat(arg);
  ave := sum / Length(Args);
  sum := 0;
  for arg in Args do
    sum := sum + sqr(ArgToFloat(arg) - ave);
  Result.ResFloat := sqrt(sum / (Length(Args) - 1));
end;

begin
  parser := TFPExpressionParser.Create(nil);
  try
    parser.BuiltIns := [bcMath];
    parser.Identifiers.AddFunction('MaxOf', 'F', 'F+', @ExprMaxOf);
    parser.Identifiers.AddFunction('MinOf', 'F', 'F+', @ExprMinOf);
    parser.Identifiers.AddFunction('SumOf', 'F', 'F+', @ExprSumOf);
    parser.Identifiers.AddFunction('AveOf', 'F', 'F+', @ExprAveOf);
    parser.Identifiers.AddFunction('StdDevOf', 'F', 'F+', @ExprStdDevOf);
    parser.Expression := 'MinOf(-1,2,3,4.1)';
    WriteLn(parser.Evaluate.ResFloat:0:3);
    parser.Expression := 'MaxOf(-1,2,3,4.1)';
    WriteLn(parser.Evaluate.ResFloat:0:3);
    parser.Expression := 'SumOf(-1,2,3,4.1)';
    WriteLn(parser.Evaluate.ResFloat:0:3);
    parser.Expression := 'AveOf(-1,2,3,4.1)';
    WriteLn(parser.Evaluate.ResFloat:0:6);
    parser.Expression := 'StdDevOf(-1,2,3,4.1)';
    WriteLn(parser.Evaluate.ResFloat:0:6);
  finally
    parser.Free;
  end;

  ReadLn;
end.
TagsNo tags attached.
Fixed in Revision43637
FPCOldBugId
FPCTarget3.2.0
Attached Files
  • fpexprpars.pp.patch (3,824 bytes)
    Index: packages/fcl-base/src/fpexprpars.pp
    ===================================================================
    --- packages/fcl-base/src/fpexprpars.pp	(revision 43609)
    +++ packages/fcl-base/src/fpexprpars.pp	(working copy)
    @@ -499,6 +499,7 @@
         FArgumentTypes: String;
         FIDType: TIdentifierType;
         FName: ShortString;
    +    FVariableArgumentCount: Boolean;
         FOnGetValue: TFPExprFunctionEvent;
         FOnGetValueCB: TFPExprFunctionCallBack;
         function GetAsBoolean: Boolean;
    @@ -544,6 +545,7 @@
         Property OnGetFunctionValue : TFPExprFunctionEvent Read FOnGetValue Write FOnGetValue;
         Property OnGetVariableValue : TFPExprVariableEvent Read FOnGetVarValue Write FOnGetVarValue;
         Property NodeType : TFPExprFunctionClass Read FNodeType Write FNodeType;
    +    property VariableArgumentCount: Boolean read FVariableArgumentCount write FVariableArgumentCount;
       end;
     
     
    @@ -2270,7 +2272,11 @@
       Result:=Add as TFPExprIdentifierDef;
       Result.Name:=Aname;
       Result.IdentifierType:=itFunctionCallBack;
    -  Result.ParameterTypes:=AParamTypes;
    +  if (AParamTypes <> '') and (AParamTypes[Length(AParamTypes)] = '+') then begin
    +    Result.ParameterTypes := Copy(AParamTypes, 1, Length(AParamTypes)-1);
    +    Result.FVariableArgumentCount := true;
    +  end else
    +    Result.ParameterTypes := AParamTypes;
       Result.ResultType:=CharToResultType(AResultType);
       Result.FOnGetValueCB:=ACallBack;
     end;
    @@ -2282,7 +2288,11 @@
       Result:=Add as TFPExprIdentifierDef;
       Result.Name:=Aname;
       Result.IdentifierType:=itFunctionHandler;
    -  Result.ParameterTypes:=AParamTypes;
    +  if (AParamTypes <> '') and (AParamTypes[Length(AParamTypes)] = '+') then begin
    +    Result.ParameterTypes := Copy(AParamTypes, 1, Length(AParamTypes)-1);
    +    Result.FVariableArgumentCount := true;
    +  end else
    +    Result.ParameterTypes := AParamTypes;
       Result.ResultType:=CharToResultType(AResultType);
       Result.FOnGetValue:=ACallBack;
     end;
    @@ -2294,7 +2304,11 @@
       Result:=Add as TFPExprIdentifierDef;
       Result.Name:=Aname;
       Result.IdentifierType:=itFunctionNode;
    -  Result.ParameterTypes:=AParamTypes;
    +  if (AParamTypes <> '') and (AParamTypes[Length(AParamTypes)] = '+') then begin
    +    Result.ParameterTypes := Copy(AParamTypes, 1, Length(AParamTypes)-1);
    +    Result.FVariableArgumentCount := true;
    +  end else
    +    Result.ParameterTypes := AParamTypes;
       Result.ResultType:=CharToResultType(AResultType);
       Result.FNodeType:=ANodeClass;
     end;
    @@ -2361,7 +2375,10 @@
     
     function TFPExprIdentifierDef.ArgumentCount: Integer;
     begin
    -  Result:=Length(FArgumentTypes);
    +  if FVariableArgumentCount then
    +    Result := -Length(FArgumentTypes)
    +  else
    +    Result:=Length(FArgumentTypes);
     end;
     
     procedure TFPExprIdentifierDef.Assign(Source: TPersistent);
    @@ -2376,6 +2393,7 @@
         FStringValue:=EID.FStringValue;
         FValue:=EID.FValue;
         FArgumentTypes:=EID.FArgumentTypes;
    +    FVariableArgumentCount := EID.FVariableArgumentCount;
         FIDType:=EID.FIDType;
         FName:=EID.FName;
         FOnGetValue:=EID.FOnGetValue;
    @@ -3776,11 +3794,14 @@
       rtp,rta : TResultType;
     
     begin
    -  If Length(FArgumentNodes)<>FID.ArgumentCount then
    +  If (Length(FArgumentNodes)<>FID.ArgumentCount) and not FID.VariableArgumentCount then
         RaiseParserError(ErrInvalidArgumentCount,[FID.Name]);
       For I:=0 to Length(FArgumentNodes)-1 do
         begin
    -    rtp:=CharToResultType(FID.ParameterTypes[i+1]);
    +    if (i < Length(FID.ParameterTypes)) then
    +      rtp := CharToResultType(FID.ParameterTypes[i+1])
    +    else if FID.VariableArgumentCount then
    +      rtp := CharToResultType(FID.ParameterTypes[Length(FID.ParameterTypes)]);
         rta:=FArgumentNodes[i].NodeType;
         If (rtp<>rta) then
           FArgumentNodes[i]:=ConvertArgument(I+1,FArgumentNodes[i],rtp);
    @@ -4448,3 +4469,4 @@
     finalization
       FreeBuiltins;
     end.
    +
    
    fpexprpars.pp.patch (3,824 bytes)

Activities

wp

2019-11-29 17:31

reporter  

fpexprpars.pp.patch (3,824 bytes)
Index: packages/fcl-base/src/fpexprpars.pp
===================================================================
--- packages/fcl-base/src/fpexprpars.pp	(revision 43609)
+++ packages/fcl-base/src/fpexprpars.pp	(working copy)
@@ -499,6 +499,7 @@
     FArgumentTypes: String;
     FIDType: TIdentifierType;
     FName: ShortString;
+    FVariableArgumentCount: Boolean;
     FOnGetValue: TFPExprFunctionEvent;
     FOnGetValueCB: TFPExprFunctionCallBack;
     function GetAsBoolean: Boolean;
@@ -544,6 +545,7 @@
     Property OnGetFunctionValue : TFPExprFunctionEvent Read FOnGetValue Write FOnGetValue;
     Property OnGetVariableValue : TFPExprVariableEvent Read FOnGetVarValue Write FOnGetVarValue;
     Property NodeType : TFPExprFunctionClass Read FNodeType Write FNodeType;
+    property VariableArgumentCount: Boolean read FVariableArgumentCount write FVariableArgumentCount;
   end;
 
 
@@ -2270,7 +2272,11 @@
   Result:=Add as TFPExprIdentifierDef;
   Result.Name:=Aname;
   Result.IdentifierType:=itFunctionCallBack;
-  Result.ParameterTypes:=AParamTypes;
+  if (AParamTypes <> '') and (AParamTypes[Length(AParamTypes)] = '+') then begin
+    Result.ParameterTypes := Copy(AParamTypes, 1, Length(AParamTypes)-1);
+    Result.FVariableArgumentCount := true;
+  end else
+    Result.ParameterTypes := AParamTypes;
   Result.ResultType:=CharToResultType(AResultType);
   Result.FOnGetValueCB:=ACallBack;
 end;
@@ -2282,7 +2288,11 @@
   Result:=Add as TFPExprIdentifierDef;
   Result.Name:=Aname;
   Result.IdentifierType:=itFunctionHandler;
-  Result.ParameterTypes:=AParamTypes;
+  if (AParamTypes <> '') and (AParamTypes[Length(AParamTypes)] = '+') then begin
+    Result.ParameterTypes := Copy(AParamTypes, 1, Length(AParamTypes)-1);
+    Result.FVariableArgumentCount := true;
+  end else
+    Result.ParameterTypes := AParamTypes;
   Result.ResultType:=CharToResultType(AResultType);
   Result.FOnGetValue:=ACallBack;
 end;
@@ -2294,7 +2304,11 @@
   Result:=Add as TFPExprIdentifierDef;
   Result.Name:=Aname;
   Result.IdentifierType:=itFunctionNode;
-  Result.ParameterTypes:=AParamTypes;
+  if (AParamTypes <> '') and (AParamTypes[Length(AParamTypes)] = '+') then begin
+    Result.ParameterTypes := Copy(AParamTypes, 1, Length(AParamTypes)-1);
+    Result.FVariableArgumentCount := true;
+  end else
+    Result.ParameterTypes := AParamTypes;
   Result.ResultType:=CharToResultType(AResultType);
   Result.FNodeType:=ANodeClass;
 end;
@@ -2361,7 +2375,10 @@
 
 function TFPExprIdentifierDef.ArgumentCount: Integer;
 begin
-  Result:=Length(FArgumentTypes);
+  if FVariableArgumentCount then
+    Result := -Length(FArgumentTypes)
+  else
+    Result:=Length(FArgumentTypes);
 end;
 
 procedure TFPExprIdentifierDef.Assign(Source: TPersistent);
@@ -2376,6 +2393,7 @@
     FStringValue:=EID.FStringValue;
     FValue:=EID.FValue;
     FArgumentTypes:=EID.FArgumentTypes;
+    FVariableArgumentCount := EID.FVariableArgumentCount;
     FIDType:=EID.FIDType;
     FName:=EID.FName;
     FOnGetValue:=EID.FOnGetValue;
@@ -3776,11 +3794,14 @@
   rtp,rta : TResultType;
 
 begin
-  If Length(FArgumentNodes)<>FID.ArgumentCount then
+  If (Length(FArgumentNodes)<>FID.ArgumentCount) and not FID.VariableArgumentCount then
     RaiseParserError(ErrInvalidArgumentCount,[FID.Name]);
   For I:=0 to Length(FArgumentNodes)-1 do
     begin
-    rtp:=CharToResultType(FID.ParameterTypes[i+1]);
+    if (i < Length(FID.ParameterTypes)) then
+      rtp := CharToResultType(FID.ParameterTypes[i+1])
+    else if FID.VariableArgumentCount then
+      rtp := CharToResultType(FID.ParameterTypes[Length(FID.ParameterTypes)]);
     rta:=FArgumentNodes[i].NodeType;
     If (rtp<>rta) then
       FArgumentNodes[i]:=ConvertArgument(I+1,FArgumentNodes[i],rtp);
@@ -4448,3 +4469,4 @@
 finalization
   FreeBuiltins;
 end.
+
fpexprpars.pp.patch (3,824 bytes)

Michael Van Canneyt

2019-12-04 12:43

administrator   ~0119611

A very useful addition, thank you very much !
I added the test program in the form of testcases.

wp

2019-12-04 15:30

reporter   ~0119614

Thanks for applying.

I updated the wiki article (https://wiki.lazarus.freepascal.org/How_To_Use_TFPExpressionParser) to document the new feature.

Issue History

Date Modified Username Field Change
2019-11-29 17:30 wp New Issue
2019-11-29 17:31 wp File Added: fpexprpars.pp.patch
2019-11-29 18:00 Michael Van Canneyt Assigned To => Michael Van Canneyt
2019-11-29 18:00 Michael Van Canneyt Status new => assigned
2019-12-04 12:43 Michael Van Canneyt Status assigned => resolved
2019-12-04 12:43 Michael Van Canneyt Resolution open => fixed
2019-12-04 12:43 Michael Van Canneyt Fixed in Version => 4.0.0
2019-12-04 12:43 Michael Van Canneyt Fixed in Revision => 43637
2019-12-04 12:43 Michael Van Canneyt FPCTarget => 3.2.0
2019-12-04 12:43 Michael Van Canneyt Note Added: 0119611
2019-12-04 15:30 wp Status resolved => closed
2019-12-04 15:30 wp Note Added: 0119614