VPF::Задача о максимальном потоке - Форум программистов

(:((_4YM_)):)

Дата 25.11.2005, 21:23 (ссылка)

(голосов: 0)

Загрузка ...

Unregistered

Задачка находится вот тут, там отсканеные картинки.

http://forum.spacenet.ru/blahdocs/uploads/file0001_3310.jpg
http://forum.spacenet.ru/blahdocs/uploads/file0002_3589.jpg

Народ если кому невпадлу напешите пожалуйста программу ну или хотяб что нить посоветуйте.

smile

Спасибо !!!!

Zero

Дата 25.11.2005, 23:13 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Завсегдатай
Сообщений: 2169
Регистрация: 23.10.2004
Где: Россия, г. Рязань

Репутация: нет
Всего: 24

Цитата

Народ если кому невпадлу напешите пожалуйста программу ну или хотяб что нить посоветуйте.

Прочитай 3-ю строчку в верху, в окне "Правила формуа Паскаль" она выделена красным цветом, но видимо, нужно её ещё и 12-ым шрифтом снабдить, а то наверно плохо заметна.

eskaflone

Дата 26.11.2005, 14:47 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

Профиль
Группа: Участник
Сообщений: 75
Регистрация: 5.11.2005

Репутация: нет
Всего: 3

Код


program max_flow_in_net;
const max_n = 20;
var c : array[1..max_n,1..max_n]of integer;
    f : array[1..max_n,1..max_n]of integer;
    met : array[1..max_n,1..2]of integer;
    n,s,t : integer;
    i,j : integer;
    bb : boolean;

procedure init;
begin
   read(n);
   for i := 1 to n do
      for j := 1 to n do
         read(c[i,j]);
   read(s,t);
end;

procedure out;
var sum : integer;
begin
   for i := 1 to n do
   begin
      for j := 1 to n do write(f[i,j],' ');
      writeln;
   end;
   sum := f[s,1];
   for i := 2 to n do
      sum := sum + f[s,i];
   writeln(sum);
end;

procedure SetMet;
var m : set of 1..max_n;
    i,l : integer;
begin
   m := [1..n];
   met[s,1] := s;met[s,2] := maxint;
   l := s;
   while (met[t,1] = 0) and bb do
      begin
         for i := 1 to n do
            if (met[i,1] = 0) and ((c[l,i] <> 0) or (c[i,l] <> 0)) then
               if f[l,i] < c[l,i] then
                  begin
                     met[i,1] := l;
                     if met[l,2] < c[l,i] - f[l,i] then
                        met[i,2] := met[l,2] else
                        met[i,2] := c[l,i] - f[l,i];
                  end else
                     if f[i,l] > 0 then
                        begin
                           met[i,1] := -l;
                           if met[l,2] < f[i,l] then
                              met[i,2] := met[l,2] else
                              met[i,2] := f[i,l];
                        end;
         m := m - [l];
         l := 1;
         repeat
            l := l + 1;
         until (l > n) or ((met[l,1] <> 0) and (l in m));
         if l > n then bb := false;
      end;
end;

procedure ChangeFlow(q : integer);
begin
   if met[q,1] > 0 then
      f[met[q,1],q] := f[met[q,1],q] + met[t,2] else
      f[q,abs(met[q,1])] := f[q,abs(met[q,1])] - met[t,2];
   if abs (met[q,1]) <> s then
      ChangeFlow(abs(met[q,1]));
end;

begin
   init;
   fillchar(f,sizeof(f),0);
   bb := true;
   while bb do
      begin
         fillchar(met,sizeof(met),0);
         SetMet;
         if bb then ChangeFlow(t);
      end;
   out;
end.

входные данные : матрица весов ребер ,начальная и конечная вершины.
выходные данные : максимальный поток и матрица потока (через какие ребра проходят части потока)

0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Object Pascal: кроссплатформенные технологии \| Следующая тема »