From 336a1cf581d722e2ca0780ac520be3c3d4486536 Mon Sep 17 00:00:00 2001 From: wp_xxyyzz Date: Fri, 4 Jul 2014 14:38:20 +0000 Subject: [PATCH] fpspreadsheet: Implement calculation of COUNTIF, several test cases passed. git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@3279 8e941d3f-bd1b-0410-a28a-d453659cc2b4 --- components/fpspreadsheet/fpsfunc.pas | 217 ++++++++++++++++++ components/fpspreadsheet/fpspreadsheet.pas | 38 ++- .../tests/testcases_calcrpnformula.inc | 74 +++++- 3 files changed, 318 insertions(+), 11 deletions(-) diff --git a/components/fpspreadsheet/fpsfunc.pas b/components/fpspreadsheet/fpsfunc.pas index 28f5192a5..c82def1b4 100644 --- a/components/fpspreadsheet/fpsfunc.pas +++ b/components/fpspreadsheet/fpsfunc.pas @@ -128,6 +128,7 @@ function fpsAVEDEV (Args: TsArgumentStack; NumArgs: Integer): TsArgument; function fpsAVERAGE (Args: TsArgumentStack; NumArgs: Integer): TsArgument; function fpsCOUNT (Args: TsArgumentStack; NumArgs: Integer): TsArgument; function fpsCOUNTBLANK (Args: TsArgumentStack; NumArgs: Integer): TsArgument; +function fpsCOUNTIF (Args: TsArgumentStack; NumArgs: Integer): TsArgument; function fpsMAX (Args: TsArgumentStack; NumArgs: Integer): TsArgument; function fpsMIN (Args: TsArgumentStack; NumArgs: Integer): TsArgument; function fpsPRODUCT (Args: TsArgumentStack; NumArgs: Integer): TsArgument; @@ -239,6 +240,148 @@ begin Result.ArgumentType := atEmpty; end; +{ Compares two arguments and returns -1 if "Arg2 > Arg1", +1 if "Arg1 < Arg2", + 0 if "Arg1 = Arg2", MaxInt if result meaningless + If AExact is true only matching types are compared, otherwise types are converted before comparing. } +function CompareArgs(Arg1, Arg2: TsArgument; AExact: Boolean): integer; +var + val1, val2: Double; + b1, b2: Boolean; + cell1, cell2: PCell; + s: String; +begin + Result := MaxInt; + + // Number - Number + if (Arg1.ArgumentType = atNumber) and (Arg2.ArgumentType = atNumber) then begin + Result := CompareValue(Arg1.NumberValue, Arg2.NumberValue); + exit; + end; + + // String - String + if (Arg1.ArgumentType = atString) and (Arg2.ArgumentType = atString) then begin + if TryStrToFloat(Arg1.StringValue, val1) and TryStrToFloat(Arg2.StringValue, val2) then + Result := CompareValue(val1, val2) + else + Result := UTF8CompareText(Arg1.StringValue, Arg2.StringValue); + exit; + end; + + // Bool - Bool + if (Arg1.ArgumentType = atBool) and (Arg2.ArgumentType = atBool) then begin + Result := CompareValue(ord(Arg1.BoolValue), ord(Arg2.BoolValue)); + exit; + end; + + // Cell - Cell + if (Arg1.ArgumentType in [atCell, atCellRange]) and (Arg2.ArgumentType in [atCell, atCellRange]) + then begin + if Arg1.ArgumentType = atCell + then cell1 := Arg1.Cell + else cell1 := Arg1.Worksheet.FindCell(Arg1.FirstRow, Arg1.FirstCol); + if Arg2.ArgumentType = atCell + then cell2 := Arg2.Cell + else cell2 := Arg2.Worksheet.FindCell(Arg2.FirstRow, Arg2.FirstCol); + if Arg1.Worksheet.ReadNumericValue(cell1, val1) and Arg2.Worksheet.ReadNumericValue(cell2, val2) then begin + Result := CompareValue(val1, val2); + exit; + end; + Result := UTF8CompareText(cell1^.UTF8StringValue, cell2^.UTF8StringValue); + exit; + end; + + // Mixed type comparison only if AExact = true + if AExact then + exit; + + // Number - string + if (Arg1.ArgumentType = atNumber) and (Arg2.ArgumentType = atString) then begin + if TryStrToFloat(Arg2.StringValue, val2) then + Result := CompareValue(Arg1.NumberValue, val2); + exit; + end; + if (Arg1.ArgumentType = atString) and (Arg2.ArgumentType = atNumber) then begin + if TryStrToFloat(Arg1.StringValue, val1) then + Result := CompareValue(val1, Arg2.NumberValue); + exit; + end; + + // Number - bool + if (Arg1.ArgumentType = atNumber) and (Arg2.ArgumentType = atBool) then begin + Result := CompareValue(Arg1.NumberValue, ord(Arg2.BoolValue)); + exit; + end; + if (Arg1.ArgumentType = atBool) and (Arg2.ArgumentType = atNumber) then begin + Result := CompareValue(ord(Arg1.BoolValue), Arg2.NumberValue); + exit; + end; + + // Number - cell + if (Arg1.ArgumentType = atNumber) and (Arg2.ArgumentType in [atCell, atCellRange]) then begin + if Arg2.ArgumentType = atCell + then cell2 := Arg2.Cell + else cell2 := Arg2.Worksheet.FindCell(Arg2.FirstRow, Arg2.FirstCol); + if (cell2 <> nil) and Arg2.Worksheet.ReadNumericValue(cell2, val2) then + Result := CompareValue(Arg1.NumberValue, val2); + exit; + end; + if (Arg2.ArgumentType = atNumber) and (Arg1.ArgumentType in [atCell, atCellRange]) then begin + Result := CompareArgs(Arg2, Arg1, AExact); + if Result <> MaxInt then Result := -Result; + exit; + end; + + // String - bool + if (Arg1.ArgumentType = atString) and (Arg2.ArgumentType = atBool) then begin + if not TryStrToFloat(Arg1.StringValue, val1) then + exit; + val2 := ord(Arg2.BoolValue); + Result := CompareValue(val1, val2); + exit; + end; + if (Arg2.ArgumentType = atString) and (Arg1.ArgumentType = atBool) then begin + Result := CompareArgs(Arg2, Arg1, AExact); + if Result <> MaxInt then Result := -Result; + end; + + // String - cell + if (Arg1.ArgumentType = atString) and (Arg2.ArgumentType in [atCell, atCellRange]) then begin + if Arg2.ArgumentType = atCell + then cell2 := Arg2.Cell + else cell2 := Arg2.Worksheet.FindCell(Arg2.FirstRow, Arg2.FirstCol); + if cell2 = nil then + exit; + if TryStrToFloat(Arg1.stringValue, val1) then begin + if Arg2.Worksheet.ReadNumericValue(cell2, val2) then + Result := CompareValue(val1, val2); + exit; + end; + Result := UTF8CompareText(Arg1.StringValue, cell2^.UTF8StringValue); + exit; + end; + if (Arg2.ArgumentType = atString) and (Arg1.ArgumentType in [atCell, atCellRange]) then begin + Result := CompareArgs(Arg2, Arg1, AExact); + if Result <> MaxInt then Result := -Result; + exit; + end; + + // Bool - cell + if (Arg1.ArgumentType = atBool) and (Arg2.ArgumentType in [atCell, atCellRange]) then begin + val1 := ord(Arg1.BoolValue); + if Arg2.ArgumentType = atCell + then cell2 := Arg2.Cell + else cell2 := Arg2.Worksheet.FindCell(Arg2.FirstRow, Arg2.FirstCol); + if (cell2 <> nil) and Arg2.Worksheet.ReadNumericValue(cell2, val2) then + Result := CompareValue(val1, val2); + exit; + end; + if (Arg2.ArgumentType = atBool) and (Arg1.ArgumentType in [atCell, atCellRange]) then begin + Result := CompareArgs(Arg2, Arg1, AExact); + if Result <> MaxInt then Result := -Result; + exit; + end; +end; + { TsArgumentStack } @@ -1445,6 +1588,80 @@ begin end; end; +function fpsCOUNTIF(Args: TsArgumentStack; NumArgs: Integer): TsArgument; +// COUNTIF( range, criteria ) +// - "range" is to the cell range to be analyzed +// - "citeria" can be a cell, a value or a string starting with a symbol like ">" etc. +// (in the former two cases a value is counted if equal to the criteria value) +var + n: Integer; + r, c: Cardinal; + arg: TsArgument; + cellarg: TsArgument; + criteria: TsArgument; + compare: TFEKind; + res: Integer; + cell: PCell; +begin + criteria := Args.Pop; + arg := Args.Pop; + compare := fekEqual; + case criteria.ArgumentType of + atCellRange: + criteria := CreateCell(criteria.Worksheet.FindCell(criteria.FirstRow, criteria.FirstCol)); + atString: + if Length(criteria.StringValue) > 1 then + case criteria.StringValue[1] of + '<' : case criteria.StringValue[2] of + '>' : begin + compare := fekNotEqual; + Delete(criteria.StringValue, 1, 2); + end; + '=' : begin + compare := fekLessEqual; + Delete(criteria.StringValue, 1, 2); + end; + else compare := fekLess; + Delete(criteria.StringValue, 1, 1); + end; + '>' : case criteria.StringValue[2] of + '=' : begin + compare := fekGreaterEqual; + Delete(criteria.StringValue, 1, 2); + end; + else compare := fekGreater; + Delete(criteria.StringValue, 1, 1); + end; + '=' : begin + compare := fekEqual; + Delete(criteria.StringValue, 1, 1); + end; + end; + end; + n := 0; + for r := arg.FirstRow to arg.LastRow do + for c := arg.FirstCol to arg.LastCol do begin + cell := arg.Worksheet.FindCell(r, c); + if cell <> nil then begin + cellarg := CreateCell(cell); + res := CompareArgs(cellarg, criteria, false); + if res <> MaxInt then begin + if (res < 0) and (compare in [fekLess, fekLessEqual, fekNotEqual]) + then inc(n) + else + if (res = 0) and (compare in [fekEqual, fekLessEqual, fekGreaterEqual]) + then inc(n) + else + if (res > 0) and (compare in [fekGreater, fekGreaterEqual, fekNotEqual]) + then inc(n); + end else + if (compare = fekNotEqual) then inc(n); + end else + if compare = fekNotEqual then inc(n); + end; + Result := CreateNumber(n); +end; + function fpsMAX(Args: TsArgumentStack; NumArgs: Integer): TsArgument; // MAX( number1, number2, ... number_n ) var diff --git a/components/fpspreadsheet/fpspreadsheet.pas b/components/fpspreadsheet/fpspreadsheet.pas index 42b98716c..26fb4dd2f 100755 --- a/components/fpspreadsheet/fpspreadsheet.pas +++ b/components/fpspreadsheet/fpspreadsheet.pas @@ -512,13 +512,14 @@ type function ReadAsDateTime(ARow, ACol: Cardinal; out AResult: TDateTime): Boolean; overload; function ReadAsDateTime(ACell: PCell; out AResult: TDateTime): Boolean; overload; function ReadFormulaAsString(ACell: PCell): String; + function ReadNumericValue(ACell: PCell; out AValue: Double): Boolean; function ReadRPNFormulaAsString(ACell: PCell): String; - function ReadUsedFormatting(ARow, ACol: Cardinal): TsUsedFormattingFields; - function ReadBackgroundColor(ARow, ACol: Cardinal): TsColor; { Reading of cell attributes } function GetNumberFormatAttributes(ACell: PCell; out ADecimals: Byte; out ACurrencySymbol: String): Boolean; + function ReadUsedFormatting(ARow, ACol: Cardinal): TsUsedFormattingFields; + function ReadBackgroundColor(ARow, ACol: Cardinal): TsColor; { Writing of values } procedure WriteBlank(ARow, ACol: Cardinal); overload; @@ -1199,7 +1200,7 @@ var (Symbol:'COUNT'; MinParams:0; MaxParams:30; Func:fpsCOUNT), // fekCOUNT (Symbol:'COUNTA'; MinParams:0; MaxParams:30; Func:nil), // fekCOUNTA (Symbol:'COUNTBLANK';MinParams:1; MaxParams:1; Func:fpsCOUNTBLANK), // fekCOUNTBLANK - (Symbol:'COUNTIF'; MinParams:2; MaxParams:2; Func:nil), // fekCOUNTIF + (Symbol:'COUNTIF'; MinParams:2; MaxParams:2; Func:fpsCOUNTIF), // fekCOUNTIF (Symbol:'MAX'; MinParams:1; MaxParams:30; Func:fpsMAX), // fekMAX (Symbol:'MEDIAN'; MinParams:1; MaxParams:30; Func:nil), // fekMEDIAN (Symbol:'MIN'; MinParams:1; MaxParams:30; Func:fpsMIN), // fekMIN @@ -2202,6 +2203,37 @@ begin Result := ACell^.FormulaValue.FormulaStr; end; +{@@ + Returns to numeric equivalent of the cell contents. This is the NumberValue + of a number cell, the DateTimeValue of a date/time cell, the ordinal BoolValue + of a boolean cell, or the string converted to a number of a string cell. + All other cases return NaN. + + @param ACell Cell to be considered + @param AValue (output) extracted numeric value + @return True if conversion to number is successfull, otherwise false } +function TsWorksheet.ReadNumericValue(ACell: PCell; out AValue: Double): Boolean; +begin + Result := True; + case ACell^.ContentType of + cctNumber: + AValue := ACell^.NumberValue; + cctDateTime: + AValue := ACell^.DateTimeValue; + cctBool: + AValue := ord(ACell^.BoolValue); + else + if (ACell^.ContentType <> cctUTF8String) or + not TryStrToFloat(ACell^.UTF8StringValue, AValue) or + not TryStrToDateTime(ACell^.UTF8StringValue, AValue) + then begin + Result := False; + AValue := NaN; + end; + end; +end; + + {@@ If a cell contains an RPN formula an Excel-like formula string is constructed and returned. diff --git a/components/fpspreadsheet/tests/testcases_calcrpnformula.inc b/components/fpspreadsheet/tests/testcases_calcrpnformula.inc index f86e14d79..06b6a734b 100644 --- a/components/fpspreadsheet/tests/testcases_calcrpnformula.inc +++ b/components/fpspreadsheet/tests/testcases_calcrpnformula.inc @@ -1,6 +1,14 @@ { include file for "formulatests.pas", containing the test cases for the calcrpnformula test. } + // Setting up some test numbers + + // Test range M1:N3 + MyWorksheet.WriteUTF8Text(0, 12, 'A'); // M1 + MyWorksheet.WriteUTF8Text(0, 13, 'A'); // N1 + MyWorksheet.WriteNumber (1, 12, 1); // M2 + MyWorksheet.WriteNumber (1, 13, 2); // N2 + {------------------------------------------------------------------------------} { Basic operations } {------------------------------------------------------------------------------} @@ -1161,14 +1169,64 @@ SetLength(sollValues, Row+1); sollValues[Row] := CreateNumber(2); - // COUNT - inc(Row); - MyWorksheet.WriteUTF8Text(Row, 0, '=COUNTBLANK(A1:D2)'); - MyWorksheet.WriteRPNFormula(Row, 1, CreateRPNFormula( - RPNCellRange('A1:D2', - RPNFunc(fekCOUNTBLANK, nil)))); - SetLength(sollValues, Row+1); - sollValues[Row] := CreateNumber(4); + if AFormat <> sfExcel2 then begin + // COUNTBLANK + inc(Row); + MyWorksheet.WriteUTF8Text(Row, 0, '=COUNTBLANK(A1:D2)'); + MyWorksheet.WriteRPNFormula(Row, 1, CreateRPNFormula( + RPNCellRange('A1:D2', + RPNFunc(fekCOUNTBLANK, nil)))); + SetLength(sollValues, Row+1); + sollValues[Row] := CreateNumber(4); + end; + + if AFormat <> sfExcel2 then begin + // COUNTIF + inc(Row); + MyWorksheet.WriteUTF8Text(Row, 0, '=COUNTIF(M1:N3,1)'); + MyWorksheet.WriteRPNFormula(Row, 1, CreateRPNFormula( + RPNCellRange('M1:N3', + RPNNumber(1, // "1" is in M2 + RPNFunc(fekCOUNTIF, nil))))); + SetLength(sollValues, Row+1); + sollValues[Row] := CreateNumber(1); + + inc(Row); + MyWorksheet.WriteUTF8Text(Row, 0, '=COUNTIF(M1:N3,">=1")'); + MyWorksheet.WriteRPNFormula(Row, 1, CreateRPNFormula( + RPNCellRange('M1:N3', + RPNString('>=1', // M2=1, N2=2 --> 2 + RPNFunc(fekCOUNTIF, nil))))); + SetLength(sollValues, Row+1); + sollValues[Row] := CreateNumber(2); + + inc(Row); + MyWorksheet.WriteUTF8Text(Row, 0, '=COUNTIF(M1:N3,"<2")'); + MyWorksheet.WriteRPNFormula(Row, 1, CreateRPNFormula( + RPNCellRange('M1:N3', + RPNString('<2', // M2=1, N2=2 --> 1 + RPNFunc(fekCOUNTIF, nil))))); + SetLength(sollValues, Row+1); + sollValues[Row] := CreateNumber(1); + + inc(Row); + MyWorksheet.WriteUTF8Text(Row, 0, '=COUNTIF(M1:N3,"<>2")'); + MyWorksheet.WriteRPNFormula(Row, 1, CreateRPNFormula( + RPNCellRange('M1:N3', + RPNString('<>2', // N2=2, 6 other cells --> 5 + RPNFunc(fekCOUNTIF, nil))))); + SetLength(sollValues, Row+1); + sollValues[Row] := CreateNumber(5); + + inc(Row); + MyWorksheet.WriteUTF8Text(Row, 0, '=COUNTIF(M1:N3,M1)'); + MyWorksheet.WriteRPNFormula(Row, 1, CreateRPNFormula( + RPNCellRange('M1:N3', + RPNCellValue('M1', // M1="A", N1="A" -> 2 + RPNFunc(fekCOUNTIF, nil))))); + SetLength(sollValues, Row+1); + sollValues[Row] := CreateNumber(2); + end; // MAX inc(Row);