Добавил:
Опубликованный материал нарушает ваши авторские права? Сообщите нам.
Вуз: Предмет: Файл:
Скачиваний:
13
Добавлен:
01.05.2014
Размер:
5.16 Кб
Скачать
{ Ї®ЁбЄ ¬ ЄбЁ¬ «м­®Ј® Ї®в®Є  ў бҐвЁ by boris }
{ ¬Ґв®¤ ”®а¤ -” «ЄҐаб®­  }
{  «Ј®аЁв¬ ќ¤¬®­¤б -Љ аЇ  }
{ ўЁ§г «Ё§ в®а }

{- Љ®­бв ­вл Ё ЇҐаҐ¬Ґ­­лҐ -}

const
  maxn = 50;                            { ¬ Єб. Є®«-ў® ўҐаиЁ­ }
  oo   = 10E10;                         { ЎҐбЄ®­Ґз­®бвм }

var
  { Ї®в®Є }
  f: array [1..maxn, 1..maxn] of real;  { f[i, j] = -f[j, i] }
  { Їа®ЇгбЄ­лҐ бЇ®б®Ў­®бвЁ }
  c: array [1..maxn, 1..maxn] of real;
  { Є®«ЁзҐбвў® ўҐиаЁ­}
  n: integer;

{- Џ®ЁбЄ ў иЁаЁ­г -}

{ ЋзҐаҐ¤м }

const
  queue_size = maxn + 2;                { а §¬Ґа ®зҐаҐ¤Ё }

type
  queue = record                        { ®зҐаҐ¤м }
    a: array [0..queue_size-1] of integer;
    head, tail: integer;
  end;

{ init_queue: Ё­ЁжЁ «Ё§Ёа®ў вм ®зҐаҐ¤м }
procedure init_queue(var q: queue);
begin
  with q do
  begin
    tail := 0;
    head := 0;
  end;
end;

{ is_queue_empty: Їгбв  «Ё ®зҐаҐ¤м }
function is_queue_empty(const q: queue): boolean;
begin
  is_queue_empty := q.tail = q.head;
end;

{ push_to_queue: Ї®«®¦Ёвм ў ®зҐаҐ¤м x}
procedure push_to_queue(var q: queue; x: integer);
begin
  with q do
  begin
    a[tail] := x;
    tail := (tail + 1) mod queue_size;
  end;
end;

{ pop_from_queue: ¤®бв вм Ё§ ®зҐаҐ¤Ё }
function pop_from_queue(var q: queue): integer;
begin
  with q do
  begin
    pop_from_queue := a[head];
    head := (head + 1) mod queue_size;
  end;
end;

{ ЏҐаҐ¬Ґ­­лҐ }

var
  { ­®¬Ґа ЇаҐ¤л¤г饩 ўҐаиЁ­л}
  p: array [1..maxn] of integer;
  { Ї®бҐйҐ­­®бвм }
  v: array [1..maxn] of boolean;
  { ®зҐаҐ¤м }
  q: queue;

{ bfs: Ї®ЁбЄ ў иЁаЁ­г ¤«п ¬Ґв®¤  ”®а¤ -” «ЄҐаб®­  }
{ ў®§ўа й Ґв true, Ґб«Ё бгйҐбвўгҐв Їгвм ®в s ¤® t }
function bfs(s, t: integer): boolean;
var
  i, j: integer;
begin
  fillchar(v, sizeof(v), false);        { ®Ў­г«пҐ¬ ¬ ббЁў Ї®бҐйҐ­Ё© }
  init_queue(q);                        { Ё­ЁжЁ «Ё§Ёа㥬 ®зҐаҐ¤м }
  push_to_queue(q, s);                  { § в «ЄЁў Ґ¬ ў ®зҐаҐ¤м Ёбв®Є }
  v[s] := true;                         { Ї®бҐвЁ«Ё Ёбв®Є }
  p[s] := -1;                           { г Ёбв®Є  ­Ґв ЇаҐ¤Є  }

  while not is_queue_empty(q) do        { Ї®Є  ®зҐаҐ¤м ­Ґ Їгбв  }
  begin
    i := pop_from_queue(q);             { ¤®бв Ґ¬ ўҐаиЁ­г Ё§ ®зҐаҐ¤Ё }
    for j := 1 to n do                  { ЇҐаҐЎЁа Ґ¬ ўбҐ ўҐаиЁ­л }
      if not v[j] and                   { ўҐаиЁ­  ­Ґ Ї®бҐйҐ­  }
        (c[i, j]-f[i, j] > 0) then      { ॡ஠i->j ­Ґ­ бл饭­®Ґ }
      begin
        v[j] := true;                   { Ї®бҐвЁ«Ё ўҐаиЁ­г j }
        push_to_queue(q, j);            { Ї®«®¦Ё«Ё ўҐаЁиЁ­г j ў ®зҐаҐ¤м }
        p[j] := i;                      { i ЇаҐ¤®Є j }
      end;
  end;

  bfs := v[t];                          { ¤®и«Ё «Ё ¤® бв®Є  }
