比赛 20120712 评测结果 AAAAAAAAAA
题目名称 登山 最终得分 100
用户昵称 isabella 运行时间 0.022 s
代码语言 Pascal 内存使用 0.26 MiB
提交时间 2012-07-12 11:54:16
显示代码纯文本
const
 dx:array[1..4]of integer=(-1,1,0,0);
 dy:array[1..4]of integer=(0,0,-1,1);
var
 un,dn,a:array[0..62,0..62]of longint;
 map,f,v:array[0..62,0..62]of boolean;
 r,x,y:array[1..3660]of longint;
 n,m,i,j,k1,k2,l,mi,ma,temp,mid,ans,xmax:longint;

function max(a,b:longint):longint;
begin if a>b then exit(a) else exit(b);end;
procedure sort(l,ll:longint);
 var i,j:longint;
 begin
  i:=l;j:=ll;
  mid:=r[(i+j)div 2];
  repeat
   while r[i]<mid do inc(i);
   while r[j]>mid do dec(j);
   if i<=j then
    begin
     temp:=r[i];r[i]:=r[j];r[j]:=temp;
     temp:=x[i];x[i]:=x[j];x[j]:=temp;
     temp:=y[i];y[i]:=y[j];y[j]:=temp;
     inc(i);dec(j);
    end;
  until i>j;
  if i<ll then sort(i,ll);
  if l<j then sort(l,j);
 end;
procedure up(x,y:longint);
var i:longint;
begin
 f[x,y]:=true;
 for i:=1 to 4 do
  if(map[x+dx[i],y+dy[i]])and(a[x+dx[i],y+dy[i]]>a[x,y])then
   begin
    up(x+dx[i],y+dy[i]);
    un[x,y]:=max(un[x,y],un[x+dx[i],y+dy[i]]+1);
   end;
end;
procedure down(x,y:longint);
var i:longint;
begin
 f[x,y]:=true;
 for i:=1 to 4 do
  if(map[x+dx[i],y+dy[i]])and(a[x+dx[i],y+dy[i]]<a[x,y])then
   begin
    down(x+dx[i],y+dy[i]);
    dn[x,y]:=max(dn[x,y],dn[x+dx[i],y+dy[i]]+1);
   end;
 //xmax:=max(xmax,dn[x,y]);
end;
procedure make;
begin
  fillchar(f,sizeof(f),0);
  up(k1 div m,k1 mod m);
  for i:=1 to n do
   for j:=1 to m do
    if f[i,j]=false then up(i,j);
  fillchar(f,sizeof(f),0);
  down(k2 div m,k2 mod m);
  xmax:=0;
  for i:=1 to n do
   for j:=1 to m do
    if f[i,j]=false then
     begin
      down(i,j);xmax:=max(xmax,dn[i,j]);
     end;
 end;

procedure next(x,y,d:longint);
 var i:longint;
 begin
  if d>ans then ans:=d;
  if (ans=n*m)then begin
   writeln(n);close(input);close(output);halt;end;
  for i:=1 to 4 do
   if(a[x+dx[i],y+dy[i]]<a[x,y])and(v[x+dx[i],y+dy[i]]=false)
      and(map[x+dx[i],y+dy[i]])then
    begin
     v[x+dx[i],y+dy[i]]:=true;
     next(x+dx[i],y+dy[i],d+1);
     v[x+dx[i],y+dy[i]]:=false;
    end;
 end;
procedure dfs(x,y,d:longint);
 var i:longint;
 begin
  if d>ans then ans:=d;
  if (ans=n*m)then begin
   writeln(n);close(input);close(output);halt;end;
  f[x,y]:=true;
  for i:=1 to 4 do
   if(a[x+dx[i],y+dy[i]]>a[x,y])and(f[x+dx[i],y+dy[i]]=false)
    and(map[x+dx[i],y+dy[i]])then
     dfs(x+dx[i],y+dy[i],d+1);

  if(d+dn[x,y]>ans)then
   begin v:=f;next(x,y,d);end;
  f[x,y]:=false;
 end;

begin
assign(input,'hike.in');reset(input);
assign(output,'hike.out');rewrite(output);
{init}
 readln(n,m);
 fillchar(map,sizeof(map),0);
 mi:=maxlongint;
 ma:=0;
 for i:=1 to n do
  for j:=1 to m do
   begin map[i,j]:=true;read(a[i,j]);
    if a[i,j]<mi then begin mi:=a[i,j];k1:=i*m+j;end;
    if a[i,j]>ma then begin ma:=a[i,j];k2:=i*m+j;end;
   end;
 make;
 for i:=1 to n do
  for j:=1 to m do
   begin r[(i-1)*m+j]:=un[i,j];x[(i-1)*m+j]:=i;
         y[(i-1)*m+j]:=j;end;
 sort(1,n*m);
{work}
ans:=0;
for i:=n*m downto 1 do
 begin
  if (xmax+un[x[i],y[i]])<=ans then continue;
 // writeln(x[i],' ',y[i],' ',ans);
  fillchar(f,sizeof(f),0);
  dfs(x[i],y[i],1);

 end;
writeln(ans);
close(input);close(output);
end.