Cod sursa(job #1026841)

Utilizator hungntnktpHungntnktp hungntnktp Data 12 noiembrie 2013 03:22:50
Problema Descompuneri Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 4.86 kb
USES math;
CONST
        tfi     ='struti.in';
        tfo     ='struti.out';
        nmax    =1000;
TYPE
        arr     =array [0..nmax,0..nmax] of longint;
        arr1    =array [1..nmax] of longint;
VAR
        fi,fo   :text;
        a,h1,h2,f1,f2:arr;
        dx,dy,st:arr1;
        n,m,p,top:longint;
 (***********************************************************************)
Procedure nhap;
      Var
        i,j     :longint;
      Begin
        assign(fi,tfi);reset(fi);
          read(fi,m,n,p);
          for i:=1 to m do
            for j:=1 to n do read(fi,a[i,j]);
          for i:=1 to p do read(fi,dx[i],dy[i]);
        close(fi);
      End;
 (***********************************************************************)
 Procedure push(x:longint);
      Begin
        inc(top);
        st[top]:=x;
      End;
 (***********************************************************************)
Procedure get(x,y:longint;var t1,t2:longint);
      Var
        i,j,t   :longint;
      Begin
        for i:=1 to m do
          for j:=1 to n do
            begin
              h1[i,j]:=0;
              h2[i,j]:=0;
              f1[i,j]:=0;
              f2[i,j]:=0;
            end;
        for j:=1 to n do
          begin
            top:=0;
            h1[1,j]:=a[1,j];push(1);
            for i:=2 to x do
              begin
                h1[i,j]:=max(h1[i-1,j],a[i,j]);
                while (top<>0) and (a[i,j]>=a[st[top],j]) do dec(top);
                push(i);
              end;
            t:=1;
            for i:=x+1 to m do
              begin
                while (top<>0) and (a[i,j]>=a[st[top],j]) do dec(top);
                push(i);
                if t>top then t:=top;
                if i-st[t]+1>x then inc(t);
                h1[i,j]:=a[st[t],j];
              end;
          end;
        for j:=1 to n do
          begin
            top:=0;
            h2[1,j]:=a[1,j];push(1);
            for i:=2 to x do
              begin
                h2[i,j]:=min(h2[i-1,j],a[i,j]);
                while (top<>0) and (a[i,j]<=a[st[top],j]) do dec(top);
                push(i);
              end;
            t:=1;
            for i:=x+1 to m do
              begin
                while (top<>0) and (a[i,j]<=a[st[top],j]) do dec(top);
                push(i);
                if t>top then t:=top;
                if i-st[t]+1>x then inc(t);
                h2[i,j]:=a[st[t],j];
              end;
          end;
        for i:=1 to m do
          begin
            top:=0;
            f1[i,1]:=h1[i,1];push(1);
            for j:=2 to y do
              begin
                f1[i,j]:=max(f1[i,j-1],h1[i,j]);
                while (top<>0) and (h1[i,j]>=h1[i,st[top]]) do dec(top);
                push(j);
              end;
            t:=1;
            for j:=y+1 to n do
              begin
                while (top<>0) and (h1[i,j]>=h1[i,st[top]]) do dec(top);
                push(j);
                if t>top then t:=top;
                if j-st[t]+1>y then inc(t);
                f1[i,j]:=h1[i,st[t]];
              end;
          end;
        for i:=1 to m do
          begin
            top:=0;
            f2[i,1]:=h2[i,1];push(1);
            for j:=2 to y do
              begin
                f2[i,j]:=min(f2[i,j-1],h2[i,j]);
                while (top<>0) and (h2[i,j]<=h2[i,st[top]]) do dec(top);
                push(j);
              end;
            t:=1;
            for j:=y+1 to n do
              begin
                while (top<>0) and (h2[i,j]<=h2[i,st[top]]) do dec(top);
                push(j);
                if t>top then t:=top;
                if j-st[t]+1>y then inc(t);
                f2[i,j]:=h2[i,st[t]];
              end;
          end;
        t1:=maxlongint;t2:=0;
        for i:=x to m do
          for j:=y to n do
            if f1[i,j]-f2[i,j]<t1 then
              begin
                t1:=f1[i,j]-f2[i,j];
                t2:=1;
              end
            else if f1[i,j]-f2[i,j]=t1 then inc(t2);
      End;
 (***********************************************************************)
Procedure lam;
      Var
        i,t1,t2,t3,t4 :longint;
      Begin
        for i:=1 to p do
          begin
            if dx[i]<>dy[i] then
              begin
                get(dx[i],dy[i],t1,t2);
                get(dy[i],dx[i],t3,t4);
                if t1=t3 then writeln(fo,t1,' ',t2+t4)
                else if t1<t3 then writeln(fo,t1,' ',t2)
                else writeln(fo,t3,' ',t4);
              end
            else
              begin
                get(dx[i],dy[i],t1,t2);
                writeln(fo,t1,' ',t2);
              end;
          end;
      End;
 (***********************************************************************)
BEGIn
        assign(fo,tfo);rewrite(fo);
          nhap;
          lam;
        close(fo);
END.