以下是我编的：
{==================================program===================================}
program NoipG3;
var
n :string;
i,j,k,l,t,total :byte;
a,c :array [1..30] of byte;
b :array [0..9] of 1..10;
x,y :array [1..15] of 0..9;
ok,flag :boolean;
d :array [0..9] of boolean;
procedure Inset;
begin
fillchar(c,sizeof(c),0);
c[1]:=1;
write('N= ');
readln(n);
for i:=1 to length(n) do
a:=ord(n)-48;
write('K= ');
readln(k);
for i:=1 to k do
readln(x,y);
end;
procedure Try(temp :byte);
var
j :byte;
begin
for j:=1 to k do
begin
t:=y[j];
if d[t] then
flag:=true
else
flag:=false;
if (x[j]=temp) and flag then
begin
d[t]:=false;
Try(y[j]);
inc(total);
d[t]:=true;
end;
end;
end;
procedure Main;
begin
for i:=0 to 9 do
begin
fillchar(d,sizeof(d),true);
d:=false;
total:=1;
Try(i);
b:=total;
end;
for i:=length(n) downto 1 do
begin
t:=a;
if b[t]=10 then
begin
for j:=29 downto 1 do
c[j+1]:=c[j];
c[1]:=0;
end
else
begin
for j:=1 to 29 do
c[j]:=c[j]*b[t];
for j:=1 to 29 do
if c[j]>=10 then
begin
c[j+1]:=c[j+1]+c[j] div 10;
c[j]:=c[j] mod 10;
end;
end;
end;
end;
procedure Outset;
begin
ok:=false;
for i:=30 downto 1 do
begin
if c<>0 then ok:=true;
if ok then write(c);
end;
writeln;
end;
begin
Inset;
Main;
Outset;
end.
{==================================program===================================} |
注册
趣题之家 → 信息学竞赛 → 算法艺术 → [推荐]做一道题
2004-11-11 22:05
