11 Replies - 1847 Views - Last Post: 11 January 2013 - 09:50 AM Rate Topic: -----

#1 donatelo  Icon User is offline

  • New D.I.C Head

Reputation: 0
  • View blog
  • Posts: 4
  • Joined: 29-December 12

VB 6.0 Knapsack

Posted 29 December 2012 - 02:31 AM

Option Explicit On
Public Class Form1

Type TreasureType
    Dim Name As String
    Dim Value As Double
    Dim Ratio As Double
    Dim Volume As Double
End Type

Type SolutionType
    Dim Desc As String
    Dim Value As Double
End Type

Type KnapsackType
    Dim Contents() As Double
    Dim CapacityWeight As Double
    Dim CapacityVolume As Double
End Type

    Dim Treasures() As TreasureType

    Public Sub Main()

        SetupTreasureShangriLa()
        'call knapsack
        'Debug.Print(CalcKnapsack(25, 0.25))

    End Sub

    Public Sub SetupTreasureShangriLa()
        'add data in array
    ReDim Treasures(11) As TreasureType
        With Treasures(1)
            .Name = "Bed"
            .Value = 1200
            .Ratio = 2.67
            .Volume = 450
        End With
        With Treasures(2)
            .Name = "Dining Room Set"
            .Value = 1800
            .Ratio = 2.81
            .Volume = 640
        End With
        With Treasures(3)
            .Name = "Sofa Set"
            .Value = 5000
            .Ratio = 5.1
            .Volume = 980
        End With
        With Treasures(4)
            .Name = "TV set"
            .Value = 1900
            .Ratio = 9.5
            .Volume = 200
        End With
        With Treasures(5)
            .Name = "Hi Fi set"
            .Value = 2600
            .Ratio = 9.63
            .Volume = 270
        End With
        With Treasures(6)
            .Name = "Sofa bed"
            .Value = 1300
            .Ratio = 3.71
            .Volume = 350
        End With
        With Treasures(7)
            .Name = "Recliner"
            .Value = 900
            .Ratio = 3.0
            .Volume = 300
        End With
        With Treasures(8)
            .Name = "Refrigerator"
            .Value = 1300
            .Ratio = 2.89
            .Volume = 450
        End With
        With Treasures(9)
            .Name = "Washer & drier"
            .Value = 1600
            .Ratio = 2.0
            .Volume = 800
        End With
        With Treasures(10)
            .Name = "Wall Cabinet"
            .Value = 1800
            .Ratio = 3.0
            .Volume = 600
        End With
        With Treasures(11)
            .Name = "Chest"
            .Value = 1400
            .Ratio = 2.8
            .Volume = 500
        End With
    End Sub

    Public Function CalcKnapsack(ByVal sCapacityRatio As Double, ByVal sCapacityVolume As Double) As String
        Dim Knapsack As KnapsackType
        Dim Solution As SolutionType

        Knapsack.CapacityVolume = sCapacityVolume
        Knapsack.CapacityRatio = sCapacityRatio
    ReDim Knapsack.Contents(UBound(Treasures)) As Integer
        Call Stuff(Knapsack, Solution, 1)
        Debug.Print("Maximum value: " & Solution.Value)
        Debug.Print("Ideal Packing(s): " & vbCrLf & Solution.Desc)

    End Function

    [i]Private Sub Stuff(ByRef Knapsack As KnapsackType, ByRef Solution As SolutionType, ByVal nDepth As Integer)[/i]
        Dim nI As Integer
        Dim curVal As Double
        Dim sWeightRemaining As Single
        Dim sVolumeRemaining As Single
        Dim nJ As Integer

        sWeightRemaining = CalcRatioRemaining(Knapsack)
        sVolumeRemaining = CalcvolumeRemaining(Knapsack)
        ' insert algorithm knapsack
        ' call calculate ratio
        With Treasures(nDepth)
            If nDepth = UBound(Treasures) Then
                Knapsack.Contents(nDepth) = Min(Fix(sWeightRemaining / .weight), Fix(sVolumeRemaining / .Volume))
                curVal = CalcValue(Knapsack)
                If curVal > Solution.Value Then
                    Solution.Value = curVal
                    Solution.Desc = BuildDesc(Knapsack)
                ElseIf curVal = Solution.Value Then
                    Solution.Desc = Solution.Desc & vbCrLf & "or" & vbCrLf & vbCrLf & BuildDesc(Knapsack)
                End If
            Else
                For nI = 0 To Min(Fix(sWeightRemaining / .weight), Fix(sVolumeRemaining / .Volume))
                    Knapsack.Contents(nDepth) = nI
                    For nJ = nDepth + 1 To UBound(Treasures)
                        Knapsack.Contents(nJ) = 0
                    Next nJ
                    Call Stuff(Knapsack, Solution, nDepth + 1)
                Next nI
            End If
        End With

    End Sub

    Private Function CalcValue(ByRef Knapsack As KnapsackType) As Double
        Dim curTmp As Double
        Dim nI As Integer

        For nI = 1 To UBound(Treasures)
            curTmp = curTmp + (Treasures(nI).Value * Knapsack.Contents(nI))
        Next nI

        CalcValue = curTmp

    End Function

    Private Function Min(ByVal vA As Object, ByVal vB As Object) As Object

        If vA < vB Then
            Min = vA
        Else
            Min = vB
        End If

    End Function

    Private Function CalcRatioRemaining(ByRef Knapsack As KnapsackType) As Single
        Dim sTmp As Single
        Dim nI As Integer

        For nI = 1 To UBound(Treasures)
            sTmp = sTmp + (Treasures(nI).weight * Knapsack.Contents(nI))
        Next nI

        CalcRatioRemaining = Knapsack.CapacityWeight - sTmp

    End Function

    Private Function CalcvolumeRemaining(ByRef Knapsack As KnapsackType) As Single
        Dim sTmp As Single
        Dim nI As Integer

        For nI = 1 To UBound(Treasures)
            sTmp = sTmp + (Treasures(nI).Volume * Knapsack.Contents(nI))
        Next nI

        CalcvolumeRemaining = Knapsack.CapacityVolume - sTmp

    End Function

    Private Function BuildDesc(ByRef Knapsack As KnapsackType) As String
        Dim cTmp As String
        Dim nI As Integer

        For nI = 1 To UBound(Treasures)
            cTmp = cTmp & Knapsack.Contents(nI) & " " & Treasures(nI).Units & " of " & Treasures(nI).Name & vbCrLf
        Next nI
        BuildDesc = cTmp

    End Function
