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]1) then begin min:=A[i,j]; miny:=j; end; end else if (A[i,j]1)and(A[i,j]<>emin) then min:=A[i,j]; end else if (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.