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.
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 read(m,n); for i:=1 to m do for j:=1 to n do read(val[i,j]); read(sx,sy,fx,fy); 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.
Code mẫu của ladpro98
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); readln(inp,m,n); for i:=1 to m do begin for j:=1 to n do read(inp,a[i,j]); readln(inp); end; readln(inp,sx,sy,fx,fy); 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; function getAdj(i:longint;u:e):e; 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 v:=getAdj(t,u); 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.
Code mẫu của RR
{$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; Procedure LoadGraph; Var f: text; i,j: integer; Begin Assign(f, input); 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, sx, sy, fx, fy); 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; Procedure adjust; 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; adjust; End; Procedure rolldown; Begin uk:= u + 1; vk:= v; sk:= p1; pk:= p2 * 100 + (7 - p1) * 10 + p3; adjust; End; Procedure rollleft; Begin uk:= u; vk:= v - 1; sk:= 7 - p3; pk:= p1 * 100 + p3 * 10 + (7 - p2); adjust; End; Procedure rollright; Begin uk:= u; vk:= v + 1; sk:= p3; pk:= p1 * 100 + (7 - p3) * 10 + p2; adjust; 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 LoadGraph; init; Dijkstra; printresult; End.
Comments