也谈十滴水-启发式搜索
园友Master_Chivu在文章[Drops 十滴水] 强大的搜索(中)提起了十滴水这个游戏的搜索问题，给人启发颇深。Master_Chivu提到启发式策略可能会提高搜索效率，因为他本人也是用“裸搜”的。刚好我是学智能计算的，接着园友的启发，心想，何不试试智能算法呢？
经过权衡，最后决定用带精英保留策略的遗传算法求解。别的语言用不熟，还是最熟悉的Matlab上。开始写程序，却发现头疼的事来了。算法本身的步骤不难，但是写程序模拟棋盘上的动态可对我这种开发菜鸟是个问题。仔细分析了很久，最后决定用一个6×6矩阵A存储棋盘状态，然后用一个3×？的矩阵W存储所有飞行的水滴状态。
W第一行是水滴位置横坐标，第二是纵坐标，第三行是速度，用1，2，3，4表示上，右，下，左。（原谅我无知，用OOP可能只要实例化一个飞行水滴类就好了，但咱也就Matlab用的熟）。
当用户操作后，将放置水滴的位置，也就是矩阵A中相应的元素加一，如果大于4了（表示爆了），就在四周产生四个水滴，如果没爆，就直接把改变了状态的矩阵A返回。由于貌似一个值为4的大水滴，在不同方向同时来多个水滴情况下，也只会爆出四个小水滴，所以采用每一回合全部刷新飞行水滴位置后，如果该位置有水滴，则棋盘上相应位置处水滴数加一，并销毁W矩阵中相应的一列。待全部刷新完后，再根据棋盘上水滴的状态生成新的水滴（只要大于4就爆，不论是5，6还是7）。水滴碰撞解决了，可是到达边缘的碰撞还没处理。想了一下，最后用一个简单的办法：假设棋盘是8×8的（注意不是6×6），即在原来棋盘基础上，四周各加一条，让水滴飞吧，位置更新全部结束后检查棋盘四个边，发现有水滴进入就销毁之。
棋盘模拟代码如下：
function [A] = Ten_Drops( A,x,y)
[ N1 N2 ] = size( A);
AL = zeros( N1 + 2 , N1 + 2);
for i = 1 : N1
for j = 1 : N1
AL( i + 1 , j + 1) = A( i , j);
end
end
AL( x + 1 , y + 1) = AL( x + 1 , y + 1) + 1;
W = [];
numDrops = 0;
flag = 0;
while flag == 0
for i = 2 : N1 + 1
for j = 2 : N1 + 1
if AL( i , j) > 4
W = [ W [ i - 1; j; 1 ]];
numDrops = numDrops + 1; % One drop added
W = [ W [ i; j + 1; 2 ]];
numDrops = numDrops + 1;
W = [ W [ i + 1; j; 3 ]];
numDrops = numDrops + 1;
W = [ W [ i; j - 1; 4 ]];
numDrops = numDrops + 1;
AL( i , j) = 0;
end
end
end
if numDrops == 0
break
end
k = 1;
while k < = numDrops % Every drop operates just once
if AL( W( 1 , k ), W( 2 , k)) ~= 0
AL( W( 1 , k ), W( 2 , k)) = AL( W( 1 , k ), W( 2 , k)) + 1;
W (:, k) = [];
numDrops = numDrops - 1; % One drop depolyed
else
switch W( 3 , k) % Update water drop velocity
case 1
W( 1 , k) = W( 1 , k) - 1;
case 2
W( 2 , k) = W( 2 , k) + 1;
case 3
W( 1 , k) = W( 1 , k) + 1;
case 4
W( 2 , k) = W( 2 , k) - 1;
end
k = k + 1;
end
end
if numDrops ~= 0
k = 1;
while k < = numDrops
if W( 1 , k) < = 1 || W( 1 , k) > = N1 + 2 || W( 2 , k) < = 1 || W( 2 , k) > = N1 + 2
W (:, k) = [];
numDrops = numDrops - 1;
else
k = k + 1;
end
end
end
if numDrops == 0
flag = 1;
else
flag = 0;
end
for i = 2 : N1 + 1
for j = 2 : N1 + 1
if AL( i , j) > 4
flag = 0;
end
end
end
end
for i = 1 : N1
for j = 1 : N1
A( i , j) = AL( i + 1 , j + 1);
end
end
return
乎，没有Matlab高亮插件啊，我非主流了。。。空格敲的我好累。
下面，用遗传算法求解最优放水序列。。。关于这个问题的遗传算法求解，更详细的讨论在这里：使劲点我！
首先AA用来存储初始棋盘状态（就是你要求解的问题），N最大序列长度，D种群规模，Ps选择概率，Pc交叉概率，Pm变异概率，iter迭代序号。
1）生成初始种群（随机），这个种群就是备选序列的集合，每两行代表一个序列，奇数为横坐标，偶数为纵坐标。
2）把每个序列都放到Ten_Drops里跑一下，求出每个序列需要多少步才能把棋盘清空（多余出的序列不起作用）。
3）按照序列的清零步长对候选的序列排序，保留最佳序列，剩下的用轮盘赌方法按一定概率选出（当然步长短的序列被选出的概率大）。选择完以后，没被选中的序列，很不幸，被淘汰了，取而代之的是随机初始化的新序列（但是总的种群规模不变，还是D）。
4）按照交叉概率从经过选择的种群中随机选出偶数对备选序列，并且在序列中任意一点为限，交换相邻的序列（继承优良的基因）。
5）按照变异概率随机选择备选序列，将其中一个坐标组合初始化。
6）如果达到最大迭代次数，则到下一步，否则返回第2步.
7）将备选序列按顺序放到Ten_Drops里跑一边，选取最短的输出。
代码如下（还是敲了很多遍空格）
% Searching for optimum drop sequence
clear all
N = 25;
D = 20;
Ps = 0 . 6;
Pc = 0 . 4;
Pm = 0 . 2;
AA = [ 4 2 1 0 3 1;
0 0 2 2 4 1;
2 0 0 2 0 3;
0 1 3 0 4 3;
2 4 3 2 0 1;
0 1 2 1 1 2 ];
%--------------Generate Population--------------
XX = ceil( 6 * rand( 2 * D ,N));
%--------------Evaluate Fittness-----------------
for iter = 1 : 1000
if rem( iter , 50) == 0
disp ([ 'iteration: ' , num2Str( iter )]);
end
que = zeros( 1 , D);
for i = 1 : D
X = XX( 2 * i - 1 : 2 * i ,:);
A = AA;
for j = 1 :N
if sum( sum( A)) ~= 0
que( i) = que( i) + 1;
A = Ten_Drops( A , X( 1 , j ), X( 2 , j));
end
end
end
%-------------Sellection------------------------
[ ord ind ] = sort( que);
roller = D ./ que /( sum( D ./ que));
for i = 2 : D
roller( i) = roller( i) + roller( i - 1);
end
XXnew = [];
for i = 1 : 1 % Preserve the best
XXnew = [ XXnew; XX( 2 * ind( i) - 1 : 2 * ind( i ),:)];
end
for i = 2 : round( D *Ps)
r = rand;
j = 1;
while roller( j) < r
j = j + 1;
end
XXnew = [ XXnew; XX( 2 * j - 1 : 2 * j ,:)];
end
XXnew = [ XXnew; ceil( 6 * rand( 2 *( D - round( D *Ps )),N ))];
XX = XXnew;
%---------------Crossover-----------------------
XXnew = [];
for i = 1 : 1 % Preserve the best indivadual
XXnew = [ XXnew; XX( 2 * ind( i) - 1 : 2 * ind( i ),:)];
XX( 2 * ind( i) - 1 : 2 * ind( i ),:) = [];
end
K = round( D * Pc);
for i = 2 : round( D * Pc)
r = ceil( K * rand);
XXnew = [ XXnew; XX( 2 * r - 1 : 2 * r ,:)];
XX( 2 * r - 1 : 2 * r ,:) = [];
K = K - 1;
end
for i = 2 : round( D * Pc) / 2
r = ceil(N * rand);
temp = XXnew( 4 * i - 5 : 4 * i - 4 , r :N);
XXnew( 4 * i - 5 : 4 * i - 4 , r :N) = XXnew( 4 * i - 3 : 4 * i - 2 , r :N);
XXnew( 4 * i - 3 : 4 * i - 2 , r :N) = temp;
clear temp;
end
XXnew = [ XXnew; XX ];
XX = XXnew;
%-------------------Mutation---------------------
for i = 2 : round( D * Pm)
r1 = ceil(( D - 1) * rand) + 1;
r2 = ceil(N * rand);
XX( 2 * r1 - 1 : 2 * r1 , r2) = ceil( 6 * rand( 2 , 1));
end
end % End of iteration
%----------------Reorder-------------------------
que = zeros( 1 , D);
for i = 1 : D
X = XX( 2 * i - 1 : 2 * i ,:);
A = AA;
for j = 1 :N
if sum( sum( A)) ~= 0
que( i) = que( i) + 1;
A = Ten_Drops( A , X( 1 , j ), X( 2 , j));
end
end
end
[ ord ind ] = sort( que);
Xopt = XX( 2 * ind( 1) - 1 : 2 * ind( 1 ),:);
minQue = ord( 1);
当然最后的两个值就是我们想要的，Xopt是最优序列，minQue是清零步长。实际上就是每次按照Xopt中一列所指示的坐标给棋盘加上一滴水，当到达minQue显示的步骤时，一定会把棋盘清空的。
这个程序算出来的序列有时候很奇特，可能前面10步一个水滴都消不掉，最后一滴加上去，Wala，满屏幕都是水。。。汗一个。
16级的时候
我的机器迅驰1.73，2G进化1000代大概需要30秒，生成的解基本优良。level10一下基本都是6，7步，level10～level20就需要十多步了（也不稳定，有时候算出来11，12，有时候30，那是无解的情况），level20以上更不好讲，但总的来说还是可以用。
这个游戏感觉难度不一定，有时候碰到比较难的局，搜几次都是最大步长，但是这局坚持过去了，下一句可能10步就完成了。但过了20还是挺费事。有时候出不了解就自己在棋盘上先想办法爆几个水滴，然后将这个状态作为初始值再求解一下，很多时候可以绕过那些让解求不出来的为止的因素。
总之，遗传算法并不能保证每次都能给出最优解，甚至都不保证能给出解（数学上说是概率收敛），但是有很大的几率给出一个相对满意的解，用来玩游戏还是可以应付了。
另外，适应度函数我直接用了清零步长的倒数，但是这个没有考虑清零过程中产生的奖励（连续爆三个加一滴水），如果算上奖励，那就应该用奖励水滴-步长=剩余水滴，并以剩余水滴最大化为目标进行搜索，这样才符合游戏的初衷。但是我对游戏本身设置的奖励机制不太清楚，是每隔三个爆就奖励呢，还是必须连续起来。要是连续的话除了第三个有奖，其余的呢。由于真正飞起来水滴太多，光听见加分的声音，也不知道是第几个爆了加的分，这个就确实不好掌握了。
算法本身也不完美，各种改进策略很多的，懒得用了。话说目前DE是最快的启发搜索算法，但是向量差分在这个序列中怎么实现还不可知，期待牛人实现一下。
达到25级了，貌似水滴不太够了，先不玩了
晚上继续，死在这一关了，这个算法还不是无敌的。。。
作者：我不容易
出处：http://www.cnblogs.com/ComputingLife/
本文版权归作者和博客园共有，欢迎转载，但未经作者同意必须保留此段声明，且在文章页面明显位置给出原文连接，否则保留追究法律责任的权利。
最近向 我不容易 学习了遗传算法
他是专门研究这智能搜索这一方面的 水平很高
在我用ID算法解决"十滴水"小游戏时
他用遗传算法也写了 很强大
我用从他那所学的遗传算法 写了一个01背包问题的程序
}
01背包问题 大家应该很熟悉
是背包问题的一种
不过值得注意的是
背包问题是NPH问题
(如果容量和体积是整数且有范围的话 自然用DP可以很好的解决)
对于此类没有多项式复杂度算法的问题
我们一般用搜索解决
对于01背包问题
最为朴素的做法是 枚举每个物品取还是不取 再选取最优解
不过这样的复杂度是2^n 加了可行性和最优性剪枝也不能优化太多
这是我们就会考虑智能搜索算法
此类算法很强大 目前我只了解过遗传算法- -|||
于是我就用遗传算法写了一个
在理解 我不容易 的教导的基础之上 我还参考了这篇论文
http://www.docin.com/p-47510663.html
遗传算法本质是模拟达尔文的生物进化论思想
将一个解视为一个生物 通过对这样的生物的种群进行繁衍
不断地使生物得到进化 也就是让解得到不断的优化
根据生物学理论 生物的性状由基因控制
我们仅保存DNA即遗传信息进行模拟
并且还设计一个函数来根据遗传信息估计生物的适应度
适应度帮助我们得到生物生存和繁衍的概率
而且 由于性状之间不互相干扰
所以遗传算法多用于解决组合类的最优化问题
01背包 每个物品取与不取与其他物品的情况无关
所以可以用遗传算法解决
我们把繁衍的过程 简化为以下几个步骤
选择 交叉 变异
基于贪心思想 又附加了修复 修正的操作
具体内容上述论文讲的很清楚
我讲一下几个注意点 方便程序实现
*实数运算有精度问题 需要多加注意
*建议将各操作分为各个函数写
高度面向过程的程序对与遗传算法这种多块的代码由为重要
主要表现在 变量不会搞混 查错方便
*几个基本变量千万不要搞错 最大繁衍代数 种群规模 遗传信息规模
排序可以用nlogn级别的 数据大了优化比较明显
另外 几个参数是需要根据测试来定的
比如 变异概率 最大繁衍代数 种群规模
可以同过测试来不断微调 直至达到满意的效果
最后给出我的代码
自以为写的比较优美 不过也变的很长
1
{
$I+,Q+,R+,S+
}
2
const
maxn
=
200
; maxp
=
20
; maxt
=
500
;
3
xrr
=
2
; dsn
=
2
;
4
pm
=
0.1
;
5
var
p,tempp:
array
[
1
..maxp,
1
..maxn]
of
longint;
6
ans:
array
[
1
..maxn]
of
longint;
7
c,w,v:
array
[
1
..maxn]
of
real;
8
h:
array
[
1
..maxp]
of
real;
9
n,m,i,j:longint;
10
max:real;
11
procedure
revise(x:longint; y:real);
12
var
i,j,t,z:longint;
13
temp:
array
[
1
..maxn]
of
longint;
14
begin
15
t:
=
0
;
16
for
i:
=
1
to
n
do
17
if
p[x][i]
=
0
18
then
begin
19
inc(t);
20
temp[t]:
=
i;
21
end
;
22
for
i:
=
1
to
t
-
1
do
23
for
j:
=
i
+
1
to
t
do
24
if
c[temp[i]]
<
c[temp[j]]
25
then
begin
26
z:
=
temp[i];
27
temp[i]:
=
temp[j];
28
temp[j]:
=
z;
29
end
;
30
i:
=
0
;
31
while
(i
<
t)
and
(y
<
m)
do
32
begin
33
inc(i);
34
p[x][temp[i]]:
=
1
;
35
y:
=
y
+
w[temp[i]];
36
end
;
37
if
y
>
m
then
p[x][temp[i]]:
=
0
;
38
end
;
39
procedure
repair(x:longint; y:real);
40
var
i,j,t,z:longint;
41
temp:
array
[
1
..maxn]
of
longint;
42
begin
43
t:
=
0
;
44
for
i:
=
1
to
n
do
45
if
p[x][i]
=
1
46
then
begin
47
inc(t);
48
temp[t]:
=
i;
49
end
;
50
for
i:
=
1
to
t
-
1
do
51
for
j:
=
i
+
1
to
t
do
52
if
c[temp[i]]
>
c[temp[j]]
53
then
begin
54
z:
=
temp[i];
55
temp[i]:
=
temp[j];
56
temp[j]:
=
z;
57
end
;
58
i:
=
0
;
59
while
(i
<
n)
and
(y
>
m)
do
60
begin
61
inc(i);
62
p[x][temp[i]]:
=
0
;
63
y:
=
y
-
w[temp[i]];
64
end
;
65
end
;
66
procedure
create;
67
var
i,j:longint;
68
t:real;
69
begin
70
for
i:
=
1
to
maxp
do
71
begin
72
t:
=
0
;
73
for
j:
=
1
to
n
do
74
begin
75
p[i][j]:
=
random(
2
);
76
t:
=
t
+
w[j]
*
p[i][j];
77
end
;
78
if
t
<
m
then
revise(i,t);
79
if
t
>
m
then
repair(i,t);
80
end
;
81
end
;
82
procedure
propagate;
83
var
i,j,x,y,t:longint;
84
k,s,tr,tr0,r:real;
85
f,temp:
array
[
1
..maxn]
of
longint;
86
begin
87
for
i:
=
1
to
maxp
do
h[i]:
=
0
;
88
for
i:
=
1
to
maxp
do
89
for
j:
=
1
to
n
do
90
h[i]:
=
h[i]
+
v[j]
*
p[i][j];
91
for
i:
=
1
to
maxp
-
1
do
92
for
j:
=
i
+
1
to
maxp
do
93
if
h[i]
<
h[j]
94
then
begin
95
move(p[i],temp,sizeof(p[i]));
96
move(p[j],p[i],sizeof(p[j]));
97
move(temp,p[i],sizeof(temp));
98
k:
=
h[i]; h[i]:
=
h[j]; h[j]:
=
k;
99
end
;
100
for
i:
=
1
to
maxp
do
f[i]:
=
0
;
101
for
i:
=
1
to
dsn
do
f[i]:
=
1
;
102
s:
=
0
;
103
for
i:
=
1
to
maxp
do
s:
=
s
+
h[i];
104
for
i:
=
1
to
maxp
do
h[i]:
=
h[i]
/
s;
105
i:
=
dsn;
106
tr0:
=
0
;
107
for
i:
=
1
to
dsn
do
tr0:
=
tr0
+
h[i];
108
while
i
<
maxp
-
xrr
do
109
begin
110
j:
=
dsn;
111
tr:
=
tr0; r:
=
random;
112
while
tr
<
r
do
113
begin
114
inc(j);
115
tr:
=
tr
+
h[j];
116
end
;
117
if
f[j]
=
1
then
continue;
118
f[j]:
=
1
;
119
inc(i);
120
end
;
121
for
i:
=
1
to
maxp
do
122
if
f[i]
=
0
123
then
begin
124
s:
=
0
;
125
for
j:
=
1
to
n
do
126
begin
127
p[i][j]:
=
random(
2
);
128
s:
=
s
+
w[j]
*
p[i][j];
129
end
;
130
if
s
<
m
then
revise(i,s);
131
if
s
>
m
then
repair(i,s);
132
end
;
133
t:
=
dsn;
134
while
t
<
maxp
do
135
begin
136
x:
=
0
;
137
tr:
=
0
; r:
=
random;
138
while
tr
<
r
do
139
begin
140
inc(x);
141
tr:
=
tr
+
h[x];
142
end
;
143
y:
=
0
;
144
tr:
=
0
; r:
=
random;
145
while
tr
<
r
do
146
begin
147
inc(y);
148
tr:
=
tr
+
h[y];
149
end
;
150
inc(t);
151
for
i:
=
1
to
n
do
152
if
random(
2
)
=
1
153
then
tempp[t][i]:
=
p[x][i]
154
else
tempp[t][i]:
=
p[y][i];
155
if
random
<
pm
156
then
for
i:
=
1
to
n
do
157
tempp[t][i]:
=
random(
2
);
158
s:
=
0
;
159
for
i:
=
1
to
n
do
160
s:
=
s
+
w[i]
*
tempp[t][i];
161
move(tempp[t],p[t],sizeof(tempp[t]));
162
if
s
<
m
then
revise(t,s);
163
if
s
>
m
then
repair(t,s);
164
s:
=
0
;
165
for
i:
=
1
to
n
do
s:
=
s
+
v[i]
*
p[t][i];
166
if
s
>
max
167
then
begin
168
max:
=
s;
169
move(p[t],ans,sizeof(p[t]));
170
end
;
171
end
;
172
end
;
173
begin
174
randomize;
175
assign(input,
'
01.in
'
); reset(input);
176
assign(output,
'
01.out
'
); rewrite(output);
177
readln(n,m);
178
for
i:
=
1
to
n
do
179
begin
180
read(w[i]); read(v[i]);
181
c[i]:
=
v[i]
/
w[i];
182
end
;
183
create;
184
max:
=
0
;
185
for
i:
=
1
to
maxt
do
186
propagate;
187
writeln(max:
0
:
4
);
188
for
i:
=
1
to
n
do
189
write(ans[i]);
190
writeln;
191
close(input); close(output);
192
end
.
193
最近向 我不容易 学习了遗传算法
他是专门研究这智能搜索这一方面的 水平很高
在我用ID算法解决"十滴水"小游戏时
他用遗传算法也写了 很强大
我用从他那所学的遗传算法 写了一个01背包问题的程序
}
01背包问题 大家应该很熟悉
是背包问题的一种
不过值得注意的是
背包问题是NPH问题
(如果容量和体积是整数且有范围的话 自然用DP可以很好的解决)
对于此类没有多项式复杂度算法的问题
我们一般用搜索解决
对于01背包问题
最为朴素的做法是 枚举每个物品取还是不取 再选取最优解
不过这样的复杂度是2^n 加了可行性和最优性剪枝也不能优化太多
这是我们就会考虑智能搜索算法
此类算法很强大 目前我只了解过遗传算法- -|||
于是我就用遗传算法写了一个
在理解 我不容易 的教导的基础之上 我还参考了这篇论文
http://www.docin.com/p-47510663.html
遗传算法本质是模拟达尔文的生物进化论思想
将一个解视为一个生物 通过对这样的生物的种群进行繁衍
不断地使生物得到进化 也就是让解得到不断的优化
根据生物学理论 生物的性状由基因控制
我们仅保存DNA即遗传信息进行模拟
并且还设计一个函数来根据遗传信息估计生物的适应度
适应度帮助我们得到生物生存和繁衍的概率
而且 由于性状之间不互相干扰
所以遗传算法多用于解决组合类的最优化问题
01背包 每个物品取与不取与其他物品的情况无关
所以可以用遗传算法解决
我们把繁衍的过程 简化为以下几个步骤
选择 交叉 变异
基于贪心思想 又附加了修复 修正的操作
具体内容上述论文讲的很清楚
我讲一下几个注意点 方便程序实现
*实数运算有精度问题 需要多加注意
*建议将各操作分为各个函数写
高度面向过程的程序对与遗传算法这种多块的代码由为重要
主要表现在 变量不会搞混 查错方便
*几个基本变量千万不要搞错 最大繁衍代数 种群规模 遗传信息规模
排序可以用nlogn级别的 数据大了优化比较明显
另外 几个参数是需要根据测试来定的
比如 变异概率 最大繁衍代数 种群规模
可以同过测试来不断微调 直至达到满意的效果
最后给出我的代码
自以为写的比较优美 不过也变的很长
1 { $I+,Q+,R+,S+ } 2 const maxn = 200 ; maxp = 20 ; maxt = 500 ; 3 xrr = 2 ; dsn = 2 ; 4 pm = 0.1 ; 5 var p,tempp: array [ 1 ..maxp, 1 ..maxn] of longint; 6 ans: array [ 1 ..maxn] of longint; 7 c,w,v: array [ 1 ..maxn] of real; 8 h: array [ 1 ..maxp] of real; 9 n,m,i,j:longint; 10 max:real; 11 procedure revise(x:longint; y:real); 12 var i,j,t,z:longint; 13 temp: array [ 1 ..maxn] of longint; 14 begin 15 t: = 0 ; 16 for i: = 1 to n do 17 if p[x][i] = 0 18 then begin 19 inc(t); 20 temp[t]: = i; 21 end ; 22 for i: = 1 to t - 1 do 23 for j: = i + 1 to t do 24 if c[temp[i]] < c[temp[j]] 25 then begin 26 z: = temp[i]; 27 temp[i]: = temp[j]; 28 temp[j]: = z; 29 end ; 30 i: = 0 ; 31 while (i < t) and (y < m) do 32 begin 33 inc(i); 34 p[x][temp[i]]: = 1 ; 35 y: = y + w[temp[i]]; 36 end ; 37 if y > m then p[x][temp[i]]: = 0 ; 38 end ; 39 procedure repair(x:longint; y:real); 40 var i,j,t,z:longint; 41 temp: array [ 1 ..maxn] of longint; 42 begin 43 t: = 0 ; 44 for i: = 1 to n do 45 if p[x][i] = 1 46 then begin 47 inc(t); 48 temp[t]: = i; 49 end ; 50 for i: = 1 to t - 1 do 51 for j: = i + 1 to t do 52 if c[temp[i]] > c[temp[j]] 53 then begin 54 z: = temp[i]; 55 temp[i]: = temp[j]; 56 temp[j]: = z; 57 end ; 58 i: = 0 ; 59 while (i < n) and (y > m) do 60 begin 61 inc(i); 62 p[x][temp[i]]: = 0 ; 63 y: = y - w[temp[i]]; 64 end ; 65 end ; 66 procedure create; 67 var i,j:longint; 68 t:real; 69 begin 70 for i: = 1 to maxp do 71 begin 72 t: = 0 ; 73 for j: = 1 to n do 74 begin 75 p[i][j]: = random( 2 ); 76 t: = t + w[j] * p[i][j]; 77 end ; 78 if t < m then revise(i,t); 79 if t > m then repair(i,t); 80 end ; 81 end ; 82 procedure propagate; 83 var i,j,x,y,t:longint; 84 k,s,tr,tr0,r:real; 85 f,temp: array [ 1 ..maxn] of longint; 86 begin 87 for i: = 1 to maxp do h[i]: = 0 ; 88 for i: = 1 to maxp do 89 for j: = 1 to n do 90 h[i]: = h[i] + v[j] * p[i][j]; 91 for i: = 1 to maxp - 1 do 92 for j: = i + 1 to maxp do 93 if h[i] < h[j] 94 then begin 95 move(p[i],temp,sizeof(p[i])); 96 move(p[j],p[i],sizeof(p[j])); 97 move(temp,p[i],sizeof(temp)); 98 k: = h[i]; h[i]: = h[j]; h[j]: = k; 99 end ; 100 for i: = 1 to maxp do f[i]: = 0 ; 101 for i: = 1 to dsn do f[i]: = 1 ; 102 s: = 0 ; 103 for i: = 1 to maxp do s: = s + h[i]; 104 for i: = 1 to maxp do h[i]: = h[i] / s; 105 i: = dsn; 106 tr0: = 0 ; 107 for i: = 1 to dsn do tr0: = tr0 + h[i]; 108 while i < maxp - xrr do 109 begin 110 j: = dsn; 111 tr: = tr0; r: = random; 112 while tr < r do 113 begin 114 inc(j); 115 tr: = tr + h[j]; 116 end ; 117 if f[j] = 1 then continue; 118 f[j]: = 1 ; 119 inc(i); 120 end ; 121 for i: = 1 to maxp do 122 if f[i] = 0 123 then begin 124 s: = 0 ; 125 for j: = 1 to n do 126 begin 127 p[i][j]: = random( 2 ); 128 s: = s + w[j] * p[i][j]; 129 end ; 130 if s < m then revise(i,s); 131 if s > m then repair(i,s); 132 end ; 133 t: = dsn; 134 while t < maxp do 135 begin 136 x: = 0 ; 137 tr: = 0 ; r: = random; 138 while tr < r do 139 begin 140 inc(x); 141 tr: = tr + h[x]; 142 end ; 143 y: = 0 ; 144 tr: = 0 ; r: = random; 145 while tr < r do 146 begin 147 inc(y); 148 tr: = tr + h[y]; 149 end ; 150 inc(t); 151 for i: = 1 to n do 152 if random( 2 ) = 1 153 then tempp[t][i]: = p[x][i] 154 else tempp[t][i]: = p[y][i]; 155 if random < pm 156 then for i: = 1 to n do 157 tempp[t][i]: = random( 2 ); 158 s: = 0 ; 159 for i: = 1 to n do 160 s: = s + w[i] * tempp[t][i]; 161 move(tempp[t],p[t],sizeof(tempp[t])); 162 if s < m then revise(t,s); 163 if s > m then repair(t,s); 164 s: = 0 ; 165 for i: = 1 to n do s: = s + v[i] * p[t][i]; 166 if s > max 167 then begin 168 max: = s; 169 move(p[t],ans,sizeof(p[t])); 170 end ; 171 end ; 172 end ; 173 begin 174 randomize; 175 assign(input, ' 01.in ' ); reset(input); 176 assign(output, ' 01.out ' ); rewrite(output); 177 readln(n,m); 178 for i: = 1 to n do 179 begin 180 read(w[i]); read(v[i]); 181 c[i]: = v[i] / w[i]; 182 end ; 183 create; 184 max: = 0 ; 185 for i: = 1 to maxt do 186 propagate; 187 writeln(max: 0 : 4 ); 188 for i: = 1 to n do 189 write(ans[i]); 190 writeln; 191 close(input); close(output); 192 end . 193
扫一扫
3906
被折叠的 条评论
为什么被折叠?
到【灌水乐园】发言
