记录编号 4252 评测结果 AAAAA
题目名称 画海岛地图 最终得分 100
用户昵称 Gravatarrottenwood 是否通过 通过
代码语言 Pascal 运行时间 0.437 s
提交时间 2008-10-15 21:11:25 内存使用 0.11 MiB
显示代码纯文本
program island;
type
shuzu=array[1..9,0..9] of integer;
shuzu1=array[1..9,1..9] of char;
var
fl,fh:shuzu;
ans:shuzu1;
i,j,k,m,n,temp,c:longint;
f1,f2:text;
procedure print;
  var
  i,j:longint;
  begin
   writeln(f2,c);
   for i:=1 to n do
   begin
   for j:=1 to n do
      write(f2,ans[i,j]);
      writeln(f2);
      end;
      end;
function pd(ans:shuzu1):boolean;
   var
   i,j,temp:longint;
   s:array[0..8] of integer;
   begin
   for i:=1 to n do
     begin
      j:=1;
      fillchar(s,sizeof(s),0);
    while (j<=n) do
     begin
     if (ans[j,i]='*')and(j=1)or(ans[j,i]='*')and(ans[j-1,i]=' ') then
     begin inc(s[0]); inc(s[s[0]]); end;
     if (ans[j,i]='*')and(j<>1)and(ans[j-1,i]='*') then
     inc(s[s[0]]);
     inc(j);
     end;
     for k:=1 to s[0] do
      if (s[0]<>fl[i,0])or(fl[i,k]<>s[k]) then   begin
      pd:=false;
      exit;  end;
      end;
     pd:=true;
      end;
procedure search(i,j,k:longint);
   var
   x,y,p,q,r,v:longint;
   begin
    if i<=n then
       begin
       for x:=j to n-fh[i,fh[i,0]]+1 do
         begin
          for y:=x to fh[i,k]+x-1 do
              ans[i,y]:='*';
              p:=i; q:=y+2; r:=k+1;
          if k=fh[i,0] then begin p:=i+1; q:=1; r:=1; end;
             search(p,q,r);
          for y:=x to fh[i,k]+x-1 do ans[i,y]:=' ';
         end;
       end
       else begin if pd(ans) then begin c:=c+1;print;  end;
            exit;
            end;
            end;
begin
assign(f1,'island.in');reset(f1);
assign(f2,'island.out');rewrite(f2);
readln(f1,n);
c:=0;
for i:=1 to n do
 begin
  fh[i,0]:=0; fl[i,0]:=0;
  read(f1,temp); j:=0;
  while temp<>0 do begin
     inc(fh[i,0]);
     inc(j);
     fh[i,j]:=temp;
     read(f1,temp);
     end;
 readln(f1);
 end;
for i:=1 to n do
 begin
  read(f1,temp); j:=0;
  while temp<>0 do begin
     inc(fl[i,0]);
     inc(j);
     fl[i,j]:=temp;
     read(f1,temp);
     end;
  readln(f1);
 end;
close(f1);
for i:=1 to n do
  for j:=1 to n do
   ans[i,j]:=' ';
search(1,1,1);
if c=0 then writeln(f2,'no');
close(f2);
end.