end;

{- ‚Ё§г «Ёв®а -}

procedure write_flow;
var
  i, j: integer;
begin
  writeln('Њ ваЁж  Ї®в®Є ');
  for i := 1 to n do
  begin
    for j := 1 to n do
      write(f[i, j]:4:0);
    writeln;
  end;
end;

{- Ћб­®ў­лҐ Їа®жҐ¤гал -}

{ min: ¬Ё­Ё¬г¬ Ё§ ¤ўге ўҐйҐб⢥­­ле зЁбҐ« }
function min(a, b: real): real;
begin
  if a > b then min := b else min := a;
end;

{ maxflow: §­ зҐ­Ёп ¬ ЄбЁ¬ «м­®Ј® Ї®в®Є  }
{ Ї®в®Є еа ­Ёвбп ў ¬ ваЁжҐ f, s-Ёбв®Є, t-бв®Є }
function maxflow(s, t: integer): real;
var
  i, j, k: integer;
  d, flow: real;
begin
  fillchar(f, sizeof(f), 0);            { ®Ў­г«пҐ¬ f }
  flow := 0;                            { Ї®в®Є Їгбв®© }

  write_flow;

  while bfs(s, t) do                    { Џ®Є  бгйҐбвўгҐв Їгвм ®в Ёбв®Є  ў }
  begin                                 { ў бв®Є ў ®бв в®з­®© бҐвЁ, ЁйҐ¬   }
    d := oo;                            { ॡ஠ў н⮬ ЇгвЁ б ¬Ё­Ё¬ «м­®©  }
    k := t;                             { ­ҐЁбЇ®«м§®ў ­­®© Їа®ЇгбЄ­®©      }
    while k <> s do                     { бЇ®б®Ў­®бвмо                     }
    begin
      d := min(d, c[p[k], k]-f[p[k], k]);
      k := p[k];                        { ЎҐаҐ¬ ўҐаиЁ­г-ЇаҐ¤®Є }
    end;

    write('ЂгЈ¬Ґ­в «м­л© Їгвм: ');

    k := t;                             { Ё¤Ґ¬ Ї® ­ ©¤Ґ­®¬г ЇгвЁ ®в бв®Є   }
    while k <> s do                     { Є Ёбв®Єг                         }
    begin
      write(k, ' ');
      f[p[k], k] := f[p[k], k] + d;     { 㢥«ЁзЁў Ґ¬ Ї® Їап¬л¬ ॡࠬ }
      f[k, p[k]] := f[k, p[k]] - d;     { 㬥­ми Ґ¬ Ї® ®Ўа в­л¬ ॡࠬ }
      k := p[k];                        { ЎҐаҐ¬ ўҐаиЁ­г-ЇаҐ¤®Є }
    end;

    writeln(s);
    flow := flow + d;                   { 㢥«ЁзЁў Ґ¬ Ї®в®Є }
    writeln('Џ®в®Є 㢥«ЁзҐ­ ­  ', d:0:2);
    write_flow;
    readln;
  end;

  maxflow := flow;                      { ў®§ўа й Ґ¬ ¬ ЄбЁ¬ «м­л© Ї®в®Є }
end;

{ init: Ё­ЁжЁ «Ё§ жЁп Ё ўў®¤ ¤ ­­ле }
procedure init;
var
  m, i, x, y, z: integer;
begin
  fillchar(c, sizeof(c), 0);

  assign(input, 'flow.in');
  reset(input);

  read(n, m);

  for i := 1 to m do
  begin
    read(x, y, z);
    c[x, y] := z;
  end;

  close(input);

  assign(input, 'con');
  reset(input);
end;

{solve: аҐиҐ­ЁҐ }
procedure solve;
begin
  writeln(maxflow(1, 6):0:2);
end;

{- ѓ« ў­ п Їа®Ја ¬¬  -}

begin
  init;
  solve;
end.
Соседние файлы в папке flows