数学建模社区-数学中国

标题: 租赁问题穷举法源程序 [打印本页]

作者: whenzl 时间: 2005-9-17 23:17
标题: 租赁问题穷举法源程序

上面是附件,用表2做的

然后是VB做的程序

Dim Per(1000, 8) As Byte '每人的前8个需求
Dim sP(1000, 3) As Byte '每人选择的3个
Dim shun(56, 3) As Byte
Dim M(100) As Integer '每类光盘剩余量
Dim oM(100) As Integer '光盘需要量
Dim p As Long
Dim du, Realdu As Long
Dim Sav(1000, 3) As Byte

Public Sub ReadFile()
Dim ts As Long
Dim Tmp As String
ts = FreeFile(0)
Open App.Path + "\output.txt" For Input As ts
p = 1
While Not EOF(ts)
Line Input #ts, Tmp
For i = 1 To 7
Per(p, i) = Val(Mid(Tmp, 1, InStr(Tmp, Chr(9))))
Tmp = Mid(Tmp, InStr(Tmp, Chr(9)) + 1)
Next
If InStr(Tmp, Chr(9)) Then
Tmp = Mid(Tmp, 1, InStr(Tmp, Chr(9)))
End If
Per(p, 8) = Val(Tmp)
p = p + 1
Wend
Close ts
Open App.Path + "\m.txt" For Input As ts
Line Input #ts, Tmp
For i = 1 To 99
M(i) = Val(Mid(Tmp, 1, InStr(Tmp, Chr(9))))
Tmp = Mid(Tmp, InStr(Tmp, Chr(9)) + 1)
Next
M(100) = Val(Tmp)
End Sub

Public Sub Init()
shun(1, 1) = 1
shun(1, 2) = 2
shun(1, 3) = 3
shun(2, 1) = 1
shun(2, 2) = 2
shun(2, 3) = 4
shun(3, 1) = 1
shun(3, 2) = 2
shun(3, 3) = 5
shun(4, 1) = 1
shun(4, 2) = 2
shun(4, 3) = 6
shun(5, 1) = 1
shun(5, 2) = 2
shun(5, 3) = 7
shun(6, 1) = 1
shun(6, 2) = 2
shun(6, 3) = 8
shun(7, 1) = 1
shun(7, 2) = 3
shun(7, 3) = 4
shun(8, 1) = 1
shun(8, 2) = 3
shun(8, 3) = 5
shun(9, 1) = 1
shun(9, 2) = 3
shun(9, 3) = 6
shun(10, 1) = 1
shun(10, 2) = 3
shun(10, 3) = 7
shun(11, 1) = 1
shun(11, 2) = 3
shun(11, 3) = 8
shun(12, 1) = 1
shun(12, 2) = 4
shun(12, 3) = 5
shun(13, 1) = 1
shun(13, 2) = 4
shun(13, 3) = 6
shun(14, 1) = 1
shun(14, 2) = 4
shun(14, 3) = 7
shun(15, 1) = 1
shun(15, 2) = 4
shun(15, 3) = 8
shun(16, 1) = 1
shun(16, 2) = 5
shun(16, 3) = 6
shun(17, 1) = 1
shun(17, 2) = 5
shun(17, 3) = 7
shun(18, 1) = 1
shun(18, 2) = 5
shun(18, 3) = 8
shun(19, 1) = 1
shun(19, 2) = 6
shun(19, 3) = 7
shun(20, 1) = 1
shun(20, 2) = 6
shun(20, 3) = 8
shun(21, 1) = 1
shun(21, 2) = 7
shun(21, 3) = 8
shun(22, 1) = 2
shun(22, 2) = 3
shun(22, 3) = 4
shun(23, 1) = 2
shun(23, 2) = 3
shun(23, 3) = 5
shun(24, 1) = 2
shun(24, 2) = 3
shun(24, 3) = 6
shun(25, 1) = 2
shun(25, 2) = 3
shun(25, 3) = 7
shun(26, 1) = 2
shun(26, 2) = 3
shun(26, 3) = 8
shun(27, 1) = 2
shun(27, 2) = 4
shun(27, 3) = 5
shun(28, 1) = 2
shun(28, 2) = 4
shun(28, 3) = 6
shun(29, 1) = 2
shun(29, 2) = 4
shun(29, 3) = 7
shun(30, 1) = 2
shun(30, 2) = 4
shun(30, 3) = 8
shun(31, 1) = 2
shun(31, 2) = 5
shun(31, 3) = 6
shun(32, 1) = 2
shun(32, 2) = 5
shun(32, 3) = 7
shun(33, 1) = 2
shun(33, 2) = 5
shun(33, 3) = 8
shun(34, 1) = 2
shun(34, 2) = 6
shun(34, 3) = 7
shun(35, 1) = 2
shun(35, 2) = 6
shun(35, 3) = 8
shun(36, 1) = 2
shun(36, 2) = 7
shun(36, 3) = 8
shun(37, 1) = 3
shun(37, 2) = 4
shun(37, 3) = 5
shun(38, 1) = 3
shun(38, 2) = 4
shun(38, 3) = 6
shun(39, 1) = 3
shun(39, 2) = 4
shun(39, 3) = 7
shun(40, 1) = 3
shun(40, 2) = 4
shun(40, 3) = 8
shun(41, 1) = 3
shun(41, 2) = 5
shun(41, 3) = 6
shun(42, 1) = 3
shun(42, 2) = 5
shun(42, 3) = 7
shun(43, 1) = 3
shun(43, 2) = 5
shun(43, 3) = 8
shun(44, 1) = 3
shun(44, 2) = 6
shun(44, 3) = 7
shun(45, 1) = 3
shun(45, 2) = 6
shun(45, 3) = 8
shun(46, 1) = 3
shun(46, 2) = 7
shun(46, 3) = 8
shun(47, 1) = 4
shun(47, 2) = 5
shun(47, 3) = 6
shun(48, 1) = 4
shun(48, 2) = 5
shun(48, 3) = 7
shun(49, 1) = 4
shun(49, 2) = 5
shun(49, 3) = 8
shun(50, 1) = 4
shun(50, 2) = 6
shun(50, 3) = 7
shun(51, 1) = 4
shun(51, 2) = 6
shun(51, 3) = 8
shun(52, 1) = 4
shun(52, 2) = 7
shun(52, 3) = 8
shun(53, 1) = 5
shun(53, 2) = 6
shun(53, 3) = 7
shun(54, 1) = 5
shun(54, 2) = 6
shun(54, 3) = 8
shun(55, 1) = 5
shun(55, 2) = 7
shun(55, 3) = 8
shun(56, 1) = 6
shun(56, 2) = 7
shun(56, 3) = 8

