Программа для построения и анализа графов / URoute

unit URoute;

interface

uses Ugraph, sysutils;

//Процедура поиска маршрутов заданной длины.
//Возвращает массв графов.
function SearchRoute(G: tgraph; len: integer): tarrg;
implementation

function SearchRoute(G: tgraph; len: integer): tarrg;
var i: integer;
nextg: tgraph;
procedure step(gp, gt: tgraph);
var nextg, gtt: tgraph;
arr: tarre;
i: integer;
begin
if high(gt.e) < len then begin
arr:=gp.GetIncE2(gt.v[0]);
for i:=1 to high(arr) do begin
gtt:=tgraph.assign(gp);
nextg:=tgraph.assign(gt);
nextg.Add(arr[i]);
nextg.comment:=nextg.comment+ ' e'+inttostr(g.Num(nextg.E[high(nextg.E)]));
if nextg.E[high(nextg.E)]^.p1 = nextg.v[0] then begin
nextg.v[0]:=nextg.E[high(nextg.E)]^.p2;
if nextg.ExistV(nextg.E[high(nextg.E)]^.p2) then begin
if nextg.service = 0 then
nextg.service:=1;
end else
nextg.Add(nextg.E[high(nextg.E)]^.p2);
end else begin
nextg.v[0]:=nextg.E[high(nextg.E)]^.p1;
if nextg.ExistV(nextg.E[high(nextg.E)]^.p1) then begin
if nextg.service = 0 then
nextg.service:=1;
end else
nextg.Add(nextg.E[high(nextg.E)].p1);
end;
nextg.comment:=nextg.comment+ ' v'+inttostr(g.Num(nextg.v[0]));
gtt.delete(nextg.E[high(nextg.E)]);
step(gtt, nextg);
gtt.Free;
nextg.Free;
end;
end else begin
nextg:=tgraph.assign(gt);
if nextg.V[1] = nextg.V[0] then //цикл
if nextg.service = 0 then //вершины не повторяются(ребра тоже)
if high(nextg.V) = high(g.V) then //содержит все вершины
if high(nextg.E) = high(g.e) then //Содержит все ребра
nextg.comment:='ГаЦикл, ЭйЦикл '+ nextg.comment
else
nextg.comment:='Гамильтонов Цикл '+ nextg.comment
else
if high(nextg.E) = high(g.e) then
nextg.comment:='Эйлеров Цикл '+ nextg.comment
else
nextg.comment:='Простой Цикл '+ nextg.comment
else //Вершины повторяются
if high(nextg.V) = high(g.V) then //содержит все вершины
if high(nextg.E) = high(g.e) then //Содержит все ребра
nextg.comment:='Эйлеров Цикл '+ nextg.comment
else
nextg.comment:='Цикл '+ nextg.comment
else
if high(nextg.E) = high(g.e) then
nextg.comment:='Эйлеров Цикл '+ nextg.comment
else
nextg.comment:='Цикл '+ nextg.comment
else
if nextg.service = 0 then //вершины не повторяются(ребра тоже)
if high(nextg.V) = high(g.V) then //содержит все вершины
if high(nextg.E) = high(g.e) then //Содержит все ребра
nextg.comment:='ГаПуть, ЭйПуть '+ nextg.comment
else
nextg.comment:='Гамильтонов Путь '+ nextg.comment
else
if high(nextg.E) = high(g.e) then
nextg.comment:='Эйлеров Путь '+ nextg.comment
else
nextg.comment:='Простой Путь '+ nextg.comment
else //Вершины повторяются
if high(nextg.V) = high(g.V) then //содержит все вершины
if high(nextg.E) = high(g.e) then //Содержит все ребра
nextg.comment:='Эйлеров Путь '+ nextg.comment
else
nextg.comment:='Путь '+ nextg.comment
else
if high(nextg.E) = high(g.e) then
nextg.comment:='Эйлеров Путь '+ nextg.comment
else
nextg.comment:='Путь '+ nextg.comment;
SetLength(result, length(result)+1);
new(result[high(result)]);
result[high(result)]^:=tgraph.assign(nextg);
nextg.Free;
end;
end;
procedure stepor(gp, gt: tgraph);
var nextg, gtt: tgraph;
arr: tarre;
i: integer;
begin
if high(gt.e) < len then begin
arr:=gp.GetIncE2(gt.v[0], 1);
for i:=1 to high(arr) do begin
gtt:=tgraph.assign(gp);
nextg:=tgraph.assign(gt);
nextg.Add(arr[i]);
nextg.comment:=nextg.comment+ ' e'+inttostr(g.Num(nextg.E[high(nextg.E)]));
if nextg.E[high(nextg.E)]^.p1 = nextg.v[0] then begin
nextg.v[0]:=nextg.E[high(nextg.E)]^.p2;
if nextg.ExistV(nextg.E[high(nextg.E)]^.p2) then begin
if nextg.service = 0 then
nextg.service:=1;
end else
nextg.Add(nextg.E[high(nextg.E)]^.p2);
end;
nextg.comment:=nextg.comment+ ' v'+inttostr(g.Num(nextg.v[0]));
gtt.delete(nextg.E[high(nextg.E)]);
stepor(gtt, nextg);
gtt.Free;
nextg.Free;
end;
end else begin
nextg:=tgraph.assign(gt);
if nextg.V[1] = nextg.V[0] then //цикл
if nextg.service = 0 then //вершины не повторяются(ребра тоже)
if high(nextg.V) = high(g.V) then //содержит все вершины
if high(nextg.E) = high(g.e) then //Содержит все ребра
nextg.comment:='ГаКонтур, ЭйКонтур '+ nextg.comment
else
nextg.comment:='Гамильтонов Контур '+ nextg.comment
else
if high(nextg.E) = high(g.e) then
nextg.comment:='Эйлеров Контур '+ nextg.comment
else
nextg.comment:='Простой Контур '+ nextg.comment
else //Вершины повторяются
if high(nextg.V) = high(g.V) then //содержит все вершины
if high(nextg.E) = high(g.e) then //Содержит все ребра
nextg.comment:='Эйлеров Контур '+ nextg.comment
else
nextg.comment:='Контур '+ nextg.comment
else
if high(nextg.E) = high(g.e) then
nextg.comment:='Эйлеров Контур '+ nextg.comment
else
nextg.comment:='Контур '+ nextg.comment
else
if nextg.service = 0 then //вершины не повторяются(ребра тоже)
if high(nextg.V) = high(g.V) then //содержит все вершины
if high(nextg.E) = high(g.e) then //Содержит все ребра
nextg.comment:='ГаОрпуть, ЭйОрпуть '+ nextg.comment
else
nextg.comment:='Гамильтонов Орпуть '+ nextg.comment
else
if high(nextg.E) = high(g.e) then
nextg.comment:='Эйлеров Орпуть '+ nextg.comment
else
nextg.comment:='Простой Орпуть '+ nextg.comment
else //Вершины повторяются
if high(nextg.V) = high(g.V) then //содержит все вершины
if high(nextg.E) = high(g.e) then //Содержит все ребра
nextg.comment:='Эйлеров Орпуть '+ nextg.comment
else
nextg.comment:='Орпуть '+ nextg.comment
else
if high(nextg.E) = high(g.e) then
nextg.comment:='Эйлеров Орпуть '+ nextg.comment
else
nextg.comment:='Орпуть '+ nextg.comment;
SetLength(result, length(result)+1);
new(result[high(result)]);
result[high(result)]^:=tgraph.assign(nextg);
nextg.Free;
end;
end;
begin
nextg:=tgraph.Create;
setlength(nextg.v, 2);
setlength(result,1);
if not g.Orgraph then
for i := 1 to high(g.V) do begin
nextg.v[high(nextg.V)]:=g.v[i];
nextg.v[0]:=g.v[i];
nextg.service:=0;
nextg.comment:='v'+inttostr(g.Num(nextg.v[high(nextg.V)]));
step(g, nextg);
end
else
for i := 1 to high(g.V) do begin
nextg.v[high(nextg.V)]:=g.v[i];
nextg.v[0]:=g.v[i];
nextg.service:=0;
nextg.comment:='v'+inttostr(g.Num(nextg.v[high(nextg.V)]));
stepor(g, nextg);
end;
nextg.free;
end;

end.