paweld/lazarus-ccr
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

fpspreadsheet: Calculation of rpn formulas with variable parameter count works.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@3253 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz 2014-06-30 08:41:29 +00:00
parent e185b2ed51
commit 2621b0d028
3 changed files with 251 additions and 118 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

310
components/fpspreadsheet/fpsmath.pas
View File

@ -46,31 +46,35 @@ function CreateError(AError: TsErrorValue): TsArgument;
These are the functions called when calculating an RPN formula. These are the functions called when calculating an RPN formula.
} }
type type
TsFormulaFunc = function(Args: TsArgumentStack): TsArgument; TsFormulaFunc = function(Args: TsArgumentStack; NumArgs: Integer): TsArgument;
function fpsAdd (Args: TsArgumentStack): TsArgument; function fpsAdd (Args: TsArgumentStack; NumArgs: Integer): TsArgument;
function fpsSub (Args: TsArgumentStack): TsArgument; function fpsSub (Args: TsArgumentStack; NumArgs: Integer): TsArgument;
function fpsMul (Args: TsArgumentStack): TsArgument; function fpsMul (Args: TsArgumentStack; NumArgs: Integer): TsArgument;
function fpsDiv (Args: TsArgumentStack): TsArgument; function fpsDiv (Args: TsArgumentStack; NumArgs: Integer): TsArgument;
function fpsPercent (Args: TsArgumentStack): TsArgument; function fpsPercent (Args: TsArgumentStack; NumArgs: Integer): TsArgument;
function fpsPower (Args: TsArgumentStack): TsArgument; function fpsPower (Args: TsArgumentStack; NumArgs: Integer): TsArgument;
function fpsUMinus (Args: TsArgumentStack): TsArgument; function fpsUMinus (Args: TsArgumentStack; NumArgs: Integer): TsArgument;
function fpsUPlus (Args: TsArgumentStack): TsArgument; function fpsUPlus (Args: TsArgumentStack; NumArgs: Integer): TsArgument;
function fpsConcat (Args: TsArgumentStack): TsArgument; function fpsConcat (Args: TsArgumentStack; NumArgs: Integer): TsArgument;
function fpsEqual (Args: TsArgumentStack): TsArgument; function fpsEqual (Args: TsArgumentStack; NumArgs: Integer): TsArgument;
function fpsGreater (Args: TsArgumentStack): TsArgument; function fpsGreater (Args: TsArgumentStack; NumArgs: Integer): TsArgument;
function fpsGreaterEqual(Args: TsArgumentStack): TsArgument; function fpsGreaterEqual(Args: TsArgumentStack; NumArgs: Integer): TsArgument;
function fpsLess (Args: TsArgumentStack): TsArgument; function fpsLess (Args: TsArgumentStack; NumArgs: Integer): TsArgument;
function fpsLessEqual(Args: TsArgumentStack): TsArgument; function fpsLessEqual (Args: TsArgumentStack; NumArgs: Integer): TsArgument;
function fpsNotEqual (Args: TsArgumentStack): TsArgument; function fpsNotEqual (Args: TsArgumentStack; NumArgs: Integer): TsArgument;
function fpsAnd (Args: TsArgumentStack; NumArgs: Integer): TsArgument;
function fpsAnd (Args: TsArgumentStack): TsArgument; function fpsOr (Args: TsArgumentStack; NumArgs: Integer): TsArgument;
implementation implementation
uses uses
Math; Math;
type
TBoolArray = array of boolean;
TFloatArray = array of double;
TStrArray = array of string;
{ TsArgumentStack } { TsArgumentStack }
@ -313,125 +317,190 @@ begin
Result := errOK; Result := errOK;
end; end;
{@@
Pops boolean values from the argument stack. Is called when calculating rpn
formulas.
@param Args Argument stack to be used.
@param NumArgs Count of arguments to be popped from the stack
@param AValues (output) Array containing the retrieved boolean values.
The array length is given by NumArgs. The data in the array
are in the same order in which they were pushed onto the stack.
@param AErrArg (output) Argument containing an error code, e.g. errWrongType
if non-boolean data were met on the stack.
@return TRUE if everything was ok, FALSE, if AErrArg reports an error. }
function PopBoolValues(Args: TsArgumentStack; NumArgs: Integer;
out AValues: TBoolArray; out AErrArg: TsArgument): Boolean;
var
err: TsErrorValue;
i: Integer;
begin
SetLength(AValues, NumArgs);
// Pop the data in reverse order they were pushed! Otherwise they will be
// applied to the function in the wrong order.
for i := NumArgs-1 downto 0 do begin
err := GetBoolFromArgument(Args.Pop, AValues[i]);
if err <> errOK then begin
Result := false;
AErrArg := CreateError(err);
SetLength(AValues, 0);
exit;
end;
end;
Result := true;
AErrArg := CreateError(errOK);
end;
{@@
Pops floating point values from the argument stack. Is called when
calculating rpn formulas.
@param Args Argument stack to be used.
@param NumArgs Count of arguments to be popped from the stack
@param AValues (output) Array containing the retrieved float values.
The array length is given by NumArgs. The data in the array
are in the same order in which they were pushed onto the stack.
@param AErrArg (output) Argument containing an error code, e.g. errWrongType
if non-float data were met on the stack.
@return TRUE if everything was ok, FALSE, if AErrArg reports an error. }
function PopFloatValues(Args: TsArgumentStack; NumArgs: Integer;
out AValues: TFloatArray; out AErrArg: TsArgument): Boolean;
var
err: TsErrorValue;
i: Integer;
begin
SetLength(AValues, NumArgs);
// Pop the data in reverse order they were pushed! Otherwise they will be
// applied to the function in the wrong order.
for i := NumArgs-1 downto 0 do begin
err := GetNumberFromArgument(Args.Pop, AValues[i]);
if err <> errOK then begin
Result := false;
SetLength(AValues, 0);
AErrArg := CreateError(errWrongType);
exit;
end;
end;
Result := true;
AErrArg := CreateError(errOK);
end;
{@@
Pops string arguments from the argument stack. Is called when calculating
rpn formulas.
@param Args Argument stack to be used.
@param NumArgs Count of arguments to be popped from the stack
@param AValues (output) Array containing the retrieved strings. The array
length is given by NumArgs. The data in the array are in the
same order in which they were pushed onto the stack.
@param AErrArg (output) Argument containing an error code , e.g. errWrongType
if non-string data were met on the stack.
@return TRUE if everything was ok, FALSE, if AErrArg reports an error. }
function PopStringValues(Args: TsArgumentStack; NumArgs: Integer;
out AValues: TStrArray; out AErrArg: TsArgument): Boolean;
var
err: TsErrorValue;
i: Integer;
begin
SetLength(AValues, NumArgs);
// Pop the data in reverse order they were pushed! Otherwise they will be
// applied to the function in the wrong order.
for i := NumArgs-1 downto 0 do begin
err := GetStringFromArgument(Args.Pop, AValues[i]);
if err <> errOK then begin
Result := false;
AErrArg := CreateError(errWrongType);
SetLength(AValues, 0);
exit;
end;
end;
Result :=true;
AErrArg := CreateError(errOK);
end;
{ Operations } { Operations }
function fpsAdd(Args: TsArgumentStack): TsArgument; function fpsAdd(Args: TsArgumentStack; NumArgs: Integer): TsArgument;
var var
a, b: Double; data: TFloatArray;
err: TsErrorValue;
begin begin
err := Pop_2Floats(Args, a, b); if PopFloatValues(Args, 2, data, Result) then
if err = errOK then Result := CreateNumber(data[0] + data[1]);
Result := CreateNumber(a + b)
else
Result := CreateError(err);
end; end;
function fpsSub(Args: TsArgumentStack): TsArgument; function fpsSub(Args: TsArgumentStack; NumArgs: Integer): TsArgument;
var var
a, b: Double; data: TFloatArray;
err: TsErrorValue;
begin begin
err := Pop_2Floats(Args, a, b); if PopFloatValues(Args, 2, data, Result) then
if err = errOK then Result := CreateNumber(data[0] - data[1]);
Result := CreateNumber(a - b)
else
Result := CreateError(err);
end; end;
function fpsMul(Args: TsArgumentStack): TsArgument; function fpsMul(Args: TsArgumentStack; NumArgs: Integer): TsArgument;
var var
a, b: Double; data: TFloatArray;
err: TsErrorValue;
begin begin
err := Pop_2Floats(Args, a, b); if PopFloatValues(Args, 2, data, Result) then
if err = errOK then Result := CreateNumber(data[0] * data[1]);
Result := CreateNumber(a * b)
else
Result := CreateError(err);
end; end;
function fpsDiv(Args: TsArgumentStack): TsArgument; function fpsDiv(Args: TsArgumentStack; NumArgs: Integer): TsArgument;
var var
a, b: Double; data: TFloatArray;
err: TsErrorValue;
begin begin
err := Pop_2Floats(Args, a, b); if PopFloatValues(Args, 2, data, Result) then begin
if err <> errOK then if data[1] = 0 then
Result := CreateError(err) Result := CreateError(errDivideByZero)
else if b = 0 then else
Result := CreateError(errDivideByZero) Result := CreateNumber(data[0] / data[1]);
else end;
Result := CreateNumber(a / b);
end; end;
function fpsPercent(Args: TsArgumentStack): TsArgument; function fpsPercent(Args: TsArgumentStack; NumArgs: Integer): TsArgument;
var var
a: Double; data: TFloatArray;
err: TsErrorValue;
begin begin
err := Pop_1Float(Args, a); if PopFloatValues(Args, 1, data, Result) then
if err = errOK then Result := CreateNumber(data[0] * 0.01);
Result := CreateNumber(a * 0.01)
else
Result := CreateError(err);
end; end;
function fpsPower(Args: TsArgumentStack): TsArgument; function fpsPower(Args: TsArgumentStack; NumArgs: Integer): TsArgument;
var var
a, b: Double; data: TFloatArray;
err: TsErrorValue;
begin begin
err := Pop_2Floats(Args, a, b); if PopFloatValues(Args, 2, data, Result) then
if err = errOK then begin
try try
Result := CreateNumber(power(a, b)); Result := CreateNumber(power(data[0], data[1]));
except on E: EInvalidArgument do except on E: EInvalidArgument do
Result := CreateError(errOverflow); Result := CreateError(errOverflow);
// this could happen, e.g., for "power( (neg value), (non-integer) )" // this could happen, e.g., for "power( (neg value), (non-integer) )"
end; end;
end else
Result := CreateError(err);
end; end;
function fpsUMinus(Args: TsArgumentStack): TsArgument; function fpsUMinus(Args: TsArgumentStack; NumArgs: Integer): TsArgument;
var var
a: Double; data: TFloatArray;
err: TsErrorValue;
begin begin
err := Pop_1Float(Args, a); if PopFloatValues(Args, 1, data, Result) then
if err = errOK then Result := CreateNumber(-data[0]);
Result := CreateNumber(-a)
else
Result := CreateError(err);
end; end;
function fpsUPlus(Args: TsArgumentStack): TsArgument; function fpsUPlus(Args: TsArgumentStack; NumArgs: Integer): TsArgument;
var var
a: Double; data: TFloatArray;
err: TsErrorValue;
begin begin
err := Pop_1Float(Args, a); if PopFloatValues(Args, 1, data, Result) then
if err = errOK then Result := CreateNumber(data[0]);
Result := CreateNumber(a)
else
Result := CreateError(err);
end; end;
function fpsConcat(Args: TsArgumentStack): TsArgument; function fpsConcat(Args: TsArgumentStack; NumArgs: Integer): TsArgument;
var var
a, b: String; data: TStrArray;
err: TsErrorValue;
begin begin
err := Pop_2Strings(Args, a, b); if PopStringValues(Args, 2, data, Result) then
if err = errOK then Result := CreateString(data[0] + data[1]);
Result := CreateString(a + b)
else
Result := CreateError(err);
end; end;
function fpsEqual(Args: TsArgumentStack): TsArgument; function fpsEqual(Args: TsArgumentStack; NumArgs: Integer): TsArgument;
var var
arg1, arg2: TsArgument; arg1, arg2: TsArgument;
begin begin
@ -447,7 +516,7 @@ begin
Result := CreateBool(false); Result := CreateBool(false);
end; end;
function fpsGreater(Args: TsArgumentStack): TsArgument; function fpsGreater(Args: TsArgumentStack; NumArgs: Integer): TsArgument;
var var
arg1, arg2: TsArgument; arg1, arg2: TsArgument;
begin begin
@ -463,7 +532,7 @@ begin
Result := CreateBool(false); Result := CreateBool(false);
end; end;
function fpsGreaterEqual(Args: TsArgumentStack): TsArgument; function fpsGreaterEqual(Args: TsArgumentStack; NumArgs: Integer): TsArgument;
var var
arg1, arg2: TsArgument; arg1, arg2: TsArgument;
begin begin
@ -479,7 +548,7 @@ begin
Result := CreateBool(false); Result := CreateBool(false);
end; end;
function fpsLess(Args: TsArgumentStack): TsArgument; function fpsLess(Args: TsArgumentStack; NumArgs: Integer): TsArgument;
var var
arg1, arg2: TsArgument; arg1, arg2: TsArgument;
begin begin
@ -495,7 +564,7 @@ begin
Result := CreateBool(false); Result := CreateBool(false);
end; end;
function fpsLessEqual(Args: TsArgumentStack): TsArgument; function fpsLessEqual(Args: TsArgumentStack; NumArgs: Integer): TsArgument;
var var
arg1, arg2: TsArgument; arg1, arg2: TsArgument;
begin begin
@ -512,7 +581,7 @@ begin
end; end;
function fpsNotEqual(Args: TsArgumentStack): TsArgument; function fpsNotEqual(Args: TsArgumentStack; NumArgs: Integer): TsArgument;
var var
arg1, arg2: TsArgument; arg1, arg2: TsArgument;
begin begin
@ -528,21 +597,40 @@ begin
Result := CreateBool(false); Result := CreateBool(false);
end; end;
function fpsAnd(Args: TsArgumentStack; NumArgs: Integer): TsArgument;
// !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
// Variable parameter count !!!!!!!!!!!!
function fpsAnd(Args: TsArgumentStack): TsArgument;
var var
a, b: Boolean; data: TBoolArray;
err: TsErrorValue; i: Integer;
b: Boolean;
begin begin
err := Pop_2Bools(Args, a, b); if PopBoolValues(Args, NumArgs, data, Result) then begin
if err = errOK then // If at least one case is false the entire AND condition is false
Result := CreateBool(a and b) b := true;
else for i:=0 to High(data) do
Result := CreateError(err); if not data[i] then begin
b := false;
break;
end;
Result := CreateBool(b);
end;
end;
function fpsOr(Args: TsArgumentStack; NumArgs: Integer): TsArgument;
var
data: TBoolArray;
i: Integer;
b: Boolean;
begin
if PopBoolValues(Args, NumArgs, data, Result) then begin
// If at least one case is true, the entire OR condition is true
b := false;
for i:=0 to High(data) do
if data[i] then begin
b := true;
break;
end;
Result := CreateBool(b);
end;
end; end;
end. end.