Realdu = -999999
End Sub

Public Sub First(p As Long) '设置为第一个
sP(p, 1) = 1
sP(p, 2) = 2
sP(p, 3) = 3
End Sub

Public Function Last(p As Long) As Boolean '设置为第二个
If sP(p, 1) = 6 And sP(p, 2) = 7 And sP(p, 3) = 8 Then
Last = True
Else
Last = False
End If
End Function

Public Sub nxt(p As Long) '指向下一个
For i = 1 To 56
If sP(p, 1) = shun(i, 1) And sP(p, 2) = shun(i, 2) And sP(p, 3) = shun(i, 3) Then
sP(p, 1) = shun((i Mod 56) + 1, 1)
sP(p, 2) = shun((i Mod 56) + 1, 1)
sP(p, 3) = shun((i Mod 56) + 1, 1)
Exit Sub
End If
Next
End Sub

Public Sub JiSuan() '计算满意度
For i = 1 To 100
oM(i) = 0
Next
For i = 1 To 1000
oM(Per(i, sP(i, 1))) = oM(Per(i, sP(i, 1))) + 1
oM(Per(i, sP(i, 2))) = oM(Per(i, sP(i, 2))) + 1
oM(Per(i, sP(i, 3))) = oM(Per(i, sP(i, 3))) + 1
Next
For i = 1 To 100
If M(i) < oM(i) Then
Exit Sub
End If
Next
du = 0
For i = 1 To 1000
du = du - sP(i, 1) - sP(i, 2) - sP(i, 3)
Next
If du > Realdu Then
Save
For i = 1 To 1000
Tmp = Tmp + Sav(i, 1) + " " + Sav(i, 2) + " " + Sav(i, 3) + vbCrLf
Next
tOutput = Tmp
DoEvents
End If
End Sub

Public Sub Save() '保存
For i = 1 To 1000
Sav(i, 1) = Per(i, sP(i, 1))
Sav(i, 2) = Per(i, sP(i, 2))
Sav(i, 3) = Per(i, sP(i, 3))
Next
End Sub

Private Sub cStart_Click()
Dim Jin As Long
Jin = 0
Init
ReadFile
For i = 1 To 1000
sP(i, 1) = 1
sP(i, 2) = 2
sP(i, 3) = 3
Next

Do
Jin = Jin + 1
lTip = Trim(Jin)
DoEvents
p = 1000
JiSuan
nxt (p)
While Last(p) Or p = 0
First (p)
p = p - 1
nxt (p)
Wend
Loop While p <> 0

Tmp = ""
For i = 1 To 1000
Tmp = Tmp + Sav(i, 1) + " " + Sav(i, 2) + " " + Sav(i, 3) + vbCrLf
Next
tOutput = Tmp
End Sub

租赁问题穷举法源程序.txt

28.71 KB, 下载次数: 4, 下载积分: 体力 -2 点

租赁问题穷举法源程序

作者: whenzl 时间: 2005-9-17 23:18
不过实现可能性不大，只能做为一个失败假设了

作者: snowland 时间: 2005-9-18 01:52
没把握发上来，还要钱啊？？

作者: 翘翘鞋 时间: 2005-9-18 03:40

发给我我看看呀

作者: feelwindy 时间: 2005-9-18 08:52

气死我了

[em06]

作者: feelwindy 时间: 2005-9-18 08:54

大家不要看

没什么意思

我还被他骗了一个金币

作者: tony1979 时间: 2005-9-19 19:08
谢谢啊

作者: pzwjn 时间: 2005-9-19 19:12

怎么没见A题有讨论的呢？

作者: vancy 时间: 2005-9-20 11:24
还差一毛钱行不行啊。

作者: dapengcai 时间: 2005-9-23 18:01
标题: 回复：（whenzl）租赁问题穷举法源程序
1111111111111111111111111111111111111111111

作者: mnpfc 时间: 2009-8-15 07:02
看过，还可以

作者: lushq 时间: 2010-7-25 12:30
这是写得社么啊

欢迎光临数学建模社区-数学中国 (http://www.madio.net/)