Привет уважаемые делфи эксперты! 
Пытаюсь найти ошибку в коде, но не могу. Задача на поиск максимального потока транспортной сети.
Кто не в курсе, кратко объясню алгоритм на пальцах:
1) строим ориентированные графы, на ребрах заполняем "с" - максимальную пропускную способность. изначально f=0 у каждых ребер графа.
2) далее выписываем все возможные пути от х до z. Пример
3) берем первый путь, увеличиваем значение переменной "f" на минимальное число "С" по данному пути (которое тоже должно на ребрах подписываться)
4) если с=f, берем это ребро и отмечаем галочками в списке путей из пункта 2, ребра которых совпали с текущим
5) далее берем путь не отмеченный галочкой. Если мы уже проходили по одному ребру (тоесть f заполнена), то "с" этого ребра будет c:=c-f;
6) затем повторяем действия с шага 3. И так пока весь список путей не отметиться галочками.
7) далее смотрим пути которые не дошли от x до z и прибавляем +1 к "f", повторяя с шага 3, пока не дойдем до z. (ЭТОТ ШАГ ЕЩЕ НЕ ДЕЛАЛ В ИСХОДНИКЕ)
Вот как это выглядит:
http://www.radikal.ru
В моей проге нужно сначала насоздавать достаточное кол-во вершин двойным кликом по пустому месту на форме. Затем кликаем на одну вершину, затем на другую - они соединяются стрелкой и сразу фокус переводится на поле для заполнения "С" данной вершины. И так соединяем все вершины. Затем жмем кнопку "Посчитать", затем "Минимальное С"
ПРОБЛЕМА: не заполняется список путей полностью галочками, не все значения "с" и "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 гуглил, по форуму искал. Все найденные варианты НЕ в графическом виде реализованы (нужно наглядные графы (вершины, ребра)), как у меня. Да и к тому же они были очень сложные, не смог понять код.
Премного благодарен. |
, чтобы посмотреть твой код