FindMaximum

FindMaximum.vb

Option Explicit On
Option Strict On

Imports Microsoft.SolverFoundation.Common
Imports Microsoft.SolverFoundation.Services

Module SolverSample

    Public Structure FindMaximumResult
        Public Solutions1() As Double
        Public Solutions2() As Double
        Public ObjectiveValue As Double
    End Structure

    Public Function FindMaximum(ByRef context As SolverContext, ByRef factors1 As Decimal(), ByRef factors2 As Decimal(), ByRef constraints As Double()) As FindMaximumResult
        If factors1.Rank <> 1 Or factors2.Rank <> 1 Or constraints.Rank <> 1 Then
            Throw New ArgumentException("Arguments must be vectors")
        End If
        Dim n As Integer = factors1.Length
        If n <> factors2.Length Or n <> constraints.Length Then
            Throw New ArgumentException("All vectors must have the same length")
        End If
        For i = 0 To n - 1
            If factors1(i) = 0 Or factors2(i) = 0 Then
                Throw New ArgumentException("No factor may be 0")
            End If
        Next
        Dim r As New FindMaximumResult
        Dim model As Model = context.CreateModel()
        r.Solutions1 = New Double(n - 1) {}
        r.Solutions2 = New Double(n - 1) {}
        Dim decisions(2 * n - 1) As Decision
        For i = 0 To 2 * n - 1
            decisions(i) = New Decision(Domain.Real, "d" & i)
            model.AddDecision(decisions(i))
            model.AddConstraint("d" & i & "_nonzero", decisions(i) >= 0)
        Next

        Dim obj As String = String.Empty
        For i = 0 To n - 1
            If i > 0 Then obj = obj & "+"
            obj = obj & "(" & (1 / factors1(i) - n) & "*" & decisions(i).Name + ")+(" & (n - 1.1 / factors2(i)) & "*" & decisions(i + n).Name & ")"
            Dim e As String = String.Empty
            For j = 0 To n - 1
                If j > 0 Then e = e & "+"
                If j = i Then
                    e = e & "(" & (1 / factors1(j) - 1) & "*" & decisions(j).Name & ")-(" & (1.1 / factors2(j) - 1) & "*" & decisions(j + n).Name & ")"
                Else
                    e = e & decisions(j + n).Name & "-" & decisions(j).Name
                End If
            Next
            e = e & "<=" & constraints(i)
            model.AddConstraint("constraint" & i, e)
        Next
        model.AddGoal("Obj", GoalKind.Maximize, obj)
        Dim sol As Solution = context.Solve(New SimplexDirective())
        r.ObjectiveValue = sol.Goals.First().ToDouble()
        For i = 0 To n - 1
            r.Solutions1(i) = sol.Decisions(i).GetDouble()
            r.Solutions2(i) = sol.Decisions(i + n).GetDouble()
        Next
        Return r
    End Function

    Sub Main()
        Dim context As SolverContext = SolverContext.GetContext()

        Dim x = FindMaximum(context, New Decimal() {1, 2, 3, 4, 5, 6}, New Decimal() {1, 2, 3, 4, 5, 6}, New Double() {20, 30, 40, 40, 25, 3})

        Console.WriteLine("Maximum = {0}", x.ObjectiveValue)

        Console.Write("Solution1 = ")
        For Each v In x.Solutions1
            Console.Write("{0} ", v)
        Next
        Console.WriteLine()

        Console.Write("Solution2 = ")
        For Each v In x.Solutions2
            Console.Write("{0} ", v)
        Next
        Console.WriteLine()

        Console.ReadLine()

    End Sub

End Module