mplSudoku.vb

VBNet Example:

Imports Maximal.OptiMax


Public Class MplSudoku

   Private _solValues() As Integer
   Private _resultString As String


   Public Sub New()
      ReDim _solValues(0)
      _resultString = ""
   End Sub


   Private Function setupDataBoxAssign(ByVal size As Integer) As Integer()
      Dim box As Double = Math.Sqrt(size)
      Dim BoxAssign(size * size) As Integer
      For i As Integer = 0 To size - 1
         Dim row As Integer = CInt(box * Math.Floor(Convert.ToDouble(i) / box))
         For j As Integer = 0 To size - 1
            Dim col As Integer = CInt(Math.Ceiling(Convert.ToDouble(j + 1) / box))
            BoxAssign(i * size + j) = row + col
         Next j
      Next i
      Return BoxAssign
   End Function


   Private Function loadModel(ByVal model As Model, ByVal size As Integer, ByVal fixedValues As Integer()) As ResultType
      Dim result As ResultType
      Try
         Dim idxRow As IndexSet = model.IndexSets.Add("row", 1, size)
         model.IndexSets.Add("coln", idxRow)
         model.IndexSets.Add("num", 1, size)
         model.IndexSets.Add("box", 1, size)

         model.DataVectors.Add("FixedValues[row,coln]", fixedValues)
         model.DataVectors.Add("BoxAssign[row,coln]", setupDataBoxAssign(size))

         model.IndexSets.Add("BoxComp[row,coln,box] WHERE (BoxAssign = box)")

         model.VariableVectors.Add("Assign[row,coln,num]", VariableType.Binary)

         Dim mplSource As String = _
            "MODEL" & vbCrLf & _
            "MIN TotalAssign = SUM(row,coln,num: Assign);" & vbCrLf & _
            "SUBJECT TO" & vbCrLf & _
            "OneValue[row,coln]: SUM(num: Assign) = 1;" & vbCrLf & _
            "OneValueOnY[row,num]: SUM(coln: Assign) = 1;" & vbCrLf & _
            "OneValueOnX[coln,num]: SUM(row: Assign) = 1;" & vbCrLf & _
            "FixValue[row,coln,num] WHERE (FixedValues = num): num*Assign = FixedValues;" & vbCrLf & _
            "OneValueBox[box,num]: SUM(row,coln IN BoxComp: Assign) = 1;" & vbCrLf & _
            "END" & vbCrLf

         result = model.Parse(mplSource)
      Catch
         result = model.LastResult
      End Try
      Return result
   End Function


   Public Function SolveModel(ByVal solverName As String, ByVal size As Integer, ByVal fixedValues As Integer()) As Boolean
      Dim mpl As OptiMax = New OptiMax
      Dim solver As Solver = mpl.Solvers.Add(solverName)
      If solver Is Nothing Then
         _resultString = "Solver " & solverName & " was not found."
         Return False
      End If
      Dim model As Model = mpl.Models.Add("Sudoku")
      model.UseExceptions = True
      Dim result As ResultType = loadModel(model, size, fixedValues)
      If Not result = ResultType.Success Then
         _resultString = model.Error.ToString()
         model.ClearModel()
         Return False
      End If
      model.UseExceptions = False
      result = model.Solve(solver)
      If Not result = ResultType.Success Then
         _resultString = "Solver " & solver.Name & ": " & model.ResultString & vbCrLf & model.Solution.ResultString
         model.ClearModel()
         Return False
      End If
      _resultString = model.Solution.ResultString
      _solValues = getSolutionValues(model, size)
      model.ClearModel()
      Return True
   End Function


   Private Function getSolutionValues(ByVal model As Model, ByVal size As Integer) As Integer()
      Dim solValues(size * size) As Integer
      Dim assignVarVect As VariableVector = model.VariableVectors("Assign")
      For Each var As Variable In assignVarVect.NonzeroVariables
         Dim row As Integer = assignVarVect.Subscripts(1).Value
         Dim col As Integer = assignVarVect.Subscripts(2).Value
         Dim val As Integer = assignVarVect.Subscripts(3).Value
         Dim nr As Integer = ((row - 1) * size) + (col - 1)
         solValues(nr) = val
      Next var
      Return solValues
   End Function


   Public ReadOnly Property SolValues() As Integer()
      Get
         Return _solValues
      End Get
   End Property


   Public ReadOnly Property ResultString() As String
      Get
         Return _resultString
      End Get
   End Property


End Class