## Editorial for Xúc xắc

Remember to use this editorial only when stuck, and not to copy-paste code from it. Please be respectful to the problem author and editorialist.
Submitting an official solution before solving the problem yourself is a bannable offence.

Lưu ý: Các code mẫu dưới đây chỉ mang tính tham khảo và có thể không AC được bài tập này

#### Code mẫu của flashmt

const fi='';
dx:array[1..4] of longint=(-1,0,1,0);
dy:array[1..4] of longint=(0,1,0,-1);
e:array[1..6,1..6] of longint=((0,3,5,2,4,0),(4,0,1,6,0,3),
(2,6,0,0,1,5),(5,1,0,0,6,2),(3,0,6,1,0,4),(0,4,2,5,3,0));
maxn=51;
maxdinh=maxn*maxn*24;
maxcanh=maxdinh*4;
var m,n,sd,sx,sy,fx,fy,s,nh,low,high:longint;
val:array[1..maxn,1..maxn] of longint;
a,c:array[1..maxcanh*2] of longint;
pos,cur,d,h,p:array[0..maxdinh] of longint;
free:array[1..maxdinh] of boolean;
b:array[1..maxn,1..maxn,1..6,1..6] of longint;

procedure rf;
var i,j:longint;
begin
for i:=1 to m do
for j:=1 to n do
high:=((fx-1)*n+fy)*24;
low:=high-23;
end;

procedure initvec;
var i,j,p,q:longint;
begin
sd:=0;
for i:=1 to m do
for j:=1 to n do
for p:=1 to 6 do
for q:=1 to 6 do
if (p<>q) and (p<>7-q) then
begin
inc(sd);
b[i,j,p,q]:=sd;
if (i=sx) and (j=sy) and (p=1) and (q=2) then s:=sd;
end;
end;

procedure calc(p,q,k:longint;var pp,qq:longint);
begin
if odd(k) then
begin
if k=1 then
begin
qq:=p; pp:=7-q;
end
else
begin
pp:=q; qq:=7-p;
end;
end
else
begin
pp:=p;
if k=2 then qq:=7-e[p,q]
else qq:=e[p,q];
end;
end;

procedure initedge;
var i,j,p,q,k,ii,jj,x,y,pp,qq:longint;
begin
for i:=1 to m do
for j:=1 to n do
for p:=1 to 6 do
for q:=1 to 6 do
if (p<>q) and (p<>7-q) then
begin
x:=b[i,j,p,q];
cur[x]:=cur[x-1]; pos[x]:=cur[x]+1;
for k:=1 to 4 do
begin
ii:=i+dx[k]; jj:=j+dy[k];
if (ii<1) or (jj<1) or (ii>m) or (jj>n) then continue;
inc(cur[x]);
calc(p,q,k,pp,qq);
y:=b[ii,jj,pp,qq];
a[cur[x]]:=y;
c[cur[x]]:=val[ii,jj]*(7-qq);
end;
end;
pos[sd+1]:=cur[sd]+1;
end;

procedure update(x:longint);
var cha,con:longint;
begin
con:=p[x];
if con=0 then
begin
inc(nh); con:=nh;
end;
cha:=con shr 1;
while (cha>0) and (d[h[cha]]>d[x]) do
begin
h[con]:=h[cha];
p[h[con]]:=con;
con:=cha;
cha:=con shr 1;
end;
h[con]:=x; p[x]:=con;
end;

function pop:longint;
var cha,con,x:longint;
begin
pop:=h[1];
x:=h[nh]; dec(nh);
cha:=1; con:=2;
while con<=nh do
begin
if (con<nh) and (d[h[con+1]]<d[h[con]]) then inc(con);
if d[x]<=d[h[con]] then break;
h[cha]:=h[con];
p[h[cha]]:=cha;
cha:=con;
con:=cha shl 1;
end;
h[cha]:=x; p[x]:=cha;
end;

