Program prim function findMinKey key array of integer mstSet array of

  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
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
Program prim;
function findMinKey(key: array of integer; mstSet: array of boolean): integer;
var min, min_index, n: integer;
begin
n := length(key);
min := MaxInt;
for var v := 0 to (n - 1) do begin
if (mstSet[v] = false) and (key[v] < min) then begin
min := key[v];
min_index := v;
end;
end;
findMinKey := min_index;
end;
procedure printMST(parent: array of integer; graph: array of array of integer);
var mst, n: integer;
begin
n := length(parent);
writeln('Дерево -> Вес');
for var i := 1 to (n - 1) do begin
writeln(parent[i], ' - ', i, ' -> ', graph[i][parent[i]]);
mst := mst + graph[i][parent[i]];
end;
writeln('МОД:', mst);
end;
// Minimum Spanning Tree
procedure findMST(graph: array of array of integer);
var parent, key: array of integer;
mstSet: array of boolean;
u, n: integer;
begin
n := length(graph);
setLength(parent, n);
setLength(key, n);
setLength(mstSet, n);
for var i := 0 to (n - 1) do begin
key[i] := MaxInt;
mstSet[i] := false;
end;
key[0] := 0;
parent[0] := -1;
for var count := 0 to (n - 2) do begin
u := findMinKey(key, mstSet);
mstSet[u] := true;
for var v := 0 to (n - 1) do begin
if (graph[u][v] > 0) and (mstSet[v] = false) and (graph[u][v] < key[v]) then begin
parent[v] := u;
key[v] := graph[u][v];
end;
end;
end;
printMST(parent, graph);
end;
procedure fillFromFile(path: string; var arr: array of array of integer);
var F: TextFile;
n: integer;
begin
assignfile(F, path);
reset(F);
while not eof(F) do begin
readlnstring(F);
inc(n);
end;
closefile(F);
SetLength(arr, n);
for var i := 0 to (n - 1) do begin
SetLength(arr[i], n);
end;
assignfile(F, path);
reset(F);
for var j := 0 to n - 1 do begin
for var i := 0 to n - 1 do begin
read(F, arr[i][j]);
end;
end;
closefile(F);
end;
procedure fillRandom(var arr: array of array of integer);
var n: integer;
begin
n := random(2, 5);
SetLength(arr, n);
for var i := 0 to (n - 1) do begin
SetLength(arr[i], n);
end;
for var j := 0 to n - 1 do begin
for var i := 0 to n - 1 do begin
arr[i][j] := random(0, 5);
end;
end;
end;
procedure writeArray(var arr: array of array of integer);
var n: integer;
begin
n := length(arr);
for var i := 0 to (n - 1) do begin
for var j := 0 to (n - 1) do begin
if(j = 0) then begin
write('|');
end;
write(arr[i, j]);
if(j = (n - 1)) then begin
write('|');
end;
if(length(arr[i, j].toString) > 1) then begin
write(' ');
end else begin
write(' ');
end;
end;
writeln;
end;
end;
var matrix: array of array of integer;
n, switch: integer;
filename: string;
begin
writeln('1 - ввод из файла, 2 - случайные числа, 3 - ручной ввод');
read(switch);
case switch of
1: begin
fillFromFile('6.txt', matrix);
end;
2: begin
read(filename);
writeln(filename);
fillRandom(matrix);
end;
else begin
writeln('Введите размерность матрицы:');
read(n);
SetLength(matrix, n);
for var i := 0 to (n - 1) do begin
SetLength(matrix[i], n);
end;
for var j := 0 to n - 1 do begin
for var i := 0 to n - 1 do begin
read(matrix[i][j]);
end;
end;
end;
end;
writeln('Введенная матрица:');
writeArray(matrix);
findMST(matrix);
end.