ENG  RUSTimus Online Judge
Online Judge
Задачи
Авторы
Соревнования
О системе
Часто задаваемые вопросы
Новости сайта
Форум
Ссылки
Архив задач
Отправить на проверку
Состояние проверки
Руководство
Регистрация
Исправить данные
Рейтинг авторов
Текущее соревнование
Расписание
Прошедшие соревнования
Правила
вернуться в форум

Общий форум

Maximum weight matching, how to do?(easy to program not the best one) help!
Послано TheBlaNK 14 апр 2003 01:44
on bipartite graph
Послано TheBlaNK 14 апр 2003 01:46
>
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 : )
Послано TheBlaNK 15 апр 2003 00:19
> {$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!
Послано TheBlaNK 15 апр 2003 00:20
>