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

unit UOstov;

interface

uses   UGraph;

//Функция поиска минимального остова
//Возвращает минимальный остов графа g
//и пишет его в поле  g.minosotv
function SearchMinOstov(G: Tgraph): tgraph;

//Процедура поиска остовов.
//Возвращает массв графов.
function SearchOstov(G: Tgraph): tarrg;
//Процедура поиска комопнент двусвязности.
//Возвращает массв графов.
function Dvusvyaz(g: tgraph): tarrg;
//Процедура поиска независимых множеств.
//Возвращает массв графов.
function Nezav(G: Tgraph): tarrg;
//Процедура поиска доминирующих множеств.
//Возвращает массв графов.
function Domin(G: Tgraph): tarrg;

implementation

uses math, Utype,  uconnectivity, sysutils;

function SearchOstov(G: Tgraph): tarrg;
var
  a: array of boolean;
  i: integer;
  gt: Tgraph;
  arr: tarrg;
  function search(len: integer): integer;
  var
    i: integer;
  begin
    i := len;
    while (i > 0) and (not a[i]) do
      dec(i);
    result := i;
  end;
  function next(k: integer; len: integer): integer;
  var
    i: integer;
  begin
    next := 1;
    if k > 1 then
    begin
      i := search(len);
      if i > 0 then
        if i < len then
        begin
          a[i] := false;
          a[i + 1] := true;
          next := 1;
        end
        else
        begin
          a[i] := false;
          next := next(k - 1, len - 1);
          i := search(len);
          a[i + 1] := true;
        end;
    end
    else
    begin
      i := search(len);
      if i < len then
      begin
        a[i] := false;
        a[i + 1] := true;
        next := 1;
      end
      else
        next := -1;
    end;
  end;

begin
  setlength(result, 1);
  setlength(a, length(G.E));
  if high(G.V) - 1 <= high(G.E) then
    for i := 1 to high(G.V) - 1 do
      a[i] := true
    else
      exit;
  repeat
    gt := Tgraph.Create;
    gt.service:=0;
    for i := 1 to high(a) do
      if a[i] then
      begin
        gt.Add(G.E[i]);
        gt.comment := gt.comment + ' e' + inttostr(G.Num(G.E[i]));
        gt.service:=gt.service+g.E[i].ves;
      end;
    for i := 1 to high(G.V) do  begin
      setlength(gt.V, length(gt.V) + 1);
      gt.V[ high(gt.V)] := G.V[i];
    end;
    arr := findConComponents(gt);
    if High(arr) = 1 then begin
      setlength(result, length(result) + 1);
      new(result[ high(result)]);
      result[ high(result)]^ := Tgraph.assign(gt); ;
      gt.Free;
    end
    else
      gt.Free;
    for i := 1 to high(arr) do
      arr[i].Free;
  until next( high(G.V) - 1, high(a)) < 0;
end;

function SearchMinOstov(G: Tgraph): tgraph;
var
  i, j: integer;
  min: Tgraph;
  addE: Tgraph;
  arr: tarre;
  ind: integer;
begin
  min := Tgraph.Create;
  try
    G.minOstov.Free;
  except
    g.minOstov:=nil;
  end;
  if high(G.V) > 0 then
    min.Add(G.V[1])
  else
    exit;
  addE := Tgraph.Create;
  arr := G.GetIncE2(G.V[1]);
  min.service:=0;
  for i := 1 to high(arr) do
    addE.Add(arr[i]);
  while high(min.V) < high(G.V) do
  begin
    if high(addE.E) < 1 then
      exit;
    ind := 1;
    for j := 1 to high(addE.E) do
      if addE.E[j].ves < addE.E[ind].ves then
        ind := j;
    if min.Add(addE.E[ind]) then begin
      min.comment := min.comment + ' e' + inttostr(G.Num(addE.E[ind]));
    min.service:=min.service+ adde.E[ind].ves;
    end;
    min.Add(addE.E[ind].p1);
    min.Add(addE.E[ind].p2);
    // Удалить цикличные ребра
    for j := 1 to high(G.E) do
      if min.ExistV(G.E[j].p1) or min.ExistV(G.E[j].p2) then
        addE.Add(G.E[j]);
    for j := 1 to high(G.E) do
      if min.ExistV(G.E[j].p1) and min.ExistV(G.E[j].p2) then
        addE.delete(G.E[j]);
  end;
  G.minOstov := min;
  result:=g.minOstov;
  if min.comment='' then
    min.comment:='Остов';
  addE.Free;
end;

