A 拯救
九连环、格雷码、N阶立方体上的Hamilton回路、Hanoi塔是等价问题。把题目的格雷码解码以后，问题变成高精度二进制数转十进制。
Codeprogram lan;
uses math;
const FileName='lan';p=10000;
type num=array[0..100] of longint;
var ans,tmp:num;
n,i:longint;
a:array[1..1000] of integer;
procedure fopen;
begin
assign(input ,FileName+'.in' );
assign(output,FileName+'.out');
reset(input);rewrite(output);
end;
procedure fclose;
begin close(input);close(output);end;
procedure ADD;
var i,len:longint;
x:Qword;
begin
len:=max(ans[0],tmp[0]);x:=0;
for i:=1 to len do begin
inc(ans[i],tmp[i]+x);
x:=ans[i] div p;
ans[i]:=ans[i] mod p;
end;
while x>0 do begin
inc(len);ans[len]:=x mod p;
x:=x div p;end;
ans[0]:=len;
end;
procedure mul;
var i,len:longint;
x:Qword;
begin
len:=tmp[0];x:=0;
for i:=1 to len do begin
tmp[i]:=tmp[i]<<1+x;
x:=tmp[i] div p;
tmp[i]:=tmp[i] mod p;
end;
while x>0 do begin
inc(len);tmp[len]:=x mod p;
x:=x div p;end;
tmp[0]:=len;
end;
procedure print;
var t,i,j:longint;
x:Qword;
s:array[1..10] of longint;
begin
if(ans[0]=1)and(ans[1]=0)
then writeln(0) else begin
x:=ans[ans[0]];t:=0;
while x>0 do begin
inc(t);s[t]:=x mod 10;
x:=x div 10;end;
for j:=t downto 1 do write(s[j]);
for i:=ans[0]-1 downto 1 do begin
x:=ans[i];
write(x div 1000,x mod 1000 div 100,
x mod 100 div 10,x mod 10);
end;
writeln;end;
end;
begin
fopen;
fillchar(ans,sizeof(ans),0);
fillchar(tmp,sizeof(tmp),0);
readln(n);
for i:=1 to n do read(A[i]);
for i:=n-1 downto 1 do
A[i]:=A[i] xor A[i+1];
//for i:=n downto 1 do write(a[i]);writeln;
ans[0]:=1;ans[1]:=0;
tmp[0]:=1;tmp[1]:=1;
for i:=1 to n do begin
if A[i]>0 then ADD;
MUL;end;
print; fclose;
end.
B 蚂蚁和瓢虫
核心思想就是一步让蚂蚁爬到位。抄标程做的，不多说。
Codeprogram mro;
uses math;
const FileName='mro';
maxn=5000;maxk=1000;
var next,v:array[0..maxn*2] of longint;
dis,head,vis,tree:array[0..maxn] of longint;
cnt,pos:array[0..maxk] of longint;
root,h,a,b,tot,flag,i,j,n,m:longint;
procedure fopen;
begin
assign( input,FileName+'.in' );
assign(output,FileName+'.out');
reset(input);rewrite(output);
end;
procedure fclose;
begin close(input);close(output);end;
procedure build(a,b:longint);
begin
inc(tot);v[tot]:=b;
next[tot]:=head[a];
head[a] :=tot;
end;
procedure DFS(u:longint);
var i:longint;
begin
vis[u]:=flag;i:=head[u];
while i<>0 do begin
if vis[v[i]]<>flag
then begin
DFS(v[i]);
if(dis[u]>dis[v[i]]+1)or
((dis[u]=dis[v[i]]+1)and
(tree[v[i]]<tree[u]))
then begin
dis [u]:=dis [v[i]]+1;
tree[u]:=tree[v[i]];
end;end;
i:=next[i];end;
end;
procedure slove(u,time:longint);
var i:longint;
begin
time:=min(dis[u],time);
vis[u]:=flag;i:=head[u];
while i<>0 do begin
if vis[v[i]]<>flag
then slove(v[i],time);
i:=next[i];end;
if dis[u]<=time then pos[tree[u]]:=u;
end;
procedure deal(root:longint);
var i:longint;
begin
filldword(dis,sizeof(dis)>>2,maxlongint-10);
for i:=1 to m do dis[pos[i]]:=0;
inc(flag);DFS(root);inc(cnt[tree[root]]);
inc(flag);slove(root,dis[root]);
end;
begin fopen;
readln(n);
for i:=1 to n-1 do
begin
read(a,b);
build(a,b);
build(b,a);
end;
readln(m);
for i:=1 to m do read(pos[i]);
for i:=1 to m do tree[pos[i]]:=i;
readln(h);
for i:=1 to h do begin
read(root);deal(root);end;
for i:=1 to m do
writeln(pos[i],' ',cnt[i]);
fclose;end.
C 反质数
把问题转化为找约数最大的数的集合中的最小值。当时打表做的，甚至写了具有友好的输入输出的素数分解用来找规律，结果没找到。。。。
x>n以后要break，不然再乘几下就回饶了。
Codeprogram ant;
const P:array[1..20] of longint=(2,3,5,7,11,13,17,19,
23,29,31,37,41,43,47,
53,59,61,67,71);
Filename='ant';
var ans,anscnt:int64;
n:longint;
procedure DFS(k,pre:integer;x,cnt:int64);
var i:longint;
temp:int64=1;
begin
if(x>n)or(k>9)then exit;//居然用前九个质数就能过
if((cnt=anscnt)and(ans>x))or
(cnt>anscnt)
then begin
ans:=x;
anscnt:=cnt;
end;
for i:=1 to pre do begin
x:=x*P[k];if x>n then break;
DFS(k+1,i,x,cnt*(i+1));
end;
end;
begin
readln(n);ans:=n;
DFS(1,trunc(ln(n)/ln(2)),1,1);
writeln(Ans);
end.