4
components/fpspreadsheet/fpspreadsheet.pas
View File

@ -1198,7 +1198,7 @@ const
(Symbol:'FALSE'; MinParams:0; MaxParams:0; Func:nil), // fekFALSE (Symbol:'FALSE'; MinParams:0; MaxParams:0; Func:nil), // fekFALSE
(Symbol:'IF'; MinParams:2; MaxParams:3; Func:nil), // fekIF (Symbol:'IF'; MinParams:2; MaxParams:3; Func:nil), // fekIF
(Symbol:'NOT'; MinParams:1; MaxParams:1; Func:nil), // fekNOT (Symbol:'NOT'; MinParams:1; MaxParams:1; Func:nil), // fekNOT
(Symbol:'OR'; MinParams:1; MaxParams:30; Func:nil), // fekOR (Symbol:'OR'; MinParams:1; MaxParams:30; Func:fpsOR), // fekOR
(Symbol:'TRUE'; MinParams:0; MaxParams:0; Func:nil), // fekTRUE (Symbol:'TRUE'; MinParams:0; MaxParams:0; Func:nil), // fekTRUE
{ string } { string }
(Symbol:'CHAR'; MinParams:1; MaxParams:1; Func:nil), // fekCHAR (Symbol:'CHAR'; MinParams:1; MaxParams:1; Func:nil), // fekCHAR
@ -1466,7 +1466,7 @@ begin
exit; exit;
end; end;
// Result of function // Result of function
val := func(args); val := func(args, fe.ParamsNum);
// Push valid result on stack, exit in case of error // Push valid result on stack, exit in case of error
case val.ArgumentType of case val.ArgumentType of
atNumber, atString, atBool: atNumber, atString, atBool:

