记录编号 6152 评测结果 AAAAA
题目名称 画海岛地图 最终得分 100
用户昵称 Gravatarname:弓虽 是否通过 通过
代码语言 Pascal 运行时间 0.127 s
提交时间 2008-10-30 20:51:03 内存使用 0.12 MiB
显示代码纯文本
program island;
  var
    n                           :longint;
    i,j,ji                      :longint;
    h,l                         :array[0..10,0..10] of longint;
    a                           :array[0..10,0..10] of longint;
    jl                          :array[0..10,0..10] of longint;
    f1,f2                       :text;
   procedure int;    {          begin int             }
     begin
       assign(f1,'island.in');
       reset(f1);
       assign(f2,'island.out');
       rewrite(f2);
       fillchar(a,sizeof(a),0);
       fillchar(h,sizeof(h),0);
       fillchar(l,sizeof(l),0);
       fillchar(jl,sizeof(jl),0);
       readln(f1,n);
       ji:=0;
       for i:=1 to n  do
         begin
           h[i,0]:=1;
           read(f1,h[i,h[i,0]]);
           while h[i,h[i,0]]<>0 do
             begin
               inc(h[i,0]);
               read(f1,h[i,h[i,0]]);
             end;
           readln(f1);
         end;
       for i:=1 to n do
         begin
           l[i,0]:=1;
           read(f1,l[i,l[i,0]]);
           while l[i,l[i,0]]<>0 do
             begin
               inc(l[i,0]);
               read(f1,l[i,l[i,0]]);
             end;
           readln(f1);
         end;
    end;      {         int end         }
  procedure chu;
    var
      o,p                       :longint;
    begin
       for i:=1 to n do
         begin
         o:=1;
           while h[i,o]<>0 do
             begin
               p:=o+1;
               while h[i,p]<>0 do
                 begin
                   jl[i,o]:=jl[i,o]+h[i,p]+1;
                   inc(p);
                 end;
               jl[i,o]:=n-jl[i,o];
               inc(o);
             end;
           jl[i,o-1]:=n-h[i,o-1]+1;
         end;
    end;      {   end chu   }
  procedure print;
    var
      i,j                       :longint;
  begin
    inc(ji);
    writeln(f2,ji);
    if ji<=4 then
    for i:=1 to n do
      begin
        for j:=1 to n do
          if a[i,j]=1 then
            write(f2,'*')
          else
            write(f2,' ');
        writeln(f2);
      end;
  end;                   {    end print   }
  procedure cha;
    var
    i,j,ss,dao,ll                :longint;
  begin
    for i:=1 to n do
      begin
        dao:=1;
        ss:=0;
        for j:=1 to n do
          begin
            if l[i,dao]=0 then
              begin
                for ll:=j to n do
                  if a[j,i]=1 then
                   exit;
                continue;
              end;
            if a[j,i]=1 then
              begin
                if  (a[j+1,i]=1) then
                  begin
                  inc(ss);
                  if ss>l[i,dao] then
                    exit;
                  end
                else
                  begin
                    inc(ss);
                    if ss>l[i,dao] then
                      exit;
                    if ss=l[i,dao] then
                      inc(dao)
                    else
                      exit;
                  end;
              end
            else
              ss:=0;
          end;           {  for j  }
      end;          {  for i  }
      print;
  end;         {   end cha   }


  procedure zhao(hx,gx,wei:longint);
    var
      m,l1                       :longint;
    begin
      if hx > n then
        cha
      else
        begin
          if h[hx,gx]<> 0 then
            begin
              for m:=wei to jl[hx,gx] do
                begin
                  for l1:=m to m+h[hx,gx]-1 do
                    a[hx,l1]:=1;
                    zhao(hx,gx+1,m+h[hx,gx]+1);
                  for l1:=m to m+h[hx,gx]-1 do
                    a[hx,l1]:=0;
                end;
            end
          else
            zhao(hx+1,1,1);
        end;
    end;
  begin                       {  main  }
    int;
    chu;
    zhao(1,1,1);
    if ji=0 then
      writeln(f2,'no');
   close(f2);
   close(f1);
  end.