Delphi. Алгоритмы. Создание графа на списках смежности

Повторяем основы. Теорию переписывать не буду, лишь моя скромная реализация базовых функций – добавить ребро, удалить ребро, найти ребро. Из которых впоследствии можно сделать граф на списках смежности.

Основная идея графа на списках смежности как я понял для себя ещё раз) – сделать массив списков смежности. Описывая граф, мы смотрим, связана ли его вершина с другими вершинами, если да, то создаем список смежности, скажем 1 вершина связана с 5 и 7, значит, можем создать такой список из 3 элементов, в котором из 1 вершины будет ссылка на 5, из 5 на 7, либо в другом порядке, но важно, что мы перечислили все вершины, с которыми смежна наша 1 вершина. Таким макаром проходим по всем другим вершинам, должно получиться что-то вроде…

Теория хорошо описана здесь.

Так как была ночь и я устал, бахаю весь модуль…

unit uMain;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.Samples.Spin, Vcl.StdCtrls, Vcl.Buttons;

type TadjencyListElement=^AdjencyListElement;

   AdjencyListElement=record

   vertex:integer; // number of adjency vertex
   weight:integer;
   next:TadjencyListElement; // pointer to next vertex

end;


type
  TMain = class(TForm)
    MemoTest: TMemo;
    bAddEdge: TBitBtn;
    seVertex1: TSpinEdit;
    seVertex2: TSpinEdit;
    Vertex1: TLabel;
    Vertex2: TLabel;
    bRemoveEdge: TBitBtn;
    SpinEdit1: TSpinEdit;
    SpinEdit2: TSpinEdit;
    Label1: TLabel;
    Label2: TLabel;
    procedure bAddEdgeClick(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    { Private declarations }

    function addEdge(AVertex1, AVertex2:integer):boolean;
    {will add to the end of adjency list or will create a first element if empty or nil }

    procedure deleteEdge(AFirstAdjencyListElement,ADeletedAdjencyListElement:TadjencyListElement);
    {< will delete in adjency list ADeletedAdjencyListElement }

    function  searchByVertex(AFirstAdjencyListElement:TadjencyListElement; AVertex:integer):TadjencyListElement;
    {< will search in adjency list an AdjencyListElement (edge) with vertex=AVertex  }

    procedure clearMemory();

  public
    { Public declarations }
    constructor Create(AOwner: TComponent); override;
  end;

const N=10;
var
  Main: TMain;
  Graph:Array [1..N] of TadjencyListElement;

implementation

{$R *.dfm}

{ TMain }

function TMain.addEdge(AVertex1, AVertex2:integer):boolean;

var newAdjencyListElement:TadjencyListElement;
    tempAdjencyListElement:TadjencyListElement;

begin
result:=false;
// will insert edge beetwen vertex x and vertex y

 if Graph[AVertex1]<>nil then begin // if list in x vertex already sterted, add to the end of adjency list

  if searchByVertex( Graph[AVertex1],AVertex2)=nil then begin // if no such vertex

  New(newAdjencyListElement);
  newAdjencyListElement.vertex:=AVertex2;
  newAdjencyListElement.next:=nil;

  tempAdjencyListElement:=Graph[AVertex1];
  while tempAdjencyListElement^.Next<>nil do
  tempAdjencyListElement:=tempAdjencyListElement^.next; // now tempAdjencyListElement is the last in adjency list

  tempAdjencyListElement^.next:=newAdjencyListElement; // now it points to the last added adjency element
  result:=True;
  end;

 end else

 begin  // creating first new element of adjency list

    New(newAdjencyListElement);
    newAdjencyListElement^.vertex:=AVertex2;
    newAdjencyListElement^.next:=nil;
    Graph[AVertex1]:=newAdjencyListElement;
 result:=True;
 end;


end;



procedure TMain.bAddEdgeClick(Sender: TObject);
begin
if addEdge(seVertex1.Value,seVertex2.Value) then
MemoTest.Lines.Add('v1='+seVertex1.Value.ToString()+' '+'v2='+seVertex2.Value.ToString());
end;

procedure TMain.clearMemory;
var
  i: Integer;
begin
 for i := 0 to High(Graph) do if Graph[i]<>nil then  Dispose(TadjencyListElement(Graph[i]));
end;

constructor TMain.Create(AOwner: TComponent);
var
  i: Integer;
begin
  inherited;
for i := 0 to High(Graph) do Graph[i]:=nil;

end;

procedure TMain.deleteEdge(AFirstAdjencyListElement,ADeletedAdjencyListElement:TadjencyListElement);
var tempAdjencyListElement:TadjencyListElement;
    beforeDeletedAdjencyListElement:TadjencyListElement;

begin

// case 1 element in adjency list
 if  (AFirstAdjencyListElement.next=nil) and (ADeletedAdjencyListElement=AFirstAdjencyListElement) then
dispose(ADeletedAdjencyListElement)

else

// case deleted element is first
if AFirstAdjencyListElement=ADeletedAdjencyListElement then begin
//AFirstAdjencyListElement:=AFirstAdjencyListElement.next;
dispose(ADeletedAdjencyListElement)
end

 else

 begin

  // search for element before deleted
  tempAdjencyListElement:=AFirstAdjencyListElement;
  while tempAdjencyListElement<>ADeletedAdjencyListElement do
  begin
  beforeDeletedAdjencyListElement:=tempAdjencyListElement;
  tempAdjencyListElement:=tempAdjencyListElement.next;
  end;

  //change links
  if ADeletedAdjencyListElement.next<>nil then  // if not last element
  beforeDeletedAdjencyListElement.next:=ADeletedAdjencyListElement.next else
  beforeDeletedAdjencyListElement.next:=nil;

  //delete
  dispose(ADeletedAdjencyListElement);

 end;


end;

procedure TMain.FormClose(Sender: TObject; var Action: TCloseAction);
begin
ReportMemoryLeaksOnShutdown:=true;
clearMemory();
end;

function TMain.searchByVertex(AFirstAdjencyListElement: TadjencyListElement; AVertex: integer):TadjencyListElement;
var tempAdjencyListElement:TadjencyListElement;
begin
Result:=nil;

tempAdjencyListElement:=AFirstAdjencyListElement;

  repeat
    if tempAdjencyListElement.vertex=AVertex then
    begin
    Result:=tempAdjencyListElement;
    Break;
    end;
  tempAdjencyListElement:=tempAdjencyListElement.next;
  until tempAdjencyListElement=nil;

end;

end.

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

122

123

124

125

126

127

128

129

130

131

132

133

134

135

136

137

138

139

140

141

142

143

144

145

146

147

148

149

150

151

152

153

154

155

156

157

158

159

160

161

162

163

164

165

166

167

168

169

170

171

172

173

174

175

176

177

178

179

180

181

182

183

184

185

186

187

188

189

190

191

192

193

194

195

unit uMain;

interface

uses

Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,

Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.Samples.Spin, Vcl.StdCtrls, Vcl.Buttons;

type TadjencyListElement=^AdjencyListElement;

AdjencyListElement=record

vertex:integer; // number of adjency vertex

weight:integer;

next:TadjencyListElement; // pointer to next vertex

end;

type

TMain = class(TForm)

MemoTest: TMemo;

bAddEdge: TBitBtn;

seVertex1: TSpinEdit;

seVertex2: TSpinEdit;

Vertex1: TLabel;

Vertex2: TLabel;

bRemoveEdge: TBitBtn;

SpinEdit1: TSpinEdit;

SpinEdit2: TSpinEdit;

Label1: TLabel;

Label2: TLabel;

procedure bAddEdgeClick(Sender: TObject);

procedure FormClose(Sender: TObject; var Action: TCloseAction);

private

{ Private declarations }

function addEdge(AVertex1, AVertex2:integer):boolean;

{will add to the end of adjency list or will create a first element if empty or nil }

procedure deleteEdge(AFirstAdjencyListElement,ADeletedAdjencyListElement:TadjencyListElement);

{< will delete in adjency list ADeletedAdjencyListElement }

function searchByVertex(AFirstAdjencyListElement:TadjencyListElement; AVertex:integer):TadjencyListElement;

{< will search in adjency list an AdjencyListElement (edge) with vertex=AVertex }

procedure clearMemory();

public

{ Public declarations }

constructor Create(AOwner: TComponent); override;

end;

const N=10;

var

Main: TMain;

Graph:Array [1..N] of TadjencyListElement;

implementation

{$R *.dfm}

{ TMain }

function TMain.addEdge(AVertex1, AVertex2:integer):boolean;

var newAdjencyListElement:TadjencyListElement;

tempAdjencyListElement:TadjencyListElement;

begin

result:=false;

// will insert edge beetwen vertex x and vertex y

if Graph[AVertex1]<>nil then begin // if list in x vertex already sterted, add to the end of adjency list

if searchByVertex( Graph[AVertex1],AVertex2)=nil then begin // if no such vertex

New(newAdjencyListElement);

newAdjencyListElement.vertex:=AVertex2;

newAdjencyListElement.next:=nil;

tempAdjencyListElement:=Graph[AVertex1];

while tempAdjencyListElement^.Next<>nil do

tempAdjencyListElement:=tempAdjencyListElement^.next; // now tempAdjencyListElement is the last in adjency list

tempAdjencyListElement^.next:=newAdjencyListElement; // now it points to the last added adjency element

result:=True;

end;

end else

begin // creating first new element of adjency list

New(newAdjencyListElement);

newAdjencyListElement^.vertex:=AVertex2;

newAdjencyListElement^.next:=nil;

Graph[AVertex1]:=newAdjencyListElement;

result:=True;

end;

procedure TMain.bAddEdgeClick(Sender: TObject);

begin

if addEdge(seVertex1.Value,seVertex2.Value) then

MemoTest.Lines.Add('v1='+seVertex1.Value.ToString()+' '+'v2='+seVertex2.Value.ToString());

end;

procedure TMain.clearMemory;

var

i: Integer;

begin

for i := 0 to High(Graph) do if Graph[i]<>nil then Dispose(TadjencyListElement(Graph[i]));

end;

constructor TMain.Create(AOwner: TComponent);

var

i: Integer;

begin

inherited;

for i := 0 to High(Graph) do Graph[i]:=nil;

end;

procedure TMain.deleteEdge(AFirstAdjencyListElement,ADeletedAdjencyListElement:TadjencyListElement);

var tempAdjencyListElement:TadjencyListElement;

beforeDeletedAdjencyListElement:TadjencyListElement;

begin

// case 1 element in adjency list

if (AFirstAdjencyListElement.next=nil) and (ADeletedAdjencyListElement=AFirstAdjencyListElement) then

dispose(ADeletedAdjencyListElement)

else

// case deleted element is first

if AFirstAdjencyListElement=ADeletedAdjencyListElement then begin

//AFirstAdjencyListElement:=AFirstAdjencyListElement.next;

dispose(ADeletedAdjencyListElement)

end

else

begin

// search for element before deleted

tempAdjencyListElement:=AFirstAdjencyListElement;

while tempAdjencyListElement<>ADeletedAdjencyListElement do

begin

beforeDeletedAdjencyListElement:=tempAdjencyListElement;

tempAdjencyListElement:=tempAdjencyListElement.next;

end;

//change links

if ADeletedAdjencyListElement.next<>nil then // if not last element

beforeDeletedAdjencyListElement.next:=ADeletedAdjencyListElement.next else

beforeDeletedAdjencyListElement.next:=nil;

//delete

dispose(ADeletedAdjencyListElement);

end;

procedure TMain.FormClose(Sender: TObject; var Action: TCloseAction);

begin

ReportMemoryLeaksOnShutdown:=true;

clearMemory();

end;

function TMain.searchByVertex(AFirstAdjencyListElement: TadjencyListElement; AVertex: integer):TadjencyListElement;

var tempAdjencyListElement:TadjencyListElement;

begin

Result:=nil;

tempAdjencyListElement:=AFirstAdjencyListElement;

repeat

if tempAdjencyListElement.vertex=AVertex then

begin

Result:=tempAdjencyListElement;

Break;

end;

tempAdjencyListElement:=tempAdjencyListElement.next;

until tempAdjencyListElement=nil;

end;

end.

Ну и исходнички 412_Graph

Чуть позже на форуме дали более простой и элегантный способ сделать тоже самое

TNode = class
  ID:integer;
end;
TEdge = class
  Node1,Node2:TNode;
  weight:integer;
end;
TNodeList=class(TObjectList<TNode>)
end;
TEdgeList=class(TObjectList<TEdge>)
end;

TNode = class

ID:integer;

end;

TEdge = class

Node1,Node2:TNode;

weight:integer;

end;

TNodeList=class(TObjectList<TNode>)

end;

TEdgeList=class(TObjectList<TEdge>)

end;

Заводим список вершин и ребер

nodes:=TNodeList.Create;
edges:=TEdgeList.Create;

1 2	nodes:=TNodeList.Create; edges:=TEdgeList.Create;

Добавляем пару вершин и ребро, которое их соединяет

node:=TNode .Create();
node.ID:=nodes.Count;
nodes.Add(Node);
node:=TNode.Create();
node.ID:=nodes.Count;
nodes.Add(Node);
 
edge:=TEdge.Create;
edge.node1:=nodes[0];
edge.node2:=nodes[1];
edges.add(Edge);

node:=TNode .Create();

node.ID:=nodes.Count;

nodes.Add(Node);

node:=TNode.Create();

node.ID:=nodes.Count;

nodes.Add(Node);

edge:=TEdge.Create;

edge.node1:=nodes[0];

edge.node2:=nodes[1];

edges.add(Edge);

Уничтожаем

edges.free;
nodes.free;

1 2	edges.free; nodes.free;

Delphi. Алгоритмы. Создание графа на списках смежности

MY PROJECTS

Recent Posts

Categories