IPB

Здравствуйте, гость ( Вход | Регистрация )

 
Ответить в эту темуОткрыть новую тему
> есть программа_как она работает?
puzen
сообщение 31.5.2010, 20:47
Сообщение #1


Пользователь


Группа: Пользователи
Сообщений: 1
Регистрация: 31.5.2010
Пользователь №: 23 045



Ребят помогите пожалуйста!
Есть программа-ищет наименьшее покрытие графа!
То есть есть граф строиться матрица инцидентности а по ней уже программа ищет наименьше покрытие графа!

Она все правильно считает но я некоторые процедуры никак не могу разобрать!!!
Спасибо!!!!
Может просто кто сталкивался !!!

//Процедура поиска наименьшего покрытия
procedure TMainForm.N6Click(Sender: TObject);
var outp:tchildform;
i,j,k,jj,SumElem,MaxSum,r,mm:integer;
E:array of byte;
o,kp:byte;
zz,z:real;
label l1,l2;
begin
//Определение наличия покрытий
SumElem:=0;
for j:=0 to n-1 do begin
for i:=0 to m-1 do SumElem:=SumElem+DataTab[i,j];
if SumElem=0 then begin ShowMessage('Для '+ActiveMDichild.caption+' покрытий не существует.');
exit; end;;
SumElem:=0;
end;
//Определение размеров массивов P и C
SumElem:=0; MaxSum:=0;
for i:=0 to m-1 do begin
for j:=0 to n-1 do SumElem:=SumElem+DataTab[i,j];
if MaxSum<SumElem then MaxSum:=SumElem;
SumElem:=0;
end;
setlength(C,n,MaxSum);
setlength(P,n,MaxSum,n);
//Формирование блоков таблицы
i:=0;j:=0;
repeat
k:=0;
repeat
if datatab[i,j]=1 then
begin
jj:=0;
setlength(C[j],k+1);
c[j][k]:=ves[i];
setlength(P[j],k+1,n);
repeat
p[j][k,jj]:=datatab[i,jj];
jj:=jj+1;
until jj>n-1;
k:=k+1;
end;
i:=i+1;
until i>m-1;
j:=j+1;
i:=0;
until j>n-1;

KDataTab:=DataTab;
KVes:=Ves;


//Поиск
setlength(E,n);kp:=1;
for i:=0 to n-1 do E[i]:=0;
k:=0;z:=0;zz:=1.7*power(10,38);B:=nil;
i:=0;
while i<=n-1 do
begin
if E[i]=0 then
begin
j:=-1;
l2:repeat
j:=j+1;
if j>high(P[i]) then goto l1;
until z+c[i,j]<=zz;
K:=k+1;setlength(B,k);
z:=z+c[i,j];B[k-1,0]:=i;
B[k-1,1]:=j;
for r:=i to n-1 do
if p[i][j,r]=1 then E[r]:=1;
end;
i:=i+1;
end;
//Удалить в листинге
if zz=z then kp:=kp+1;
zz:=z;BB:=B;
l1: if B=nil then begin

//Вывод результата
Пользователь в офлайнеКарточка пользователяОтправить личное сообщение
Вернуться в начало страницы
+Ответить с цитированием данного сообщения

Ответить в эту темуОткрыть новую тему
1 чел. читают эту тему (гостей: 1, скрытых пользователей: 0)
Пользователей: 0

 



- Текстовая версия Сейчас: 6.2.2012, 9:17