租赁问题穷举法源程序

whenzl

租赁问题穷举法源程序.txt (389 Bytes, 下载次数: 6)

2005-9-17 23:15 上传

点击文件名下载附件
租赁问题穷举法源程序
下载积分: 体力 -2 点

上面是附件,用表2做的

% H( r- H/ k" C7 q

然后是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

% ?) W0 B6 f. v& x

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

8 P9 \7 F- f2 M2 H# [1 R4 J

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

6 H$ U9 c! c* u" d6 E* v7 Z

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

lushq

这是写得社么啊

mnpfc

看过，还可以

dapengcai

1111111111111111111111111111111111111111111

vancy

还差一毛钱行不行啊。

feelwindy

大家不要看

: U7 L. [1 O2 N# V

没什么意思

1 ^3 {9 b+ t" a V+ F

我还被他骗了一个金币

feelwindy

气死我了

[em06]

翘翘鞋

发给我我看看呀

snowland

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

whenzl

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