Cod sursa(job #326373)

Utilizator levap1506Gutu Pavel levap1506 Data 24 iunie 2009 20:20:24
Problema Matrice 2 Scor 15
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.44 kb
program matrice2;
 var a,b:text;
  i,j,k,n,q,x1,y1,x2,y2,lmax,lmax1:longint;
  z,y,yy:array[0..301,0..301] of longint;
  bb:boolean;
  procedure longest(x,y:integer);
   begin
    yy[x,y]:=0;
    if ((x=x2) and (y=y2)) or bb then begin bb:=true; exit; end;
    if (x>1) and (yy[x-1,y]<>0) then
      longest(x-1,y);
    if (x<n) and (yy[x+1,y]<>0)then
      longest(x+1,y);
    if (Y>1) and (yy[x,y-1]<>0) then
      longest(x,y-1);
    if (y<n) and (yy[x,y+1]<>0) then
      longest(x,y+1);
   end;
  procedure fixmin;
   var i,j:integer;
     min:longint;
   begin
    min:=maxlongint;
    for i:=1 to n do
     for j:=1 to n do
      if (z[i,j]<>0) and (z[i,j]<min)  then min:=z[i,j];
    for i:=1 to n do
     for j:=1 to n do
      if z[i,j]=min then z[i,j]:=0;
    lmax1:=min;
   end;
  begin
   assign(a,'matrice2.in');
   assign(b,'matrice2.out');
   reset(a);
   rewrite(b);
   readln(a,n,q);
   for i:=1 to n do
    begin
     for j:=1 to n do
       Read(a,y[i,j]);
     Readln(a);
    end;
   for i:=1 to q do
    begin
    z:=y;
     bb:=true;
     lmax1:=-maxlongint;
     Readln(a,x1,y1,x2,y2);
     while bb do
      begin
       yy:=z;
       lmax:=lmax1;
       bb:=false;
       longest(x1,y1);
       fixmin;
       if z[x1,y1]=0 then begin lmax:=y[x1,y1]; break; end;
       if z[x2,y2]=0 then begin lmax:=y[x2,y2]; break; end;
      end;
     Writeln(b,lmax);
    end;
    close(b);

  end.