Общий форумMaximum weight matching, how to do?(easy to program not the best one) help! Here is my solution of 1076. (Hungary algorithm) Послано Agh 14 апр 2003 18:42 {$R+,Q+,S+} const maxn = 200; var w : array[1..maxn, 0..maxn] of integer; lx, ly : array[1..maxn] of integer; ux, uy : array[1..maxn] of boolean; g : array[1..maxn] of integer; n, d : integer; i, x, y : integer; function can(x, y : integer) : boolean; begin can := lx[x] + ly[y] = w[x, y]; end; function process(k : integer) : boolean; var i : integer; begin if ux[k] then begin process := false; exit; end; ux[k] := true; for i := 1 to n do if can(k, i) then begin uy[i] := true; if (g[i] = 0) or (process(g[i])) then begin g[i] := k; process := true; exit; end; end; process := false; end; begin { assign(input, 'input.txt'); reset(input); assign(output, 'output.txt'); rewrite(output);} fillchar(w, sizeof(w), 0); read(n); for x := 1 to n do for y := 1 to n do begin read(w[x, y]); w[x, 0] := w[x, 0] + w[x, y]; end; fillchar(lx, sizeof(lx), 0); fillchar(ly, sizeof(ly), 0); for x := 1 to n do begin lx[x] := maxint; for y := 1 to n do begin w[x, y] := w[x, 0] - w[x, y]; if w[x, y] < lx[x] then lx[x] := w[x, y]; ly[y] := 0; end; w[x, 0] := 0; end; fillchar(g, sizeof(g), 0); for i := 1 to n do begin fillchar(ux, sizeof(ux), false); fillchar(uy, sizeof(uy), false); while not process(i) do begin d := maxint; for x := 1 to n do if ux[x] then for y := 1 to n do if not uy[y] then begin if w[x, y] - lx[x] - ly[y] < d then d := w[x, y] - lx [x] - ly[y]; end; for x := 1 to n do if ux[x] then lx[x] := lx[x] + d; for y := 1 to n do if uy[y] then ly[y] := ly[y] - d; fillchar(ux, sizeof(ux), false); fillchar(uy, sizeof(uy), false); end; end; d := 0; for i := 1 to n do d := d + w[g[i], i]; writeln(d); end. thank you very much but it'll better if in C not pascal : ) > {$R+,Q+,S+} > const maxn = 200; > var w : array[1..maxn, 0..maxn] of integer; > lx, ly : array[1..maxn] of integer; > ux, uy : array[1..maxn] of boolean; > g : array[1..maxn] of integer; > n, d : integer; > i, x, y : integer; > > function can(x, y : integer) : boolean; > begin > can := lx[x] + ly[y] = w[x, y]; > end; > > function process(k : integer) : boolean; > var i : integer; > begin > if ux[k] then > begin > process := false; > exit; > end; > ux[k] := true; > > for i := 1 to n do > if can(k, i) then > begin > uy[i] := true; > if (g[i] = 0) or (process(g[i])) then > begin > g[i] := k; > process := true; > exit; > end; > end; > process := false; > end; > > begin > { assign(input, 'input.txt'); reset(input); > assign(output, 'output.txt'); rewrite(output);} > > fillchar(w, sizeof(w), 0); > read(n); > for x := 1 to n do > for y := 1 to n do > begin > read(w[x, y]); > w[x, 0] := w[x, 0] + w[x, y]; > end; > > fillchar(lx, sizeof(lx), 0); > fillchar(ly, sizeof(ly), 0); > for x := 1 to n do > begin > lx[x] := maxint; > for y := 1 to n do > begin > w[x, y] := w[x, 0] - w[x, y]; > if w[x, y] < lx[x] then lx[x] := w[x, y]; > ly[y] := 0; > end; > w[x, 0] := 0; > end; > > fillchar(g, sizeof(g), 0); > for i := 1 to n do > begin > fillchar(ux, sizeof(ux), false); > fillchar(uy, sizeof(uy), false); > while not process(i) do > begin > d := maxint; > for x := 1 to n do > if ux[x] then > for y := 1 to n do > if not uy[y] then > begin > if w[x, y] - lx[x] - ly[y] < d then d := w[x, y] - lx > [x] - ly[y]; > end; > for x := 1 to n do > if ux[x] then lx[x] := lx[x] + d; > for y := 1 to n do > if uy[y] then ly[y] := ly[y] - d; > fillchar(ux, sizeof(ux), false); > fillchar(uy, sizeof(uy), false); > end; > end; > > d := 0; > for i := 1 to n do > d := d + w[g[i], i]; > writeln(d); > end. and i know that it have another solution that use network flow but i have no idea about it anyone help! > |