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