Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > IT форум > Помощь студентам
Регистрация

Восстановить пароль

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 10.01.2010, 22:30   #1
d3mon4eg
 
Регистрация: 10.01.2010
Сообщений: 4
По умолчанию Нахождение максимального потока транспортной сети (где ошибка)

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

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

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

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

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

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


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

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

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

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

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

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

Последний раз редактировалось d3mon4eg; 11.01.2010 в 12:21.
d3mon4eg вне форума Ответить с цитированием
Старый 11.01.2010, 08:44   #2
d3mon4eg
 
Регистрация: 10.01.2010
Сообщений: 4
По умолчанию

Вот сам код:

Код:
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;
// определим мин пропускн. способн. и выбираем минимум.Входной параметр строка-путь
d3mon4eg вне форума Ответить с цитированием
Старый 11.01.2010, 08:46   #3
d3mon4eg
 
Регистрация: 10.01.2010
Сообщений: 4
По умолчанию

Код:
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;
d3mon4eg вне форума Ответить с цитированием
Старый 11.01.2010, 08:46   #4
d3mon4eg
 
Регистрация: 10.01.2010
Сообщений: 4
По умолчанию

Код:
//выявление всех возможных путей. Работает. Не трожь!)
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.
d3mon4eg вне форума Ответить с цитированием
Старый 13.06.2015, 15:05   #5
Azot_Epta
Новичок
Джуниор
 
Регистрация: 13.06.2015
Сообщений: 1
По умолчанию Помоги плиз

Друг, не мог бы ты кинуть свою программу, если конечно она не затерялась спустя столько лет, помоги бедному глупому студенту))
Azot_Epta вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Нахождение запущенного сервака в сети. =) mazutka =) Помощь студентам 7 17.05.2013 08:30
нахождение максимального элемента в дереве. Haskell densan Помощь студентам 4 01.06.2009 13:23
TASM - нахождения максимального числа из трех положительных целых чисел и умножения максимального числа iggor Assembler - Ассемблер (FASM, MASM, WASM, NASM, GoASM, Gas, RosAsm, HLA) и не рекомендуем TASM 4 24.05.2009 20:16
Реализация алгоритма нахождения максимального потока в сети Myasnik Помощь студентам 3 06.01.2008 06:42