[Tin học] Xây dựng trường Chuyên Bến Tre

Nội dung bài viết

2. Đề bài về cặp ghép cực đại có trọng số nhỏ nhất
2. Hướng dẫn Hungari
3. Code tham khảo Hungari

2. Đề bài về cặp ghép cực đại có trọng số nhỏ nhất

Trường THPT Chuyên Bến Tre ra quyết định xây dựng trường chuyên mới. Ban giám hiệu quyết định trả tiền ngay trong ngày cho các nhà thầu. Có n công trình và n nhà thầu tham gia đấu thầu công trình. Biết thời gian xây dựng công trình của các nhà thầu là khác nhau. Vì số ngày làm ảnh hưởng đến chi phí nên nhà trường quyết định chọn các nhà thầu thích hợp để tổng chi phí phải trả cho mỗi nhà thầu là thấp nhất.

Yêu cầu: Hãy cho biết tổng thời gian nhỏ nhất và lịch phân công.

Dữ liệu vào

CHUYENBT.INP

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 u,v,c cho biết nhà thầu u ra giá cho công trình v là c (0<=c<=200, 1<=u,v<=200)

Dữ liệu ra

CHUYENBT.OUT

Dòng đầu chứa số S là tổng thời gian nhỏ nhất tìm được.
N dòng tiếp theo, mỗi dòng gồm 2 số u, v cho biết nhà thầu u sẽ đảm nhận công trình v (lịch phân công tối ưu nhất theo S).

Example

Input

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

1 1

2 4

3 2

4 3

2. Hướng dẫn Hungari

Đây là dạng bài toán phân công tối ưu.
Áp dụng thuật toán Hungari tìm cặp ghép cực đại có trọng số nhỏ nhất

3. Code tham khảo Hungari

const   fi='chuyenBT.inp';
        fo='chuyenBT.out';
        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]]);
        assign(f,fo); rewrite(f);
        writeln(f,res);
        for i:=1 to n do
                if MatchX[i]<>0 then
                        writeln(f,i, ' ',MatchX[i]);
        close(f);
end;

begin
        docfile;
        init;
        xuli;
end.

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

122

123

124

125

126

127

128

129

130

131

132

133

134

135

136

137

138

139

140

141

142

143

144

145

146

147

148

149

150

151

152

153

154

155

156

157

158

159

160

161

162

163

const fi='chuyenBT.inp';

fo='chuyenBT.out';

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;

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;

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;

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]]);

assign(f,fo); rewrite(f);

writeln(f,res);

for i:=1 to n do

if MatchX[i]<>0 then

writeln(f,i, ' ',MatchX[i]);

close(f);

end;

begin

docfile;

init;

xuli;

end.

[Tin học] Xây dựng trường Chuyên Bến Tre

2. Đề bài về cặp ghép cực đại có trọng số nhỏ nhất

Dữ liệu vào

Dữ liệu ra

Example

2. Hướng dẫn Hungari

3. Code tham khảo Hungari

Bài viết liên quan

Trả lời Hủy