Экспертная система Delphi.int.ru

Сообщество программистов
Общение, помощь, обмен опытом
Логин:
Пароль:
Регистрация | Забыли пароль?

Delphi.int.ru Expert

Другие разделы портала

Переход к вопросу:

#   

Статистика за сегодня:  


Лучшие эксперты

Подробнее »

Вопрос # 3 641

Раздел: Delphi » Общие вопросы по программированию
/ вопрос открыт /

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

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

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

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

Вот как это выглядит:
http://s60.radikal.ru/i170/1001/5b/6b694380a2da.jpg

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

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

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

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

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

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

Приложение:
  1. unit MainUnit;
  2.  
  3. interface
  4.  
  5. uses
  6. Windows,Messages,SysUtils,Variants,Classes,Graphics,Controls,Forms,
  7. Dialogs,XPMan,StdCtrls,Buttons,sSkinManager,sButton,sBitBtn,
  8. ExtCtrls,math,AdvWiiProgressBar,AdvSmoothPanel,sLabel,sEdit,sSpinEdit,
  9. Spin,ComCtrls,Grids,sAlphaListBox,sCheckListBox;
  10.  
  11. type
  12. TMainFrm=class(TForm)
  13. sSkinManager1: TsSkinManager;
  14. AdvSmoothPanel1: TAdvSmoothPanel;
  15. LabeledEdit1: TLabeledEdit;
  16. sButton1: TsButton;
  17. sLabel1: TsLabel;
  18. Memo1: TMemo;
  19. SpinEdit1: TSpinEdit;
  20. Label1: TLabel;
  21. Button1: TButton;
  22. Button2: TButton;
  23. sCheckListBox1: TsCheckListBox;
  24. Label2: TLabel;
  25. procedure FormCreate(Sender: TObject);
  26. procedure FormDblClick(Sender: TObject);
  27. procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,
  28. Y: Integer);
  29. procedure sBitBtn1Click(Sender: TObject);
  30. procedure line(Sender: TObject);
  31. procedure drawstr(canv: tcanvas; x1,y1,x2,y2: integer);
  32. procedure hideedit(Sender: TObject);
  33. procedure Edit1KeyPress(Sender: TObject; var Key: Char);
  34. procedure sButton1Click(Sender: TObject);
  35. procedure LabeledEdit1Change(Sender: TObject);
  36. procedure Button1Click(Sender: TObject);
  37. function getminvaluec(u: string): integer;
  38. function metka(u: string): integer;
  39. procedure Button2Click(Sender: TObject);
  40. private
  41. { Private declarations }
  42. public
  43. { Public declarations }
  44.  
  45.  
  46. end;
  47.  
  48.  
  49. savey: integer;
  50. end;
  51.  
  52. c: integer;
  53. f: integer;
  54. buf: integer;
  55. track: boolean;
  56. polon: boolean;
  57.  
  58.  
  59. end;
  60.  
  61. var
  62. MainFrm: TMainFrm;
  63. coordX,coordY: integer;
  64. i,m,k,h: integer;
  65.  
  66. Coord2: Tcoord;
  67.  
  68.  
  69.  
  70.  
  71.  
  72.  
  73. implementation
  74.  
  75. {$R *.dfm}
  76.  
  77. function TMainFrm.metka(u: string): integer;
  78. var z,x,b,p: integer;
  79. s,s2: string;
  80. begin
  81. z:=length(u);
  82.  
  83. for h:=1 to 50 do
  84. begin
  85. for i:=1 to z-1 do
  86. begin
  87. if (tracking[h].dot1+tracking[h].dot2)=(s[i]+s[i+1]) then
  88. begin
  89. if tracking[h].c=tracking[h].f then
  90. begin
  91. for x:=0 to schecklistbox1.Count-1 do
  92.  
  93. s2:=schecklistbox1.Items.Strings[x];
  94. for b:=1 to length(schecklistbox1.Items.Strings[x])-1 do
  95. if (tracking[h].dot1+tracking[h].dot2)=(s2[b]+s2[b+1]) then
  96. schecklistbox1.Checked[x]:=true;
  97. end;
  98. end;
  99. end;
  100. end;
  101. end;
  102. end;
  103.  
  104.  
  105. function TMainFrm.getminvaluec(u: string): integer;
  106. var s: string;
  107.  
  108.  
  109. begin
  110. x:=1;
  111.  
  112. z:=length(u);
  113. s:=u;
  114.  
  115. for h:=1 to 50 do
  116. begin
  117. for i:=1 to z-1 do
  118. begin
  119. if (tracking[h].dot1+tracking[h].dot2)=(s[i]+s[i+1]) then
  120. begin
  121.  
  122. begin
  123. tracking[h].c:=tracking[h].c-tracking[h].f;
  124. // showmessage(inttostr(tracking[h].f));
  125. end;
  126. end;
  127. end;
  128. end;
  129.  
  130. for h:=1 to 50 do
  131. begin
  132. for i:=1 to z-1 do
  133. begin
  134. if (tracking[h].dot1+tracking[h].dot2)=(s[i]+s[i+1]) then
  135. begin
  136. if tracking[h].c<minvaluec then
  137. begin
  138. minvaluec:=tracking[h].c;
  139. end;
  140. tracking[h].track:=true;
  141. end;
  142. end;
  143. end;
  144.  
  145.  
  146. begin
  147. for i:=1 to z-1 do
  148. begin
  149. if (tracking[h].dot1+tracking[h].dot2)=(s[i]+s[i+1]) then
  150. begin
  151. tracking[h].f:=tracking[h].f+minvaluec;
  152. end;
  153. end;
  154. end;
  155. result:=minvaluec;
  156. end;
  157.  
  158. procedure TMainFrm.hideedit(Sender: TObject);
  159. begin
  160. {canvas.TextOut((coordx+coord1.savex) div 2,(coordy+coord1.savey) div 2,tempedit.Text);
  161. tempedit.Free;
  162. mainfrm.Repaint;
  163. mainfrm.Refresh;}
  164. end;
  165.  
  166. procedure TMainFrm.drawstr(canv: tcanvas; x1,y1,x2,y2: integer);
  167. var x3,x4,y3,y4: real; x5,y5,ox,oy: real;
  168.  
  169. if (x1<>x2)or(y1<>y2) then begin
  170. x5:=abs(((x2-x1)*sqrt(200)/sqrt(sqr(x2-x1)+sqr(y2-y1)))-x2);
  171. y5:=abs(((y2-y1)*sqrt(200)/sqrt(sqr(x2-x1)+sqr(y2-y1)))-y2);
  172. ox:=(x2-(x2-x5)/2);
  173. oy:=(y2-(y2-y5)/2);
  174. x3:=(ox-(y2-y5)/2);
  175. y3:=(oy+(x2-x5)/2);
  176. x4:=(ox+(y2-y5)/2);
  177. y4:=(oy-(x2-x5)/2);
  178. canv.Pen.Width:=spinedit1.Value;
  179. with canv do begin
  180. moveto(round(x1),round(y1));
  181. lineto(round(x2),round(y2));
  182. lineto(round(x3),round(y3));
  183. lineto(round(x4),round(y4));
  184. lineto(round(x2),round(y2));
  185. end; end;
  186. end;
  187.  
  188. procedure TMainFrm.line(Sender: TObject);
  189. begin
  190.  
  191. begin
  192. coord2.savex:=coordx;
  193. coord2.savey:=coordy;
  194. drawstr(canvas,coord1.savex,coord1.savey,coord2.savex,coord2.savey);
  195. Labelededit1.SetFocus;
  196. pushbtn:=false;
  197.  
  198. inc(k);
  199. strlst.Text:=strlst.Text+tracking[m].dot1+tracking[m].dot2+#13#10;
  200. inc(m);
  201. end else
  202. begin
  203.  
  204. coord1.savex:=coordx;
  205. coord1.savey:=coordy;
  206. pushbtn:=true;
  207. tracking[k].dot1:=(Sender as TButton).Caption;
  208. end;
  209. end;
  210.  
  211.  
  212. procedure TMainFrm.FormCreate(Sender: TObject);
  213. begin
  214. //sskinmanager1.SkinDirectory:=extractfilepath(application.ExeName);
  215. //sskinmanager1.SkinName:='Office2007 Blue (internal) extracted';
  216.  
  217.  
  218. i:=1;
  219. k:=1;
  220. m:=1;
  221. h:=-1;
  222. end;
  223.  
  224. procedure TMainFrm.FormDblClick(Sender: TObject);
  225. begin
  226. button[i]:=TSButton.Create(MainFrm);
  227. button[i].Parent:=MainFrm;
  228. button[i].top:=coordy;
  229. button[i].left:=coordx;
  230. button[i].Width:=61;
  231. button[i].Height:=61;
  232. button[i].SkinData.SkinSection:='BUTTON_HUGE';
  233. if i=1 then
  234. button[i].Caption:='x' else
  235. button[i].Caption:=inttostr(i-1);
  236. button[i].Font.Size:=18;
  237. button[i].OnClick:=line;
  238. inc(i);
  239. end;
  240.  
  241. procedure TMainFrm.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
  242. Y: Integer);
  243. begin
  244.  
  245. coordY:=y;
  246. //canvas.LineTo(.);
  247. // canvas.Pen.Style:=psXOR;
  248. end;
  249.  
  250. procedure TMainFrm.sBitBtn1Click(Sender: TObject);
  251. begin
  252. showmessage(Labelededit1.Text);
  253. end;
  254.  
  255. procedure TMainFrm.Edit1KeyPress(Sender: TObject; var Key: Char);
  256. var s: string;
  257. begin
  258.  
  259. canvas.TextOut((coord2.savex+coord1.savex)div 2,(coord2.savey+coord1.savey)div 2,Labelededit1.Text);
  260. end;
  261.  
  262. procedure TMainFrm.sButton1Click(Sender: TObject);
  263. label step2;
  264. var i,j,o,v,g: integer;
  265. label25: Tlabel;
  266. s1,s2: string;
  267. ss2,ss1: string;
  268. strlst1,strlst2,strlst3: Tstringlist;
  269. begin
  270.  
  271.  
  272. strlst1:=Tstringlist.Create;
  273. strlst2:=Tstringlist.Create;
  274. strlst3:=Tstringlist.Create;
  275. strlst1.AddStrings(strlst);
  276. //////step 1//////
  277. for i:=strlst1.Count-1 downto 0 do
  278. begin
  279. s1:=strlst1[i];
  280. if s1[1]='x' then
  281. begin
  282. strlst2.Add(strlst1[i]);
  283. strlst1.Delete(i);
  284. end;
  285. end;
  286. //////step 2/////
  287. step2:
  288. for j:=0 to strlst2.Count-1 do
  289. begin
  290. for i:=0 to strlst1.Count-1 do
  291. begin
  292. s1:=strlst1[i];
  293. s2:=strlst2[j];
  294. if s2[length(s2)]=s1[1] then
  295. strlst3.Add(s2+copy(s1,2,length(s1)));
  296. end;
  297. end;
  298. //////step 3//////
  299. strlst2.Clear;
  300. //////step 4//////
  301. for i:=strlst3.Count-1 downto 0 do
  302. begin
  303. s1:=strlst3[i];
  304. if s1[length(s1)]<>'z' then
  305. begin
  306. strlst2.Add(strlst3[i]);
  307. strlst3.Delete(i);
  308. end;
  309. end;
  310. /////////step 5/////
  311. if strlst2.Text<>'' then
  312. goto step2;
  313. memo1.Lines.AddStrings(strlst3);
  314. schecklistbox1.Items.AddStrings(strlst3);
  315. end;
  316.  
  317. procedure TMainFrm.LabeledEdit1Change(Sender: TObject);
  318.  
  319. tracking[k-1].c:=strtoint(labelededit1.Text);
  320. canvas.TextOut((coord2.savex+coord1.savex)div 2,(coord2.savey+coord1.savey)div 2,'c='+Labelededit1.Text);
  321. end;
  322.  
  323. procedure TMainFrm.Button1Click(Sender: TObject);
  324. var s: string;
  325. minvaluec,j,z,x: integer;
  326.  
  327. for j:=0 to schecklistbox1.Items.Count-1 do
  328. begin
  329. if schecklistbox1.Checked[j]=false then
  330. begin
  331. memo1.Lines.Add(inttostr(getminvaluec(schecklistbox1.Items.Strings[j])));
  332. metka(schecklistbox1.Items.Strings[j]);
  333. end;
  334. end;
  335.  
  336. { for z:=1 to 10 do
  337. begin
  338. for j:=0 to schecklistbox1.Items.Count-1 do
  339. if schecklistbox1.Checked[j]=true then
  340. metka(schecklistbox1.Items.Strings[j-1]);
  341. end;}
  342. end;
  343.  
  344. procedure TMainFrm.Button2Click(Sender: TObject);
  345. var i: integer;
  346. begin
  347. for i:=1 to 20 do
  348.  
  349. slabel1.Caption:=slabel1.Caption+inttostr(tracking[i].f)+#13#10;
  350. label2.Caption:=label2.Caption+inttostr(tracking[i].c)+#13#10;
  351. end;
  352. end;
  353.  
  354. end.