procedure pr;
var i,x,y:longint;
begin
for i:=1 to sd do
begin
d[i]:=1000000000;
free[i]:=true;
end;
d[s]:=5*val[sx,sy];
update(s);
repeat
x:=pop; free[x]:=false;
if (x>=low) and (x<=high) then
begin
writeln(d[x]); exit;
end;
for i:=pos[x] to pos[x+1]-1 do
begin
y:=a[i];
if free[y] and (d[y]>d[x]+c[i]) then
begin
d[y]:=d[x]+c[i];
update(y);
end;
end;
until nh=0;
end;

begin
assign(input,fi); reset(input);
rf;
initvec;
initedge;
pr;
close(input);
end.


program xucxac;
uses    math;
type    e=record
x,y,f,u,r:longint;
end;
const   maxn=55;
maxT=6*6*6*maxn*maxn;
fi='';
var     h:array[1..maxT] of e;
pos:array[1..maxn,1..maxn,1..6,1..6,1..6] of longint;
d:array[1..maxn,1..maxn,1..6,1..6,1..6] of longint;
a:array[1..maxn,1..maxn] of longint;
res,m,n,sx,sy,fx,fy,nh:longint;

procedure input;
var     inp:text;
i,j:longint;
begin
assign(inp,fi);
reset(inp);
for i:=1 to m do
begin
for j:=1 to n do read(inp,a[i,j]);
end;
close(inp);

end;

procedure update(x,y,f,u,r:longint);
var     c,p:longint;

begin
c:=pos[x,y,f,u,r];
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,h[p].f,h[p].u,h[p].r]<=d[x,y,f,u,r]) then break;
h[c]:=h[p];
pos[h[c].x,h[c].y,h[c].f,h[c].u,h[c].r]:=c;
c:=p;
until false;
h[c].x:=x;h[c].y:=y;h[c].f:=f;h[c].u:=u;h[c].r:=r;
pos[x,y,f,u,r]:=c;
end;

function extract:e;
var     v,temp:e;
c,p:longint;
begin
temp:=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,h[c+1].f,h[c+1].u,h[c+1].r]<
d[h[c].x,h[c].y,h[c].f,h[c].u,h[c].r]) then inc(c);
if (c>nh) or (d[v.x,v.y,v.f,v.u,v.r]<=
d[h[c].x,h[c].y,h[c].f,h[c].u,h[c].r]) then break;
h[p]:=h[c];
pos[h[p].x,h[p].y,h[p].f,h[p].u,h[p].r]:=p;
p:=c;
until false;
h[p]:=v;
pos[v.x,v.y,v.f,v.u,v.r]:=p;
exit(temp);
end;

var     t:e;
begin
if i=1 then
begin
t.x:=u.x-1;
t.y:=u.y;
t.f:=7-u.u;
t.u:=u.f;
t.r:=u.r;
end
else
if i=2 then
begin
t.x:=u.x;
t.y:=u.y+1;
t.f:=u.f;
t.u:=7-u.r;
t.r:=u.u;
end
else
if i=3 then
begin
t.x:=u.x+1;
t.y:=u.y;
t.f:=u.u;
t.u:=7-u.f;
t.r:=u.r;
end
else
begin
t.x:=u.x;
t.y:=u.y-1;
t.f:=u.f;
t.u:=u.r;
t.r:=7-u.u;
end;
exit(t);
end;

function inBound(i,j:longint):boolean;
begin
exit((1<=i) and (i<=m) and (1<=j) and (j<=n));
end;

procedure init;
var     i,j,p,q,r:longint;
begin
nh:=0;
for i:=1 to m do
for j:=1 to n do
for p:=1 to 6 do
for q:=1 to 6 do
for r:=1 to 6 do
d[i,j,p,q,r]:=high(longint);
d[sx,sy,1,2,3]:=0;
res:=high(longint);
end;

