mplCirclePack.vb

VBNet Example:


Imports Maximal.OptiMax


Public Class MplCirclePack


   Private _resultString As String
   Private _xValues() As Double
   Private _yValues() As Double
   Private _radius As Double


   Public Sub New()
      _resultString = ""
      ReDim _xValues(0)
      ReDim _yValues(0)
      _radius = 0.0
   End Sub


   Private Function loadModel(ByVal model As Model, ByVal circleCount As Integer) As ResultType
      Try
         model.IndexSets.Add("i", 1, circleCount)
         model.IndexSets.Add("j", 1, circleCount)

         Dim varRadius As Variable = model.PlainVariables.Add("Radius")
         Dim varX As VariableVector = model.VariableVectors.Add("x[i]", "", VariableType.Free)
         Dim varY As VariableVector = model.VariableVectors.Add("y[i]", "", VariableType.Free)

         varRadius.UpperBound = 1.0
         varX.LowerBound = -1.0
         varX.UpperBound = 1.0
         varY.LowerBound = -1.0
         varY.UpperBound = 1.0

         model.Objectives.Add("Radius", ObjectSense.Maximize)
         model.ConstraintVectors.Add("NoOverlap[i,j]", _
            "2 * Radius <= ((x[i] - x[i:=j])^2 + (y[i] - y[i:=j])^2)^0.5", "WHERE(i < j)")
         model.ConstraintVectors.Add("InBoundsA[i]", "x + Radius <= 1")
         model.ConstraintVectors.Add("InBoundsB[i]", "x - Radius >= -1")
         model.ConstraintVectors.Add("InBoundsC[i]", "y + Radius <= 1")
         model.ConstraintVectors.Add("InBoundsD[i]", "y - Radius >= -1")

      Catch ex As Exception
         Console.WriteLine(ex.Message)
      End Try

      Return model.LastResult
   End Function


   Public Function SolveModel(ByVal solverName As String, ByVal numCircles As Integer) As Boolean
      Dim mpl As OptiMax = New OptiMax()
      Dim model As Model = mpl.Models.Add("CirclePack")
      mpl.Options("ModelType").ValueStr = "Nonlinear"
      mpl.Options("ParserType").ValueStr = "Extended"
      Dim solver As Solver = mpl.Solvers.Add(solverName)
      If solver Is Nothing Then
         _resultString = "Solver " & solverName & " was not found."
         Return False
      End If
      Dim result As ResultType = loadModel(model, numCircles)
      If Not result = ResultType.Success Then
         _resultString = model.Error.ToString()
         Return False
      End If
      result = model.Solve()
      If Not result = ResultType.Success Then
         _resultString = "Solver " & solver.Name & ": " & model.ResultString & vbCrLf & model.Solution.ResultString
         Return False
      End If
      _resultString = model.Solution.ResultString
      getSolutionValues(model)
      Return True
   End Function


   Private Sub getSolutionValues(ByVal model As Model)
      _radius = model.Solution.ObjectValue
      Dim xList As List(Of Double) = New List(Of Double)()
      Dim yList As List(Of Double) = New List(Of Double)()
      For Each xVar As Variable In model.VariableVectors("x")
         xList.Add(xVar.Activity)
      Next xVar
      For Each yVar As Variable In model.VariableVectors("y")
         yList.Add(yVar.Activity)
      Next yVar
      _xValues = xList.ToArray()
      _yValues = yList.ToArray()
   End Sub


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

   Public ReadOnly Property Radius() As Double
      Get
         Return _radius
      End Get
   End Property

   Public ReadOnly Property xValues() As Double()
      Get
         Return _xValues
      End Get
   End Property

   Public ReadOnly Property yValues() As Double()
      Get
         Return _yValues
      End Get
   End Property


End Class

        

Back To Top | Maximal Home Page | List of Samples | Previous Page | Next Page