USACO 2.1.1
题解：
这题有点毒，调了一个中午……
先读入，用一个三维布尔数组储存第(i,j)个点的四个方向是否有墙。
对于第一个问题，直接BFS求连通块，并构造出一个图，第(i,j)个点的数字表示该房间属于第几个连通块。
对于第二个问题，边BFS边统计。
对于第三个问题，直接暴力枚举每面墙，找最大值。
对于第四个问题，同样是暴力枚举，但要考虑优先级问题。从右上角的房间枚举到左下角的房间(j=m downto 1;i=1 to n)，每个房间先看东墙再看北墙。
代码：
{
ID:m1599491
PROG:castle
LANG:PASCAL
}
const fx:array[1..4] of longint=(0,-1,0,1);
const fy:array[1..4] of longint=(-1,0,1,0);
var k:array[1..50,1..50,1..4] of boolean;
var n,m,i,j,x,tot,l,maxx,ans1,ans2,ans3,p:longint;
var num:array[1..2500] of longint;
var f:array[1..1000,1..2] of longint;
var b,t:array[1..100,1..100] of longint;
function max(x,y:longint):longint; begin if x>y then exit(x);exit(y); end;
procedure bfs(x,y,tot:longint);
var i,j,front,rear,nx,ny:longint;
begin
front:=0;rear:=1;
f[rear,1]:=x;f[rear,2]:=y;
b[x,y]:=tot;
num[tot]:=1;
maxx:=max(maxx,num[tot]);
while front<rear do
begin
inc(front);
for i:=1 to 4 do
begin
nx:=f[front,1];ny:=f[front,2];
if (not k[nx,ny,1])and(i=1) then ny:=ny-1;
if (not k[nx,ny,2])and(i=2) then nx:=nx-1;
if (not k[nx,ny,3])and(i=3) then ny:=ny+1;
if (not k[nx,ny,4])and(i=4) then nx:=nx+1;
if (nx>0)and(ny>0)and(nx<=n)and(ny<=m)and(b[nx,ny]=0) then
begin
inc(rear);
f[rear,1]:=nx;f[rear,2]:=ny;
b[nx,ny]:=tot;
inc(num[tot]);
maxx:=max(maxx,num[tot]);
end;
end;
end;
end;
procedure o;
var i,j,t,nx,ny:longint;
begin
for j:=m downto 1 do
for i:=1 to n do
begin
for t:=3 downto 2 do
begin
nx:=i+fx[t];ny:=j+fy[t];
if b[nx,ny]=b[i,j] then continue;
if (nx<1)or(ny<1)or(nx>n)or(ny>m) then continue;
if num[b[i,j]]+num[b[nx,ny]]=p then
begin
ans1:=i;ans2:=j;ans3:=t;
end;
end;
end;
end;
function find(x:longint):longint;
var i,j,t,nx,ny,merge:longint;
begin
merge:=-maxlongint;
for j:=1 to m do
for i:=1 to n do
begin
for t:=4 downto 1 do
begin
nx:=i+fx[t];ny:=j+fy[t];
if (nx<1)or(ny<1)or(nx>n)or(ny>m) then continue;
if (k[i,j,t])and(b[i,j]<>b[nx,ny]) then
if merge<=num[b[i,j]]+num[b[nx,ny]] then merge:=num[b[i,j]]+num[b[nx,ny]];
end;
end;
exit(merge);
end;
begin
assign(input,'castle.in');reset(input);
assign(output,'castle.out');rewrite(output);
readln(m,n);
for i:=1 to n do
begin
for j:=1 to m do
begin
read(x);
t[i,j]:=x;
if x=1 then k[i,j,1]:=true;
if x=2 then k[i,j,2]:=true;
if x=4 then k[i,j,3]:=true;
if x=8 then k[i,j,4]:=true;
if x=3 then begin k[i,j,1]:=true;k[i,j,2]:=true; end;
if x=5 then begin k[i,j,1]:=true;k[i,j,3]:=true; end;
if x=9 then begin k[i,j,1]:=true;k[i,j,4]:=true; end;
if x=6 then begin k[i,j,2]:=true;k[i,j,3]:=true; end;
if x=10 then begin k[i,j,2]:=true;k[i,j,4]:=true; end;
if x=12 then begin k[i,j,3]:=true;k[i,j,4]:=true; end;
if x=7 then begin k[i,j,1]:=true;k[i,j,2]:=true;k[i,j,3]:=true; end;
if x=11 then begin k[i,j,1]:=true;k[i,j,2]:=true;k[i,j,4]:=true; end;
if x=14 then begin k[i,j,2]:=true;k[i,j,3]:=true;k[i,j,4]:=true; end;
if x=13 then begin k[i,j,1]:=true;k[i,j,3]:=true;k[i,j,4]:=true; end;
if x=15 then begin k[i,j,1]:=true;k[i,j,2]:=true;k[i,j,3]:=true;k[i,j,4]:=true; end;
end;
readln;
end;
maxx:=0;
for i:=1 to n do for j:=1 to m do if b[i,j]=0 then
begin
inc(tot);
bfs(i,j,tot);
end;
writeln(tot);
writeln(maxx);
p:=find(0);o;
writeln(p);
if ans3=3 then writeln(ans1,' ',ans2,' E');
if ans3=2 then writeln(ans1,' ',ans2,' N');
close(input);close(output);
end.
USACO 2.1.2
题解：
暴枚每一种不大于1的分数情况，边判个GCD是不是等于1，接着快排一下出答案。
代码：
{
ID:m1599491
PROG:frac1
LANG:PASCAL
}
var z:array[1..100000] of double;
var x,y:array[1..100000] of longint;
var i,n,j,tot:longint;
function gcd(a,b:longint):longint;
begin
if b=0 then exit(a);
gcd:=gcd(b,a mod b);
end;
procedure qs(l,r:longint);
var i,j,p:longint;
var m,t:double;
begin
i:=l;j:=r;m:=z[(l+r)>>1];
repeat
while z[i]<m do inc(i);while z[j]>m do dec(j);
if i<=j then
begin
t:=z[i];z[i]:=z[j];z[j]:=t;
p:=x[i];x[i]:=x[j];x[j]:=p;
p:=y[i];y[i]:=y[j];y[j]:=p;
inc(i);dec(j);
end;
until i>j;
if i<r then qs(i,r);if l<j then qs(l,j);
end;
begin
assign(input,'frac1.in');reset(input);
assign(output,'frac1.out');rewrite(output);
readln(n);
for i:=0 to n do for j:=1 to n do if (gcd(i,j)=1)and(i/j<=1) then
begin
inc(tot);
x[tot]:=i;y[tot]:=j;z[tot]:=i/j;
end;
qs(1,tot);
for i:=1 to tot do writeln(x[i],'/',y[i]);
close(input);close(output);
end.
USACO 2.1.3
题解：
列出排序后的数组，判断一下就行。
代码：
{
ID:m1599491
PROG:sort3
LANG:PASCAL
}
var nn,ans,i,j,n,t:longint;
var a,b,num:array[1..1001] of longint;
begin
assign(input,'sort3.in');reset(input);
assign(output,'sort3.out');rewrite(output);
readln(n);
for i:=1 to n do
begin
readln(a[i]);
inc(num[a[i]]);
end;
for i:=1 to num[1] do b[i]:=1;
for i:=num[1]+1 to num[1]+num[2] do b[i]:=2;
for i:=num[1]+num[2]+1 to n do b[i]:=3;
for i:=1 to n do for j:=1 to n do
if (a[i]<>a[j])and(b[i]=a[j])and(b[j]=a[i]) then
begin
t:=a[i];a[i]:=a[j];a[j]:=t;inc(nn);
end;
for i:=1 to n do if a[i]<>b[i] then inc(ans);
writeln(nn+trunc(ans/3*2));
close(input);close(output);
end.
USACO 2.1.4
题解：
深搜，没啥好说的。
代码：
{
ID:m1599491
PROG:holstein
LANG:PASCAL
}
var sum,nee,anss,answer:array[1..100] of longint;
var a:array[1..100,1..100] of longint;
var b:array[1..100] of boolean;
var ans,i,j,n,v,g:longint;
procedure dfs(tot,dep:longint);
var p,t:boolean;
var i,j:longint;
begin
p:=true;t:=false;
for i:=1 to v do if sum[i]<nee[i] then p:=false;
if p then
begin
if dep<=ans then
begin
if dep=ans then for i:=1 to dep do if answer[i]>anss[i] then
begin
t:=true;
break;
end;
if t then for i:=1 to dep do answer[i]:=anss[i];
if dep<ans then
begin
for i:=1 to dep do answer[i]:=anss[i];
ans:=dep;
end;
end;exit;
end;
for i:=tot+1 to n do
begin
if not b[i] then
begin
dep:=dep+1;b[i]:=true;anss[dep]:=i;
for j:=1 to v do sum[j]:=sum[j]+a[i,j];
dfs(i,dep);anss[dep]:=0;
for j:=1 to v do sum[j]:=sum[j]-a[i,j];
dec(dep);b[i]:=false;
end;
end;
end;
begin
assign(input,'holstein.in');reset(input);
assign(output,'holstein.out');rewrite(output);
readln(v);for i:=1 to v do read(nee[i]);readln(n);
for i:=1 to n do for j:=1 to v do read(a[i,j]);
for i:=1 to 1000 do answer[i]:=maxlongint;
ans:=maxlongint;dfs(0,0);
write(ans);for i:=1 to ans do write(' ',answer[i]);writeln;
close(input);close(output);
end.
USACO 2.1.5
题解：
首先看它二进制编码的位数，则转为十进制最多只有2^b-1个数，接着用一个数组把这些二进制编码储存起来(记得补0)，然后上深搜。
代码：
{
ID:m1599491
PROG:hamming
LANG:PASCAL
}
var n,b,d,i,k,tot:longint;
var s:array[0..1000] of ansistring;
var ans:array[0..1000] of longint;
var e:array[0..1000] of boolean;
function ch(n:longint):ansistring;
var s:ansistring;
begin
s:='';
repeat
if n and 1=0 then s:='0'+s else s:='1'+s;
n:=n>>1;
until n=0;
while length(s)<b do s:='0'+s;
exit(s);
end;
function pow(x:longint):longint;
begin
if x=0 then exit(1);
pow:=pow(x>>1);
pow:=pow*pow;
if x and 1=1 then pow:=pow*2;
end;
function ok(s1,s2:ansistring):boolean;
var sum,i:longint;
begin
sum:=0;
for i:=1 to b do
begin
if s1[i]<>s2[i] then inc(sum);
if sum>=d then exit(true);
end;
exit(false);
end;
function okk(t:longint):boolean;
var i:longint;
begin
for i:=1 to tot do if not ok(s[t],s[ans[i]]) then exit(false);
exit(true);
end;
procedure o;
var i:longint;
begin
for i:=1 to tot do if (i mod 10=0)or(i=tot) then writeln(ans[i]) else write(ans[i],' ');
close(input);close(output);
halt;
end;
procedure dfs(x,dep:longint);
var i:longint;
begin
if dep>=n then
begin
if dep=n then o;
exit;
end;
for i:=x+1 to k do
begin
if (not e[i])and(okk(i)) then
begin
e[i]:=true;
inc(tot);ans[tot]:=i;
dfs(i,dep+1);
ans[tot]:=0;dec(tot);
e[i]:=false;
end;
end;
end;
begin
assign(input,'hamming.in');reset(input);
assign(output,'hamming.out');rewrite(output);
readln(n,b,d);
k:=pow(b)-1;
for i:=0 to k do s[i]:=ch(i);
dfs(-1,0);
end.