?? track.pas
字號:
program track;
const yd1:string[5]=' A B ';
yd2:string[5]=' A C ';
yd3:string[5]=' A D ';
yd4:string[5]=' B C ';
yd5:string[5]=' B D ';
yd6:string[5]=' C D ';
type arr=array[1..26] of string[6];
var sa,sb,sc,sd:string;
so,s:arr;
n,lena,lenb,lenc:byte;
step,b,bs:word;
flag:boolean;
input,output:text;
procedure init;
begin
assign(input,'track.in'); reset(input);
readln(input,n); readln(input,sd); close(input);
sa:=copy('abcdefghijklmnopqrstuvwxyz',1,n);
sb:=copy(' ',1,n);
sc:=sb;
lena:=n; lenb:=0;lenc:=0; step:=65535; flag:=false;
end;
procedure work(i:byte);
var j,k,bstemp,atemp,btemp,ctemp:word;
m,t:longint;
satemp,sbtemp,sctemp:string;
a:array[1..25] of 0..1;
procedure check;
begin
if i=1 then
begin
flag:=true;
if bs<step then begin
step:=bs;
for b:=1 to bs do so[b]:=s[b];
end;
end
else work(i-1)
end;
begin
if pos(sd[i],sa)>0 then
begin
k:=pos(sd[i],sa);
if k<lena then
begin
bstemp:=bs; atemp:=lena;btemp:=lenb; ctemp:=lenc;
satemp:=sa;sbtemp:=sb;sctemp:=sc;
t:=1; for j:=k+1 to lena do t:=t*2;
while t>0 do
begin
t:=t-1; m:=t; j:=0;
bs:=bstemp;lena:=atemp;lenb:=btemp;lenc:=ctemp;
sa:=satemp;sb:=sbtemp;sc:=sctemp;
for j:=1 to lena-k do begin a[j]:=m mod 2; m:=m div 2;end;
for j:=1 to lena-k do
begin
inc(bs);
if a[j]=1 then begin
s[bs]:=sa[lena+1-j]+yd1;
inc(lenb); sb[lenb]:=sa[lena+1-j];
end
else
begin
s[bs]:=sa[lena+1-j]+yd2;
inc(lenc); sc[lenc]:=sa[lena+1-j];
end;
end; {for}
inc(bs);s[bs]:=sd[i]+yd3;
delete(sa,k,lena+1-k);lena:=k-1;
work(i-1);
end; {while t>0}
end {if k<lena}
else
begin
inc(bs);s[bs]:=sd[i]+yd3;
delete(sa,k,1);lena:=k-1;
check;
end
end {if pos(d[i],sa)>0}
else if pos(sd[i],sb)>0 then
begin
k:=pos(sd[i],sb);
for j:=lenb downto k+1 do
begin
inc(bs);s[bs]:=sb[j]+yd4;
inc(lenc);sc[lenc]:=sb[j];
end;
inc(bs);s[bs]:=sd[i]+yd5;
delete(sb,k,lenb+1-k);lenb:=k-1;
check;
end
else
if pos(sd[i],sc)=lenc then begin
inc(bs);s[bs]:=sd[i]+yd6;
delete(sc,lenc,1);
dec(lenc);
check;
end
else exit;
end;
procedure print;
begin
assign(output,'track.out');
rewrite(output);
if flag then for b:=1 to step do writeln(output,so[b])
else writeln(output,'NO');
close(output)
end;
begin {main}
init; work(n); print
end.
?? 快捷鍵說明
復(fù)制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -