VPF::Нахождение максимального потока (где ошибка?)

d3mon4eg

Дата 10.1.2010, 22:24 (ссылка)

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

Загрузка ...

Новичок

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

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

Привет уважаемые делфи эксперты! smile

Пытаюсь найти ошибку в коде, но не могу. Задача на поиск максимального потока транспортной сети.

Кто не в курсе, кратко объясню алгоритм на пальцах:

1) строим ориентированные графы, на ребрах заполняем "с" - максимальную пропускную способность. изначально f=0 у каждых ребер графа.
2) далее выписываем все возможные пути от х до z. Пример
user posted image

3) берем первый путь, увеличиваем значение переменной "f" на минимальное число "С" по данному пути (которое тоже должно на ребрах подписываться)
4) если с=f, берем это ребро и отмечаем галочками в списке путей из пункта 2, ребра которых совпали с текущим
5) далее берем путь не отмеченный галочкой. Если мы уже проходили по одному ребру (тоесть f заполнена), то "с" этого ребра будет c:=c-f;
6) затем повторяем действия с шага 3. И так пока весь список путей не отметиться галочками.
7) далее смотрим пути которые не дошли от x до z и прибавляем +1 к "f", повторяя с шага 3, пока не дойдем до z. (ЭТОТ ШАГ ЕЩЕ НЕ ДЕЛАЛ В ИСХОДНИКЕ)

Вот как это выглядит:

В моей проге нужно сначала насоздавать достаточное кол-во вершин двойным кликом по пустому месту на форме. Затем кликаем на одну вершину, затем на другую - они соединяются стрелкой и сразу фокус переводится на поле для заполнения "С" данной вершины. И так соединяем все вершины. Затем жмем кнопку "Посчитать", затем "Минимальное С"

ПРОБЛЕМА: не заполняется список путей полностью галочками, не все значения "с" и "f" считаются правильно. Доходят до определенного места, и значения идут в минуса.

Исходник:

Код


unit MainUnit;

interface

uses
  Windows,Messages,SysUtils,Variants,Classes,Graphics,Controls,Forms,
  Dialogs,XPMan,StdCtrls,Buttons,sSkinManager,sButton,sBitBtn,
  ExtCtrls,math,AdvWiiProgressBar,AdvSmoothPanel,sLabel,sEdit,sSpinEdit,
  Spin,ComCtrls,Grids,sAlphaListBox,sCheckListBox;

type
  TMainFrm=class(TForm)
    sSkinManager1: TsSkinManager;
    AdvSmoothPanel1: TAdvSmoothPanel;
    LabeledEdit1: TLabeledEdit;
    sButton1: TsButton;
    sLabel1: TsLabel;
    Memo1: TMemo;
    SpinEdit1: TSpinEdit;
    Label1: TLabel;
    Button1: TButton;
    Button2: TButton;
    sCheckListBox1: TsCheckListBox;
    Label2: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure FormDblClick(Sender: TObject);
    procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure sBitBtn1Click(Sender: TObject);
    procedure line(Sender: TObject);
    procedure drawstr(canv: tcanvas; x1,y1,x2,y2: integer);
    procedure hideedit(Sender: TObject);
    procedure Edit1KeyPress(Sender: TObject; var Key: Char);
    procedure sButton1Click(Sender: TObject);
    procedure LabeledEdit1Change(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    function getminvaluec(u: string): integer;
    function metka(u: string): integer;
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    button: array[1..50] of TSbutton; //массив вершин графа

  end;
  TCoord=record //переменные для координат мыши во время нажатия кнопки
    savex: integer;  // делал для выведения С и F посередине ребра
    savey: integer;
  end;
  TTrack=record  //Путь, некоторые переменные пока не использовал
    c: integer;
    f: integer;
    buf: integer;
    track: boolean;
    polon: boolean;
    dot1: string; //точка начала ребра. Например "х"
    dot2: string; //точка конца ребра. Например "2"
  end;

var
  MainFrm: TMainFrm;
  coordX,coordY: integer;
  i,m,k,h: integer;
  Coord1: Tcoord; // координаты, нужны для выведения посередине ребра надписи
  Coord2: Tcoord;
  track: TTrack; // Путь
  pushbtn: boolean; // узнать, нажали ли кнопку
  tempedit: Tedit;  // не юзал вроде
  tracking: array[1..50] of TTrack; // массив путей, описанных выше
  strlst: Tstringlist; // не юзал вроде

implementation

{$R *.dfm}
// пометка пути (входной параметр) из списка, выходной еще не использовал
function TMainFrm.metka(u: string): integer;
var z,x,b,p: integer;
  s,s2: string;
begin
  z:=length(u);
  s:=u; // }  f присваиваем мин значение. Код до конца ф-ии
  for h:=1 to 50 do
    begin
      for i:=1 to z-1 do
        begin
          if (tracking[h].dot1+tracking[h].dot2)=(s[i]+s[i+1]) then
            begin
              if tracking[h].c=tracking[h].f then
                begin
                  for x:=0 to schecklistbox1.Count-1 do
                    begin         // отмечаем пути, где в ребрах с=f
                      s2:=schecklistbox1.Items.Strings[x];
                      for b:=1 to length(schecklistbox1.Items.Strings[x])-1 do
                        if (tracking[h].dot1+tracking[h].dot2)=(s2[b]+s2[b+1]) then
                          schecklistbox1.Checked[x]:=true;
                    end;
                end;
            end;
        end;
    end;
end;
// определим мин пропускн. способн. и выбираем минимум.Входной параметр строка-путь

function TMainFrm.getminvaluec(u: string): integer;
var s: string;
  minvaluec,j,z,x: integer;//minvaluec - мин. знач. С
  bufmin: array[1..50] of integer; // индекс найденных путей tracking[] в строке, не использовал
begin
  x:=1;
  minvaluec:=1000; // на всякий пожарный, чтобы уменьшать значение при сравнении
  z:=length(u);
  s:=u;
//  вычисляем уже встречавшиеся пути с-f
  for h:=1 to 50 do
    begin
      for i:=1 to z-1 do
        begin
          if (tracking[h].dot1+tracking[h].dot2)=(s[i]+s[i+1]) then
            begin
              if tracking[h].track then  //если уже проходили по этому пути
                begin
                  tracking[h].c:=tracking[h].c-tracking[h].f;
                 // showmessage(inttostr(tracking[h].f));
                end;
            end;
        end;
    end;
// находим минимальное с
  for h:=1 to 50 do
    begin
      for i:=1 to z-1 do
        begin
          if (tracking[h].dot1+tracking[h].dot2)=(s[i]+s[i+1]) then
            begin
              if tracking[h].c<minvaluec then
                begin
                  minvaluec:=tracking[h].c;
                end;
              tracking[h].track:=true;
            end;
        end;
    end;

  for h:=1 to 50 do // f присваиваем мин значение c
    begin
      for i:=1 to z-1 do
        begin
          if (tracking[h].dot1+tracking[h].dot2)=(s[i]+s[i+1]) then
            begin
              tracking[h].f:=tracking[h].f+minvaluec;
            end;
        end;
    end;
  result:=minvaluec;
end;

procedure TMainFrm.hideedit(Sender: TObject);
begin
{canvas.TextOut((coordx+coord1.savex) div 2,(coordy+coord1.savey) div 2,tempedit.Text);
tempedit.Free;
mainfrm.Repaint;
mainfrm.Refresh;}
end;

procedure TMainFrm.drawstr(canv: tcanvas; x1,y1,x2,y2: integer);
var x3,x4,y3,y4: real; x5,y5,ox,oy: real;
begin     // функция для вырисовки стрелки
  if (x1<>x2)or(y1<>y2) then begin
      x5:=abs(((x2-x1)*sqrt(200)/sqrt(sqr(x2-x1)+sqr(y2-y1)))-x2);
      y5:=abs(((y2-y1)*sqrt(200)/sqrt(sqr(x2-x1)+sqr(y2-y1)))-y2);
      ox:=(x2-(x2-x5)/2);
      oy:=(y2-(y2-y5)/2);
      x3:=(ox-(y2-y5)/2);
      y3:=(oy+(x2-x5)/2);
      x4:=(ox+(y2-y5)/2);
      y4:=(oy-(x2-x5)/2);
      canv.Pen.Width:=spinedit1.Value;
      with canv do begin
          moveto(round(x1),round(y1));
          lineto(round(x2),round(y2));
          lineto(round(x3),round(y3));
          lineto(round(x4),round(y4));
          lineto(round(x2),round(y2));
        end; end;
end;

procedure TMainFrm.line(Sender: TObject);
begin
  if pushbtn then  //если нажали кнопку
    begin
      coord2.savex:=coordx;
      coord2.savey:=coordy;
      drawstr(canvas,coord1.savex,coord1.savey,coord2.savex,coord2.savey);
      Labelededit1.SetFocus;
      pushbtn:=false;
      tracking[k].dot2:=(Sender as TButton).caption;//запоминаем
      inc(k);
      strlst.Text:=strlst.Text+tracking[m].dot1+tracking[m].dot2+#13#10;
      inc(m);
    end else
    begin
      button[i-1].Caption:='z'; // последней вершине присваиваем имя Z
      coord1.savex:=coordx;
      coord1.savey:=coordy;
      pushbtn:=true;
      tracking[k].dot1:=(Sender as TButton).Caption;
    end;
end;


procedure TMainFrm.FormCreate(Sender: TObject);
begin
//sskinmanager1.SkinDirectory:=extractfilepath(application.ExeName);
//sskinmanager1.SkinName:='Office2007 Blue (internal) extracted';
  sskinmanager1.Active:=true;  // понтовое оформление
  strlst:=Tstringlist.Create;  // список ребер
  i:=1;
  k:=1;
  m:=1;
  h:=-1;
end;
//создание вершины даблкликом по пустой форме
procedure TMainFrm.FormDblClick(Sender: TObject);
begin
  button[i]:=TSButton.Create(MainFrm);
  button[i].Parent:=MainFrm;
  button[i].top:=coordy;
  button[i].left:=coordx;
  button[i].Width:=61;
  button[i].Height:=61;
  button[i].SkinData.SkinSection:='BUTTON_HUGE';
  if i=1 then
    button[i].Caption:='x' else
    button[i].Caption:=inttostr(i-1);
  button[i].Font.Size:=18;
  button[i].OnClick:=line;
  inc(i);
end;

procedure TMainFrm.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  coordX:=x;//запоминаем координаты мыши, чтобы потом вычислить середину ребра
  coordY:=y;
//canvas.LineTo(.);
// canvas.Pen.Style:=psXOR;
end;

procedure TMainFrm.sBitBtn1Click(Sender: TObject);
begin
  showmessage(Labelededit1.Text);
end;

procedure TMainFrm.Edit1KeyPress(Sender: TObject; var Key: Char);
var s: string;
begin
  if key=#13 then  //вывод надписи "С" посередине ребра
    canvas.TextOut((coord2.savex+coord1.savex)div 2,(coord2.savey+coord1.savey)div 2,Labelededit1.Text);
end;
//выявление всех возможных путей. Работает. Не трожь!)
procedure TMainFrm.sButton1Click(Sender: TObject);
label step2;
var i,j,o,v,g: integer;
  label25: Tlabel;
  s1,s2: string;
  ss2,ss1: string;
  strlst1,strlst2,strlst3: Tstringlist;
begin

// анализ и преобразование путей
  strlst1:=Tstringlist.Create;
  strlst2:=Tstringlist.Create;
  strlst3:=Tstringlist.Create;
  strlst1.AddStrings(strlst);
//////step 1//////
  for i:=strlst1.Count-1 downto 0 do
    begin
      s1:=strlst1[i];
      if s1[1]='x' then
        begin
          strlst2.Add(strlst1[i]);
          strlst1.Delete(i);
        end;
    end;
//////step 2/////
  step2:
  for j:=0 to strlst2.Count-1 do
    begin
      for i:=0 to strlst1.Count-1 do
        begin
          s1:=strlst1[i];
          s2:=strlst2[j];
          if s2[length(s2)]=s1[1] then
            strlst3.Add(s2+copy(s1,2,length(s1)));
        end;
    end;
//////step 3//////
  strlst2.Clear;
//////step 4//////
  for i:=strlst3.Count-1 downto 0 do
    begin
      s1:=strlst3[i];
      if s1[length(s1)]<>'z' then
        begin
          strlst2.Add(strlst3[i]);
          strlst3.Delete(i);
        end;
    end;
/////////step 5/////
  if strlst2.Text<>'' then
    goto step2;
  memo1.Lines.AddStrings(strlst3);
  schecklistbox1.Items.AddStrings(strlst3);
end;

procedure TMainFrm.LabeledEdit1Change(Sender: TObject);
begin //рисуем значение "С" посередине ребра
  tracking[k-1].c:=strtoint(labelededit1.Text);
  canvas.TextOut((coord2.savex+coord1.savex)div 2,(coord2.savey+coord1.savey)div 2,'c='+Labelededit1.Text);
end;

procedure TMainFrm.Button1Click(Sender: TObject);
var s: string;
  minvaluec,j,z,x: integer;
begin      //Ну вот и главная кнопка
  for j:=0 to schecklistbox1.Items.Count-1 do
    begin
      if schecklistbox1.Checked[j]=false then
        begin
          memo1.Lines.Add(inttostr(getminvaluec(schecklistbox1.Items.Strings[j])));
          metka(schecklistbox1.Items.Strings[j]);
        end;
    end;

 { for z:=1 to 10 do
  begin
  for j:=0 to schecklistbox1.Items.Count-1 do
  if schecklistbox1.Checked[j]=true then
  metka(schecklistbox1.Items.Strings[j-1]);
  end;}
end;

procedure TMainFrm.Button2Click(Sender: TObject);
var i: integer;
begin
  for i:=1 to 20 do
    begin   //посмотреть, че в "С" и "F" творится
      slabel1.Caption:=slabel1.Caption+inttostr(tracking[i].f)+#13#10;
      label2.Caption:=label2.Caption+inttostr(tracking[i].c)+#13#10;
    end;
end;

end.

Из дополнительных компонентов юзал TMS, Alphaskins, вроде все.

Если кто делал такую прогу выложите плиз.

PS гуглил, по форуму искал. Все найденные варианты НЕ в графическом виде реализованы (нужно наглядные графы (вершины, ребра)), как у меня. Да и к тому же они были очень сложные, не смог понять код.

Премного благодарен.

DarkProg

Дата 11.1.2010, 00:04 (ссылка)

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

Загрузка ...

Законченный романтик

Профиль
Группа: Завсегдатай
Сообщений: 1784
Регистрация: 11.3.2009
Где: Земля

Репутация: 4
Всего: 19

Первая ошибка состоит в том что ты начинаешь подсчёт уже после того как нашёл все пути, начинай подсчёт во время поиска путей, так будет проще правильнее

И ты неправильно ищещь максимальный поток, максимальный поток определяется путём у которого наименьшее ребро как можно больше, в твоём примере максимальный поток равен 6(так мне объясняли), а ты зачем-то пребавляешь наименьшее ребро - мне непонятно как ты ищешь, кинь ссылку, где ты это вычитал.

Вообще странно, меня учили так как я написал, хотя я был не согласен с тем что не преподавали, ну просто вроде как по твоей системе если правильно всё распределить, то дойдёт 9, это при правильном распределении и если одновременно отправить максимум из Х в вершину 1 и 2, ну в общем интересно...

Цитата(d3mon4eg @ 10.1.2010, 22:24

)

ПРОБЛЕМА: не заполняется список путей полностью галочками, не все значения "с" и "f" считаются правильно. Доходят до определенного места, и значения идут в минуса.

ну насчёт перебора всех путей я уже написал; проблема с минусами связана с тем что ты там что-то отнимаешь(я не понял зачем), если походить по всем путям во время их определения, то проблем не должно возникнуть.

Извини, но у меня пока нет времени и нужных компонентов smile

, чтобы посмотреть твой код

--------------------

"И твоя голова всегда в ответе за то куда сядет твой зад..."

"Я студент - скажите с какого я ВУЗа..."

smile

d3mon4eg

Дата 11.1.2010, 12:53 (ссылка)

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

Загрузка ...

Новичок

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

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

Цитата

Первая ошибка состоит в том что ты начинаешь подсчёт уже после того как нашёл все пути, начинай подсчёт во время поиска путей, так будет проще правильнее

Даже не знаю. Нас учили сначала выписывать все возможные пути (моя прога справилась с этой задачей).

Цитата

И ты неправильно ищещь максимальный поток, максимальный поток определяется путём у которого наименьшее ребро как можно больше, в твоём примере максимальный поток равен 6(так мне объясняли), а ты зачем-то пребавляешь наименьшее ребро - мне непонятно как ты ищешь, кинь ссылку, где ты это вычитал.

Вообще ответ не должен быть одним числом. Весь построенный граф с посчитанными значениями, это и будет ответ. Я это НЕ из книг взял. Весь алгоритм нам так объяснили. Даже помню 5 за это получил на контрольной smile

Цитата

Извини, но у меня пока нет времени и нужных компонентов , чтобы посмотреть твой код

и на том спасибо

DarkProg

Дата 11.1.2010, 17:35 (ссылка)

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

Загрузка ...

Законченный романтик

Профиль
Группа: Завсегдатай
Сообщений: 1784
Регистрация: 11.3.2009
Где: Земля

Репутация: 4
Всего: 19

Цитата(d3mon4eg @ 11.1.2010, 12:53

)

Даже не знаю. Нас учили сначала выписывать все возможные пути (моя прога справилась с этой задачей).

Тебе обязательно нужно следовать чётким инструкциям???
Я вот тебе скажу, что если будешь всё считаь во время нахождения всех путей, то твоя прога заработает как минимум в 2 раза быстрее smile

Просто совет на будущее: нужно думать чтобы твоя прога летала не на Пентиуме4 с 2 гб ОЗУ и +побольше видюхи, а на расчитывать чтобы она лётала на i486 с 2 мб ОЗУ и 2 мб видеопамяти smile

Цитата(d3mon4eg @ 11.1.2010, 12:53

)

Вообще ответ не должен быть одним числом. Весь построенный граф с посчитанными значениями, это и будет ответ. Я это НЕ из книг взял. Весь алгоритм нам так объяснили.

Просто максимальный поток это и есть одно число, а как ты ещё узнаешь максимум сколько пройёт по твоему пути???

--------------------

"И твоя голова всегда в ответе за то куда сядет твой зад..."

"Я студент - скажите с какого я ВУЗа..."

smile

d3mon4eg

Дата 11.1.2010, 19:09 (ссылка)

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

Загрузка ...

Новичок

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

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

Цитата

Просто максимальный поток это и есть одно число, а как ты ещё узнаешь максимум сколько пройёт по твоему пути???

да, наверно так и есть. Щас уже не вспомню.

Цитата

Тебе обязательно нужно следовать чётким инструкциям???

Ну можно и как ты говоришь. Я обычно и стараюсь так делать. Но щас более важна скорость написание программы, а не работы, т.к. не сегодня-завтра мне ее нужно сдавать. Если не сдам, плакал мой автомат по дискретной математике smile

DarkProg

Дата 11.1.2010, 20:02 (ссылка)

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

Загрузка ...

Законченный романтик

Профиль
Группа: Завсегдатай
Сообщений: 1784
Регистрация: 11.3.2009
Где: Земля

Репутация: 4
Всего: 19

Я попробую помочь, но для этого выложи всю папку с проектом, а то с одним кодом тяжело набросать проект

P.S. для облегчения веса архива удали скомпилированный еxe-шник

Добавлено через 8 минут и 1 секунду
Пpuмep. Paccмoтpим ceть, зaдaннyю нa pиcунке. Tpeбyeтcя нaйти мaкcимaльнo вoзмoжный пoтoк из yзлa 1 в yзeл 7.

Bычиcлим пpoпycкнyю cпocoбнocть ключeвыx ceчeний.

Имeeм пpoпycкнaя cпocoбнocть ceчeния {(1,2), (1,3)} paвнa 4,

пpoпycкнaя cпocoбнocть ceчeния {(2, 4), (3, 5)} paвнa 4,

пpoпycкнaя cпocoбнocть ceчeния {(1, 3), (2, 3), (6, 7)}paвнa 5,

пpoпycкнaя cпocoбнocть ceчeния {(5,7), (6,7)} paвнa 2.

Cpaвнивaя пpoпycкныe cпocoбнocти ceчeний, пoлyчaeм, чтo мaк-cимaльный пoтoк oтвepшины 1 к вepшинe 7 paвeн 2.

Это пример оттуда откуда мне давали, может тебе чем-то поможет.

Присоединённый файл ( Кол-во скачиваний: 11 )

image003.jpg 5,58 Kb

--------------------

"И твоя голова всегда в ответе за то куда сядет твой зад..."

"Я студент - скажите с какого я ВУЗа..."

smile

d3mon4eg

Дата 11.1.2010, 22:20 (ссылка)

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

Загрузка ...

Новичок

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

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

У нас все таки немногу по другому. У нас ориентированные графы, это которые со стрелками, тоесть движение возможно только в одно направление. Эти графы вроде как могут вычислять пропускную способность дорог и электрических проводов.

Вот, держи исходник. Там нужно установить компоненты tms и alphaskins. Но впринципе можно заменить лейблы sLabel стандартными, кнопки sButton тоже. Единственное sCheckListBoxEx. Это где пути с галочками, скрин наверху. Я использовал массив записей для облегчения. Этот массив записей - ребра (не путай только с вершинами). У него несколько использованных свойств:

1) tracking[x].dot1 - начальная точка и tracking[x].dot2 - конечная (если их сложить то буит например x2)

