CUTRECT - Cắt hình chữ nhật
Tác giả: ladpro98
Ngôn ngữ: Pascal
{$MODE OBJFPC}
program cutrect;
uses math;
type e=record
x,y:longint;
w:int64;
end;
const fi='';
maxn=444;
oo=high(int64);
var lr,ud:array[0..maxn,0..maxn] of int64;
d:array[0..maxn,0..maxn] of int64;
pos:array[0..maxn,0..maxn] of longint;
h:array[0..maxn*maxn] of e;
m,n,nh:longint;
res:int64;
procedure input;
var inp:text;
i,j:longint;
begin
assign(inp,fi);
reset(inp);
readln(inp,m,n);
//if (m=1) and (n=1) then begin write(-1); halt; end;
inc(m);inc(n);
for i:=1 to m-1 do
begin
for j:=2 to n-1 do
read(inp,ud[i,j]);
readln(inp);
end;
for i:=2 to m-1 do
begin
for j:=1 to n-1 do
read(inp,lr[i,j]);
readln(inp);
end;
close(inp);
end;
function getAdj(k,i,j:longint):e;
var t:e;
begin
//if j=0 then writeln('shit');
if k=1 then
begin
t.x:=i-1;
t.y:=j;
t.w:=ud[i-1,j];
end
else
if k=2 then
begin
t.x:=i;
t.y:=j+1;
t.w:=lr[i,j];
end
else
if k=3 then
begin
t.x:=i+1;
t.y:=j;
t.w:=ud[i,j];
end
else
if k=4 then
begin
t.x:=i;
t.y:=j-1;
t.w:=lr[i,j-1];
end;
exit(t);
end;
procedure update(v:e);
var p,c:longint;
begin
c:=pos[v.x,v.y];
if c=0 then
begin
inc(nh);
c:=nh;
end;
repeat
p:=c div 2;
if (p=0) or (d[h[p].x,h[p].y]<=d[v.x,v.y]) then break;
h[c]:=h[p];
pos[h[c].x,h[c].y]:=c;
c:=p;
until false;
h[c]:=v;
pos[v.x,v.y]:=c;
end;
function extract:e;
var v:e;
p,c:longint;
begin
result:=h[1];
v:=h[nh];
dec(nh);
p:=1;
repeat
c:=2*p;
if (c<nh) and (d[h[c+1].x,h[c+1].y]<d[h[c].x,h[c].y]) then inc(c);
if (c>nh) or (d[v.x,v.y]<=d[h[c].x,h[c].y]) then break;
h[p]:=h[c];
pos[h[p].x,h[p].y]:=p;
p:=c;
until false;
h[p]:=v;
pos[v.x,v.y]:=p;
end;
function inBound(i,j:longint):boolean;
begin
if ((i=1) and (j=1)) or ((i=m) and (j=n)) then exit(false);
exit((1<=i) and (i<=m) and (1<=j) and (j<=n));
end;
function last(i,j:longint):boolean;
begin
if (i=1) and (2<=j) and (j<n) then exit(true);
if (j=n) and (2<=i) and (i<m) then exit(true);
exit(false);
end;
function toE(i,j:longint):e;
var t:e;
begin
t.x:=i;
t.y:=j;
exit(t);
end;
procedure init;
var i,j:longint;
begin
for i:=1 to m do
for j:=1 to n do
d[i,j]:=oo;
for i:=2 to m-1 do
begin
d[i,1]:=0;
update(toE(i,1));
end;
for i:=2 to n-1 do
begin
d[m,i]:=0;
update(toE(m,i));
end;
for i:=1 to n-1 do
begin
lr[1,i]:=oo;
lr[m,i]:=oo;
end;
for i:=1 to m-1 do
begin
ud[i,1]:=oo;
ud[i,n]:=oo;
end;
res:=oo;
end;
procedure dijkstra;
var u,v:e;
i:longint;
begin
update(toE(1,1));
repeat
u:=extract;
if last(u.x,u.y) then
res:=min(res,d[u.x,u.y]);
for i:=1 to 4 do
begin
v:=getAdj(i,u.x,u.y);
if inBound(v.x,v.y) then
if d[v.x,v.y]-v.w>d[u.x,u.y] then
begin
d[v.x,v.y]:=d[u.x,u.y]+v.w;
update(v);
end;
end;
until nh=0;
end;
begin
input;
init;
dijkstra;
if res=oo then res:=-1;
write(res);
end.