Hungari Cặp ghép cực đại có trọng số cực tiểu

Nguồn đề bài: http://vn.spoj.com/problems/MATCH2/

1. Đề bài Cặp ghép cực đại có trọng số cực tiểu

Cho đồ thị hai phía G = (X U Y, E); Các đỉnh của X ký hiệu là x1, x2, …, xn, các đỉnh của Y ký hiệu là y1, y2, …, yn. Mỗi cạnh của G được gán một trọng số không âm. Một bộ ghép đầy đủ trên G là một tập n cạnh thuộc E đôi một không có đỉnh chung. Trọng số của bộ ghép là tổng trọng số các cạnh nằm trong bộ ghép.

Ràng buộc: Luôn tồn tại ít nhất một bộ ghép đầy đủ trên G.
Chú ý dùng Eof chứ không dùng SeekEof

Input

• Dòng 1: Chứa số n (1 ≤ n ≤ 200)
• Các dòng tiếp theo, mỗi dòng chứa 3 số nguyên i, j, c cho biết có một cạnh (xi, yj) và trọng số cạnh đó là c (0 ≤ c ≤ 200).

Output

• Dòng 1: Ghi trọng số bộ ghép tìm được
• n dòng tiếp, mỗi dòng ghi hai số (u, v) tượng trưng cho một cạnh (xu, yv) được chọn vào bộ ghép.

Example

Input:
4
1 1 0
1 2 0
2 1 0
2 4 2
3 2 1
3 3 0
4 3 0
4 4 9
Output:
3
1 1
2 4
3 2
4 3

2. Code tham khảo thuật toán Hungari , MATCH2 spoj

Bài này các bạn vui lòng coi thuật toán chi tiết trong sách Lê Minh Hoàng.

const   fi='';
        nmax=200;
        vc=100000000;
type    data=longint;
var
        f:text;
        A:array[0..nmax+1,0..nmax+1] of data;
        Fx,Fy,MatchX,MatchY,tr:array[0..nmax+1] of data;
        Q:array[0..nmax*nmax] of data;
        ddx,ddy:array[0..nmax+1] of boolean;
        dau,cuoi,start,finish:data;
        n:data;

procedure docfile;
var     i,j,u,v,c:data;
begin
        assign(f,fi); reset(f);
        readln(f,n);
        for i:=1 to n do
                for j:=1 to n do
                        a[i,j]:=vc;
        while not eof(f) do
                begin
                        readln(f,u,v,c);
                        a[u,v]:=c;
                end;
        close(f);
end;

procedure init;
var     i,j:data;
begin
        fillchar(MatchX,sizeof(matchx),0);
        MatchY:=MatchX;

        for i:=1 to n do
                begin
                        fx[i]:=vc;
                        for j:=1 to n do
                                if fx[i]>a[i,j] then
                                        fx[i]:=a[i,j];
                end;
        for i:=1 to n do
                begin
                        fy[i]:=vc;
                        for j:=1 to n do
                                if a[i,j]-fx[i]<fy[i] then
                                        fy[i]:=a[i,j]-fx[i];
                end;
end;

function get(i,j:data):data;
begin
        get:=a[i,j]-fx[i]-fy[j];
end;

procedure themvao(x:data);
begin
        inc(cuoi);
        q[cuoi]:=x;
end;

function layra:data;
begin
        layra:=q[dau];
        inc(dau);
end;

procedure bfs;
var     u,v,j,i:data;
begin
        fillchar(tr,sizeof(tr),0);
        dau:=1;
        cuoi:=0;
        themvao(start);
        while dau<=cuoi do
                begin
                        u:=layra;
                        for v:=1 to n do
                                if (tr[v]=0) and (get(u,v)=0) then
                                        begin
                                                tr[v]:=u;
                                                if matchy[v]=0 then
                                                        begin
                                                                finish:=v;
                                                                exit;
                                                        end;
                                                themvao(matchy[v]);
                                        end;
                end;
end;

procedure enlager(u:data);
var     v,next:data;
begin
        repeat
                v:=tr[u];
                next:=MatchX[v];
                MatchX[v]:=u;
                MatchY[u]:=v;
                u:=next;
        until   u=0;
end;

procedure subX_addY;
var     i,j,delta:data;
begin
        fillchar(ddx,sizeof(ddx),false);
        ddy:=ddx;
        ddx[start]:=true;
        for i:=1 to n do
                if tr[i]<>0 then
                        begin
                                ddx[MatchY[i]]:=true;
                                ddy[i]:=true;
                        end;
        delta:=vc;
        for i:=1 to n do
                if ddx[i] then
                        for j:=1 to n do
                                if (not ddy[j]) and (delta>get(i,j)) then
                                        delta:=get(i,j);
        for i:=1 to n do
                begin
                        if ddx[i] then fx[i]:=fx[i]+delta;
                        if ddy[i] then fy[i]:=fy[i]-delta;
                end;
end;

procedure xuli;
var     i,j,res:data;
begin
        for i:=1 to n do
                begin
                        start:=i;
                        finish:=0;
                        repeat
                                bfs;
                                if finish=0 then subx_addy;
                        until finish<>0;
                        enlager(finish);
                end;
        res:=0;
        for i:=1 to n do
                if MatchX[i]<>0 then
                        inc(res,a[i,Matchx[i]]);
        writeln(res);
        for i:=1 to n do
                if MatchX[i]<>0 then
                        writeln(i, ' ',MatchX[i]);

end;

begin
        docfile;
        init;
        xuli;
end.

2 thoughts on “Hungari Cặp ghép cực đại có trọng số cực tiểu

Trả lời

Email của bạn sẽ không được hiển thị công khai. Các trường bắt buộc được đánh dấu *