Cặp ghép với số đỉnh rất lớn

Cặp ghép với số đỉnh rất lớn

Cặp ghép với số đỉnh rất lớn

Võ Xuân Sơn

Trong số 26 (11/2001), tác giả Lê Văn Chương đã giới thiệu cho chúng ta thuật toán Kuhn

− Munkres giải bài toán tìm cặp ghép có tổng trọng số lớn nhất, nhỏ nhất nhưng với số đỉnh rất bé Sau đây, dựa theo thuật toán Kuhn − Munkres tôi trình bày bài toán cặp ghép với số đỉnh rất lớn (nhỏ hơn 5000 đỉnh).

Ví dụ minh hoạ

Bài toán xếp hình:

1 trò chơi xếp hình trên máy tính từ những ô hình vuông kích thước giống nhau Mỗi ô hình vuông này được chia thành 4 tam giác, mỗi tam giác có thể nhận 1 trong 4màu đỏ, xanh, vàng, trắng (quy ước: 0 − đỏ; 1 − xanh; 2 − vàng; 3− trắng)

như hình vẽ:

Người chơi cần dùng chuột kéo những ô vuông đã cho vào một lưới ô vuông M hàng, N cột đến khi đầy lưới sau đó có thể nhấn chuột để quay ô Mỗi lần nhấn chuột ô quay 1 góc

900 theo chiều kim đồng hồ Giả thiết mỗi lần kéo một ô vuông vào một vị trí của lưới mất 1s và mỗi lần nhấn chuột mất 1s Bằng những thao tác như vậy, người chơi cần tạo ra một hình giống như hình mẫu cho trước với thời gian nhanh nhất

Các ô vuông đã cho được đánh số từ 1 Trạng thái của ô vuông được mã hoá bằng 1 byte (8 bit) như sau: hai bit trái nhất mô tả giá trị mầu của tam giác phía Bắc, lần lượt các nhóm 2 bit tiếp theo mô tả giá trị mầu của các tam giác phía Đông, Nam, Tây của ô vuông

Dữ liệu vào: Xephinh.inp (m, n ≤ 50)

Dữ liệu ra: Xephinh.out

Nếu không có cách xếp thì ghi -1

Ví dụ:

Tư tưởng thuật toán:

Đầu tiên chúng ta tìm các trạng thái có thể có được khi xoay các ô vuông theo chiều kim đồng hồ Sau đó tiến hành ghép cặp các trạng thái đặt vào các ô của hình mẫu sao cho cách ghép đó là ghép được và thoả mãn với hình mẫu, Từ đó tiến hành lần lượt các bước như trong thuật toán Kuhn − Munkres với tổng thời gian (trọng số) nhỏ nhất

Các bạn có thể tham khảo thuật toán này qua chương trình sau:

Program xephinh;

const inp = ′xephinh.inp′;

out = ′xephinh.out′;

Ln = 2500;

Var c: array [1 ln, 0 3] of byte;

mau, tt: array [1 ln] of byte;

px, py: array [1 ln] of integer;

F, q, qu: array [1 ln*2] of integer;

m, n, mn, x, y, i, u, z: integer;

start: longint; g: text;

procedure input;

begin

assign (g,inp) ; reset (g);

readln (g,m,n); mn:= m*n;

for x:=1 to mn do read (g,tt[x]);

readln (g);

for x:=1 to mn do readln(g, mau[x]);

close (g);

start:= meml [0: $46c];

End;

procedure state;

var b1, b2: byte;

for x:=1 to mn do

for y:=0 to 3 do

begin

c[x, y]:=tt[x];

b1:= tt[x] shr 2;

b2:= byte (Tt[x] shl 6);

Tt[x]:= b1 or b2;

end;

end;

procedure khoitao;

var ok: boolean;

begin

fillchar (f, sizeof (f), 0);

fillchar (px, sizeof (px), 0);

fillchar (py, sizeof (py), 0);

for x:=1 to mn do

begin

ok:= false;

for i:= 0 to 3 do

begin

for y:= 1 to mn do

If (py[y]=0) and (c[x,i] = mau [y]) then begin

px [x]:= y;

py[y]:= x;

ok:=true;

break;

end;

if ok then

begin

F[x]:=i;

break;

end;

end;

end;

end;

Function liberty: boolean;

begin

for x:=1 to mn do;

if px[x]= 0 then

begin

liberty:= true;

u:=x; exit;

end;

liberty:= false;

Function Findpath: boolean;

Var dau, cuoi, v,w,n: integer;

begin

fillchar (q, sizeof (q),0);

dau:=1; cuoi:= 1; qu[1]:=u; q[u]:=u; while dau <= cuoi do

begin

v:= qu[dau]; inc(dau);

if v<= mn then;

for x:=0 to 3 do

for u:= mn + 1 to mn * 2 do

if c[v, x] =mau [u-mn] then

if (F[v] + F[u]= x) and (q[w] = 0) then begin q[u]:= v;

inc (cuoi);

qu [cuoi]:= w;

end;

if v > mn then

if py[v - mn] = 0 then

begin

findpath:=true;

z:= v ;

exit;

end

else begin

u:=py[v-mn];

inc (cuoi);

qu [cuoi]:= w;

q[u]:= v;

end;

end;

findpath:= false;

end;

procedure tangcg;

var thuocy: boolean;

begin

y:= y ; thuocy:= true;

while y<> u do

begin x:= q[y];

if thuocy then

begin

px [x]:= y - mn;

py [y-mn]:= x;

end;

y:= x;

thuocy:= not thuocy;

end;

end;

procedure suanhan;

var d, h: integer;

begin

d:= maxint;

for x:= 1 to mn do

if q[x] > 0 then

for y:= mn + 1 to mn * 2 do

if q[y] = 0 then

for i:= 0 to 3 do

if c[x,i] =mau [y-mn] then

begin

h:= i - f[x] - f[y];

if d>h then d:= h;

break;

end;

for x:=1 to mn do

if q[x] > 0 then f[x]:= f[x] + d;

for y:= mn+1 to mn * 2 do

if q[y] > 0 then f[y]:= f[y] - d;

end;

procedure Virus;

begin

assign (g,out) ; rewrite (g);

write (g, -1); close (g); halt;

end;

procedure process;

begin

while liberty do

begin

while not findpath do

begin

if (meml [0: $46c] - start) / 18.22 > 1 then virus; suanhan;

end;

tangcg;

end;

end;

procedure output;

begin

assign (g,out); rewrite (g);

for x:=1 to mn do

begin

write (g,py[x],′ ′);

if x mod n = 0 then writeln (g); end;

for x:=1 to mn do

begin

for y:= 0 to 3 do

if c[py[x], y] = mau[x] then begin

write (g, y+1, ′ ′);

break;

end;

if x mod n =0 then writeln(g); end;

close (g);

end;

begin

input;

state;

khoitao;

process;

output;

end