记录编号 4319 评测结果 AAAAA
题目名称 画海岛地图 最终得分 100
用户昵称 GravatarEnAsn 是否通过 通过
代码语言 Pascal 运行时间 0.984 s
提交时间 2008-10-17 13:19:43 内存使用 0.11 MiB
显示代码纯文本
program ex;
type
 ss=array[1..10,0..10]of integer;
 sz=array[1..10,1..10]of char;
var
 a:sz;
 hang,lie,b:ss;
 f1,f2:text;
 n,tot:integer;
procedure init;
 var
  i,j,x,t:integer;
 begin
  assign(f1,'island.in');
  assign(f2,'island.out');
  reset(f1);
  rewrite(f2);
  readln(f1,n);
  x:=0;
  for i:=1 to n do
   begin
    j:=0;
    read(f1,x);
    while x<>0 do
     begin
      inc(j);
      hang[i,j]:=x;
      read(f1,x);
     end;
    hang[i,0]:=j;
   end;
  x:=0;
  for i:=1 to n do
   begin
    j:=0;
    read(f1,x);
    while x<>0 do
     begin
      inc(j);
      lie[i,j]:=x;
      read(f1,x);
     end;
    lie[i,0]:=j;
   end;
  for i:=1 to n do
   begin
    t:=n;
    for j:=hang[i,0] downto 1 do
     begin
      b[i,j]:=t;
      t:=t-hang[i,j]+1;
     end;
   end;
   for i:=1 to n do
    for j:=1 to n do a[i,j]:=' ';
 end;

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

function f(a:sz):boolean;
 var
  c:ss;
  i,j,m:integer;
  p,q:integer;
 begin
  fillchar(c,sizeof(c),0);
  for j:=1 to n do
   begin
    q:=0;p:=0;m:=1;
    while (a[m,j]=' ')and(m<=n) do inc(m);
    for i:=m to n do
     begin
      if a[i,j]='*'
         then inc(p);
      if (a[i,j]=' ')and(p<>0)or(i=n) then
            begin
             inc(q);
             c[j,q]:=p;
             p:=0;
            end;
     end;
   end;
  f:=true;
  for i:=1 to n do
    for j:=1 to lie[i,0] do
      begin
       if c[i,j]<>lie[i,j]
        then begin
              f:=false;
              exit;
             end;
      end;
   { for i:=1 to n do
   begin
    for j:=1 to n do
     write(f2,c[i,j],' ');
   writeln(f2);
   end;
  writeln(f2);}
 end;
procedure try(x,k,i:integer);
 var
  m,j:integer;
  x1,k1,i1:integer;
 begin
  if k-1=n then begin
   if f(a)=true then
    begin
     inc(tot);
     print;
   end;
   exit;
  end;
  for m:=x to b[k,i] do
   begin
    for j:=m to m+hang[k,i]-1 do  a[k,j]:='*';
    k1:=k;
    x1:=m+hang[k,i]+1;
    i1:=i+1;
    if i=hang[k,0] then
     begin
      k1:=k+1;
      x1:=1;
      i1:=1;
     end;
    try(x1,k1,i1);
    for j:=m to m+hang[k,i]-1 do a[k,j]:=' ';
   end;
 end;
begin
 init;
 try(1,1,1);
 if tot=0 then writeln(f2,'no');
 close(f2);
end.