Демон^unix Вопрос ожидает решения (принимаются ответы, доступен мини-форум)

Вопрос задал: Демон^unix (статус: Посетитель)
Вопрос отправлен: 10 января 2010, 22:44
Состояние вопроса: открыт, ответов: 0.


Мини-форум вопроса

Всего сообщений: 3; последнее сообщение — 12 января 2010, 09:52; участников в обсуждении: 2.
Death_Master

Death_Master (статус: Посетитель), 11 января 2010, 16:54 [#1]:

Я бы для начала провёл анализ узлов и разделил их на зелёные жёлтые и красные...
узел 1 зелёный - может принять 3, может отравить 8
узел 2 зелёный - может принять 13, может отправить 15
узел 3 зелёный - может принять 8, может отправить 12, из них 7 точно дойдут
узел 4 жёлтый - может принять 14, может отправить 6, из них 6 точно дойдут

на входе у нас 11, на выходе- 13
вывод: дойдёт всё, но узел 4 надо проанализиовать внимательно.

красные узлы- это те, которые ведут в никуда...
Обычно захожу по ночам... (60-70%)
Если нужно что-то написать, то беру оборудованием, деньгими и пивом(при личной встрече)...
P.S. Помогаю и рассказываю бесплатно ^_^.....Nyaaa!
Демон^unix

Демон^unix (статус: Посетитель), 12 января 2010, 08:40 [#2]:

а есть еще какие нибудь предложения?
Демон^unix

Демон^unix (статус: Посетитель), 12 января 2010, 09:52 [#3]:

Я переписал исходник на delphi 7 без сторонних компонентов. Ребята, помогите до завтра. Это мой единственный шанс сдать на автомат.
Исходник
http://webfile.ru/4224109

Чтобы оставлять сообщения в мини-форумах, Вы должны авторизироваться на сайте.
Версия движка: 2.6+ (26.01.2011)
© 2005-2025
Текущее время: 31 октября 2025, 07:22
Выполнено за 0.03 сек.