procedure dijkstra;
var     u,v:e;
t:longint;
begin
update(sx,sy,1,2,3);
repeat
u:=extract;
if (u.x=fx) and (u.y=fy) then
res:=min(res,d[u.x,u.y,u.f,u.u,u.r]);
for t:=1 to 4 do
begin
if inBound(v.x,v.y) then
if d[v.x,v.y,v.f,v.u,v.r]>d[u.x,u.y,u.f,u.u,u.r]+a[v.x,v.y]*(7-v.u) then
begin
d[v.x,v.y,v.f,v.u,v.r]:=d[u.x,u.y,u.f,u.u,u.r]+a[v.x,v.y]*(7-v.u);
update(v.x,v.y,v.f,v.u,v.r);
end;
end;
until nh=0;
end;

begin
input;
init;
dijkstra;
write(res+5*a[sx,sy]);
end.


{$R+,Q+} PROGRAM XUCXAC; CONST finp=''; fout=''; maxn=50; oo=1000000000; TYPE rec=record i,j,f,u,r:longint; end; VAR fin:array[1..maxn,1..maxn,1..6,1..6,1..6] of byte; hpos,d:array[1..maxn,1..maxn,1..6,1..6,1..6] of longint; a:array[1..maxn,1..maxn] of longint; h:array[1..maxn*maxn*6*6*6] of rec; kq,m,n:longint; hsize:longint; si,sj,fi,fj:longint; Procedure ReadInput; Var f:text; i,j:longint; Begin Assign(f,finp); Reset(f); Readln(f,m,n); For i:=1 to m do For j:=1 to n do Read(f,a[i,j]); Readln(f,si,sj,fi,fj); Close(f); End; Procedure Init; Var i,j,f,u,r:longint; Begin For i:=1 to maxn do For j:=1 to maxn do For f:=1 to 6 do For u:=1 to 6 do For r:=1 to 6 do d[i,j,f,u,r]:=oo; hsize:=1; with h[1] do begin i:=si; j:=sj; f:=1; u:=2; r:=3; end; hpos[si,sj,1,2,3]:=1; d[si,sj,1,2,3]:=5*a[si,sj]; End; Procedure WriteOutput; Var fo:text; Begin Assign(fo,fout); Rewrite(fo); Writeln(fo,kq); Close(fo); End; Procedure Swap(var a,b:longint); Var temp:longint; Begin temp:=a; a:=b; b:=temp; End; Procedure SwapRec(var a,b:rec); Var temp:rec; Begin temp:=a; a:=b; b:=temp; End; Procedure DownHeap(i:longint); Var j:longint; Begin j:=i shl 1; while (j<=hsize) do begin if (j<hsize) and (d[h[j+1].i,h[j+1].j,h[j+1].f,h[j+1].u,h[j+1].r] <d[h[j].i,h[j].j,h[j].f,h[j].u,h[j].r]) then inc(j); if d[h[j].i,h[j].j,h[j].f,h[j].u,h[j].r] <d[h[i].i,h[i].j,h[i].f,h[i].u,h[i].r] then begin Swap(hpos[h[i].i,h[i].j,h[i].f,h[i].u,h[i].r], hpos[h[j].i,h[j].j,h[j].f,h[j].u,h[j].r]); Swaprec(h[i],h[j]); end; i:=j; j:=i shl 1; end; End; Procedure Extract; Begin Swap(hpos[h[1].i,h[1].j,h[1].f,h[1].u,h[1].r], hpos[h[hsize].i,h[hsize].j,h[hsize].f,h[hsize].u,h[hsize].r]); Swaprec(h[1],h[hsize]); dec(hsize); DownHeap(1); End; Procedure Insert(i,j,f,u,r:longint); Var k:longint; Begin inc(hsize); k:=hsize; while (k>1) and (d[h[k shr 1].i,h[k shr 1].j,h[k shr 1].f,h[k shr 1].u,h[k shr 1].r]>d[i,j,f,u,r]) do begin h[k]:=h[k shr 1]; hpos[h[k].i,h[k].j,h[k].f,h[k].u,h[k].r]:=k; k:=k shr 1; end; h[k].i:=i; h[k].j:=j; h[k].f:=f; h[k].u:=u; h[k].r:=r; hpos[i,j,f,u,r]:=k; End; Procedure Heapify(i:longint); Begin while (i>1) and (d[h[i shr 1].i,h[i shr 1].j,h[i shr 1].f,h[i shr 1].u,h[i shr 1].r] >d[h[i].i,h[i].j,h[i].f,h[i].u,h[i].r]) do begin Swap(hpos[h[i].i,h[i].j,h[i].f,h[i].u,h[i].r], hpos[h[i shr 1].i,h[i shr 1].j,h[i shr 1].f,h[i shr 1].u,h[i shr 1].r]); SwapRec(h[i],h[i shr 1]); i:=i shr 1; end; End; Procedure Dijkstra; Var i,j,f,u,r:longint; Begin while hsize>0 do begin i:=h[1].i; j:=h[1].j; f:=h[1].f; u:=h[1].u; r:=h[1].r; If (i=fi) and (j=fj) then begin kq:=d[i,j,f,u,r]; exit; end; fin[i,j,f,u,r]:=1; Extract; if (j<n) and (fin[i,j+1,f,7-r,u]=0) and (d[i,j+1,f,7-r,u]>d[i,j,f,u,r]+r*a[i,j+1]) then begin d[i,j+1,f,7-r,u]:=d[i,j,f,u,r]+r*a[i,j+1]; if hpos[i,j+1,f,7-r,u]=0 then Insert(i,j+1,f,7-r,u) else heapify(hpos[i,j+1,f,7-r,u]); end; if (j>1) and (fin[i,j-1,f,r,7-u]=0) and (d[i,j-1,f,r,7-u]>d[i,j,f,u,r]+(7-r)*a[i,j-1]) then begin d[i,j-1,f,r,7-u]:=d[i,j,f,u,r]+(7-r)*a[i,j-1]; if hpos[i,j-1,f,r,7-u]=0 then Insert(i,j-1,f,r,7-u) else heapify(hpos[i,j-1,f,r,7-u]); end; if (i<m) and (fin[i+1,j,u,7-f,r]=0) and (d[i+1,j,u,7-f,r]>d[i,j,f,u,r]+f*a[i+1,j]) then begin d[i+1,j,u,7-f,r]:=d[i,j,f,u,r]+f*a[i+1,j]; if hpos[i+1,j,u,7-f,r]=0 then Insert(i+1,j,u,7-f,r) else heapify(hpos[i+1,j,u,7-f,r]); end; if (i>1) and (fin[i-1,j,7-u,f,r]=0) and (d[i-1,j,7-u,f,r]>d[i,j,f,u,r]+(7-f)*a[i-1,j]) then begin d[i-1,j,7-u,f,r]:=d[i,j,f,u,r]+(7-f)*a[i-1,j]; if hpos[i-1,j,7-u,f,r]=0 then Insert(i-1,j,7-u,f,r) else heapify(hpos[i-1,j,7-u,f,r]); end; end; End; BEGIN ReadInput; Init; Dijkstra; WriteOutput; END.  #### Code mẫu của ll931110 {$MODE DELPHI}
Program XUCXAC;
Const
input  = '';
output = '';
maxn = 50;
maxp = 654;
minp = 123;
maxc = 1000000000;
Type
rec = record
x,y,z: integer;
end;
Var
m,n,sx,sy,fx,fy: integer;
free: array[0..maxn + 1, 0..maxn + 1, minp..maxp] of boolean;
d,pos: array[1..maxn, 1..maxn, minp..maxp] of integer;
a: array[1..maxn,1..maxn] of integer;
heap: array[1..1500000] of rec;
u,v,p: integer;
p1,p2,p3: integer;
uk,vk,pk,sk: integer;
nHeap: integer;

