Форум программистов [Powered by Invision Power Board]

Версия для печати темы
Нажмите сюда для просмотра этой темы в оригинальном формате

Форум программистов > Object Pascal: кроссплатформенные технологии > Задача о максимальном потоке

Автор: (:((_4YM_)):) 25.11.2005, 21:23

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

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

Цитата

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

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

Автор: eskaflone 26.11.2005, 14:47

Код


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.

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