Browse Source

* Min/Max aggregates

git-svn-id: trunk@34422 -
michael 9 years ago
parent
commit
394ec97d80
2 changed files with 141 additions and 7 deletions
  1. 112 7
      packages/fcl-base/src/fpexprpars.pp
  2. 29 0
      packages/fcl-base/tests/testexprpars.pp

+ 112 - 7
packages/fcl-base/src/fpexprpars.pp

@@ -571,6 +571,26 @@ Type
     Procedure GetNodeValue(var Result : TFPExpressionResult);  override;
     Procedure GetNodeValue(var Result : TFPExpressionResult);  override;
   end;
   end;
 
 
+  { TAggregateMin }
+
+  TAggregateMin = Class(TAggregateExpr)
+  Public
+    FFirst: Boolean;
+  Public
+    Procedure InitAggregate; override;
+    Procedure UpdateAggregate; override;
+  end;
+
+  { TAggregateMax }
+
+  TAggregateMax = Class(TAggregateExpr)
+  Public
+    FFirst: Boolean;
+  Public
+    Procedure InitAggregate; override;
+    Procedure UpdateAggregate; override;
+  end;
+
   { TAggregateSum }
   { TAggregateSum }
 
 
   TAggregateSum = Class(TAggregateExpr)
   TAggregateSum = Class(TAggregateExpr)
@@ -841,6 +861,78 @@ begin
   FreeAndNil(Builtins);
   FreeAndNil(Builtins);
 end;
 end;
 
 
+{ TAggregateMax }
+
+procedure TAggregateMax.InitAggregate;
+begin
+  inherited InitAggregate;
+  FFirst:=True;
+  FResult.ResultType:=rtFloat;
+  FResult.resFloat:=0;
+end;
+
+procedure TAggregateMax.UpdateAggregate;
+
+Var
+  OK : Boolean;
+  N : TFPExpressionResult;
+
+begin
+  FArgumentNodes[0].GetNodeValue(N);
+  if FFirst then
+    begin
+    FFirst:=False;
+    OK:=True;
+    end
+  else
+    Case N.ResultType of
+      rtFloat: OK:=N.ResFloat>FResult.ResFloat;
+      rtinteger: OK:=N.ResInteger>FResult.ResFloat;
+    end;
+  if OK then
+    Case N.ResultType of
+      rtFloat: FResult.ResFloat:=N.ResFloat;
+      rtinteger: FResult.ResFloat:=N.ResInteger;
+    end;
+end;
+
+{ TAggregateMin }
+
+procedure TAggregateMin.InitAggregate;
+begin
+  inherited InitAggregate;
+  FFirst:=True;
+  FResult.ResultType:=rtFloat;
+  FResult.resFloat:=0;
+end;
+
+procedure TAggregateMin.UpdateAggregate;
+
+Var
+  OK : Boolean;
+  N : TFPExpressionResult;
+
+begin
+  FArgumentNodes[0].GetNodeValue(N);
+  if FFirst then
+    begin
+    FResult.ResultType:=N.ResultType;
+    FFirst:=False;
+    OK:=True;
+    end
+  else
+    Case N.ResultType of
+      rtFloat: OK:=N.ResFloat<FResult.ResFloat;
+      rtinteger: OK:=N.ResInteger<FResult.ResFloat;
+    end;
+  if OK then
+    Case FResult.ResultType of
+      rtFloat: FResult.ResFloat:=N.ResFloat;
+      rtinteger: FResult.ResFloat:=N.ResInteger;
+    end;
+  inherited UpdateAggregate;
+end;
+
 { TAggregateAvg }
 { TAggregateAvg }
 
 
 procedure TAggregateAvg.InitAggregate;
 procedure TAggregateAvg.InitAggregate;
@@ -2050,6 +2142,7 @@ procedure TFPExprIdentifierDef.FetchValue;
 
 
 Var
 Var
   RT,RT2 : TResultType;
   RT,RT2 : TResultType;
+  I : Integer;
 
 
 begin
 begin
   RT:=FValue.ResultType;
   RT:=FValue.ResultType;
@@ -2060,13 +2153,23 @@ begin
   RT2:=FValue.ResultType;
   RT2:=FValue.ResultType;
   if RT2<>RT then
   if RT2<>RT then
     begin
     begin
