哈尔滨市第三中学 刘翀

　　　　　　　　　　　　3． 《找名字》的程序

　　program namenum;
　　　const empty:string[12]=' ';
　　　　　　　value:array[2..9,1..3]of string=(('A','B','C'),
　　　　　　　　　　　　　　　　　　　　　　　　('D','E','F'),
　　　　　　　　　　　　　　　　　　　　　　　　('G','H','I'),
　　　　　　　　　　　　　　　　　　　　　　　　('J','K','L'),
　　　　　　　　　　　　　　　　　　　　　　　　('M','N','O'),
　　　　　　　　　　　　　　　　　　　　　　　　('P','R','S'),
　　　　　　　　　　　　　　　　　　　　　　　　('T','U','V'),
　　　　　　　　　　　　　　　　　　　　　　　　('W','X','Y'));
　　　var fin,fout,dict:text;
　　　　index:array[-1..13882]of string[12];
　　　　quest:string;
　　　　check:boolean;
　　function hash(s:string):integer;
　　　var i,tmp:longint;
　　　begin
　　　　tmp:=0;
　　　　if length(s)>1 then begin
　　　　tmp:=tmp*27+ord(s[1])-64;
　　　　for i:=1 downto 0 do
　　　　　tmp:=tmp*27+ord(s[length(s)-i])-64;
　　　　　　　　　　　　end
　　　　　　　　　　　else for i:=1 to 3 do
　　　　　　　　　　　　　　　tmp:=tmp*27+ord(s[1])-64;
　　　　hash:=tmp mod 13883;
　　　end;
　　function locate(s:string):integer;
　　　var tmp,i:integer;
　　　begin
　　　　tmp:=hash(s);
　　　　i:=0;
　　　　while (index[(i+tmp)mod 13883]<>s)and(index[(i+tmp)mod 　　　　　13883]<>empty) do
　　　　　i:=(i+23)mod 13883;
　　　　locate:=(i+tmp)mod 13883;
　　　end;
　　procedure int(s:string);
　　　var tmp:integer;
　　　begin
　　　　tmp:=locate(s);
　　　　index[tmp]:=s;
　　　end;
　　procedure init;
　　　var s:string;
　　　　　i:integer;
　　　begin
　　　　assign(fin,{'d:\namenum.txt'}'namenum.in');
　　　　assign(fout,{'d:\namenum.out'}'namenum.out');
　　　　reset(fin);
　　　　rewrite(fout);
　　　　assign(dict,{'d:\dict1.txt'}'dict.txt');
　　　　reset(dict);
　　　　for i:=0 to 13882 do
　　　　　index[i]:=empty;
　　　　while not eof(dict) do
　　　　　begin
　　　　　　readln(dict,s);
　　　　　　int(s);
　　　　　end;
　　　　close(dict);
　　　　readln(fin,quest);
　　　　close(fin);
　　　end;
　　function member(s:string):boolean;
　　　var tmp:integer;
　　　begin
　　　　tmp:=locate(s);
　　　　if index[tmp]=s then member:=true
　　　　　　　　　　　　else member:=false;
　　　end;
　　procedure work;
　　　var st:string;
　　　　j:integer;
　　　procedure examin(t:integer;ch:string);
　　　　var i:integer;
　　　　begin
　　　　　if t=length(quest) then begin
　　　　　　　　　　　　　　　　st:=st+ch;
　　　　　　　　　　　　　　　　if member(st) then begin
　　　　　　　　　　　　　　　　　　　　　　　　writeln(fout,st);
　　　　　　　　　　　　　　　　　　　　　　　　check:=true;
　　　　　　　　　　　　　　　　　　　　　　　end;
　　　　　　　　　　　　　　　　exit;
　　　　　　　　　　　　　　　end;
　　　　st:=st+ch;
　　　　for i:=1 to 3 do
　　　　 begin
　　　　 examin(t+1,value[ord(quest[t+1])-ord('0'),i]);
　　　　 delete(st,length(st),1);
　　　　 end;
　　　end;
　　begin
　　　check:=false;
　　　for j:=1 to 3 do
　　　　　begin
　　　　　　st:='';
　　　　　　examin(1,value[ord(quest[1])-ord('0'),j]);
　　　　　end;
　　　　if not check then writeln(fout,'NONE');
　　　　close(fout);
　　　end;
　　begin
　　　init;
　　　work;
　　end.

　　　　　　　　　　　4． 《转花盆》的程序

　　（这个程序是 SGOI-8 Flowers 的标准程序）

　　program flowers;
　　　const
　　　　size=1058148;
　　　　base=262143;
　　　　circle:array[1..7,1..6] of longint
　　　　=((1,2,6,10,9,4),
　　　　　(2,3,7,11,10,5),
　　　　　(4,5,10,14,13,8),
　　　　　(5,6,11,15,14,9),
　　　　　(6,7,12,16,15,10),
　　　　　(9,10,15,18,17,13),
　　　　　(10,11,16,19,18,14));
　　　　x:array[1..7] of longint=(2,2,3,3,3,4,4);
　　　　y:array[1..7] of longint=(2,3,2,3,4,2,3);
　　　　InputFn='flowers.in';
　　　　OutputFn='flowers.out';
　　　var
　　　　last,next,q:array[1..size] of longint;
　　　　id:array[1..size] of shortint;
　　　　hash:array[0..base] of longint;
　　　　step,i,j,k,start,target,qs,l,r:longint;
　　　　bit,s,t:array[1..19] of longint;
　　　　d:array[0..7] of longint;
　　　　nowlast,nowid:longint;
　　　　f,fo:text;

