dongtaiguihua.txt

动态规划算法的一个实例

Option Explicit
  Dim c%, n%, i%
  Dim v(), w(), m(), x()
'0-1背包问题的动态规划算法
Public Sub Knapsack(v(), w(), c%, n%, m())
  ReDim m(n, c)
  Dim j%, jMax%
  jMax = Min(w(n) - 1, c)
  For j = 0 To jMax Step 1
    m(n, j) = 0
  Next
  For j = w(n) To c Step 1
    m(n, j) = v(n)
  Next
  For i = n - 1 To 2 Step -1
    jMax = Min(w(i) - 1, c)
    For j = 0 To jMax Step 1
      m(i, j) = m(i + 1, j)
    Next
    For j = w(i) To c Step 1
      m(i, j) = Max(m(i + 1, j), m(i + 1, j - w(i)) + v(i))
    Next
  Next
  m(1, c) = m(2, c)
  If c >= w(1) Then m(1, c) = Max(m(1, c), m(2, c - w(1)) + v(1))
End Sub
'求最小值的函数
Public Function Min(x, y)
  If x > y Then Min = y Else Min = x
End Function
'求最大值的函数
Public Function Max(x, y)
  If x > y Then Max = x Else Max = y
End Function
'构造最优解
Public Sub Traceback(m(), w(), c%, n%, x())
  Dim i%
  For i = 1 To n - 1 Step 1
    If m(i, c) = m(i + 1, c) Then x(i) = 0 Else x(i) = 1: c = c - w(i)
  Next
  If m(n, c) = 0 Then x(n) = 0 Else x(n) = 1
End Sub
'输入物品种数n和背包容量c
Private Sub Command1_Click()
  n = Val(InputBox("请输入物品种数N", "0-1背包算法"))
  c = Val(InputBox("请输入背包容量C", "0-1背包算法"))
  ReDim v(n), w(n), m(n, c), x(n)
  For i = 1 To n
    w(i) = Val(InputBox("请输入第i种物品的重量w(i)，每次只输入一个正整数", "0-1背包算法"))
  Next
  For i = 1 To n
    v(i) = Val(InputBox("请输入第i种物品的价值v(i)", "0-1背包算法"))
  Next
End Sub
'输出最佳方案
Private Sub Command2_Click()
  Dim strings$, Sum
  Call Knapsack(v, w, c, n, m)
  Call Traceback(m, w, c, n, x)
  CurrentX = 1000
  CurrentY = 600
  Print "物品编号："
  CurrentX = 1000
  CurrentY = 950
  Print "物品重量："
  CurrentX = 1000
  CurrentY = 1300
  Print "物品价值："
  CurrentX = 1000
  CurrentY = 1650
  Print "打包方案："
  CurrentX = 1000
  CurrentY = 2000
  Print "总 价 值："
  '输出物品编号
  CurrentX = 2500
  CurrentY = 600
  strings = " "
  For i = 1 To n
    strings = strings + Str$(i) + " "
  Next
  Print strings
  '输出物品重量
  CurrentX = 2500
  CurrentY = 950
  strings = " "
  For i = 1 To n
    strings = strings + Str$(w(i)) + " "
  Next
  Print strings
  '输出物品价值
  CurrentX = 2500
  CurrentY = 1300
  strings = " "
  For i = 1 To n
    strings = strings + Str$(v(i)) + " "
  Next
  Print strings
  '输出打包方案
  CurrentX = 2500
  CurrentY = 1650
  strings = " "
  For i = 1 To n
    strings = strings + Str$(x(i)) + " "
  Next
  Print strings
  '输出总价值
  CurrentX = 2650
  CurrentY = 2000
  Sum = 0
  For i = 1 To n
    Sum = v(i) * x(i) + Sum
  Next
  Print Str$(Sum)
End Sub
'退出程序
Private Sub Command3_Click()
  End
End Sub
'调用下一个实验
Private Sub Command4_Click()
  Form2.Hide
  Form3.Show
End Sub

Private Sub Form_Load()

End Sub

'动态显示0-1算法
Private Sub Timer1_Timer()
  Static order As Integer
  order = order + 1
  If order = 1 Then Text1.ForeColor = &HFF00FF: Text2.ForeColor = &HFF0000: Text3.ForeColor = &HFF0000: Text4.ForeColor = &HFF0000
  If order = 2 Then Text1.ForeColor = &HFF0000: Text2.ForeColor = &HFF00FF: Text3.ForeColor = &HFF0000: Text4.ForeColor = &HFF0000
  If order = 3 Then Text1.ForeColor = &HFF0000: Text2.ForeColor = &HFF0000: Text3.ForeColor = &HFF00FF: Text4.ForeColor = &HFF0000
  If order = 4 Then Text1.ForeColor = &HFF0000: Text2.ForeColor = &HFF0000: Text3.ForeColor = &HFF0000: order = 0: Text4.ForeColor = &HFF00FF
End Sub