Cod sursa(job #1024912)

Utilizator hungntnktpHungntnktp hungntnktp Data 9 noiembrie 2013 12:20:37
Problema Struti Scor 10
Compilator fpc Status done
Runda Arhiva de probleme Marime 2.63 kb
program REC;
Uses math;
Const
        fi='struti.in';
        fo='struti.out';
Type
        bg=record
        ma,mi:longint;
        end;
Var     N,M,ans,i,x,y,p,q,k,exam,tg,kq,j,z,zz:longint;
        a:array[0..1010,0..1010] of longint;
        dd:array[0..8000] of longint;

        procedure inout;
        Var fin,fout:text;
        begin
                Assign(fin,fi);Reset(fin);
                Assign(fout,fo);Rewrite(fout);
                Readln(fin,N,M,P);
                For i:=1 to M do
                begin
                      For j:=1 to N do Read(fin,a[i,j]);
                      readln(fin);
                end;
                IF n<=300 then
                begin
                For i:=1 to P do
                begin
                        Readln(fin,x,y);
                        exam:=maxlongint;
                        Fillchar(dd,Sizeof(dd),0);
                        For k:=1 to M-x+1 do
                          For q:=1 to N-y+1 do
                          begin
                                ans:=-maxlongint;
                                kq:=maxlongint;
                                For z:=k to k+x-1 do
                                  For zz:=q to q+y-1 do
                                  begin
                                         IF a[z,zz]>ans then ans:=a[z,zz];
                                         IF a[z,zz]<kq then kq:=a[z,zz];
                                  end;
                                tg:=ans-kq;
                                inc(dd[tg]);
                                IF tg<exam then exam:=tg;
                          end;
                         IF x<>y then
                         begin
                         For k:=1 to M-y+1 do
                          For q:=1 to N-x+1 do
                          begin
                                ans:=-maxlongint;
                                kq:=maxlongint;
                                For z:=k to k+y-1 do
                                  For zz:=q to q+x-1 do
                                  begin
                                         IF a[z,zz]>ans then ans:=a[z,zz];
                                         IF a[z,zz]<kq then kq:=a[z,zz];
                                  end;
                                tg:=ans-kq;
                                inc(dd[tg]);
                                IF tg<exam then exam:=tg;
                          end;
                         end;
                        Writeln(fout,exam,' ',dd[exam]);
                end;
                end;
                close(Fout);
        end;

BEGIN
        inout;
END.