ScriptForge - (Calc) redesign CompactUp() and CompactLeft()

This commit is mainly about the introduction of
a new internal method:
_ComputeFilter(range, filterformula, filterscope)

A FilterFormula is a Calc formula that returns TRUE or FALSE
The formula is expressed in terms of
- the top-left cell of the range when FilterScope = "CELL"
- the topmost row of the range when FilterScope = "ROW"
- the leftmost column of the range when FilterScope = "COLUMN"
After pasting, the relative and absolute references
will be interpreted correctly.
The FilterScope indicates the way the formula is applied,
once by row, column or individual cell.

The concept of FilterFormula was already used by CompactUp()
and CompactLeft(). Their implicit (Filter)scopes were resp.
"ROW" and "COLUMN".

The _ComputeFilter() method returns an array of subranges
contained in the initial range that match the filter.

The isolation the code for the management of filters
applied on ranges makes the later use of the concepts of
FilterFormula and FilterScope reusable for other methods.

CompactUp() and CompactLeft() are functionally unchanged.
No impact on documentation.

Change-Id: I7c4e890b54f315486f29b5434a3c236167e2f9ea
Reviewed-on: https://gerrit.libreoffice.org/c/core/+/138368
Tested-by: Jean-Pierre Ledure <jp@ledure.be>
Reviewed-by: Jean-Pierre Ledure <jp@ledure.be>
Tested-by: Jenkins

1 files changed, 180 insertions, 78 deletions

diff --git a/wizards/source/sfdocuments/SF_Calc.xba b/wizards/source/sfdocuments/SF_Calc.xba
index b929faccd58c..61d1691f7d43 100644
--- a/wizards/source/sfdocuments/SF_Calc.xba
+++ b/wizards/source/sfdocuments/SF_Calc.xba
@@ -45,6 +45,7 @@ Option Explicit
 '''			' The substring "SFDocuments." in the service name is optional
 '''
 '''		Definitions:
+'''
 '''			Many methods require a "Sheet" or a "Range" as argument. (NB: a single cell is considered as a special case of a Range)
 '''			Usually, within a specific Calc instance, sheets and ranges are given as a string: "SheetX" and "D2:F6"
 '''			Multiple ranges are not supported in this context.
@@ -71,6 +72,21 @@ Option Explicit
 '''					myDoc.Range("SheetX.D2:F6")
 '''											A range within the sheet SheetX in file associated with the myDoc Calc instance
 '''
+'''			Several methods may receive a "FilterFormula" as argument.
+'''			A FilterFormula may be associated with a FilterScope: "row", "column" or "cell".
+'''			These arguments determines on which rows/columns/cells of a range the method should be applied
+'''			Examples:
+'''				oDoc.ClearAll("A1:J10", FilterFormula := "=(A1<=0)", FilterScope := "CELL")		'	Clear all negative values
+'''				oDoc.ClearAll("A2:J10", FilterFormula := "=(A2<>A1)", FilterScope := "COLUMN")	'	Clear when identical to above cell
+'''
+'''				FilterFormula:	a Calc formula that returns TRUE or FALSE
+'''								the formula is expressed in terms of
+'''									- the top-left cell of the range when FilterScope = "CELL"
+'''									- the topmost row of the range when FilterScope = "ROW"
+'''									- the leftmost column of the range when FilterScope = "COLUMN"
+'''								relative and absolute references will be interpreted correctly
+'''				FilterScope:	the way the formula is applied, once by row, by column, or by individual cell
+'''
 '''		Detailed user documentation:
 '''			https://help.libreoffice.org/latest/en-US/text/sbasic/shared/03/sf_calc.html?DbPAR=BASIC
 '''
@@ -544,7 +560,7 @@ Const cstSubArgs = "Range"
 Check:
 	If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
 		If Not _IsStillAlive() Then GoTo Finally
-		If Not ScriptForge.SF_Utils._Validate(Range, "Range", V_STRING) Then GoTo Finally
+		If Not ScriptForge.SF_Utils._Validate(Range, "Range", Array(V_STRING, ScriptForge.V_OBJECT)) Then GoTo Finally
 	End If
 
 Try:
@@ -560,7 +576,7 @@ Try:
 					+ .OBJECTS _
 					+ .EDITATTR _
 					+ .FORMATTED
-		Set oRange = _ParseAddress(Range)
+		If VarType(Range) = V_STRING Then Set oRange = _ParseAddress(Range) Else Set oRange = Range
 		oRange.XCellRange.clearContents(lClear)
 	End With
 
