Cod sursa(job #1026442)

Utilizator baolaptrinhbaolaptrinh baolaptrinh Data 11 noiembrie 2013 17:13:24
Problema Struti Scor 80
Compilator fpc Status done
Runda Arhiva de probleme Marime 5.84 kb
{$inline on}
Const
        oo=1000000000;
Type
        mat=array [1..1000,1..1000] of longint;
Var     a,b,c,d,g:mat;
        n,m,p,dai,rong,f,r,k,min1,sl1,min2,sl2,res,kq:longint;
        q,h:array [1..1000] of longint;
        fi,fo:text;

Procedure Doc;  inline;
        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(i:longint);  inline;
        Begin
                While (f<=r) and (h[i]<=h[q[r]]) do dec(r);
                inc(r);
                q[r]:=i;
                If q[f]=i-k then inc(f);
        end;

Procedure Day(i:longint);   inline;
        Begin
                While (f<=r) and (h[i]>=h[q[r]]) do dec(r);
                inc(r);
                q[r]:=i;
                If q[f]=i-k then inc(f);
        end;

Procedure Doicho(Var x,y:longint);     inline;
        Var tg:longint;
        Begin
                tg:=x;
                x:=y;
                y:=tg;
        end;

Procedure Progress;     inline;
        Var i,j:longint;
        Begin
                k:=dai;
                For i:=1 to m do
                 Begin
                        f:=1; r:=0;
                        For j:=1 to n do
                         Begin
                                h[j]:=a[i,j];
                                Push(j);
                                b[i,j]:=h[q[f]];
                         end;
                 end;
                k:=rong;
                For i:=1 to n do
                 Begin
                        f:=1; r:=0;
                        For j:=1 to m do
                         Begin
                                h[j]:=b[j,i];
                                Push(j);
                                c[j,i]:=h[q[f]];
                         end;
                 end;
                k:=dai;
                For i:=1 to m do
                 Begin
                        f:=1; r:=0;
                        For j:=1 to n do
                         Begin
                                h[j]:=a[i,j];
                                Day(j);
                                d[i,j]:=h[q[f]];
                         end;
                 end;
                k:=rong;
                For i:=1 to n do
                 Begin
                        f:=1; r:=0;
                        For j:=1 to m do
                         Begin
                                h[j]:=d[j,i];
                                Day(j);
                                g[j,i]:=h[q[f]];
                         end;
                 end;
                min1:=oo;
                sl1:=0;
                For i:=rong to m do
                 For j:=dai to n do
                  If g[i,j]-c[i,j]<min1 then
                   Begin
                        min1:=g[i,j]-c[i,j];
                        sl1:=1;
                   end
                  else If g[i,j]-c[i,j]=min1 then inc(sl1);
                res:=min1;
                kq:=sl1;
                If dai=rong then exit;
                Doicho(dai,rong);
               // Donmin;
                //Donmax;
                  k:=dai;
                For i:=1 to m do
                 Begin
                        f:=1; r:=0;
                        For j:=1 to n do
                         Begin
                                h[j]:=a[i,j];
                                Push(j);
                                b[i,j]:=h[q[f]];
                         end;
                 end;
                k:=rong;
                For i:=1 to n do
                 Begin
                        f:=1; r:=0;
                        For j:=1 to m do
                         Begin
                                h[j]:=b[j,i];
                                Push(j);
                                c[j,i]:=h[q[f]];
                         end;
                 end;
                k:=dai;
                For i:=1 to m do
                 Begin
                        f:=1; r:=0;
                        For j:=1 to n do
                         Begin
                                h[j]:=a[i,j];
                                Day(j);
                                d[i,j]:=h[q[f]];
                         end;
                 end;
                k:=rong;
                For i:=1 to n do
                 Begin
                        f:=1; r:=0;
                        For j:=1 to m do
                         Begin
                                h[j]:=d[j,i];
                                Day(j);
                                g[j,i]:=h[q[f]];
                         end;
                 end;
                min2:=oo;
                sl2:=0;
                For i:=rong to m do
                 For j:=dai to n do
                  If g[i,j]-c[i,j]<min2 then
                   Begin
                        min2:=g[i,j]-c[i,j];
                        sl2:=1;
                   end
                  else If g[i,j]-c[i,j]=min2 then inc(sl2);
                If res>min2 then
                 Begin
                        res:=min2;
                        kq:=sl2;
                 end
                else If res=min2 then kq:=kq+sl2;
        end;

Procedure Lam;     inline;
        Var j:longint;
        Begin
                For j:=1 to p do
                 Begin
                        Read(fi,dai,rong);
                        Progress;
                        Writeln(fo,res,' ',kq);
                 end;
        end;

Procedure Inkq;   inline;
        Begin
        end;

        Begin
                Assign(fi,'struti.in');Reset(fi);
                Assign(fo,'struti.out');Rewrite(fo);
                        Doc;
                        Lam;
                        Inkq;
                Close(fo);Close(fi);
        end.