Bài toán lượng cực đại và ứng dụng

Bài toán lượng cực đại và ứng dụng

Một số ứng dụng của bài toán luồng cực đại

Lê Thanh Hà

Ta xét bài toán sau:

- Có m chàng trai, mỗi chàng biết những cô gái mà anh ta vừa ý trong n cô gái trong làng, liệu có thể xếp cặp cho cả m chàng trai đó không

- Có m thợ, mỗi thợ có khả năng làm được một số công việc nào đó Và bạn hãy xắp xếp việc làm cho m thợ sao cho mội thợ chỉ làm một việc và mỗi việc chỉ do một người thợ đảm nhiệm

Để giải quyết hai bài toán trên ta xây dựng đồ thị với các đỉnh biểu thị cho các chàng trai Ti(hay người thợ) và các cô gái (hay công việc) còn các cạnh biểu thị sự vừa ý của các chàng trai đối với các cô gái Gi (hay khả năng của các người thợ đối với các công việc) Khi đó đồ thị mà ta nhận được là đồ thị hai phía

Giả sử ta đã thu được đồ thị sau:

Ta gán cho trọng số của mỗi cạnh là 1 Và tìm luồng cực đại từ S sang T Nhưng nếu áp dụng thuật toán lát cắt hẹp nhất để tìm luồng cực đại trong một đồ thị tương đối đơn giản này thì quả thật là "đem dao mổ trâu để giết ruồi" Bạn hãy đọc kĩ đoạn chương trình sau, thuật toán đã cắt lược đi rất nhiều bước của thuật toán tìm luồn cực đại để giải bài toán trên Trong đó hoàn toàn không còn các đỉnh S và T nữa và thời gian của thuật toán này

so với thuật toán tìm luồng chuật thì thật tuyệt vời Và thực tế nó đã hoàn toàn chuyển sang dạng thuật toán tìm cặp ghép cực đại trong đồ thị hai phía

uses crt;

const fi = 'input.txt';

fo = 'output.txt';

var m:array[1 200,1 200] of byte; a,b,c,dt:array[1 200] of byte; s:string;

n:byte;

f:text;

time:longint;

tich:longint absolute 0:$46c; procedure input;

var i,j:byte;

begin

assign(f,fi);

reset(f);

readln(f,n);

fillchar(m,sizeof(m),0);

while not eof(f) do

begin

readln(f,i,j);

m[i,j]:=1;

end;

close(f);

end;

procedure tim;

label done;

var i,j,k:byte;

begin

fillchar(a,sizeof(a),0);

fillchar(b,sizeof(b),0);

for i:=1 to n do

if a[i]=0 then

begin

s:=chr(i);

fillchar(c,sizeof(c),0);

repeat

k:=ord(s[length(s)]);

delete(s,length(s),1);

for j:=1 to n do

if (c[j]=0) and (m[k,j]=1) then begin

c[j]:=1;

dt[j]:=k;

if b[j]>0 then s:=s+chr(b[j]) else begin

repeat

b[j]:=dt[j];

k:=a[dt[j]];

a[dt[j]]:=j;

until j=0;

goto done;

end;

end;

until s='';

done: end;

writeln(tich-time);

assign(f,fo);

rewrite(f);

k:=0;

for i:=1 to n do if a[i]<>0 then inc(k);

writeln(f,k);

for i:=1 to n do if a[i]<>0 then writeln(f,i,' ',a[i]);

close(f);

end;

begin

input;

time:=tich;

tim;

end

Tuy nhiên bài toán sẽ thực sự khó hơn nếu như mỗi chàng trai sẽ có một mức độ tình cảm nào đó đối với mỗi cô gái hay mỗi nguời thợ sẽ có một năng xuất nào đó đỗi với mỗi công việc Và công việc của ta phải làm là ghép cặp cho các chàng trai với các cô gái và người thợ với mỗi công việc để không những thoả mãn điều kiện như cũ mà tổng số mức

độ tình cảm hay năng xuất phải là lớn nhất Để giải quyết vấn đề trên ta tiếp tục cải tiến thuật toán trên: Trước tiên ta xây dựng một đồ thị hai phía mới với các đỉnh vẫn như cũ

Ta lần lượt thêm vào đồ thị từng cạnh của đồ thị cũ theo thứ tự từ cao xuống thấp của giá trị trọng số Sau mỗi lần thêm, ta lại tìm một cặp ghép cực đại trong đồ thị đó cho tới khi tìm được giá trị cực đại đó bằng m thì dừng Bạn tham khảo chương trình sau:

uses crt;

const fi = 'input.txt';

fo = 'output.txt';

var m,dx:array[1 150,1 150] of byte;

a,b,c,dtr:array[1 150] of byte;

n:byte;

dem:word;

f:text;

time:longint absolute 0:$46c;

tich:longint;

procedure input;

var i,j:Byte;

begin

assign(f,fi);

reset(f);

readln(f,n);

for i:=1 to n do

begin

for j:=1 to n do read(f,m[i,j]);

readln(f);

close(f);

end;

procedure work;

label 1;

var i,j,k,x,y,max,max1:byte;

s:string;

ok:boolean;

begin

fillchar(a,sizeof(a),0);

fillchar(b,sizeof(b),0);

fillchar(dx,sizeof(dx),0);

max:=0;

for i:=1 to n do

for j:=1 to n do if m[i,j]>max then max:=m[i,j]; repeat

max1:=0;

for i:=1 to n do

for j:=1 to n do

if (dx[i,j]=0) and (m[i,j]>max1) then

begin

max1:=m[i,j];

x:=i;

end;

dx[x,y]:=1;

for i:=1 to n do

if a[i]=0 then

begin

s:=chr(i);

fillchar(c,sizeof(c),0);

repeat

k:=ord(s[1]);

delete(s,1,1);

for j:=1 to n do

if (dx[k,j]=1) and (c[j]=0) then begin

dtr[j]:=k;

c[j]:=1;

if b[j]<>0 then s:=s+chr(b[j]) else

begin

repeat

b[j]:=dtr[j];

k:=a[b[j]];

a[b[j]]:=j;

until j = 0;

goto 1;

end;

end;

until s = '';

1: end;

ok := false;

for i:=1 to n do if a[i]=0 then

begin

ok := true;

writeln(time-tich);

break;

end;

until ok =false;

assign(f,fo);

rewrite(f);

dem:=0;

for i:=1 to n do dem:=dem+m[i,a[i]];

writeln(f,dem);

for i:=1 to n do writeln(f,i,' ',a[i],' ',m[i,a[i]]); close(f);

end;

input;

tich:=time; work;

write(time-tich); end