记录编号 4159 评测结果 AAAAA
题目名称 画海岛地图 最终得分 100
用户昵称 Gravatar苏轼 是否通过 通过
代码语言 Pascal 运行时间 0.155 s
提交时间 2008-10-14 13:30:49 内存使用 0.11 MiB
显示代码纯文本
program cch(input,output);
type
 sz=array[1..10,1..10] of char;
var
 tot,n:integer;
 ans:sz;
 hang,lie,limit:array[1..10,0..10] of integer;

procedure init;
var
 i,x,j,tmp:integer;
begin
 assign(input,'island.in');
 assign(output,'island.out');
 reset(input);
 rewrite(output);
 readln(n);
 for i:=1 to n do
  begin
   hang[i,0]:=0;
   lie[i,0]:=0;
  end;
 for i:=1 to n do
  begin
   read(x);
   while x<>0 do
    begin
     inc(hang[i,0]);
     hang[i,hang[i,0]]:=x;
     read(x);
    end;
  end;
 for i:=1 to n do
  begin
   read(x);
   while x<>0 do
    begin
     inc(lie[i,0]);
     lie[i,lie[i,0]]:=x;
     read(x);
    end;
  end;
 for i:=1 to n do
  begin
   tmp:=n;
   for j:=hang[i,0] downto 1 do
    begin
     tmp:=tmp-hang[i,j]+1;
     limit[i,j]:=tmp;
     dec(tmp,2);
    end;
  end;
 for i:=1 to n do
  for j:=1 to n do ans[i,j]:=' ';
end;

{function check(ans:sz):boolean;
var
 i,j,q,ch:integer;
begin
 for i:=1 to n do
  begin
   q:=1; ch:=0;
   while q<=n do
    begin
     while (q<=n)and(ans[q,i]=' ') do inc(q);
     if (q>n)and(ch=lie[i,0]) then break;
     if (q>n)and(ch<>lie[i,0]) then exit(false);
     inc(ch);
     if ch>lie[i,0] then exit(false);
     for j:=1 to lie[i,ch] do
      begin
       if (ans[q,i]=' ')or(q>n) then exit(false);
       inc(q);
      end;
     if ans[q,i]<>' ' then exit(false);
    end;
  end;
 check:=true;
end;}

function check(ans:sz):boolean;
var
 i,q,ch,w:integer;
begin
 for i:=1 to n do
  begin
   q:=1; ch:=0;
   while q<=n do
    begin
     while (q<=n)and(ans[q,i]=' ') do inc(q);
     if q>n then break;
     w:=0;
     while (q<=n)and(ans[q,i]='*') do
      begin
       inc(w); inc(q);
      end;
     inc(ch);
     if lie[i,ch]<>w then exit(false);
    end;
   if ch<>lie[i,0] then exit(false);
  end;
 check:=true;
end;

procedure print;
var
 i,j:integer;
begin
 writeln(tot);
 for i:=1 to n do
  begin
   for j:=1 to n do
    write(ans[i,j]);
   writeln;
  end;
end;

procedure search(x,y,q:integer);
var
 i,x1,q1,j,y1,k,p:integer;
begin
 if (x=n+1) then
  begin
   if check(ans) then
    begin
     inc(tot);
     print;
    end;
   exit;
  end;
 for i:=y to limit[x,q] do
  begin
   for j:=i to hang[x,q]+i-1 do ans[x,j]:='*';
   x1:=x; q1:=q+1; y1:=i+2;
   if q=hang[x,0] then begin x1:=x+1; q1:=1; y1:=1; end;
   search(x1,y1,q1);
   for j:=i to hang[x,q]+i-1 do ans[x,j]:=' ';
  end;
end;

begin
 init;
 tot:=0;
 search(1,1,1);
 if tot=0 then writeln('no');
 close(input);
 close(output);
end.