Cặp ghép với số đỉnh rất lớn
Bạn đang xem bản rút gọn của tài liệu. Xem và tải ngay bản đầy đủ của tài liệu tại đây (112.12 KB, 6 trang )
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
90
0
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;
begin
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;
end;
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],′ ′);
