比赛 NOIP_1 评测结果 AAAAA
题目名称 画海岛地图 最终得分 100
用户昵称 辨机ZN 运行时间 0.000 s
代码语言 Pascal 内存使用 0.00 MiB
提交时间 2009-07-20 11:07:16
显示代码纯文本
program ex(f1,f2);
 type
  zn=array [1..8,0..8] of integer;
  ha=array [0..8] of integer;
  ka=array [1..8,1..8] of boolean;
  fa=array [1..8] of boolean;
 var
   f1,f2:text;   map,map2:ka; maxl:ha;
  a,hang,lie,cl,ch,ml,ml2:zn; i,j,k,m,n,p,l,daan:integer;
 procedure init;
  var
   i,j,k,p:integer;
  begin
   for i:=1 to n do
    begin
     k:=1;
     hang[i,0]:=0;
     while k<>0 do
      begin
       read(f1,k);
       if k<>0 then
        begin
         inc(hang[i,0]);
         hang[i,hang[i,0]]:=k;
        end;
      end;
    end;

   for i:=1 to n do
    begin
     k:=1;
     lie[i,0]:=0;
     p:=0;
     while k<>0 do
      begin
       read(f1,k);
       if k>p then p:=k;
       if k<>0 then
        begin
         inc(lie[i,0]);
         lie[i,lie[i,0]]:=k;
        end;
      end;
     maxl[i]:=p;
    end;

   for i:=1 to n do
    begin
     k:=hang[i,0];
     ch[i,k]:=n-hang[i,k]+1;
     for j:=k-1 downto 1 do ch[i,j]:=ch[i,j+1]-hang[i,j]-1;
    end;
   for i:=1 to n do
    begin
     k:=lie[i,0];
     cl[i,k]:=n-lie[i,k]+1;
     for j:=k-1 downto 1 do cl[i,j]:=cl[i,j+1]-lie[i,j]-1;
    end;
  end;
 procedure panduan(map3:ka; liez:zn);
  var
   i,j,k:integer; flag:boolean;
  begin
   flag:=true;
   for i:=1 to n do
    begin
     for j:=1 to lie[i,0] do
      if lie[i,j]<>liez[i,j] then
       begin
        flag:=false;
        break;
       end;
    end;
   if flag then
    begin
     inc(daan);
     writeln(f2,daan);
     for i:=1 to n do
      begin
      for j:=1 to n do
       if map3[i,j] then write(f2,' ')
                    else write(f2,'*');
      writeln(f2);
      end;
     end;

     end;



 procedure search(x,y,q:integer; map2:ka; ml2:zn);
  var
   i,j,k,p,m:integer;  flag5:boolean;
  begin
     for j:=y to ch[x,q] do
      begin
       flag5:=true;
       for k:=j to j+hang[x,q]-1 do
       begin
       map2[x,k]:=false;
       if x=1 then
               begin
                inc(ml2[k,0]);
                ml2[k,ml2[k,0]]:=1;
                if (ml2[k,0]>lie[k,0])or(ml2[k,ml2[k,0]]>maxl[k])
                  then
                   begin
                   ml2[k,ml2[k,0]]:=0;
                   dec(ml2[k,0]);
                   map2[x,k]:=true;
                   flag5:=false;
                   break;
                   end;
               end
              else
               begin
                if map2[x-1,k]=true then
                 begin
                 inc(ml2[k,0]);
                 ml2[k,ml2[k,0]]:=1;
                 if (ml2[k,0]>lie[k,0])or(ml2[k,ml2[k,0]]>maxl[k])
                  then
                   begin
                   ml2[k,ml2[k,0]]:=0;
                   dec(ml2[k,0]);
                   map2[x,k]:=true;
                   flag5:=false;
                   break;
                   end;
                 end
                 else
                  begin
                   inc(ml2[k,ml2[k,0]]);
                   if (ml2[k,0]>lie[k,0])or(ml2[k,ml2[k,0]]>maxl[k])
                    then
                     begin
                     dec(ml2[k,ml2[k,0]]);{here}
                     map2[x,k]:=true;
                     flag5:=false;
                     break;
                     end;
                  end;
               end;
          end;
      if flag5 then
      begin
      if (x=n)and(q=hang[x,0]) then panduan(map2,ml2)
       else begin
       if q=hang[x,0] then search(x+1,1,1,map2,ml2)
                      else search(x,j+hang[x,q]+1,q+1,map2,ml2);
            end;
      end;
      for k:=j to j+hang[x,q]-1 do map2[x,k]:=true;
      if x=1 then for k:=1 to n do begin ml2[k,1]:=0; ml2[k,0]:=0; end
      else
      if flag5 then
      for k:=j to j+hang[x,q]-1 do
         begin
           if map2[x-1,k]=true then begin ml2[k,ml2[k,0]]:=0; dec(ml2[k,0]); end
                               else dec(ml2[k,ml2[k,0]]);
         end;
      end;
  end;





 begin
  assign(f1,'island.in'); reset(f1);
  assign(f2,'island.out'); rewrite(f2);
  readln(f1,n);
  daan:=0;
  init;
  for i:=1 to n do
   for j:=1 to n do
    begin
     ml[i,j]:=0;
     map[i,j]:=true;
    end;
  search(1,1,1,map,ml);
  if daan=0 then writeln(f2,'no');
  close(f1);
  close(f2);
 end.