@@ -663,9 +679,9 @@ Public Function CompactLeft(Optional ByVal Range As Variant _
 '''		WholeColumn: when True (default = False), erase whole columns
 '''		FilterFormula: the formula to be applied on each column.
 '''			The column is erased when the formula results in True,
-'''			The formula shall probably involve one or more cells of the first column of the range..
+'''			The formula shall probably involve one or more cells of the first column of the range.
 '''			By default, a column is erased when all the cells of the column are empty,
-'''			i.e. suppose the range is "A1:J200" (height = 0) the default value becomes
+'''			i.e. suppose the range is "A1:J200" (height = 200) the default value becomes
 '''				"=(COUNTBLANK(A1:A200)=200)"
 '''	Returns:
 '''		A string representing the location of the initial range after compaction,
@@ -676,13 +692,12 @@ Public Function CompactLeft(Optional ByVal Range As Variant _
 '''			'	The columns having a "X" in row 7 are completely suppressed
 
 Dim sCompact As String			'	Return value
-Dim oSourceAddress As Object	'	Alias of Range as _Address
-Dim lLastRow As Long			'	Last used row number in the sheet containing Range
-Dim sFormulaRange As String		'	Range, as a string, where the FilterFormula must be stored
-Dim vCompact As Variant			'	Array of Boolean values indicating which columns should be erased
+Dim oCompact As Object			'	Return value as an _Address type
 Dim lCountDeleted As Long		'	Count the deleted columns
-Dim lCountToDelete As Long		'	Count contiguous columns to be deleted at once
-Dim sPartialRange As String		'	Contiguous columns to be deleted
+Dim vCompactRanges As Variant	'	Array of ranges to be compacted based on the formula
+Dim oSourceAddress As Object	'	Alias of Range as _Address
+Dim oPartialRange As Object		'	Contiguous columns to be deleted
+Dim sShiftRange As String		'	Contiguous columns to be shifted
 Dim i As Long
 
 Const cstThisSub = "SFDocuments.Calc.CompactLeft"
@@ -703,48 +718,34 @@ Check:
 
 Try:
 	Set oSourceAddress = _ParseAddress(Range)
+	lCountDeleted = 0
 
 	With oSourceAddress
 
 		'	Set the default formula => all cells are blank
 		If FilterFormula = "" Then FilterFormula = Printf("=(COUNTBLANK(%C1%R1:%C1%R2)-" & .Height & "=0)", Range)
-		'	Compute the range where to apply the formula
-		lLastRow = LastRow(.SheetName)
-		sFormulaRange = Offset(Range, lLastRow - .XCellRange.RangeAddress.StartColumn + 1, , 1)
-		SetFormula(sFormulaRange, FilterFormula)
-		'	Get the columns to compact: 0 = False, 1 = True
-		vCompact = GetValue(sFormulaRange)
-		If Not IsArray(vCompact) Then vCompact = Array(vCompact)
-		ClearAll(sFormulaRange)
-
-		'	Iterates from the last to the first column of the range and remove the columns that match the filter
-		'	by groups of contiguous columns
-		lCountDeleted = 0
-		lCountToDelete = 0
-		For i = UBound(vCompact) To 0 Step -1
-			If vCompact(i) = 1 Then lCountToDelete = lCountToDelete + 1
-			If i > 0 And vCompact(i) = 1 Then
-				'	Do nothing
-			ElseIf lCountToDelete > 0 Then		'	The current column must be kept but columns at the left must be removed
-				'	Do not forget when the 1st column must be removed
-				sPartialRange = Offset(Range, , Iif(i = 0 And vCompact(i) = 1, 0, i + 1), , lCountToDelete)
-				ShiftLeft(sPartialRange, WholeColumn)
-				lCountDeleted = lCountDeleted + lCountToDelete
-				lCountToDelete = 0
-			End If
-		Next i
 
+		'	Identify the ranges to compact based on the given formula
+		vCompactRanges = _ComputeFilter(oSourceAddress, FilterFormula, "COLUMN")
+
+		'	Iterate through the ranges from bottom to top and shift them up
+		For i = UBound(vCompactRanges) To 0 Step -1
+			Set oPartialRange = vCompactRanges(i)
+			ShiftLeft(oPartialRange.RangeName, WholeColumn)
+			lCountDeleted = lCountDeleted + oPartialRange.Width
+		Next i
+	
 		'	Compute the final range position
-		If lCountDeleted < .Width Then sCompact = Offset(Range, 0, 0, , .Width - lCountDeleted)
+		If lCountDeleted < .Width Then sCompact = Offset(Range, 0, 0, 0, .Width - lCountDeleted)
 
-		'	Push rightwards the cells that migrated leftwards irrelevantly
+		'	Push to the right the cells that migrated leftwards irrelevantly
 		If Not WholeColumn Then
 			If Len(sCompact) > 0 Then
-				sPartialRange = Offset(sCompact, 0, .Width - lCountDeleted, , lCountDeleted)
+				sShiftRange = Offset(sCompact, 0, .Width - lCountDeleted, , lCountDeleted)
 			Else
-				sPartialRange = .RangeName
+				sShiftRange = .RangeName
 			End If
-			ShiftRight(sPartialRange, WholeColumn := False)
+			ShiftRight(sShiftRange, WholeColumn := False)
 		End If
 
 	End With
@@ -773,7 +774,7 @@ Public Function CompactUp(Optional ByVal Range As Variant _
 '''		WholeRow: when True (default = False), erase whole rows
 '''		FilterFormula: the formula to be applied on each row.
 '''			The row is erased when the formula results in True,
-'''			The formula shall probably involve one or more cells of the first row of the range..
+'''			The formula shall probably involve one or more cells of the first row of the range.
 '''			By default, a row is erased when all the cells of the row are empty,
 '''			i.e. suppose the range is "A1:J200" (width = 10) the default value becomes
 '''				"=(COUNTBLANK(A1:J1)=10)"
@@ -786,13 +787,12 @@ Public Function CompactUp(Optional ByVal Range As Variant _
 '''			'	The rows having a "X" in column G are completely suppressed
 
 Dim sCompact As String			'	Return value
-Dim oSourceAddress As Object	'	Alias of Range as _Address
-Dim lLastCol As Long			'	Last used column number in the sheet containing Range
-Dim sFormulaRange As String		'	Range, as a string, where the FilterFormula must be stored
-Dim vCompact As Variant			'	Array of Boolean values indicating which rows should be erased
+Dim oCompact As Object			'	Return value as an _Address type
 Dim lCountDeleted As Long		'	Count the deleted rows
-Dim lCountToDelete As Long		'	Count contiguous rows to be deleted at once
-Dim sPartialRange As String		'	Contiguous rows to be deleted
+Dim vCompactRanges As Variant	'	Array of ranges to be compacted based on the formula
+Dim oSourceAddress As Object	'	Alias of Range as _Address
+Dim oPartialRange As Object		'	Contiguous rows to be deleted
+Dim sShiftRange As String		'	Contiguous rows to be shifted
 Dim i As Long
 
 Const cstThisSub = "SFDocuments.Calc.CompactUp"
@@ -813,48 +813,34 @@ Check:
 
 Try:
 	Set oSourceAddress = _ParseAddress(Range)
+	lCountDeleted = 0
 
 	With oSourceAddress
 
 		'	Set the default formula => all cells are blank
 		If FilterFormula = "" Then FilterFormula = Printf("=(COUNTBLANK(%C1%R1:%C2%R1)-" & .Width & "=0)", Range)
-		'	Compute the range where to apply the formula
-		lLastCol = LastColumn(.SheetName)
-		sFormulaRange = Offset(Range, , lLastCol - .XCellRange.RangeAddress.StartRow + 1, , 1)
-		SetFormula(sFormulaRange, FilterFormula)
-		'	Get the rows to compact: 0 = False, 1 = True
-		vCompact = GetValue(sFormulaRange)
-		If Not IsArray(vCompact) Then vCompact = Array(vCompact)
-		ClearAll(sFormulaRange)
-
-		'	Iterates from the last to the first row of the range and remove the rows that match the filter
-		'	by groups of contiguous rows
-		lCountDeleted = 0
-		lCountToDelete = 0
-		For i = UBound(vCompact) To 0 Step -1
-			If vCompact(i) = 1 Then lCountToDelete = lCountToDelete + 1
-			If i > 0 And vCompact(i) = 1 Then
-				'	Do nothing
-			ElseIf lCountToDelete > 0 Then		'	The current row must be kept but rows below must be removed
-				'	Do not forget when the 1st row must be removed
-				sPartialRange = Offset(Range, Iif(i = 0 And vCompact(i) = 1, 0, i + 1), , lCountToDelete)
-				ShiftUp(sPartialRange, WholeRow)
-				lCountDeleted = lCountDeleted + lCountToDelete
-				lCountToDelete = 0
-			End If
-		Next i
 
+		'	Identify the ranges to compact based on the given formula
+		vCompactRanges = _ComputeFilter(oSourceAddress, FilterFormula, "ROW")
+
+		'	Iterate through the ranges from bottom to top and shift them up
+		For i = UBound(vCompactRanges) To 0 Step -1
+			Set oPartialRange = vCompactRanges(i)
+			ShiftUp(oPartialRange.RangeName, WholeRow)
+			lCountDeleted = lCountDeleted + oPartialRange.Height
+		Next i
+	
 		'	Compute the final range position
-		If lCountDeleted < .Height Then sCompact = Offset(Range, 0, 0, .Height - lCountDeleted)
+		If lCountDeleted < .Height Then sCompact = Offset(Range, 0, 0, .Height - lCountDeleted, 0)
 
 		'	Push downwards the cells that migrated upwards irrelevantly
 		If Not WholeRow Then
 			If Len(sCompact) > 0 Then
-				sPartialRange = Offset(sCompact, .Height - lCountDeleted, 0, lCountDeleted)
+				sShiftRange = Offset(sCompact, .Height - lCountDeleted, 0, lCountDeleted)
 			Else
-				sPartialRange = .RangeName
+				sShiftRange = .RangeName
 			End If
-			ShiftDown(sPartialRange, WholeRow := False)
+			ShiftDown(sShiftRange, WholeRow := False)
 		End If
 
 	End With
@@ -2874,7 +2860,7 @@ Const cstSubArgs = "TargetRange, Formula"
 Check:
 	If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
 		If Not _IsStillAlive() Then GoTo Finally
-		If Not ScriptForge.SF_Utils._Validate(TargetRange, "TargetRange", V_STRING) Then GoTo Finally
+		If Not ScriptForge.SF_Utils._Validate(TargetRange, "TargetRange", Array(V_STRING, ScriptForge.V_OBJECT)) Then GoTo Finally
 		If IsArray(Formula) Then
 			If Not ScriptForge.SF_Utils._ValidateArray(Formula, "Formula", 0, V_STRING) Then GoTo Finally
 		Else
@@ -2883,7 +2869,7 @@ Check:
 	End If
 
 Try:
-	Set oAddress = _ParseAddress(TargetRange)
+	If VarType(TargetRange) = V_STRING Then Set oAddress = _ParseAddress(TargetRange) Else Set oAddress = TargetRange
 	With oAddress
 		If IsArray(Formula) Then
 			'	Convert to data array and limit its size to the size of the initial range
@@ -3664,6 +3650,122 @@ End Function	'   SFDocuments.SF_Calc.SetPrinter
 REM =========================================================== PRIVATE FUNCTIONS
 
 REM -----------------------------------------------------------------------------
+Public Function _ComputeFilter(ByVal poRange As Object _
+								, ByVal psFilterFormula As String _
+								, ByVal psFilterScope As String _
+								) As Variant
+'''	Compute in the given range the cells, rows or columns for which
+'''	the given formula refurns TRUE
+'''	Args:
+'''		poRange: the range on which to compute the filter as an _Address type
+'''		psFilterFormula: the formula to be applied on each row, column or cell
+'''		psFilterSCope: "ROW", "COLUMN" or "CELL"
+'''	Returns:
+'''		An array of ranges as objects of type _Address
+
+Dim vRanges As Variant			'	Return value
+Dim oRange As Object			'	A single vRanges() item
+Dim lLast As Long				'	Last used row or column number in the sheet containing Range
+Dim oFormulaRange As _Address	'	Range where the FilterFormula must be stored
+Dim sFormulaDirection As String	'	Either V(ertical), H(orizontal) or B(oth)
+Dim vDataArray As Variant		'	DataArray compatible with .DataArray UNO property
+Dim vFilter As Variant			'	Array of Boolean values indicating which rows should be erased
+Dim bFilter As Boolean			'	A single item in vFilter
+Dim iDims As Integer			'	Number of dimensions of vFilter()
+Dim lLower As Long				'	Lower level of contiguous True filter values
+Dim lUpper As Long				'	Upper level of contiguous True filter values
+Dim i As Long, j As Long
+
+Check:
+	'	Error handling is determined by the calling method
+	vRanges = Array()
+
+Try:
+	With poRange
+
+		'	Compute the range where to apply the formula
+		'	Determine the direction of the range containing the formula vertical, horizontal or both
+		Select Case psFilterScope
+			Case "ROW"
+				lLast = LastColumn(.SheetName)
+				'	Put formulas as a single column in the unused area at the right of the range to filter
+				Set oFormulaRange = _Offset(poRange, 0, lLast - .XCellRange.RangeAddress.StartColumn + 1, 0, 1)
+				sFormulaDirection = "V"
+			Case "COLUMN"
+				lLast = LastRow(.SheetName)
+				'	Put formulas as a single row in the unused area at the bottom of the range to filter
+				Set oFormulaRange = _Offset(poRange, lLast - .XCellRange.RangeAddress.StartRow + 1, 0, 1, 0)
+				sFormulaDirection = "H"
+			Case "CELL"
+				lLast = LastRow(.SheetName)
+				'	Put formulas as a matrix in the unused area at the bottom of the range to filter
+				Set oFormulaRange = _Offset(poRange, lLast - .XCellRange.RangeAddress.StartRow + 1, 0, 0, 0)
+				sFormulaDirection = "B"
+				If oFormulaRange.Width = 1 Then
+					sFormulaDirection = "V"
+				ElseIf oFormulaRange.Height = 1 Then
+					sFormulaDirection = "H"
+				End If
+		End Select
+
+		'	Apply the formula and get the result as an array of Boolean values. Clean up
+		SetFormula(oFormulaRange, psFilterFormula)
+		vDataArray = oFormulaRange.XCellRange.getDataArray()
+		vFilter = _ConvertFromDataArray(vDataArray)
+		iDims = ScriptForge.SF_Array.CountDims(vFilter)
+		ClearAll(oFormulaRange)
+
+		'	Convert the filter values (0 = False, 1 = True) to a set of ranges
+		Select Case iDims
+			Case -1			'	Scalar
+				If vFilter = 1 Then vRanges = ScriptForge.SF_Array.Append(vRanges, poRange)
+			Case 0			'	Empty array
+				'	Nothing to do
+			Case 1, 2		'	Vector or Array
+				'	Strategy: group contiguous applicable rows/columns to optimize heavy operations like CompactUp, CompactLeft
+				'	Stack the contiguous ranges of True values in vRanges()
+
+				'	To manage vector and array with same code, setup a single fictitious loop when vector, otherwise scan array by row
+				For i = 0 To Iif(iDims = 1, 0, UBound(vFilter, 1))
+					lLower = -1		:	lUpper = -1
+
+					For j = 0 To UBound(vFilter, iDims)
+						If iDims = 1 Then bFilter = CBool(vFilter(j)) Else bFilter = CBool(vFilter(i, j))
+						If j = UBound(vFilter, iDims) And bFilter Then	'	Don't forget the last item
+							If lLower < 0 Then lLower = j
+							lUpper = j
+						ElseIf Not bFilter Then
+							If lLower >= 0 Then lUpper = j - 1
+						ElseIf bFilter Then
+							If lLower < 0 Then lLower = j
+						End If
+						'	Determine the next applicable range when one found and limit reached
+						If lUpper > -1 Then
+							If sFormulaDirection = "V" Then			'	ROW
+								Set oRange = _Offset(poRange, lLower, 0, lUpper - lLower + 1, 0)
+							ElseIf sFormulaDirection = "H" Then		'	COLUMN
+								Set oRange = _Offset(poRange, 0, lLower, 0, lUpper - lLower + 1)
+							Else									'	CELL
+								Set oRange = _Offset(poRange, i, lLower, 1, lUpper - lLower + 1)
+							End If
+							If Not IsNull(oRange) Then vRanges = ScriptForge.SF_Array.Append(vRanges, oRange)
+							lLower = -1		:	lUpper = -1
+						End If
+					Next j
+
+				Next i
+			Case Else
+				'	Should not happen
+		End Select
+
+	End With
+
+Finally:
+	_ComputeFilter = vRanges()
+	Exit Function
+End Function    '   SFDocuments.SF_Calc._ComputeFilter
+
+REM -----------------------------------------------------------------------------
 Public Function _ConvertFromDataArray(ByRef pvDataArray As Variant) As Variant
 '''	Convert a data array to a scalar, a vector or a 2D array
 '''	Args: