Добавил:
Опубликованный материал нарушает ваши авторские права? Сообщите нам.
Вуз: Предмет: Файл:
Скачиваний:
22
Добавлен:
28.06.2014
Размер:
2 Кб
Скачать
unit Ufund;

interface
uses ugraph, classes;
function FundCycle(gg: TGraph; ts: tstrings): integer;
function FundRaz(gg: TGraph; ts:tstrings): integer;

implementation
uses Uroute, Utype, Uostov, Sysutils,  Uconnectivity;

function FundCycle(gg: TGraph; ts:tstrings): integer;
var i, k, j,p: integer;
  gt, gp, gs: tgraph;
  arr, svyaz:tarrg;
  begin
    svyaz := FindConComponents(gg);
    result:=0;
    for j := 1 to high(svyaz) do begin
      gs:=tgraph.assign(svyaz[j]^);
      SearchMinOstov(gs);
      if gs.minOstov <> nil then
      for i := 1 to high(gS.E) do
        if not gS.minOstov.ExistE(gS.E[i]) then begin // фунд цикл
          gt:=tgraph.assign(gS.minOstov);
          gt.Add(gS.E[i]);
          arr:=SearchOstov(gt);
          gp:=tgraph.Create;
          for k := 1 to high(gt.E) do begin
            p:=1;
            while (p<=high(arr)) and (arr[p].ExistE(gt.E[k])) do
              inc(p);
            if p <= high(arr) then
              gp.Add(gt.E[k]);
          end;
          for k := 1 to high(gp.E) do begin
            gp.Add(gp.e[k].p1);
            gp.Add(gp.e[k].p2);
          end;
          ts.AddObject('Фундаментальный цикл ', gp);
          inc(result);
          for k := 1 to high(arr)  do
            arr[k].Free;
          GT.Free;
        end;
    end;
    for j := 1 to high(svyaz) do
      svyaz[j].Free;
  end;


function FundRaz(gg: TGraph; ts:tstrings): integer;
var i, k, j: integer;
  gt, gp, gs, gr: tgraph;
  svyaz: tarrg;
  begin
    result:=0;
    svyaz := FindConComponents(gg);
    for j := 1 to high(svyaz) do begin
      gs:=tgraph.assign(svyaz[j]^);
      SearchMinOstov(gs);
      if gs.minOstov <> nil  then begin
      for k := 1 to high(gs.minOstov.E) do begin
        gt:=tgraph.assign(gs.minOstov);
        gt.delete(gs.minostov.E[k]);
        gr:=tgraph.Create;
        for i := 1 to high(gs.E) do begin
          gp:=tgraph.assign(gt);
          gp.Add(gs.E[i]);
          gp.minOstov:=nil;
          SearchMinOstov(gp);
          if gp.minOstov <> nil then begin
            gr.Add(gs.E[i]);
          end;
          gp.Free;
        end;
        gt.Free;
        ts.AddObject('Фундаментальный разрез ', gr);
        inc(result);
      end;
      gs.Free;
      end;
    end;
    for j := 1 to high(svyaz) do
      svyaz[j].Free;
  end;

end.
Соседние файлы в папке Программа для построения и анализа графов