All pastes #924785 Raw Edit

Stuff

public text v1 · immutable
·published 2008-03-01 18:29 UTC
rendered paste body
program lacusta;
var
 T:Array[1..101,1..101] of Byte;
 A:Array[1..101,1..101] of Longint;
 i,j,n,m,miny:Integer;
 kezd,megoldas:Longint;
 
 procedure readData;
 var f:Text;
     i,j:Byte;
 begin
  Assign(f,'lacusta.in');
  Reset(f);
  ReadLn(f,n,m);
  for i:=1 to n do  
   for j:=1 to m do Read(f,T[i,j]);
  Close(f);
 end;
 
function minimum(i:Byte):Integer;
var min,j:Integer;
begin 
 min:=MAXINT;
 for j:=1 to m do
  begin
   if i=1 then 
    begin
        if (A[i,j]<min)and(j<>1) then 
   	  begin 
    	   min:=A[i,j];
    	   miny:=j;
   	  end;
    end
     else
      if (A[i,j]<min) then 
       begin
        min:=A[i,j];
        miny:=j;
       end;
  end;

 minimum:=min;
end;

function masodikminimum(i:Byte):Integer;
var min,emin,j:Integer;
begin 
 emin:=minimum(i);
 min:=MAXINT;
 for j:=1 to m do
  begin
   if i=1 then 
    begin
     if (A[i,j]<min)and(j<>1)and(A[i,j]<>emin) then min:=A[i,j];
    end
     else
      if (A[i,j]<min)and(A[i,j]<>emin) then min:=A[i,j];
  end;

 masodikminimum:=min;
end;



procedure megalkot;
var i,j:Byte;
begin
 kezd:=T[1,1];
 miny:=1;
 A[1,1]:=kezd;
 {az utolso sorra nem kell megcsinalni az utolso elott meg bele kell szamitani a sarok erteket is.}
 for i:=1 to n-2 do 
  begin
   for j:=1 to m do 
    begin 
      if (j<>miny) then A[i,j]:=kezd+T[i,j]+T[i+1,j]
       else if(i<>1) then A[i,j]:=masodikminimum(i-1)+T[i,j]+T[i+1,j];
                        
    {else if(i<>1) then A[i,j]:=MAXINT;  }
    end;
   kezd:=minimum(i);
  end;
 {utolso sora a megoldas matrixnak}
 i:=n-1;
 for j:=1 to m do
  begin
   if(j<>m) then
    begin
     if (j<>miny) then A[i,j]:=kezd+T[i,j]+T[i+1,j]+T[n,m]
      else if(i<>1) then A[i,j]:=masodikminimum(i-1)+T[i,j]+T[i+1,j]+T[n,m];
    end;
   if j=m then
    if (j<>miny) then A[i,j]:=kezd+T[i,j]+T[i+1,j]
     else if(i<>1) then A[i,j]:=masodikminimum(i-1)+T[i,j]+T[i+1,j];
  end;
 megoldas:=minimum(n-1);
end;

procedure kiir;
var g:Text;
begin
 Assign(g,'lacusta.out');
 ReWrite(g);
 WriteLn(g,megoldas);
 Close(g);
end;

begin
 readData;
 megalkot;
 {for i:=1 to n-1 do 
  begin 
   for j:=1 to m do Write(A[i,j],' ');
   WriteLn;
  end;}
 kiir;
end.