Startseite / Tipps / VB.NET-Tipp 0018: KnapSack

VB.NET-Tipp 0018: KnapSack

 von Herfried Wagner

' Dieser Quellcode stammt von http://www.activevb.de
' und kann frei verwendet werden. Für eventuelle Schäden
' wird nicht gehaftet.

' Um Fehler oder Fragen zu klären, nutzen Sie bitte unser Forum.
' Ansonsten viel Spaß und Erfolg mit diesem Source!

' Projektversion:   Visual Studio 2002/2003
' Option Strict:    An
' Option Explicit:  An
'
' Referenzen: 
'  - System
'

' ##############################################################################
' ############################# KnapsackObject.vb ##############################
' ##############################################################################
Option Explicit On 
Option Strict On
Option Compare Binary

' <remarks>
'   Repräsentiert ein Objekt für ein Rucksackproblem.
' </remarks>
Public Class KnapsackObject
    Private m_dblCost As Double
    Private m_dblWeight As Double
    Private m_objId As Object

    ' <summary>
    '   Erstellt eine neue Instanz der Klasse und 
    '   weist den Eigenschaften die in den Parametern
    '   angebenen Werte zu.
    ' </summary>
    ' <param name="dblCost">Kosten des Objekts.</param>
    ' <param name="dblWeight">Gewicht des Objekts.</param>
    ' <param name="objId">ID des Objekts.</param>
    Public Sub New( _
      ByVal dblCost As Double, _
      ByVal dblWeight As Double, _
      ByVal objId As Object)
        Me.Cost = dblCost
        Me.Weight = dblWeight
        Me.Id = objId
    End Sub

    ' <summary>
    '   Gibt die Kosten des Objekts an oder gibt sie zurück.
    ' </summary>
    ' <value>Kosten des Objekts.</value>
    Public Property Cost() As Double
        Get
            Return m_dblCost
        End Get
        Set(ByVal Value As Double)
            m_dblCost = Value
        End Set
    End Property

    ' <summary>
    '   Gibt das Gewicht des Objekts an oder gibt es zurück.
    ' </summary>
    ' <value>Gewicht des Objekts.</value>
    Public Property Weight() As Double
        Get
            Return m_dblWeight
        End Get
        Set(ByVal Value As Double)
            m_dblWeight = Value
        End Set
    End Property

    ' <summary>
    '   Gibt ein Objekt an oder zurück, das das 
    '   Element eindeutig identifiziert.
    ' </summary>
    ' <value>ID des Objekts.</value>
    Public Property Id() As Object
        Get
            Return m_objId
        End Get
        Set(ByVal Value As Object)
            m_objId = Value
        End Set
    End Property

    ' <summary>
    '   Gibt einen String zurück, der die Objektinstanz repräsentiert.
    ' </summary>
    ' <returns>String, der die Objektinstanz repräsentiert.</returns>
    Public Overrides Function ToString() As String
        Return "ID = """ & Me.Id.ToString() & """, _Cost = " & _
          Me.Cost.ToString() & _
          ", Weight = " & Me.Weight.ToString()
    End Function
End Class
' ##############################################################################
' ############################ KnapsackSolution.vb #############################
' ##############################################################################
Option Explicit On 
Option Strict On
Option Compare Binary

Imports Microsoft.VisualBasic

' <remarks>
'   Repräsentiert eine Lösung eines Rucksackproblems.
' </remarks>
Public Class KnapsackSolution
    Private m_dblTotalCost As Double
    Private m_akobjSelectedObjects() As KnapsackObject

    ' <summary>
    '   Gibt die Gesamtkosten der Objekte der Lösung 
    '   an oder gibt sie zurück.
    ' </summary>
    ' <value>Gesamtkosten der Objekte der Lösung.</value>
    Public Property TotalCost() As Double
        Get
            Return m_dblTotalCost
        End Get
        Set(ByVal Value As Double)
            m_dblTotalCost = Value
        End Set
    End Property

    ' <summary>
    '   Gibt ein Array von <c>KnapsackObject</c>-Objekten 
    '   an oder zurück, die eine Lösung eines
    '   Rucksackproblems darstellen.
    ' </summary>
    ' <value>Array von <c>KnapsackObject</c>-Objekten, die 
    '  eine Lösung eines Rucksackproblems darstellen.</value>
    Public Property SelectedObjects() As KnapsackObject()
        Get
            Return m_akobjSelectedObjects
        End Get
        Set(ByVal Value() As KnapsackObject)
            m_akobjSelectedObjects = Value
        End Set
    End Property

    ' <summary>
    '   Gibt einen String zurück, der die Objektinstanz repräsentiert.
    ' </summary>
    ' <returns>String, der die Objektinstanz repräsentiert.</returns>
    Public Overloads Function ToString() As String
        Dim s As String = _
            "TotalCost = " & Me.TotalCost.ToString() & _
            ControlChars.NewLine & _
            "SelectedObjects = {"
        If Me.SelectedObjects.Length > 0 Then
            s &= _
                ControlChars.NewLine & _
                "    (" & Me.SelectedObjects(0).ToString() & ")"
        End If
        If Me.SelectedObjects.Length > 1 Then
            Dim i As Integer
            For i = 1 To Me.SelectedObjects.Length - 1
                s &= _
                    "," & ControlChars.NewLine & _
                    "    (" & Me.SelectedObjects(i).ToString() & ")"
            Next i
        End If
        Return _
            s & ControlChars.NewLine & _
            "}"
    End Function
End Class
' ##############################################################################
' ############################# KnapsackSolver.vb ##############################
' ##############################################################################
Option Explicit On 
Option Strict On
Option Compare Binary

Imports System
Imports System.Collections

' <remarks>
'   Ermittelt eine Lösung für ein 0/1-Rucksackproblem.
' </remarks>
Public Class KnapsackSolver
    Private m_akobjObjects() As KnapsackObject
    Private m_dblKnapsackSize As Double

    ' Beste bisher gefundene Lösung.
    Private m_ablnMaxVec() As Boolean

    ' Maximale bisher gefundene Kosten.
    Private m_dblMaxCost As Double

    ' <summary>
    '   Löst das durch die in der Eigenschaft 
    '  <c>KnapsackSize</c> angegebene Grösse und die in der
    '   Eigenschaft <c>Objects</c> angebenen 
    '   <c>KnapsackObject</c>-Objekte spezifizierte Rucksackproblem
    '   und gibt die Lösung zurück.
    ' </summary>
    ' <returns>Lösung in Form eines 
    '    <c>KnapsackSolution</c>-Objekts.</returns>
    ' <exeption name="Exception">
    '   Wird geworfen, wenn die Eigenschaft <c>Objects</c> 
    '   nicht initialisiert wurde.
    ' </exception>
    Public Function Solve() As KnapsackSolution
        If Me.Objects Is Nothing Then
            Throw New Exception( _
              "Die Eigenschaft Objects muss ein gültiges Array" & _
              " von KnapsackObject-Objekten enthalten.")
        Else
            m_dblMaxCost = 0
            m_ablnMaxVec = New Boolean(Me.Objects.Length - 1) {}
            Dim v() As Boolean = New Boolean(Me.Objects.Length - 1) {}

            ' Enumeration durchführen.
            Enumerate(-1, 0, 0, v)

            ' Da Arrays sehr unflexibel sind und wir auch 
            ' keine ArrayList verwenden wollten, müssen
            ' wir hier zuerst eine ArrayList der gewählten 
            ' Elemente erstellen und diese dann in ein
            ' Array kopieren.
            Dim ks As KnapsackSolution = New KnapsackSolution()
            ks.TotalCost = m_dblMaxCost
            Dim i As Integer
            Dim al As New ArrayList()
            For i = 0 To m_akobjObjects.Length - 1
                If m_ablnMaxVec(i) Then
                    al.Add(m_akobjObjects(i))
                End If
            Next i
            Dim akobj() As KnapsackObject = _
              New KnapsackObject(al.Count - 1) {}
            For i = 0 To al.Count - 1
                akobj(i) = CType(al(i), KnapsackObject)
            Next i
            ks.SelectedObjects = akobj
            Return ks
        End If
    End Function

    ' <summary>
    '   Enumeriert über alle gültigen Lösungen des 
    '   0/1-Ruchsackproblems. Danach findet sich
    '   die Lösung (gefüllter Entscheidungsvektor) in 
    '   den entsprechenden globalen Variablen.
    ' </summary>
    Private Sub Enumerate( _
      ByVal z As Integer, _
      ByVal vcost As Double, _
      ByVal vweight As Double, _
      ByRef v As Boolean())
        Dim i As Integer
        If vweight <= Me.KnapsackSize Then
            If vcost > m_dblMaxCost Then
                m_dblMaxCost = vcost
                For i = 0 To v.Length - 1
                    m_ablnMaxVec(i) = v(i)
                Next i
            End If
            For i = z + 1 To Me.Objects.Length - 1
                v(i) = True
                Enumerate(i, vcost + Me.Objects(i).Cost, _
                  vweight + Me.Objects(i).Weight, v)
                v(i) = False
            Next i
        End If
    End Sub

    ' <summary>
    '   Gibt ein Array von <c>KnapsackObject</c>-Objekten 
    '   an oder gibt es zurück, die als Eingabedaten
    '   für die Methode <c>Solve</c> verwendet werden sollen.
    ' </summary>
    ' <value>Objekte, die das Problem charakterisieren.</value>
    Public Property Objects() As KnapsackObject()
        Get
            Return m_akobjObjects
        End Get
        Set(ByVal Value() As KnapsackObject)
            m_akobjObjects = Value
        End Set
    End Property

    ' <summary>
    '   Gibt die Grösse des Rucksacks an oder gibt sie zurück.
    ' </summary>
    ' <value>Grösse des Rucksacks.</value>
    Public Property KnapsackSize() As Double
        Get
            Return m_dblKnapsackSize
        End Get
        Set(ByVal Value As Double)
            m_dblKnapsackSize = Value
        End Set
    End Property
End Class
' ##############################################################################
' ################################## Main.vb ###################################
' ##############################################################################
Option Explicit On 
Option Strict On
Option Compare Binary

Imports System

' <remarks>
'   Stellt den Einsprungspunkt der Anwendung bereit.
' </remarks>
Public Class Main

    ' <summary>
    '   Der Einsprungspunkt der Anwendung.
    ' </summary>
    Public Shared Sub Main()

        ' Knapsack-Solver mit Beispieldaten vorbereiten.
        Dim ks As New KnapsackSolver()
        ks.KnapsackSize = 14.2
        ks.Objects = New KnapsackObject() { _
            New KnapsackObject(12.1, 7.9, 1), _
            New KnapsackObject(1.2, 12.1, 2), _
            New KnapsackObject(7.9, 3.5, 3), _
            New KnapsackObject(3.5, 1.2, 4), _
            New KnapsackObject(9.6, 9.6, 5) _
        }

        ' Knapsack-Problem lösen.
        Console.WriteLine(ks.Solve().ToString())
    End Sub
End Class

Archivierte Nutzerkommentare 

Klicken Sie diesen Text an, wenn Sie die 3 archivierten Kommentare ansehen möchten.
Diese stammen noch von der Zeit, als es noch keine direkte Forenunterstützung für Fragen und Kommentare zu einzelnen Artikeln gab.
Aus Gründen der Vollständigkeit können Sie sich die ausgeblendeten Kommentare zu diesem Artikel aber gerne weiterhin ansehen.

#light 

Let rec Knapsack valueSum costSum costThreshold values costs data n max =
    If n <= max Then        
    
        Let CostSum   = If n = 0 Then costSum  Else costSum  + (float (List.hd data)) * (costs  n)
        Let ValueSum  = If n = 0 Then valueSum Else valueSum + (float (List.hd data)) * (values n)
      
        If CostSum > costThreshold Then
           (costSum, valueSum, List.tl data)
        Else
            Let (cost1, value1, data1) = Knapsack ValueSum CostSum costThreshold values costs (0 :: data) (n + 1) max
            Let (cost2, value2, data2) = Knapsack ValueSum CostSum costThreshold values costs (1 :: data) (n + 1) max
            
            If value1 > value2 Then (cost1, value1, data1) Else (cost2, value2, data2)
    Else
        (costSum, valueSum, List.tl data)

Let SolveKnapsack numItems costThreshold valueFunc costFunc =
    Knapsack 0.0 0.0 costThreshold valueFunc costFunc [] 0 numItems

Type 'a Item = { ID : 'a ; Cost : float; Value : float }

Let Items =
    [| { Value = 12.1; Cost =  7.9; ID = 1};
       { Value =  1.2; Cost = 12.1; ID = 2};
       { Value =  7.9; Cost =  3.5; ID = 3}; 
       { Value =  3.5; Cost =  1.2; ID = 4}; 
       { Value =  9.6; Cost =  9.6; ID = 5} |]

Let valueFunc idx = Items.[idx - 1].Value
Let costFunc  idx = Items.[idx - 1].Cost

Let costThreshold = 14.2

Let (cost, value, data) = SolveKnapsack Items.Length costThreshold valueFunc costFunc

Let selectedItems = (List.zip (List.rev data) [1..data.Length]) |> List.choose (fun (n, idx) -> If n <> 0 Then Some(Items.[idx - 1]) Else None)

printfn "Kosten: %f\nWert: %f\n" cost value

For It in selectedItems Do
    printfn "> ID: %A" It.ID

System.Console.ReadKey() |> ignore