2) tracking[x].track - булевый индикатор, проходил ли уже по этому пути

3) tracking[x].с и tracking[x].f - значения пропускной способн. и Фи

Присоединённый файл ( Кол-во скачиваний: 19 )

routing.rar 761,58 Kb

d3mon4eg

Дата 12.1.2010, 09:42 (ссылка)

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

Загрузка ...

Новичок

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

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

ВНИМАНИЕ! Переписал полностью на Delphi 7 без сторонних компонентов !!!!!!

Выкладываю исходник, помогите до завтра.

Присоединённый файл ( Кол-во скачиваний: 49 )

___delphi_7.zip 471,51 Kb

d3mon4eg

Дата 12.1.2010, 13:54 (ссылка)

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

Загрузка ...

Новичок

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

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

Всем спасиба, мне уже помогли

DarkProg

Дата 12.1.2010, 18:25 (ссылка)

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

Загрузка ...

Законченный романтик

Профиль
Группа: Завсегдатай
Сообщений: 1784
Регистрация: 11.3.2009
Где: Земля

Репутация: 4
Всего: 19

Цитата(d3mon4eg @ 12.1.2010, 13:54

)

Всем спасиба, мне уже помогли

Тогда пометь тему решённой smile

--------------------

"И твоя голова всегда в ответе за то куда сядет твой зад..."

"Я студент - скажите с какого я ВУЗа..."

smile

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