Var
f: text;
i,j: integer;
Begin
Assign(f, input);
Reset(f);

For i:= 1 to m do
For j:= 1 to n do read(f, a[i,j]);

Close(f);
End;

Procedure init;
Var
i,j,k: integer;
Begin
For i:= 1 to m do
For j:= 1 to n do
For k:= minp to maxp do d[i,j,k]:= maxc;
d[sx,sy,minp]:= 5 * a[sx,sy];

Fillchar(pos, sizeof(pos), 0);
Fillchar(free, sizeof(free), false);
For i:= 1 to m do
For j:= 1 to n do
For k:= minp to maxp do free[i,j,k]:= true;

nHeap:= 0;
End;

Procedure update(ux,vx,px: integer);
Var
child,parent: integer;
Begin
child:= pos[ux,vx,px];
If child = 0 then
Begin
inc(nHeap);
child:= nHeap;
End;

parent:= child div 2;
While (parent > 0)
and (d[heap[parent].x,heap[parent].y,heap[parent].z] > d[ux,vx,px]) do
Begin
heap[child]:= heap[parent];
pos[heap[child].x,heap[child].y,heap[child].z]:= child;

child:= parent;
parent:= child div 2;
End;

with heap[child] do
Begin
x:= ux;
y:= vx;
z:= px;
End;
pos[ux,vx,px]:= child;
End;