End Class



when i compile there is user define type not define, your help kindly assist,

Is This A Good Question/Topic? 0
  • +

Replies To: VB 6.0 Knapsack

#2 maj3091  Icon User is offline

  • D.I.C Lover
  • member icon

Reputation: 303
  • View blog
  • Posts: 1,796
  • Joined: 26-March 09

Re: VB 6.0 Knapsack

Posted 29 December 2012 - 02:41 AM

Any particular line that highlighted with the compile error?
Was This Post Helpful? 0
  • +
  • -

#3 donatelo  Icon User is offline

  • New D.I.C Head

Reputation: 0
  • View blog
  • Posts: 4
  • Joined: 29-December 12

Re: VB 6.0 Knapsack

Posted 29 December 2012 - 02:56 AM

line 116,

Private Sub Stuff(ByRef Knapsack As KnapsackType, ByRef Solution As SolutionType, ByVal nDepth As Integer)

Was This Post Helpful? 0
  • +
  • -

#4 maj3091  Icon User is offline

  • D.I.C Lover
  • member icon

Reputation: 303
  • View blog
  • Posts: 1,796
  • Joined: 26-March 09

Re: VB 6.0 Knapsack

Posted 29 December 2012 - 05:19 AM

I've just had a quick look at the code and I'm guessing that this is .Net based on the Option Explicit On statement, which would just be Option Explicit in VB6.

I did notice that you're referencing type variables that don't exist, for example you reference Knapsack.CapacityRatio which isn't part of your Type definition.

I'm not all that familiar with the .Net IDE, but did you do a full compile on this code, or did you just try to run it?
Was This Post Helpful? 0
  • +
  • -

#5 donatelo  Icon User is offline

  • New D.I.C Head

Reputation: 0
  • View blog
  • Posts: 4
  • Joined: 29-December 12

Re: VB 6.0 Knapsack

Posted 29 December 2012 - 06:05 AM

i just want to try run it, i take this from rosetta.

i try to assist my girl to do her assignment, i try to understand but fail, i really need do homework back, 3 years ago i learn a little vb.net, not vb 6.0
Was This Post Helpful? 0
  • +
  • -

