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

unit Uconnectivity;

interface

uses ugraph,classes,sysutils,dialogs;

procedure FindConComponents(g:tgraph; lb:tstrings);
procedure FindStronglyConComponents(g:tgraph; lb:tstrings);

implementation

uses UType;


//поиск компонент связности (если ориентированный - поиск слабосвязных компонент)
                                    //lb-массив компонент связности,Orgraph-ориентированный ли граф
procedure FindConComponents(g:tgraph; lb:tstrings);
var
Mark:array of  integer;  //массив вершин,значение -№ компоненты связности,к-ой принадлежит вершина
i,j:integer;
//gt:tgraph;    //компонента связности   (из вершин и ребер)
gp:tgraph;
count:integer;//число компонент смежности
k:integer;//счетчик по вершинам в компоненте
MatrixSmNotOr: array of array of 0..1; //неориентированная м-ца смежности ориентированного графа
 MatrixSm:tmatrix;
  //m,n:integer;//размеры м-цы смежности

//процедура добавления вершин и смежных с ними ребер в текущую компоненту связности
                     //x-номер текущей вершины,count-номер текущей компоненты связности
Procedure Component( x,count :Integer);
Var
i,j :Integer;

begin
SetLength(gp.V,length(gp.V)+1);
Mark[x]:=count;
{if length(gp^.V)<x then
  SetLength(gp^.V,x+1); }
gp.V[k]:=g.V[x];
inc(k);




for i:=1 to high(g.V) do
  //если вершина смежна с текущей
  if ((not g.Orgraph) and (MatrixSm.Matrix[x,i] = 1)) or ((g.Orgraph) and (MatrixSmNotOr[x,i] = 1))  then
  begin

    //поиск в графе g этих смежных ребер и их добавление в подграф gp^
    //if (x<i) then  //если ребро идет от текущей к смежной
    for j := 1   to high(g.E) do
      if ((g.E[j].p1 = g.V[x]) and (g.E[j].p2 = g.V[i])){ or ((g.E[j].p1 = g.V[i]) and (g.E[j].p2 = g.V[x]))) } then
      begin
        SetLength(gp.E,length(gp.E)+1);
        gp.E[length(gp.E)-1] := g.E[j];
        break;
      end;

    {gp^.E[length(gp^.E)-1].p1:=g.V[x];
    gp^.E[length(gp^.E)-1].p2:=g.V[i];
    gp^.E[length(gp^.E)-1].num:=length(gp^.E)-1;}
    //если вершина не входит ни в одну компоненту связности
    if mark[i] = 0 then
      Component(i,count);
  end;
end;

begin
ProcessMessages;

{if g.Orgraph then
for i := 1 to length(mark) do
  SetLength(high(g.V)+1,high(g.V)+1);
end
else }
  SetLength(mark,high(g.V)+1);
count:=0;


for i := 1 to high(g.V) do
  mark[i]:=0;
//new(matrixsm);
//MatrixSm.create(m,n);
g.GetMatrixSm(MatrixSm);
//new(matrixsm);
//MatrixSm.create(m,n);

//построение неориентированной м-цы смежности ориентированного графа
if g.orgraph  then
begin
  setlength(MatrixSmNotor, length(g.V), length(g.V));
    for i := 1 to high(MatrixSmNotor) do
    for j := 1 to high(MatrixSmNotor) do
      MatrixSmNotOr[i, j]:=0;

    for i := 1 to MatrixSm.row do
      for j := 1  to MatrixSm.col do
       if (MatrixSm.Matrix[i,j]=1) and (i<>j) then
       begin
        MatrixSmNotOr[i,j]:=1;
        MatrixSmNotOr[j,i]:=1;
       end;



end;

for i := 1 to high(g.V) do
 if mark[i]=0 then
    begin
      gp:=tgraph.Create;
      SetLength(gp.V,1);
      SetLength(gp.e,1);
      k:=1;
      inc(count);
      Component(i,count);
      gp.comment:='Компонента связности '+inttostr(count);

      //gp^:=gt;
      LB.Addobject(gp.comment, Tobject(gp));
    end;
    g.SearchReachMatrix;

//setlength(MatrixSm.Matrix,0,0);
matrixsm.free;
matrixsm:=nil;
//MatrixSm.destroy;
SetLength(mark,0);
mark:=nil;
end;


//поиск сильносвязных компонент связности в ориентированном графе
                                    //lb-массив компонент связности,Orgraph-ориентированный ли граф
procedure FindStronglyConComponents(g:tgraph; lb:tstrings);
var
R:TBoolMatrix;  //Матрица достижимости (i-ая строка - достижимые вершины для i-ой вершины)
c:array of array of 0..1;//строка - мно-во вершин, образующих сильно связную компоненту
i,j,t:integer;
gp:tgraph;
k:integer;//счетчик по вершинам в компоненте

begin
ProcessMessages;

//!!!!!!!!!!!!!!!!!!!!!!!!!!генерировать исключение
if not g.Orgraph then
 exit;

SetLength(R,high(g.V)+1,high(g.V)+1);



    r:=g.SearchReachMatrix;
    SetLength(C,high(g.V)+1,high(g.V)+1);
    for i := 1 to high(g.V) do
      for j := 1  to high(g.V) do
        c[i,j]:=0;


    //C=R*Q, где Q-транспонированная R
    for i := 1 to high(g.V) do
      for j := 1 to high(g.V) do
        c[i,j] := r[i,j] * r[j,i];
    //удаляем одинаковые строки
    for i := 1 to high(c)-1 do
    begin
      j:=i+1;
      while j<=high(c) do
      begin
        if  (length(c[i])=length(c[j])) and CompareMem(@c[i][0],@c[j][0],length(c[i])*sizeof(c[1][1])) then
        begin
          for k  := j to high(c)-1 do
            c[k]:=c[k+1];
          SetLength(c,length(c)-1);
          dec(j);
        end;
        inc(j);
      end;

    end;

    //Формирование подграфа-сильной компоненты связности

    for i := 1 to high(c) do //цикл по сильно связным компонентам
    begin
      gp:=tgraph.create;
      SetLength(gp.V,1);
      SetLength(gp.e,1);
      k:= 1;
      for j := 1 to high(c[i]) do
        if c[i,j]=1 then
        begin
          SetLength(gp.V,length(gp.V)+1);
          gp.V[k]:=g.V[j];
          for  t := 1   to high(g.E) do//добавление ребер,принадле-их сильно связной компоненте
          if (g.E[t].p1 = g.V[j])  then
           // for m := 1 to high(c[i]) do
             if  c[i,g.Num(g.e[t].p2)] = 1 then
             begin
              SetLength(gp.E,length(gp.E)+1);
              gp.E[length(gp.E)-1] := g.E[t];
              //break;
             end;
          inc(k);
        end;
      gp.comment:='Сильно связная компонента '+inttostr(i);
      LB.Addobject(gp.comment, Tobject(gp));

    end;





SetLength(C,0,0);
C:=nil;
SetLength(R,0,0);
R:=nil;
end;




end.