function Nezav(G: Tgraph): tarrg;
var
  i, p, q: integer;
  matrix: Tmatrix;
  nextg: Tgraph;
  function exist(gt: Tgraph; Num: integer): boolean;
  var
    i: integer;
  begin
    result := true;
    i := 1;
    while (i <= high(gt.V)) and (matrix.matrix[G.Num(gt.V[i]), Num] = 0) do
      inc(i);
    if i <= high(gt.V) then
      result := false;
  end;
  procedure step(gt: Tgraph; ind: integer);
  var
    nextg: Tgraph;
    i: integer;
    flag: boolean;
  begin
    flag := true;
    for i := ind + 1 to high(G.V) do
      if exist(gt, i) then
      begin
        // if not gt.ExistV(g.V[i]) then  begin
        nextg := Tgraph.assign(gt);
        nextg.Add(G.V[i]);
        nextg.comment := nextg.comment + ' v' + inttostr(i);
        nextg.service := nextg.service + round(power(2, i));
        step(nextg, i);
        nextg.Free;
        flag := false;
        // end;
      end;
    if flag then
    begin // вЫХОД. вЫВОД
      flag := true;
      for i := 1 to high(result) do
      begin
        q := gt.service;
        p := result[i].service;
        while (p > 0) and (q > 0) and (p mod 2 - q mod 2 >= 0) do
        begin
          p := p div 2;
          q := q div 2;
        end;
        if q = 0 then
        begin
          flag := false;
          break;
        end;
      end;
      if flag then
      begin
        setlength(result, length(result) + 1);
        new(result[ high(result)]);
        result[ high(result)]^ := Tgraph.assign(gt);
      end;
    end;
  end;

begin
  setlength(result, 1);
  G.GetMatrixSm(matrix);
  for i := 1 to high(G.V) do
  begin
    nextg := Tgraph.Create;
    nextg.comment := 'v' + inttostr(i);
    nextg.service := round(power(2, i));
    nextg.Add(G.V[i]);
    step(nextg, i);
    nextg.Free;
  end;
end;

function Domin(G: Tgraph): tarrg;
var
  i: integer;
  gt: Tgraph;
  procedure step(gt: Tgraph);
  var
    gp, gq, gadd: Tgraph;
    arr: tarrv;
    i, j, k, p: integer;
  begin
    for i := 1 to high(gt.V) do
    begin
      gp := Tgraph.assign(gt);
      if gp.delete(gt.V[i]) then
        gp.service := gp.service - round(power(2, G.Num(gt.V[i])));
      gq := Tgraph.Create;
      for k := 1 to high(gp.V) do
      begin
        arr := G.GetIncV2(gp.V[k], booltoint(g.Orgraph));
        for j := 1 to high(arr) do
          gq.Add(arr[j]);
        if { love u } gq.Add(gp.V[k]) then
          gq.service := gq.service + round(power(2, G.Num(gp.V[k])));
      end;
      if high(gq.V) = high(G.V) then
      begin // gq - доминирующее
        j := gp.service;
        p := 0;
        gp.comment := '';
        while j > 0 do
        begin
          if j mod 2 = 1 then
            gp.comment := gp.comment + ' v' + inttostr(p);
          inc(p);
          j := j div 2;
        end;
        k := 1; { i love u }
        while (k <= high(result)) and (result[k].comment <> gp.comment) do
          inc(k);
        if k > high(result) then
        begin
          gadd := Tgraph.assign(gp);
          setlength(result, length(result) + 1);
          new(result[ high(result)]);
          result[ high(result)]^ := Tgraph.assign(gadd);
          step(gadd);
          gadd.Free;
        end;
      end;
      gq.Free;
      gp.Free;
    end;
  end;

begin
  setlength(result, 1);
  gt := Tgraph.Create;
  setlength(gt.V, length(G.V));
  gt.service := 0;
  for i := 1 to high(G.V) do
  begin
    gt.V[i] := G.V[i];
    gt.service := gt.service + round(power(2, i));
  end;
  step(gt);
  gt.Free;
end;

function Dvusvyaz(g: tgraph): tarrg;
  procedure step(gk: tgraph);
    var i, j, k: integer;
      arr: tarrg;
      gt, gp: tgraph;
      flag: boolean;
    begin
      flag := true;
      for i := 1 to high(Gk.V) do begin
        gt := Tgraph.assign(Gk);
        gt.delete(Gk.V[i]);
        arr:=FindConComponents(gt);
        if high(arr) > 1 then begin
          for j := 1 to high(arr) do begin
            gp:=tgraph.assign(arr[j]^);
            gp.Add(gk.V[i]);
            for k := 1 to high(gp.v) do
              gp.Add(gk.GetE(gk.V[i], gp.V[k]));
            step(gp);
            gp.Free;
          end;
          flag:=false;
        end;
        gt.Free;
        for j := 1 to high(arr) do
          arr[j].Free;
      end;
      if flag then begin
        gk.service:=0;
        gk.comment:='';
        for j := 1 to high(gk.V) do
          gk.service:=gk.service+round(power(2, g.Num(gk.V[j]) ));
        k:=0;
        while gk.service > 0 do begin
          if gk.service mod 2 = 1 then
            gk.comment:=gk.comment+' v'+inttostr(k);
          inc(k);
          gk.service:=gk.service div 2;
        end;
        setlength(result, length(result)+1);
        new(result[ high(result)]);
        result[high(result)]^:=tgraph.assign(gk);
      end;
   end;
begin
  setlength(result, 1);
  step(g);
end;
end.