租赁问题穷举法源程序

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

tony1979 发表于 2005-9-19 19:08

谢谢啊

pzwjn 发表于 2005-9-19 19:12

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

whenzl 发表于 2005-9-17 23:18

不过实现可能性不大，只能做为一个失败假设了

snowland 发表于 2005-9-18 01:52

没把握发上来，还要钱啊？？

翘翘鞋 发表于 2005-9-18 03:40

发给我我看看呀

feelwindy 发表于 2005-9-18 08:52

气死我了

feelwindy 发表于 2005-9-18 08:54

大家不要看
没什么意思
我还被他骗了一个金币

vancy 发表于 2005-9-20 11:24

还差一毛钱行不行啊。

dapengcai 发表于 2005-9-23 18:01

回复：（whenzl）租赁问题穷举法源程序

1111111111111111111111111111111111111111111

页: [1] 2

数学建模社区-数学中国's Archiver

租赁问题穷举法源程序

回复：（whenzl）租赁问题穷举法源程序