Cod sursa(job #1026105)

Utilizator hungntnktpHungntnktp hungntnktp Data 11 noiembrie 2013 09:03:51
Problema Struti Scor 80
Compilator fpc Status done
Runda Arhiva de probleme Marime 3.41 kb
Program rec;
Const   finp='struti.in';
        fout='struti.out';
Var     fi,fo:text;
        m,n,p,dx,dy,ix,smin,res,top,bot  :longint;
        a,mind,maxd,minxy,maxxy :array[0..1000,0..1000] of longint;
        q  :array[1..1000] of longint;

Procedure enter;
        var i,j  :longint;
        begin
                read(fi,m,n,p);
                for i:=1 to m do
                    for j:=1 to n do read(fi,a[i,j]);
        end;

Procedure push(x:longint);
        begin
                inc(top);q[top]:=x;
        end;

Procedure process;
        var i,j,k :longint;
        begin
                k:=dx;
                for j:=1 to n do
                    begin
                        bot:=1;top:=0;
                        for i:=1 to m do
                            begin
                                while (top>=bot)and(a[q[top],j]>=a[i,j]) do dec(top);
                                push(i);
                                while q[bot]+k<=i do inc(bot);
                                mind[i,j]:=a[q[bot],j];
                            end;
                    end;
                for j:=1 to n do
                    begin
                        bot:=1;top:=0;
                        for i:=1 to m do
                            begin
                                while (top>=bot)and(a[q[top],j]<=a[i,j]) do dec(top);
                                push(i);
                                while q[bot]+k<=i do inc(bot);
                                maxd[i,j]:=a[q[bot],j];
                            end;
                    end;
                k:=dy;
                for i:=dx to m do
                  begin
                    bot:=1;top:=0;
                    for j:=1 to n do
                       begin
                         while (top>=bot)and(mind[i,q[top]]>=mind[i,j]) do dec(top);
                         push(j);
                         while q[bot]+k<=j do inc(bot);
                         minxy[i,j]:=mind[i,q[bot]];
                       end;
                  end;
                for i:=dx to m do
                  begin
                    bot:=1;top:=0;
                    for j:=1 to n do
                      begin
                        while (top>=bot)and(maxd[i,q[top]]<=maxd[i,j]) do dec(top);
                        push(j);
                        while q[bot]+k<=j do inc(bot);
                        maxxy[i,j]:=maxd[i,q[bot]];
                      end;
                  end;
                for i:=dx to m do
                    for j:=dy to n do
                        if maxxy[i,j]-minxy[i,j]<smin then
                           begin smin:=maxxy[i,j]-minxy[i,j];
                                 res:=1;
                           end
                        else if maxxy[i,j]-minxy[i,j]=smin then inc(res);
        end;

Procedure  swap(var x,y:longint);
        var tg:longint;
        begin
                tg:=x;x:=y;y:=tg;
        end;

Procedure result;
        begin
                writeln(fo,smin,' ',res);
        end;

BEGIN
        assign(fi,finp);reset(fi);
        assign(fo,fout);rewrite(fo);
        enter;
        for ix:=1 to p do
            begin
                read(fi,dx,dy);
                smin:=10000;res:=0;
                process;
                if dx<>dy then begin swap(dx,dy); process; end;
                result;
            end;
        close(fi);close(fo);
END.