Procedure pop;
Var
r,c,vx,vy,vz: integer;
Begin
with heap[1] do
Begin
u:= x;
v:= y;
p:= z;
End;

with heap[nHeap] do
Begin
vx:= x;
vy:= y;
vz:= z;
End;
dec(nHeap);

r:= 1;
While r * 2 <= nHeap do
Begin
c:= r * 2;
If (c < nHeap) and
(d[heap[c + 1].x,heap[c + 1].y,heap[c + 1].z] < d[heap[c].x,heap[c].y,heap[c].z]) then inc(c);

If d[vx,vy,vz] <= d[heap[c].x,heap[c].y,heap[c].z] then break;
heap[r]:= heap[c];
pos[heap[r].x,heap[r].y,heap[r].z]:= r;
r:= c;
End;

with heap[r] do
Begin
x:= vx;
y:= vy;
z:= vz;
End;
pos[vx,vy,vz]:= r;
End;

Var
tmp: integer;
Begin
If free[uk,vk,pk] then
Begin
tmp:= d[u,v,p] + a[uk,vk] * sk;
If d[uk,vk,pk] > tmp then
Begin
d[uk,vk,pk]:= tmp;
update(uk,vk,pk);
End;
End;
End;

Procedure rollup;
Begin
uk:= u - 1;
vk:= v;

sk:= 7 - p1;
pk:= (7 - p2) * 100 + p1 * 10 + p3;

End;

Procedure rolldown;
Begin
uk:= u + 1;
vk:= v;

sk:= p1;
pk:= p2 * 100 + (7 - p1) * 10 + p3;

End;

Procedure rollleft;
Begin
uk:= u;
vk:= v - 1;

sk:= 7 - p3;
pk:= p1 * 100 + p3 * 10 + (7 - p2);

End;

Procedure rollright;
Begin
uk:= u;
vk:= v + 1;

sk:= p3;
pk:= p1 * 100 + (7 - p3) * 10 + p2;

End;

Procedure Dijkstra;
Begin
update(sx,sy,minp);
Repeat
pop;
If (u = fx) and (v = fy) then exit;
free[u,v,p]:= false;

p1:= p div 100;
p2:= (p mod 100) div 10;
p3:= p mod 10;

rollup;
rolldown;
rollleft;
rollright;
Until nHeap = 0;
End;

Procedure printresult;
Var
f: text;
val,i: integer;
Begin
Assign(f, output);
Rewrite(f);

val:= maxc;
For i:= minp to maxp do
if val > d[fx,fy,i] then val:= d[fx,fy,i];

Writeln(f, val);
Close(f);
End;

Begin