Теоретический материал
{$A8,B-,C+,D-,E-,F-,G+,H+,I-,J-,K-,L-,M-,N+,O+,P+,Q-,R-,S-,T-,U-,V+,W-,X+,Y+,Z1}
//{$A8,B-,C+,D+,E-,F-,G+,H+,I+,J-,K-,L+,M-,N+,O-,P+,Q+,R+,S+,T-,U-,V+,W-,X+,Y+,Z1}
{$MAXSTACKSIZE 30000000}
program Fur;
{$APPTYPE CONSOLE}
uses
SysUtils;
type
int=longint;
real=extended;
bool=boolean;
TEl=record
first:int;
i,j:int;
link:array['a'..'z']of int;
end;
const
in_f='fur.in';
out_f='fur.out';
maxN=1000+5;
maxL=2000+5;
maxK=10+5;
max=2*maxN;
var
N:int;
a:array[1..maxN] of string;
k:int;
need:array[1..maxK] of int;
g:array[1..maxN,1..maxN] of int;
way:array[1..maxN,1..maxN] of string[2];
inf:int;
bor:array[0..max] of TEl;
uk:int;
d,link:array[1..maxN] of int;
ok:array[1..maxN] of bool;
procedure WriteAns(aa,bb:int);
var
i,min:int;
procedure WriteS(i,j:int);
var
t:int;
begin
if way[i,j][1]='!' then
begin
if way[i,j][2]='u' then
Writeln('up')
else
Writeln('down');
end
else
begin
Writeln('Alt');
for t := 1 to g[i,j]-1 do
Writeln(a[j][t]);
end;
end;
procedure WriteIt(i:int);
begin
if link[i]<>0 then
begin
WriteIt(link[i]);
WriteS(link[i],i);
end;
end;
begin
for i:= 1 to N do
d[i]:=inf;
fillchar(ok,sizeof(ok),0);
fillchar(link,sizeof(link),0);
d[aa]:=0;
min:=aa;
while min<>bb do
begin
for i := 1 to N do
if d[i]>g[min,i]+d[min] then
begin
d[i]:=g[min,i]+d[min];
link[i]:=min;
end;
ok[min]:=true;
for i:= 1 to N Do
if not ok[i] then
min:=i;
for i:= 1 to N do
if not ok[i] and (d[i]<d[min]) then
min:=i;
end;
Writeln(d[bb]);
WriteIt(bb);
end;
procedure Add(j:int);
var
cur,t,x:int;
begin
cur:=0;
t:=1;
while t<=length(a[j]) do
begin
if bor[cur].link[a[j][t]]=0 then
begin
inc(uk);
fillchar(bor[uk],sizeof(bor[uk]),0);
bor[cur].link[a[j][t]]:=uk;
bor[cur].first:=j;
bor[uk].first:=j;
bor[uk].i:=t;
bor[uk].j:=length(a[j]);
BReak;
end
else
begin
bor[cur].first:=j;
cur:=bor[cur].link[a[j][t]];
x:=bor[cur].i;
while (x<=bor[cur].j) and (x<=length(a[j])) and (a[j][x]=a[bor[cur].first][x]) do
inc(x);
dec(x);
if x<>bor[cur].j then
begin
inc(uk);
fillchar(bor[uk],sizeof(bor[uk]),0);
bor[uk].first:=bor[cur].first;
bor[uk].i:=x+1;
bor[uk].j:=bor[cur].j;
bor[uk].link:=bor[cur].link;
bor[cur].first:=j;
bor[cur].j:=x;
fillchar(bor[cur].link,sizeof(bor[cur].link),0);
bor[cur].link[a[bor[uk].first][x+1]]:=uk;
if x<>length(a[j]) then
begin
inc(uk);
fillchar(bor[uk],sizeof(bor[uk]),0);
bor[uk].first:=j;
bor[uk].i:=x+1;
bor[uk].j:=length(a[j]);
bor[cur].link[a[bor[uk].first][x+1]]:=uk;
end;
Break;
end
else
begin
t:=x+1;
bor[cur].first:=j;
end;
end;
end;
end;
procedure Run;
var
i,j,cur:int;
procedure Dfs(cur:int);
var
lp:char;
begin
if cur<>0 then
begin
if g[i,bor[cur].first]>bor[cur].i+1 then
begin
g[i,bor[cur].first]:=bor[cur].i+1;
way[i,bor[cur].first]:='-';
end;
end;
for lp:= 'a' to 'z' do
if bor[cur].link[lp]<>0 then
dfs(bor[cur].link[lp]{,ans});
end;
begin
Readln(n);
for i:= 1 to N do
readln(a[i]);
Read(K);
for i := 1 to K do
Read(need[i]);
inf:=N+10;
for i:= 1 to N do
for j := 1 to N do
g[i,j]:=inf;
for i := 1 to N do
begin
g[i,i mod N+1]:=1;
way[i,i mod N+1]:='!d';
g[i mod N+1,i]:=1;
way[i mod N+1,i]:='!u';
end;
for i:= 1 to N do
begin
g[i,i]:=0;
way[i,i]:='';
end;
uk:=0;
fillchar(bor[0],sizeof(bor[0]),0);
bor[0].j:=-1;
for j := N downto 1 do
Add(j);
for i := N downto 1 do
begin
Add(i);
Dfs(0{,''});
end;
{
for i:= 1 to N Do
begin
for j := 1 to N do
Write(g[i,j],' ',way[i,j], ' ');
Writeln;
end;
}
cur:=1;
for i := 1 to k do
begin
WriteAns(cur,need[i]);
cur:=need[i];
end;
end;
procedure OpenFiles;
begin
Reset(input,in_f);
Rewrite(output,out_f);
end;
procedure CloseFiles;
begin
Close(input);
Close(output);
end;
begin
OPenFiles;
Run;
CLoseFiles;
end.