比赛 NOIP2008集训模拟1 评测结果 ATAAAATTTT
题目名称 血色叛徒 最终得分 50
用户昵称 NOIer 运行时间 0.000 s
代码语言 Pascal 内存使用 0.00 MiB
提交时间 2008-11-10 11:23:33
显示代码纯文本
program crusade;
  const
    fx                          :array[1..4,1..2] of longint=((1,0),(-1,0),(0,1),(0,-1));
    max                         =600;
  type
    sss                         =record
                          x,y,f:longint
  end;
  var
    n,m,a,b                     :longint;
    jia,jib                     :array[1..max*max,1..2] of longint;
    map,ji                      :array[0..max,0..max] of longint;
    f1,f2                       :text;
  procedure init;
    var
      i                         :longint;
  begin
    assign(f1,'crusade.in');
    reset(f1);
    assign(f2,'crusade.out');
    rewrite(f2);
    filldword(map,sizeof(map) div 4,maxlongint);
    readln(f1,n,m,a,b);
    for i:=1 to a do
      readln(f1,jia[i,1],jia[i,2]);
    for i:=1 to b do
      readln(f1,jib[i,1],jib[i,2]);
  end;
  procedure sousuo(k:longint);
    var
      g                         :array[1..max*max] of sss;
      tou,wei                   :longint;
      i,j                       :longint;
  begin
//    fillchar(ji,sizeof(ji),0);
    for i:=0 to max do
      for j:=0 to max do
        ji[i,j]:=0;
    tou:=1;
    wei:=1;
    g[tou].x:=jia[k,1];
    g[tou].y:=jia[k,2];
    g[tou].f:=0;
    map[g[tou].x,g[tou].y]:=0;
    ji[g[tou].x,g[tou].y]:=0;
    repeat
      for i:=1 to 4 do
        if (ji[g[tou].x+fx[i,1],g[tou].y+fx[i,2]]=0) and (g[tou].x+fx[i,1]>=1) and (g[tou].x+fx[i,1]<=n) and (g[tou].y+fx[i,2]>=1) and (g[tou].y+fx[i,2]<=m) then
        begin
          inc(wei);
          g[wei].x:=g[tou].x+fx[i,1];
          g[wei].y:=g[tou].y+fx[i,2];
          g[wei].f:=g[tou].f+1;
          ji[g[wei].x,g[wei].y]:=1;
          if map[g[wei].x,g[wei].y]>g[wei].f then
            map[g[wei].x,g[wei].y]:=g[wei].f;
        end;
      inc(tou);
    until tou>wei;
  end;
  procedure main;
    var
      i                         :longint;
  begin
    for i:=1 to a do
      sousuo(i);
  end;
  procedure print;
    var
      i                         :longint;
  begin
    for i:=1 to b do
      writeln(f2,map[jib[i,1],jib[i,2]]);
    close(f1);
    close(f2);
  end;
  begin
    init;
    main;
    print;
  end.