记录编号 4274 评测结果 AAAAA
题目名称 画海岛地图 最终得分 100
用户昵称 Gravatarzpl123 是否通过 通过
代码语言 Pascal 运行时间 0.002 s
提交时间 2008-10-15 22:21:10 内存使用 0.11 MiB
显示代码纯文本
program island;
type
map=array[1..8,1..8] of integer;
dz=array[1..8,0..8] of integer;
limit=array[1..8,1..8] of integer;
var
n:integer;
tot:integer;
ans:map;
hdz,ldz,lldz:dz;
hlimit:limit;

procedure ini;
var
i,j,x,k:integer;
begin
assign(input,'island.in');
reset(input);
assign(output,'island.out');
rewrite(output);
readln(n);

fillchar(hdz,sizeof(hdz),0);
fillchar(ldz,sizeof(ldz),0);
fillchar(hlimit,sizeof(hlimit),0);
fillchar(ans,sizeof(ans),0);
fillchar(lldz,sizeof(lldz),0);
tot:=0;

for i:=1 to n do
 begin
 read(x);
 j:=0;
 while x<>0 do
  begin
  inc(j);
  hdz[i,j]:=x;
  read(x);
  end;
 hdz[i,0]:=j;
 readln;
 end;

for i:=1 to n do
 begin
 read(x);
 j:=0;
 while x<>0 do
  begin
  inc(j);
  ldz[i,j]:=x;
  read(x);
  end;
 ldz[i,0]:=j;
 readln;
 end;

for i:=1 to n do
 begin
 k:=n;
 for j:=hdz[i,0] downto 1 do
  begin
  hlimit[i,j]:=k-hdz[i,j]+1;
  k:=hlimit[i,j]+2;
  end;
 end;

end;{ini}

function pd(x,y,q:integer; var ans:map; var lldz:dz):boolean;
var
i,j,k:integer;
ans1:map;
lldz1:dz;
begin
pd:=true;
k:=hdz[x,q];
if x=1 then
 for i:=y to y+k-1 do
  begin
  inc(lldz[i,0]);
  inc(lldz[i,1]);
  inc(ans[x,i]);
  end
 else
 begin
 ans1:=ans;
 lldz1:=lldz;
 for i:=y to y+k-1 do
  begin
  inc(ans[x,i]);
  if ans[x-1,i]=0 then inc(lldz[i,0]);
  j:=lldz[i,0];
  if j>ldz[i,0] then begin
                     pd:=false;
                     ans:=ans1;
                     lldz:=lldz1;
                     exit;
                     end;
  inc(lldz[i,j]);
  if lldz[i,j]>ldz[i,j] then begin
                             pd:=false;
                             ans:=ans1;
                             lldz:=lldz1;
                             exit;
                             end;
  end;
 end;
end;


procedure print(ans:map);
var
i,j:integer;
begin
inc(tot);
writeln(tot);
for i:=1 to n do
 begin
 for j:=1 to n do
 if ans[i,j]=0 then write(' ') else write('*');
 writeln;
 end;
end;


procedure main(x,y,q:integer; ans:map; lldz:dz);
var
x1,i,j,k:integer;
ans1:map;
lldz1:dz;
begin
for i:=y to hlimit[x,q] do
 begin
 ans1:=ans;
 lldz1:=lldz;
 if pd(x,i,q,ans1,lldz1) then
  begin
  k:=q+1;
  j:=i+hdz[x,q]+1;
  x1:=x;
  if k>hdz[x,0] then
   begin
   inc(x1);
   k:=1;
   j:=1;
   end;
  if x1>n then print(ans1)
          else main(x1,j,k,ans1,lldz1);
  end;
 end;{for i}
end;



begin
ini;
main(1,1,1,ans,lldz);
if tot=0 then writeln('no');
close(output);
end.