1675: [Usaco2005 Feb]Rigging the Bovine Election 竞选划区
Time Limit: 5 Sec Memory Limit: 64 MB
Submit: 198 Solved: 118
[Submit][Status][Discuss]
Description
It's election time. The farm is partitioned into a 5x5 grid of cow locations, each of which holds either a Holstein ('H') or Jersey ('J') cow. The Jerseys want to create a voting district of 7 contiguous (vertically or horizontally) cow locations such that the Jerseys outnumber the Holsteins. How many ways can this be done for the supplied grid?
农场被划分为5x5的格子，每个格子中都有一头奶牛，并且只有荷斯坦(标记为H)和杰尔西（标记为J）两个品种．如果一头奶牛在另一头上下左右四个格子中的任一格里，我们说它们相连． 奶牛要大选了．现在有一只杰尔西奶牛们想选择7头相连的奶牛，划成一个竞选区，使得其中它们品种的奶牛比荷斯坦的多． 要求你编写一个程序求出方案总数．
Input
* Lines 1..5: Each of the five lines contains five characters per line, each 'H' or 'J'. No spaces are present.
Output
* Line 1: The number of distinct districts of 7 connected cows such that the Jerseys outnumber the Holsteins in the district.
Sample Input
JHJHJ
HHHHH
HJHHJ
HHHHH
Sample Output
HINT
Source
题解：之前的题解中（传送门），采用的是\(O\left({25}^{7} \right)\)的简单暴力枚举，虽然能A，我一直认为还有更灵活的办法可以去做，于是有了这个第二篇题解
这次的思路是：每次先找一个点，然后向这个点的四周进行扩张，每一层dfs在原有的块的基础上再向外扩张一个，最终形成的块必然是7个连续的格子，应该能够起到比较好的优化效果——因为我每次选取扩张的点，都是通过动态维护当前块周围一圈的点来进行的，对于联通块而言，在地图内最多只能有15个周围的点，所以复杂度一下子降到了\(O\left({15}^{7} \right)\)，并且完全不需要判断7个点是否构成一块。。。
以上是优点，但是这样一来仔细想想，缺点也十分明显——由于对于同样一个图形而言，可以由很多中扩张顺序可以形成，所以势必造成巨大的重复计算，这是个致命的伤。。。所以只好进行判重，所以只好又写了个双值哈希，确保一种选取情况对应一对唯一的哈希值，而对于一大堆乱七八糟的哈希值对，怎样判断是否存在呢？于是逗比的我又来个了平衡树进行查找，这样子算下来，时间复杂度 \(O\left({15}^{7}\times 7 Ans \log Ans \right)\)
/**************************************************************
Problem:
User: HansBug
Language: Pascal
Result: Accepted
Time: ms
Memory: kb
****************************************************************/ const p=;q=;
type
pair=record
a0,b0:int64;
end;
var
i,j,k,l,m,n,head,tot,ans,av:longint;
lef,rig,fix:array[..] of longint;
b:array[..,..] of int64;
c,d:array[..,..] of longint;
a,e:array[..,..] of longint;
list:array[..,..] of int64;
ch:char;
procedure rt(var x:longint);
var l,f:longint;
begin
if (x=) or (lef[x]=) then exit;
f:=x;l:=lef[x];
lef[f]:=rig[l];
rig[l]:=f;
x:=l;
end;
procedure lt(var x:longint);
var r,f:longint;
begin
if (x=) or (rig[x]=) then exit;
f:=x;r:=rig[x];
rig[f]:=lef[r];
lef[r]:=f;
x:=r;
end;
function ins(var x:longint;y:longint):boolean;
begin
ins:=true;
if x= then
begin
x:=y;
exit;
end;
if (b[y,]<b[x,]) or ((b[y,]=b[x,]) and (b[y,]<b[x,])) then
begin
if lef[x]= then lef[x]:=y else ins:=ins(lef[x],y);
if fix[lef[x]]<fix[x] then rt(x);
end
else if (b[y,]>b[x,]) or ((b[y,]=b[x,]) and (b[y,]>b[x,])) then
begin
if rig[x]= then rig[x]:=y else ins:=ins(rig[x],y);
if fix[rig[x]]<fix[x] then lt(x);
end
else exit(false);
end;
function checkhash(t:pair):boolean;
begin
inc(tot);
b[tot,]:=t.a0;b[tot,]:=t.b0;
lef[tot]:=;rig[tot]:=;fix[tot]:=random(maxlongint);
checkhash:=ins(head,tot);
if not(checkhash) then dec(tot);
end;
function trans(x,y:longint):longint;
begin
trans:=(x-)*+y;
end;
function hashstate:pair;
var
i,j:longint;x,y:int64;t:pair;
begin
x:=;y:=;
for i:= to do
begin
j:=trans(c[i,],c[i,]);
x:=(x+list[j,]) mod q;
y:=(y+list[j,]) mod p;
end;
t.a0:=x;t.b0:=y;
exit(t);
end;
procedure hashstartup;
var i:longint;
begin
list[,]:=;list[,]:=;
for i:= to do
begin
list[i,]:=(list[i-,]*p) mod q;
list[i,]:=(list[i-,]*q) mod p;
end;
end;
procedure dfs(z:longint);
var i,j,k,l:longint;
begin
if z> then
begin
j:=;
for i:= to do inc(j,a[c[i,],c[i,]]);
if j<= then exit;
if checkhash(hashstate) then
begin
inc(ans);
end;
exit;
end;
l:=av;
for i:= to l do
begin
if e[d[i,],d[i,]]<> then continue;
c[z,]:=d[i,];c[z,]:=d[i,];
e[d[i,],d[i,]]:=;
if e[d[i,]-,d[i,]]= then
begin
inc(av);
d[av,]:=d[i,]-;
d[av,]:=d[i,];
e[d[i,]-,d[i,]]:=;
end;
if e[d[i,]+,d[i,]]= then
begin
inc(av);
d[av,]:=d[i,]+;
d[av,]:=d[i,];
e[d[i,]+,d[i,]]:=;
end;
if e[d[i,],d[i,]-]= then
begin
inc(av);
d[av,]:=d[i,];
d[av,]:=d[i,]-;
e[d[i,],d[i,]-]:=;
end;
if e[d[i,],d[i,]+]= then
begin
inc(av);
d[av,]:=d[i,];
d[av,]:=d[i,]+;
e[d[i,],d[i,]+]:=;
end;
dfs(z+);
while av>l do
begin
e[d[av,],d[av,]]:=;
d[av,]:=;d[av,]:=;
dec(av);
end;
e[d[i,],d[i,]]:=;
end;
end;
begin
hashstartup;
tot:=;head:=;ans:=;av:=;
randomize;
fillchar(e,sizeof(e),);
for i:= to do
begin
e[i,]:=;e[,i]:=;
e[i,]:=;e[,i]:=;
end;
for i:= to do
begin
for j:= to do
begin
read(ch);
case upcase(ch) of
'H':a[i,j]:=;
'J':a[i,j]:=;
end;
end;
readln;
end;
for i:= to do
for j:= to do
begin
av:=;
c[,]:=i;c[,]:=j;
if e[i-,j]= then
begin
inc(av);
d[av,]:=i-;d[av,]:=j;
e[i-,j]:=;
end;
if e[i+,j]= then
begin
inc(av);
d[av,]:=i+;d[av,]:=j;
e[i+,j]:=;
end;
if e[i,j-]= then
begin
inc(av);
d[av,]:=i;d[av,]:=j-;
e[i,j-]:=;
end;
if e[i,j+]= then
begin
inc(av);
d[av,]:=i;d[av,]:=j+;
e[i,j+]:=;
end;
e[i,j]:=;
dfs();
while av> do
begin
e[d[av,],d[av,]]:=;
d[av,]:=;d[av,]:=;
dec(av);
end;
e[i,j]:=;
end;
writeln(ans);
readln;
end.
于是我很嗨皮的交了一下，结果是（上面的那个是这种新的算法，下面的是之前的纯暴力）
于是我再一次有了一种彻底被吓尿的赶脚QAQ，实在没想到这玩意常数会这么大，还有后来查了一下数据，事实证明在有些比较单调的图中，我程序的速度相当坑TT
所以只能优化啦——比如，我们不难发现每个块总有一个x值最小的点，于是可以在下面的搜索过程中限制扩张方向，只准向下、向右、向左（注意：不可以一一个点为基准，同时限制向下和向左，想想为什么^_^）；还有，当当前的块里面已经出现4个H的时候，我觉得这个块就没任何继续下去的必要了对不——就算接下来全是J也没有用^_^；还有就是简单的常数优化了
于是再交了一次，结果如下（这两个都是优化过的，唯一的区别在于是否在过程和函数后面加了inline;）
于是，我终于战胜了原来的纯暴力，可实际上也不难发现一个问题——我后来写的优化程序有7KB还多，而简单的暴力只有2.5KB的样子，而且弄来弄去我最终的程序也才快了0.2s的样子，在考场上这根本不存在决定性作用。
显然，对这道题而言，还是朴素的暴力算法性价比高得多，尤其是考场上在极为有限的时间内，选择一个合适的方法尤其重要；不过我们还是不要为此导致不敢乱搞，脑洞还是要大开的^_^
优化代码：
/**************************************************************
Problem:
User: HansBug
Language: Pascal
Result: Accepted
Time: ms
Memory: kb
****************************************************************/ const p=;q=;
type
pair=record
a0,b0:int64;
end;
var
i,j,k,l,m,n,head,tot,ans,av:longint;
lef,rig,fix:array[..] of longint;
b:array[..,..] of int64;
c,d:array[..,..] of longint;
a,e:array[..,..] of longint;
list:array[..,..] of int64;
ch:char;
procedure rt(var x:longint);inline;
var l,f:longint;
begin
if (x=) or (lef[x]=) then exit;
f:=x;l:=lef[x];
lef[f]:=rig[l];
rig[l]:=f;
x:=l;
end;
procedure lt(var x:longint);inline;
var r,f:longint;
begin
if (x=) or (rig[x]=) then exit;
f:=x;r:=rig[x];
rig[f]:=lef[r];
lef[r]:=f;
x:=r;
end;
function ins(var x:longint;y:longint):boolean;inline;
begin
ins:=true;
if x= then
begin
x:=y;
exit;
end;
if (b[y,]<b[x,]) or ((b[y,]=b[x,]) and (b[y,]<b[x,])) then
begin
if lef[x]= then lef[x]:=y else ins:=ins(lef[x],y);
if fix[lef[x]]<fix[x] then rt(x);
end
else if (b[y,]>b[x,]) or ((b[y,]=b[x,]) and (b[y,]>b[x,])) then
begin
if rig[x]= then rig[x]:=y else ins:=ins(rig[x],y);
if fix[rig[x]]<fix[x] then lt(x);
end
else exit(false);
end;
function checkhash(t:pair):boolean;inline;
begin
inc(tot);
b[tot,]:=t.a0;b[tot,]:=t.b0;
lef[tot]:=;rig[tot]:=;fix[tot]:=random(maxlongint);
checkhash:=ins(head,tot);
if not(checkhash) then dec(tot);
end;
function trans(x,y:longint):longint;inline;
begin
trans:=(x-)*+y;
end;
function hashstate:pair;inline;
var
i,j:longint;x,y:int64;t:pair;
begin
x:=;y:=;
for i:= to do
begin
j:=trans(c[i,],c[i,]);
x:=(x+list[j,]) mod q;
y:=(y+list[j,]) mod p;
end;
t.a0:=x;t.b0:=y;
exit(t);
end;
procedure hashstartup;inline;
var i:longint;
begin
list[,]:=;list[,]:=;
for i:= to do
begin
list[i,]:=(list[i-,]*p) mod q;
list[i,]:=(list[i-,]*q) mod p;
end;
end;
procedure dfs(z,t:longint);inline;
var i,j,k,l:longint;
begin
if (z-t)> then exit;
if z> then
begin
if checkhash(hashstate) then
begin
inc(ans);
end;
exit;
end;
l:=av;
for i:= to l do
begin
if e[d[i,],d[i,]]<> then continue;
c[z,]:=d[i,];c[z,]:=d[i,];
e[d[i,],d[i,]]:=;
if e[d[i,]-,d[i,]]= then
begin
inc(av);
d[av,]:=d[i,]-;
d[av,]:=d[i,];
e[d[i,]-,d[i,]]:=;
end;
if e[d[i,]+,d[i,]]= then
begin
inc(av);
d[av,]:=d[i,]+;
d[av,]:=d[i,];
e[d[i,]+,d[i,]]:=;
end;
if e[d[i,],d[i,]-]= then
begin
inc(av);
d[av,]:=d[i,];
d[av,]:=d[i,]-;
e[d[i,],d[i,]-]:=;
end;
if e[d[i,],d[i,]+]= then
begin
inc(av);
d[av,]:=d[i,];
d[av,]:=d[i,]+;
e[d[i,],d[i,]+]:=;
end;
dfs(z+,t+a[d[i,],d[i,]]);
while av>l do
begin
e[d[av,],d[av,]]:=;
d[av,]:=;d[av,]:=;
dec(av);
end;
e[d[i,],d[i,]]:=;
end;
end;
begin
hashstartup;
tot:=;head:=;ans:=;av:=;
randomize;
fillchar(e,sizeof(e),);
for i:= to do
begin
e[i,]:=;e[,i]:=;
e[i,]:=;e[,i]:=;
end;
for i:= to do
begin
for j:= to do
begin
read(ch);
case upcase(ch) of
'H':a[i,j]:=;
'J':a[i,j]:=;
end;
end;
readln;
end;
for i:= to do
begin
for j:= to do c[i-,j]:=;
for j:= to do
begin
av:=;
c[,]:=i;c[,]:=j;
if e[i-,j]= then
begin
inc(av);
d[av,]:=i-;d[av,]:=j;
e[i-,j]:=;
end;
if e[i+,j]= then
begin
inc(av);
d[av,]:=i+;d[av,]:=j;
e[i+,j]:=;
end;
if e[i,j-]= then
begin
inc(av);
d[av,]:=i;d[av,]:=j-;
e[i,j-]:=;
end;
if e[i,j+]= then
begin
inc(av);
d[av,]:=i;d[av,]:=j+;
e[i,j+]:=;
end;
e[i,j]:=;
dfs(,a[i,j]);
while av> do
begin
e[d[av,],d[av,]]:=;
d[av,]:=;d[av,]:=;
dec(av);
end;
e[i,j]:=;
end;
end;
writeln(ans);
readln;
end.