比赛 NOIP2008集训模拟1 评测结果 EEEEEEEEEE
题目名称 血色叛徒 最终得分 0
用户昵称 zhai 运行时间 0.000 s
代码语言 Pascal 内存使用 0.00 MiB
提交时间 2008-11-10 09:02:32
显示代码纯文本
program crusade;
  const
    max=500;
  type
    sz=array[1..max,1..max]of integer;
    sx=array[1..2,1..max*max]of integer;
  var
    f1,f2:text;
    n,m:integer;
    sa,sb:integer;
    a,b:sx;
    t:longint;
    c:sz;
    procedure ini;
      var
        i:longint;
      begin
        assign(f1,'crusade.in');reset(f1);
        assign(f2,'crusade.out');rewrite(f2);
        fillchar(a,sizeof(a),0);
        fillchar(b,sizeof(b),0);
        readln(f1,n,m,sa,sb);
        for i:=1 to sa do readln(f1,a[1,i],a[2,i]);
        for i:=1 to sb do readln(f1,b[1,i],b[2,i]);
        close(f1);
        fillchar(c,sizeof(c),0);
        t:=sa;
      end;
    function pan:boolean;
      var
        i:integer;
      begin
        pan:=false;
        i:=1;
        while (pan=false)and(i<=sb)do begin
          if c[b[1,i],b[2,i]]=0 then pan:=true;
          inc(i);
        end;
      end;
    procedure main;
      var
        i:integer;
      begin
        while pan do begin
          for i:=1 to sa do begin
            if (a[1,i]+1<=n)and(c[a[1,i]+1,a[2,i]]=0) then begin
              c[a[1,i]+1,a[2,i]]:=c[a[1,i],a[2,i]]+1;
              inc(t);
              a[1,t]:=a[1,i]+1;a[2,t] :=a[2,i];
            end;
            if (a[1,i]-1>=1)and(c[a[1,i]-1,a[2,i]]=0) then begin
              c[a[1,i]-1,a[2,i]]:=c[a[1,i],a[2,i]]+1;
              inc(t);
              a[1,t]:=a[1,i]-1;a[2,t]:=a[2,i];
            end;
            if (a[2,i]+1<=m)and(c[a[1,i],a[2,i]+1]=0) then begin
              c[a[1,i],a[2,i]+1]:=c[a[1,i],a[2,i]]+1;
              inc(t);
              a[1,t]:=a[1,i];a[2,t]:=a[2,i]+1;
            end;
            if (a[2,i]-1>=1)and(c[a[1,i],a[2,i]-1]=0) then begin
              c[a[1,i],a[2,i]-1]:=c[a[1,i],a[2,i]]+1;
              inc(t);
              a[1,t]:=a[1,i];a[2,t]:=a[2,i];
            end;
          end;
          sa:=t;
        end;
      end;
    procedure pr;
      var
        i:longint;
      begin
        for i:=1 to sb do writeln(f2,c[b[1,i],b[2,i]]);
      end;
  begin
    ini;
    main;
    pr;
    close(f2);
  end.