开通博客赚积分
发布资源赚积分
分类

源码开发语言/平台
当前位置：首页 > 源码/资料 > 数值算法/人工智能 > 查看源码
frmPak.frm
资源名称：lx.rar　[点击查看]
上传用户：sdxhx123
上传日期：2022-08-06
资源大小：3453k
文件大小：5k
源码类别：

数值算法/人工智能

开发平台：

Visual Basic

frmPak.frm：源码内容
  1. VERSION 5.00
  2. Begin VB.Form frmPak 
  3.    Caption         =   "回溯法求解背包问题"
  4.    ClientHeight    =   8220
  5.    ClientLeft      =   60
  6.    ClientTop       =   465
  7.    ClientWidth     =   10005
  8.    Icon            =   "frmPak.frx":0000
  9.    LinkTopic       =   "Form1"
  10.    Picture         =   "frmPak.frx":030A
  11.    ScaleHeight     =   8220
  12.    ScaleWidth      =   10005
  13.    StartUpPosition =   3  '窗口缺省
  14.    Begin VB.TextBox Text1 
  15.       BackColor       =   &H00C0FFFF&
  16.       BeginProperty Font 
  17.          Name            =   "隶书"
  18.          Size            =   15
  19.          Charset         =   134
  20.          Weight          =   400
  21.          Underline       =   0   'False
  22.          Italic          =   0   'False
  23.          Strikethrough   =   0   'False
  24.       EndProperty
  25.       Height          =   4335
  26.       Left            =   600
  27.       MultiLine       =   -1  'True
  28.       TabIndex        =   2
  29.       Top             =   960
  30.       Width           =   4335
  31.    End
  32.    Begin VB.CommandButton Command2 
  33.       Caption         =   "退出"
  34.       BeginProperty Font 
  35.          Name            =   "隶书"
  36.          Size            =   15
  37.          Charset         =   134
  38.          Weight          =   700
  39.          Underline       =   0   'False
  40.          Italic          =   0   'False
  41.          Strikethrough   =   0   'False
  42.       EndProperty
  43.       Height          =   495
  44.       Left            =   6480
  45.       TabIndex        =   1
  46.       Top             =   6600
  47.       Width           =   1815
  48.    End
  49.    Begin VB.CommandButton Command1 
  50.       Caption         =   "录入数据"
  51.       BeginProperty Font 
  52.          Name            =   "隶书"
  53.          Size            =   15
  54.          Charset         =   134
  55.          Weight          =   700
  56.          Underline       =   0   'False
  57.          Italic          =   0   'False
  58.          Strikethrough   =   0   'False
  59.       EndProperty
  60.       Height          =   495
  61.       Left            =   1680
  62.       TabIndex        =   0
  63.       Top             =   6600
  64.       Width           =   1815
  65.    End
  66.    Begin VB.Line Line1 
  67.       X1              =   5520
  68.       X2              =   5520
  69.       Y1              =   600
  70.       Y2              =   5760
  71.    End
  72.    Begin VB.Label Label1 
  73.       BackColor       =   &H00C0FFFF&
  74.       BackStyle       =   0  'Transparent
  75.       Caption         =   $"frmPak.frx":D8EA
  76.       BeginProperty Font 
  77.          Name            =   "楷体_GB2312"
  78.          Size            =   14.25
  79.          Charset         =   134
  80.          Weight          =   400
  81.          Underline       =   0   'False
  82.          Italic          =   0   'False
  83.          Strikethrough   =   0   'False
  84.       EndProperty
  85.       ForeColor       =   &H00C0FFFF&
  86.       Height          =   3495
  87.       Left            =   6000
  88.       TabIndex        =   3
  89.       Top             =   1080
  90.       Width           =   3495
  91.    End
  92. End
  93. Attribute VB_Name = "frmPak"
  94. Attribute VB_GlobalNameSpace = False
  95. Attribute VB_Creatable = False
  96. Attribute VB_PredeclaredId = True
  97. Attribute VB_Exposed = False
  98. Private Sub Command1_Click()
  99. Dim i, j, k, Num As Integer
  100. Dim MaxWeight, WR As Integer '定义变量MaxWeight为最大装载量,W为剩余容量
  101. Dim W(), P() As Integer '定义每箱的重量和价值
  102. Dim F() As Integer '最优值函数
  103. Dim X() As Integer '表示那些物品被放入。放入的是1，否则为零
  105. Num = Val(InputBox("请输入物品数量：")) '输入箱数和MaxWeight
  106. Text1 = "物品个数为" & Num & "；" & vbCrLf
  107. MaxWeight = Val(InputBox("背包容量为："))
  108. Text1 = Text1 & "背包的容量为" & MaxWeight & "；" & vbCrLf
  109. ReDim W(1 To Num) '重新定义动态数组大小
  110. ReDim P(1 To Num)
  111. ReDim F(0 To Num, 0 To MaxWeight)
  112. ReDim X(1 To Num)
  114. '输入每个物品的重量和价值
  115. For j = 1 To Num
  116.   W(j) = Val(InputBox("第" & j & "个物品的重量为："))
  117.   P(j) = Val(InputBox("第" & j & "个物品的价值为："))
  118.   Text1 = Text1 & "第" & j & "个物品的重量为" & W(j) & "，价值为" & P(j) & "；" & vbCrLf
  119. Next j
  121. For i = 1 To Num
  122.     F(i, 0) = 0  '清零
  123.     For WR = 1 To MaxWeight
  124.        If W(i) <= WR Then
  125.            If P(i) + F(i - 1, WR - W(i)) > F((i - 1), WR) Then
  126.                F(i, WR) = P(i) + F(i - 1, WR - W(i))
  127.            Else
  128.                F(i, WR) = F(i - 1, WR)
  129.            End If
  130.        Else
  131.          F(i, WR) = F(i - 1, WR)
  132.        End If
  133.     Next WR
  134. Next i
  135. Text1 = Text1 & "最大价值为" & F(Num, MaxWeight) & "；" & vbCrLf
  137. '从后往上找最优解
  138. For m = Num To 2 Step -1
  139.   If F(m, MaxWeight) = F(m - 1, MaxWeight) Then
  140.     X(m) = 0
  141.   Else
  142.     X(m) = 1
  143.     MaxWeight = MaxWeight - W(m)
  144.   End If
  145. Next m
  146.    
  147. '对X(1)单独讨论
  148. If F(1, MaxWeight) = 0 Then
  149.    X(1) = 0
  150. Else
  151.    X(1) = 1
  152. End If
  154. '输出物品序号
  155. For i = 1 To Num
  156.     temp = temp + X(i)
  157. Next i
  158. If temp = 0 Then
  159.     Text1 = Text1 & "没有物品可以放入背包。"
  160. Else
  161.     For i = 1 To Num
  162.         If X(i) <> 0 Then Text1 = Text1 & i & " "
  163.     Next i
  164.     Text1 = Text1 & "号物品被放入背包。"
  165. End If
  166. End Sub
  168. '退出程序
  169. Private Sub Command2_Click()
  170.     Unload Me
  171. End Sub