Программа для построения и анализа графов / 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.