[Solved] Launching solver from macro and stagnation
Posted: Fri May 01, 2020 1:14 pm
Hi all! I'm using a NLP DE-PS solver in calc of Libreoffice 6.4.0.3 both on Windows 10 and Debian Linux to remotely execute some dynamically generated problems and I'm quite satisfied with the results so far. The only problem is that when I launch the solver from the dialog windows it correctly stops due to stagnation when satisfying the constraint of objective=0, while if I launch the solver via macro (solv = CreateUnoService("com.sun.star.comp.Calc.NLPSolver.DEPSSolverImpl") ) replicating the same exact setting and scenario the solver works but stagnation is never reached, it doesn't even seem to be processed at all (setting a very low stagnation limit and/or a very high tolerance has no effect whatsoever). It gets to the correct result, but the stagnation meter doesn't move and the solver doesn't stop due to stagnation. This also happens with com.sun.star.comp.Calc.NLPSolver.SCOSolverImpl, and simplifying the problem or removing all settings doesn't seem to affect it either. Am I missing some implementation or doing something wrong?
I tried looking for any discussion on this exact issue but I found none, really sorry if there was one.
Here's a snippet of my code:
I tried looking for any discussion on this exact issue but I found none, really sorry if there was one.
Here's a snippet of my code:
Code: Select all
REM ***** BASIC *****
Option VBASupport 1
Sub Main
dim document as object
dim dispatcher as object
Dim Doc As Object
Dim PathDoc As String
Dim Props(0) As New com.sun.star.beans.PropertyValue
PathDoc = ConvertToURL("C:\Users\bard\Desktop\testdata.ods")
Props(0).Name = "Hidden"
Props(0).Value = True
oDoc = StarDesktop.loadComponentFromURL(PathDoc, "_blank", 0, Props())
rem oDoc = ThisComponent
svc = createUnoService( "com.sun.star.sheet.FunctionAccess" )
Dim Variables(1) as Object
Dim Constraint as New com.sun.star.sheet.SolverConstraint
Dim Constraints(1) as Object
Dim i as integer
Dim j as integer
Dim k as integer
Dim loc as integer
Dim rows as integer
Dim cols as integer
Dim counter as integer
Dim counter2 as integer
Dim colScore as integer
smgr = GetProcessServiceManager()
rem CHOOSING THE SOLVER
solv = CreateUnoService("com.sun.star.comp.Calc.NLPSolver.DEPSSolverImpl")
rem solv = CreateUnoService("com.sun.star.comp.Calc.NLPSolver.SCOSolverImpl")
solv.Document = oDoc
Sheet = oDoc.Sheets(0)
ConstrBin = com.sun.star.sheet.SolverConstraintOperator.BINARY
ConstrEqual = com.sun.star.sheet.SolverConstraintOperator.EQUAL
i = 0
counter=-1
counter2=-1
colScore=-1
rem reading the size of the problem
oCell = Sheet.getCellByPosition(0,0)
loc=oCell.Value
oCell = Sheet.getCellByPosition(0,loc+2)
rows=oCell.Value
oCell = Sheet.getCellByPosition(0,loc+4)
cols=oCell.Value
For i = 0 To rows
For j = 0 To cols
oCell = Sheet.getCellByPosition(j,i)
rem dinamically assigning variables and contraints (binary)
If InStr(oCell.String,"<") <> 0 Then
counter=counter+1
counter2=counter2+1
nchar=Len(oCell.String)
ReDim Preserve Variables(counter) As Object
Variables(counter) = oCell.CellAddress
Constraint.Left = oCell.CellAddress
Constraint.Operator = ConstrBin
ReDim Preserve Constraints(counter2) As Object
Constraints(counter2) = Constraint
oCell.Value=1
End If
rem finding the score cell
If InStr(oCell.String,"Score") <> 0 Then
colScore=j+1
End If
rem assigning the score cell
If j=colScore AND i=0 Then
solv.Objective = oCell.CellAddress
counter2=counter2+1
Constraint.Left = oCell.CellAddress
Constraint.Operator = ConstrEqual
Constraint.Right = 0
ReDim Preserve Constraints(counter2) As Object
Constraints(counter2) = Constraint
End If
Next j
Next i
solv.Variables = Variables()
solv.Constraints = Constraints()
solv.Maximize = False
solv.SwarmSize = 2
If Round(counter/3) > 2 Then
solv.SwarmSize = Round(counter)/3
End If
solv.LearningCycles=20000
solv.DECR=0.05
solv.DEFactorMin=0.1
solv.DEFactorMax=0.3
solv.AgentSwitchRate=1
solv.StagnationLimit=2
solv.Tolerance=100
solv.GuessVariableRange=false
solv.Solve()
cURL = ConvertToURL("C:\Users\bard\Desktop\testresults.ods")
Dim oPropertyValue As New com.sun.star.beans.PropertyValue
oPropertyValue.Name = "FilterName"
oPropertyValue.Value = "calc8"
oDoc.storeToURL( cURL, Array(oPropertyValue))
oDoc.Close(true)
End Sub