#6 andrewsw  Icon User is online

  • It's just been revoked!
  • member icon

Reputation: 3734
  • View blog
  • Posts: 13,056
  • Joined: 12-December 12

Re: VB 6.0 Knapsack

Posted 29 December 2012 - 07:07 AM

Option Explicit On is for VB6, although On can be omitted as it is the default.

I'm guessing this code should not be in a Form, but in a Standard Module. Delete the lines

Public Class Form1
'and, at the end,
End Class


and move the code into a standard module.
Was This Post Helpful? 0
  • +
  • -

#7 maj3091  Icon User is offline

  • D.I.C Lover
  • member icon

Reputation: 303
  • View blog
  • Posts: 1,796
  • Joined: 26-March 09

Re: VB 6.0 Knapsack

Posted 29 December 2012 - 07:48 AM

View Postandrewsw, on 29 December 2012 - 02:07 PM, said:

Option Explicit On is for VB6, although On can be omitted as it is the default.

I'm guessing this code should not be in a Form, but in a Standard Module. Delete the lines

Public Class Form1
'and, at the end,
End Class


and move the code into a standard module.


Hmmm...my VB6 compiler balks at the ON, my understanding was it was off if you don't add the line, or on if you did. I have it on as default in my preferences, so can't say I've ever tried anything different.

The reason I asked if it had been fully compiled or whether indeed it was .Net is that declaring types with DIM in the them doesn't work in VB6, it causes a compile errors.
Was This Post Helpful? 0
  • +
  • -

#8 andrewsw  Icon User is online

  • It's just been revoked!
  • member icon

Reputation: 3734
  • View blog
  • Posts: 13,056
  • Joined: 12-December 12

Re: VB 6.0 Knapsack

Posted 29 December 2012 - 08:12 AM

The original example seems to be this and, as maj3091 explained, DIMs are not valid in Types (makes sense!). [Seems to be a problem copying and pasting :)/>/>/> ]

I read this On business from this page which references Visual Studio 2005. I assumed that this was for VB6? The Microsoft documentation is very poor at identifying VB6 (as am I, it appears :)/>/>/> .) My apologies for the mis-statement.

Unfortunately, I no longer have VB6 available, so I'm reliant on memory, comparison with VBA, and Googling.

Edited: Visual Studio 6.0 was for VB6.

This post has been edited by andrewsw: 29 December 2012 - 11:01 AM

Was This Post Helpful? 0
  • +
  • -

#9 maj3091  Icon User is offline

  • D.I.C Lover
  • member icon

Reputation: 303
  • View blog
  • Posts: 1,796
  • Joined: 26-March 09

Re: VB 6.0 Knapsack

Posted 29 December 2012 - 11:21 AM

No need to apologise mate, it's one of those things that's set in my environment and I've never changed it since day dot, so went away to check it on my VM. :)

I think it might be useful for the OP to run this using Full Compile and get it run that way first. Once I commented out a lot of the invalid references to type elements that didn't exist, it doesn't give an error on the line referred to by the OP.
Was This Post Helpful? 0
  • +
  • -

#10 donatelo  Icon User is offline

  • New D.I.C Head

Reputation: 0
  • View blog
  • Posts: 4
  • Joined: 29-December 12

Re: VB 6.0 Knapsack

Posted 29 December 2012 - 12:42 PM

may i know what is proper code, im really newbie in VB6,
Was This Post Helpful? 0
  • +
  • -

#11 modi123_1  Icon User is offline

  • Suitor #2
  • member icon



Reputation: 9493
  • View blog
  • Posts: 35,827
  • Joined: 12-June 08

Re: VB 6.0 Knapsack

Posted 29 December 2012 - 12:45 PM

Read the rules - we don't do people's homework.
Was This Post Helpful? 0
  • +
  • -

#12 BobRodes  Icon User is offline

  • Your Friendly Local Curmudgeon
  • member icon

Reputation: 574
  • View blog
  • Posts: 2,989
  • Joined: 19-May 09

Re: VB 6.0 Knapsack

Posted 11 January 2013 - 09:50 AM

Here is the VB6 reference. Also, I've posted a link to the reference in the pinned topics at the top of the forum page.

This post has been edited by BobRodes: 11 January 2013 - 09:54 AM

Was This Post Helpful? 0
  • +
  • -

Page 1 of 1