栾宫涅吧 关注:6贴子:216
  • 0回复贴,共1
const dx:array[1..4]of integer=(0,1,0,-1);
      dy:array[1..4]of integer=(1,0,-1,0);
type myque=record
     x,y:integer;
     end;
var longest:array[1..500,1..500]of longint;
    map:array[1..500,1..500]of integer;
    open,rear,n,m:longint;
    que:array[1..250000]of myque;
    f:array[1..500,1..500]of boolean;
procedure inque(y,x:integer);
begin
     if open>250000 then open:=1;
     que[open].x:=x;
     que[open].y:=y;
     inc(open);
end;
procedure outque(var y,x:integer);
begin
     x:=que[rear].x;
     y:=que[rear].y;
     inc(rear);
     if rear<1 then rear:=250000;
end;
function empty:boolean;
begin
     if open=rear then empty:=true
                  else empty:=false;
end;
{que}
procedure findmin;
var i,j:integer;
    min:longint;
begin
     min:=maxlongint;
     for i:=1 to n do
       for j:=1 to m do
         if (min>map[i,j])and(f[i,j]=false) then min:=map[i,j];
     for i:=1 to n do
       for j:=1 to m do
         if map[i,j]=min then
         begin
              longest[i,j]:=1;
              f[i,j]:=true;
              inque(i,j);
         end;
end; {findmin}
procedure run;
var i,x,y,tx,ty:integer;
begin
     while not empty do
     begin
          outque(y,x);
          for i:=1 to 4 do
          begin
            tx:=x+dx[i]; ty:=y+dy[i];
            if (tx>0)and(tx<m+1)and(ty>0)and(ty<n+1)then
              if (map[ty,tx]>map[y,x])and
                 (longest[ty,tx]<longest[y,x])then
                 begin
                      longest[ty,tx]:=longest[y,x]+1;
                      f[ty,tx]:=true;
                      inque(ty,tx);
                 end;
          end;
     end;
end; {run}
procedure allslution;
var max:longint;
    i,j:integer;
function allarr:boolean;
var i,j:integer;
    c:longint;
begin
     c:=0;
     for i:=1 to n do
       for j:=1 to m do
         if f[i,j] then inc©;

     if c=n*m then allarr:=true
              else allarr:=false;
end; {allslution-allarr}
begin
     while not allarr do
     begin
          findmin;
          run;
     end;
     max:=0;
     for i:=1 to n do
       for j:=1 to m do
         if max<longest[i,j] then max:=longest[i,j];
     writeln(max);
end; {allslution}
procedure init;
var i,j:integer;
begin
     readln(n,m);
     for i:=1 to n do
     begin
          for j:=1 to m do read(map[i,j]);
          readln;
     end;
end; {init}
procedure start;
var i,j:integer;
begin
     fillchar(f,sizeof(f),false);
     for i:=1 to n do
       for j:=1 to m do longest[i,j]:=0;
     open:=1; rear:=1;
end; {start}
begin
     init;
     start;
     allslution;
     readln;
end. 


1楼2006-11-14 18:02回复