55
components/fpspreadsheet/tests/testcases_calcrpnformula.inc
View File

@ -321,18 +321,63 @@
SetLength(sollValues, Row+1); SetLength(sollValues, Row+1);
sollValues[Row] := CreateBool(1<>1); sollValues[Row] := CreateBool(1<>1);
// AND of one values (bool)
inc(Row);
MyWorksheet.WriteUTF8Text(Row, 0, '=AND(true)');
MyWorksheet.WriteRPNFormula(Row, 1, CreateRPNFormula(
RPNBool(true,
RPNFunc(fekAND, 1, nil))));
SetLength(sollValues, Row+1);
sollValues[Row] := CreateBool(true);
// AND of two values (bool)
(* variable param count !!!!!!!!!!!!!!!!
// AND (bool)
inc(Row); inc(Row);
MyWorksheet.WriteUTF8Text(Row, 0, '=AND(true,false)'); MyWorksheet.WriteUTF8Text(Row, 0, '=AND(true,false)');
MyWorksheet.WriteRPNFormula(Row, 1, CreateRPNFormula( MyWorksheet.WriteRPNFormula(Row, 1, CreateRPNFormula(
RPNBool(true, RPNBool(true,
RPNBool(false, RPNBool(false,
RPNFunc(fekAND, nil))))); RPNFunc(fekAND, 2, nil)))));
SetLength(sollValues, Row+1); SetLength(sollValues, Row+1);
sollValues[Row] := CreateBool(true and false); sollValues[Row] := CreateBool(true and false);
*)
// AND of three values (bool)
inc(Row);
MyWorksheet.WriteUTF8Text(Row, 0, '=AND(true,false,true)');
MyWorksheet.WriteRPNFormula(Row, 1, CreateRPNFormula(
RPNBool(true,
RPNBool(false,
RPNBool(true,
RPNFunc(fekAND, 3, nil))))));
SetLength(sollValues, Row+1);
sollValues[Row] := CreateBool(true and false and true);
// OR of one values (bool)
inc(Row);
MyWorksheet.WriteUTF8Text(Row, 0, '=OR(true)');
MyWorksheet.WriteRPNFormula(Row, 1, CreateRPNFormula(
RPNBool(true,
RPNFunc(fekOR, 1, nil))));
SetLength(sollValues, Row+1);
sollValues[Row] := CreateBool(true);
// OR of two values (bool)
inc(Row);
MyWorksheet.WriteUTF8Text(Row, 0, '=OR(true,false)');
MyWorksheet.WriteRPNFormula(Row, 1, CreateRPNFormula(
RPNBool(true,
RPNBool(false,
RPNFunc(fekOR, 2, nil)))));
SetLength(sollValues, Row+1);
sollValues[Row] := CreateBool(true or false);
// OR of three values (bool)
inc(Row);
MyWorksheet.WriteUTF8Text(Row, 0, '=OR(true,false,true)');
MyWorksheet.WriteRPNFormula(Row, 1, CreateRPNFormula(
RPNBool(true,
RPNBool(false,
RPNBool(true,
RPNFunc(fekOR, 3, nil))))));
SetLength(sollValues, Row+1);
sollValues[Row] := CreateBool(true or false or true);