program centerGraph;
{$R-} {отключаем проверку границ диапазона}
uses
crt;
type
pMyVector = ^myVector;
myVector = array[1..1] of shortInt;
myArrayPtr = ^myArray;
myArray = array[1..1] of pMyVector;
var
countTop : shortInt; {количество вершин графа}
matrixArc : myArrayPtr; {динамическая матрица хранит вес дуг графа}
minLength : myArrayPtr; {динамическая матрица хранит минимальные расстояния между вершинами}
{===============================================================}
{выделяем память для динамической матрицы}
procedure getMemory(var x : myArrayPtr);
var
i : byte;
begin
getMem(x, countTop * sizeOf(pMyVector));
for i := 1 to countTop do
begin
getMem(x^[i], countTop * sizeOf(shortInt));
end;
end;
{===============================================================}
{ввод весов дуг для орграфа}
procedure inputValueOfArc;
var
i, j : byte;
begin
writeln('Если указанные вершины не соединены между собой, то введите 100(аналог бесконечность).');
writeln('Отрицательные значения недопустимы!');
for i := 1 to countTop do
begin
for j := 1 to countTop do
begin
if(i <> j) then
begin
write('Введите стоимость/"вес" дуги, соединяющей вершину с номером ', i, ' и вершину ', j, ': ');
{$I-}
readln(matrixArc^[i]^[j]);
{$I+}
if(IOResult <> 0) then
begin
writeln('Ошибка ввода! Принимаем значение по умолчанию 10.');
matrixArc^[i]^[j] := 10;
end;
if(matrixArc^[i]^[j] < 0) then
begin
writeln('Введено отрицательное значение веса графа, что недопустимо! По умолчанию 10.');
matrixArc^[i]^[j] := 10;
end;
end
else
begin
matrixArc^[i]^[j] := 0;
end;
end;
end;
end;
{===============================================================}
{отображение динамической матрицы}
procedure printWeightArc(x : myArrayPtr; comment : string);
var
i, j : byte;
begin
writeln;
writeln('Данный граф, состоящий из ', countTop, comment);
for i := 1 to countTop do
begin
for j := 1 to countTop do
begin
write(x^[i]^[j]:3, ' ');
end;
writeln;
end;
end;
{===============================================================}
{ищем минимальные расстояния между вершинами графа}
procedure getMinLength;
var
i, j, k : byte;
begin
for i := 1 to countTop do
begin
for j := 1 to countTop do
begin
minLength^[i]^[j] := matrixArc^[i]^[j];
end;
end;
for k := 1 to countTop do
begin
for i := 1 to countTop do
begin
for j := 1 to countTop do
begin
if(minLength^[i]^[k] + minLength^[k]^[j] < minLength^[i]^[j]) then
begin
minLength^[i]^[j] := minLength^[i]^[k] + minLength^[k]^[j];
end;
end;
end;
end;
for i := 1 to countTop do
begin
minLength^[i]^[i] := 0;
end;
end;
{===============================================================}
{находим искомую вершину, являющуюся центром орграфа}
function seekCenterGraf : byte;
var
i, j : byte;
maxColumn, center : byte;
minMatrix : byte;
begin
center := 1; {иначе может быть такая ситуация, что центр будет в первой вершине, и отобразится
в переменной мусор, т к какое либо значение ни разу не будет присвоено}
minMatrix := 101;
for i := 1 to countTop do
begin
maxColumn := minLength^[1]^[i];
for j := 1 to countTop do
begin
if(minLength^[j]^[i] > maxColumn) then
begin
maxColumn := minLength^[j]^[i];
end;
end;
if(minMatrix > maxColumn) then
begin
minMatrix := maxColumn;
center := i
end;
end;
seekCenterGraf := center;
end;
{===============================================================}
begin
clrscr;
writeln('Введите количество вершин графа');
writeln('Рекомендация: слишком большое количество вводить не нужно(в пределах 5),');
writeln('т к это существенно замедлит дальнейший ввод. Отрицательное значение недопустимо');
readln(countTop);
if(countTop <= 0) then
begin
writeln('Введено отрицательное количество вершин графа! По умолчанию принимается 4.');
countTop := 4;
end;
getMemory(matrixArc);
getMemory(minLength);
inputValueOfArc;
printWeightArc(matrixArc, ' вершин имеет следующие веса дуг:');
getMinLength;
printWeightArc(minLength, ' вершин имеет следующие минимальные расстояния:');
writeln;
writeln('Центром данного орграфа является вершина под номером: ', seekCenterGraf:2);
readln;
end.
)
).
(нужен будет одномерный динамический массив, с количеством элементов = количеству вершин -> записывать туда максимумы по столбцам -> первым циклом найти минимум, а вторым сравнить каждый элемент с этим минимумом, и если равны, то найден еще один центр графа).