　　procedure init;
　　var
　　　d:array[0..5] of longint;
　　　i,j:longint;
　　begin
　　　assign(f,InputFn);
　　　reset(f);
　　　for i:=1 to 19 do
　　　　read(f,s[i]);
　　　for i:=1 to 19 do
　　　　read(f,t[i]);
　　　close(f);
　　　d[0]:=0;
　　　for i:=1 to 19 do
　　　　begin
　　　　　inc(d[0]); d[d[0]]:=s[i];
　　　　　for j:=1 to d[0] do
　　　　　　if d[j]=s[i] then break;
　　　　　s[i]:=j-1;
　　　　　if j<>d[0] then dec(d[0]);

　　　　　inc(d[0]); d[d[0]]:=t[i];
　　　　　for j:=1 to d[0] do
　　　　　　if d[j]=t[i] then break;
　　　　　t[i]:=j-1;
　　　　　if j<>d[0] then dec(d[0]);
　　　　end;
　　　fillchar(next,sizeof(next),0);
　　　fillchar(hash,sizeof(hash),0);
　　end;

　　function change(a,b:longint; plus:longint):longint;
　　var
　　　i:longint;
　　begin
　　　for i:=1 to 6 do
　　　　d[i]:=(a div bit[circle[b,i]]) mod 3;
　　　d[7]:=d[1]; d[0]:=d[6];
　　　for i:=1 to 6 do
　　　　a:=a+(d[i+plus]-d[i])*bit[circle[b,i]];
　　　change:=a;
　　end;

　　procedure out;
　　var
　　　i,j,dep:longint;
　　　stack:array[1..20] of longint;
　　begin
　　　i:=qs; dep:=0;
　　　while i<>1 do
　　　　begin
　　　　　inc(dep);
　　　　　stack[dep]:=id[i];
　　　　　i:=last[i];
　　　　end;
　　　for i:=dep downto 1 do
　　　　if stack[i]>0 then
　　　　　writeln(fo,x[stack[i]],' ',y[stack[i]],' ',1)
　　　　else writeln(fo,x[-stack[i]],' ',y[-stack[i]],' ',0);
　　end;

　　procedure insert(now:longint);
　　var
　　　i:longint;
　　begin
　　　if now=target then
　　　　begin
　　　　　assign(fo,OutputFn);
　　　　　rewrite(fo);
　　　　　writeln(fo,step);
　　　　　inc(qs); q[qs]:=now;
　　　　　last[qs]:=nowlast; id[qs]:=nowid;
　　　　　out;
　　　　　close(fo);
　　　　　halt;
　　　　end;
　　　i:=now and base;
　　　if hash[i]=0 then
　　　　begin
　　　　　inc(qs); q[qs]:=now;
　　　　　last[qs]:=nowlast; id[qs]:=nowid;
　　　　　hash[i]:=qs;
　　　　end
　　　else
　　　　begin
　　　　　i:=hash[i];
　　　　　while next[i]<>0 do
　　　　　　begin
　　　　　　　if q[i]=now then exit;
　　　　　　　i:=next[i];
　　　　　　end;
　　　　　if q[i]=now then exit;
　　　　　inc(qs); q[qs]:=now;
　　　　　next[i]:=qs;
　　　　　last[qs]:=nowlast; id[qs]:=nowid;
　　　　end;
　　end;

　　begin
　　　init;
　　　bit[1]:=1;
　　　for i:=2 to 19 do
　　　　bit[i]:=bit[i-1]*3;
　　　start:=0; target:=0;
　　　for i:=1 to 19 do
　　　　begin
　　　　　start:=start+s[i]*bit[i];
　　　　　target:=target+t[i]*bit[i];
　　　　end;
　　　r:=0; qs:=0; step:=0;
　　　insert(start);
　　　repeat
　　　　l:=r+1; r:=qs;
　　　　inc(step);
　　　　for i:=l to r do
　　　　　for j:=1 to 7 do
　　　　　　begin
　　　　　　　k:=change(q[i],j,1);
　　　　　　　nowlast:=i; nowid:=j;
　　　　　　　insert(k);
　　　　　　　k:=change(q[i],j,-1);
　　　　　　　nowlast:=i; nowid:=-j;
　　　　　　　insert(k);
　　　　　　end;
　　　until qs=r;
　　end.

　　　　　　　　　　　　　　　　　　　　　　相关链接：浅谈竞赛中哈希表的应用（一）
　　　　　　　　　　　　　　　　　　　　　　　　　　　浅谈竞赛中哈希表的应用（二）
　　　　　　　　　　　　　　　　　　　　　　　　　　　浅谈竞赛中哈希表的应用（三）
　　　　　　　　　　　　　　　　　　　　　　　　　　　浅谈竞赛中哈希表的应用（四）
　　　　　　　　　　　　　　　　　　　　　　　　　　　浅谈竞赛中哈希表的应用（五）
　　　　　　　　　　　　　　　　　　　　　　　　　　　浅谈竞赛中哈希表的应用（六）
　　　　　　　　　　　　　　　　　　　　　　　　　　　浅谈竞赛中哈希表的应用（七）