-    // Restore
-    FValue.ResultType:=RT;
-    Raise EExprParser.CreateFmt('Value handler for variable %s returned wrong type, expected "%s", got "%s"',[
-      FName,
-      GetEnumName(TypeInfo(TResultType),Ord(rt)),
-      GetEnumName(TypeInfo(TResultType),Ord(rt2))
-    ]);
+    // Automatically convert integer to float.
+    if (rt2=rtInteger) and (rt=rtFLoat) then
+      begin
+      FValue.ResultType:=RT;
+      I:=FValue.resInteger;
+      FValue.resFloat:=I;
+      end
+    else
+      begin
+      // Restore
+      FValue.ResultType:=RT;
+      Raise EExprParser.CreateFmt('Value handler for variable %s returned wrong type, expected "%s", got "%s"',[
+        FName,
+        GetEnumName(TypeInfo(TResultType),Ord(rt)),
+        GetEnumName(TypeInfo(TResultType),Ord(rt2))
+        ]);
+      end;
     end;
     end;
 end;
 end;
 
 
@@ -3819,6 +3922,8 @@ begin
       AddFunction(bcAggregate,'count','I','',TAggregateCount);
       AddFunction(bcAggregate,'count','I','',TAggregateCount);
       AddFunction(bcAggregate,'sum','F','F',TAggregateSum);
       AddFunction(bcAggregate,'sum','F','F',TAggregateSum);
       AddFunction(bcAggregate,'avg','F','F',TAggregateAvg);
       AddFunction(bcAggregate,'avg','F','F',TAggregateAvg);
+      AddFunction(bcAggregate,'min','F','F',TAggregateMin);
+      AddFunction(bcAggregate,'max','F','F',TAggregateMax);
       end;
       end;
     end;
     end;
 end;
 end;

+ 29 - 0
packages/fcl-base/tests/testexprpars.pp

@@ -857,6 +857,7 @@ type
     FM : TExprBuiltInManager;
     FM : TExprBuiltInManager;
     FExpr : String;
     FExpr : String;
     procedure DoAverage(Var Result : TFPExpressionResult; ConstRef AName : ShortString);
     procedure DoAverage(Var Result : TFPExpressionResult; ConstRef AName : ShortString);
+    procedure DoSeries(var Result: TFPExpressionResult; ConstRef AName: ShortString);
   Protected
   Protected
     procedure Setup; override;
     procedure Setup; override;
     procedure Teardown; override;
     procedure Teardown; override;
@@ -939,6 +940,8 @@ type
     Procedure TestFunctionAggregateSum;
     Procedure TestFunctionAggregateSum;
     Procedure TestFunctionAggregateCount;
     Procedure TestFunctionAggregateCount;
     Procedure TestFunctionAggregateAvg;
     Procedure TestFunctionAggregateAvg;
+    Procedure TestFunctionAggregateMin;
+    Procedure TestFunctionAggregateMax;
   end;
   end;
 
 
 implementation
 implementation
@@ -6088,12 +6091,38 @@ begin
   Result.ResultType:=rtInteger;
   Result.ResultType:=rtInteger;
 end;
 end;
 
 
+procedure TTestBuiltins.DoSeries(var Result: TFPExpressionResult; ConstRef
+  AName: ShortString);
+
+Const
+  Values : Array[1..10] of double =
+  (1.3,1.8,1.1,9.9,1.4,2.4,5.8,6.5,7.8,8.1);
+
+
+begin
+  Inc(FValue);
+  Result.ResFloat:=Values[FValue];
+  Result.ResultType:=rtFloat;
+end;
+
 procedure TTestBuiltins.TestFunctionAggregateAvg;
 procedure TTestBuiltins.TestFunctionAggregateAvg;
 begin
 begin
   FP.Identifiers.AddVariable('S',rtInteger,@DoAverage);
   FP.Identifiers.AddVariable('S',rtInteger,@DoAverage);
   AssertAggregateExpression('avg(S)',5.5,10);
   AssertAggregateExpression('avg(S)',5.5,10);
 end;
 end;
 
 
+procedure TTestBuiltins.TestFunctionAggregateMin;
+begin
+  FP.Identifiers.AddVariable('S',rtFloat,@DoSeries);
+  AssertAggregateExpression('Min(S)',1.1,10);
+end;
+
+procedure TTestBuiltins.TestFunctionAggregateMax;
+begin
+  FP.Identifiers.AddVariable('S',rtFloat,@DoSeries);
+  AssertAggregateExpression('Max(S)',9.9,10);
+end;
+
 { TTestNotNode }
 { TTestNotNode }
 
 
 procedure TTestNotNode.TearDown;
 procedure TTestNotNode.TearDown;