Delphi, алгоритма Беллмана-Шимбела (графы, вычисления кратчайшего пути)

[ogamilait]

Нужна помощь для написания алгоритма Беллмана-Шимбела.(именно этот)
(графы, вычисления кратчайшего пути)
Пример, есть матрица C1:
0 1 0 2 2
1 0 1 0 1
0 1 0 2 3
2 0 2 0 1
2 1 3 1 0

По ней нужно сделать матрицу C2:
0 1 2 2 2
1 0 1 2 1
2 1 0 2 2
2 2 2 0 1
2 1 2 1 0
Теперь например для вычисления елемента С13 матрицы С2:
С13=min(C11+C13;C12+C23;C13+C33;C14+C4 3;C15+C53)=(0;2;0;4;5)=2 и т.д. (тоесть произведение строки на столбец и поиск миниму)
И так дале ищем С4 С8 ... Cn пока последняя матрица не совпадает с предыдущей.

Ну так вот я сделал таблицу StringGrid внес туда первоначальные даные, выставил вторую таблицу StringGrid, дале...
Наверное каждый елемент матрицы С2 нужно будет пересчитывать за формулой. Например, чтоб вычеслить C13 нужно:
Взять первую строку (StringGrid1.Rows[1]) положыть в масив, взять стобец (StringGrid1.Cols[3]) в масив, потом масивы додать, и найти минимальное значение но значения > 0 . Или можна сразу найти произведение с таблицы и найти минимум больше 0, не занося в масив?
Возможно я все утруждаю себе.
Нужен совет как все сделать болия мения компактно.

[ZX Spectrum-128]

StringGrid - это и есть массив. Двумерный массив строк. Работайте прямо с ним. Когда нужны будут вычисления, используйте StrToInt (строка в число), после вычислений - IntToStr (число в строку). А минимум можно и так искать, не преобразовывая строки в числа.

[ogamilait]

Сообщение от ZX Spectrum-128

StringGrid - это и есть массив. Двумерный массив строк. Работайте прямо с ним. Когда нужны будут вычисления, используйте StrToInt (строка в число), после вычислений - IntToStr (число в строку). А минимум можно и так искать, не преобразовывая строки в числа.

Тогда наведите пожалуйста пример как найти минимум C13.

[ZX Spectrum-128]

Если я правильно понял алгоритм.
Пояснения в тексте

uses
  crt;
const
  n=5;
var
  d,c : array [1..n,1..n] of integer;
  nmin,k,min,i,j : integer;
  b : array [1..n] of integer;
begin
  clrscr;
  for i:=1 to n do
    for j:=1 to n do
      c[i,j]:=random(3);

  for i:=1 to n do
    begin
      for j:=1 to n do
        write(c[i,j]:4);
      writeln;
    end;

  for i:=1 to n do
    begin
      for j:=1 to n do
        begin
          for k:=1 to n do
            b[k]:=c[i,k]+c[k,i]; //Находим суммы элементов столбца и строки
          for k:=1 to n do  //находим первый ненулевой элемент
            if b[k]<>0 then
              begin
               nmin:=k;
               break;
             end;
          min:=b[nmin];
          for k:=nmin to n do //ищем минимум среди ненулевых элементов
        if (b[k]<>0) and (min>b[k]) then
            min:=b[k];
        d[i,j]:=min;
      end;
  end;
  writeln;
  for i:=1 to n do
    begin
      for j:=1 to n do
        write(d[i,j]:4);
      writeln;
    end;

  readln;
end.

На ваших данных не проверял. Проверьте.

[ogamilait]

Спасибо. Буду проверять.

[ogamilait]

Сообщение от ZX Spectrum-128

Если я правильно понял алгоритм.
Пояснения в тексте

uses
  crt;
const
  n=5;
var
  d,c : array [1..n,1..n] of integer;
  nmin,k,min,i,j : integer;
  b : array [1..n] of integer;
begin
  clrscr;
  for i:=1 to n do
    for j:=1 to n do
      c[i,j]:=random(3);

  for i:=1 to n do
    begin
      for j:=1 to n do
        write(c[i,j]:4);
      writeln;
    end;

  for i:=1 to n do
    begin
      for j:=1 to n do
        begin
          for k:=1 to n do
            b[k]:=c[i,k]+c[k,i]; //Находим суммы элементов столбца и строки
          for k:=1 to n do  //находим первый ненулевой элемент
            if b[k]<>0 then
              begin
               nmin:=k;
               break;
             end;
          min:=b[nmin];
          for k:=nmin to n do //ищем минимум среди ненулевых элементов
        if (b[k]<>0) and (min>b[k]) then
            min:=b[k];
        d[i,j]:=min;
      end;
  end;
  writeln;
  for i:=1 to n do
    begin
      for j:=1 to n do
        write(d[i,j]:4);
      writeln;
    end;

  readln;
end.

На ваших данных не проверял. Проверьте.

Проблема, должно работать по другому немножка, не нужно искать произведение всех строк на столбцы, а только те что идиут после главной диагноли матрицы (0). Выделил оранжевым.
0 1 0 2 2
1 0 1 0 1
0 1 0 2 3
2 0 2 0 1
2 1 3 1 0

Тоесть нужно найти только суму етих елементов и их минимум и записать в матрицу С2, и семетрически записать их в столбцы.

[ZX Spectrum-128]

Нужно добавить условие if i>j then, если выше главной диагонали. А что такое семетрически?

[ogamilait]

"симметрично" - плохо с языком.

[ZX Spectrum-128]

Сообщение от ogamilait

"симметрично" - плохо с языком.

Нет-нет. Я понял, что симметрично. Я не понял, что означает симметрично записать в столбец.
Алгоритм заключается в том, что нужно провести для элементов, лежащих выше главной диагонали, сложение элементов строки с соответствующим столбцом, далее найти минимум и записать. А что означает симметрично?

[ogamilait]

Сообщение от ZX Spectrum-128

Нет-нет. Я понял, что симметрично. Я не понял, что означает симметрично записать в столбец.
Алгоритм заключается в том, что нужно провести для элементов, лежащих выше главной диагонали, сложение элементов строки с соответствующим столбцом, далее найти минимум и записать. А что означает симметрично?

записать их симметрично в столбцы в новую таблицу:
0 1 0 2 2
1 0 1 0 1
0 1 0 2 3
2 0 2 0 1
2 1 3 1 0
выделил цветами. Ну это так второстипенное дело.
Меня больше алгоритм интирисует который ты дал он как то не так щитает как нужно.
Вот приме маленький:
С1
0 1 2
1 0 9
2 9 0
находим C2:
C12=min(C11+C12;C12+C22;C13+C23)=min(0 +1;1+0;2+9)=1 и т.д.
выйдет такая матрица:
0 1 2
1 0 2
2 2 0
А в если запустить в алгоритм матрицу эту выйдет
0 2 2
0 0 2
0 0 0
Ну три 0 что ниже глав. диагонали ето через if j>i... но там не все 2 должны быть сверху.
Вроде как то так. Я не силен пробывал сам с 0, но как то не оч получаетса.

uses
  crt;
const
  n=3;
  c : array [1..n,1..n] of integer=(
  (0,1,2),
  (1,0,9),
  (2,9,0));
var
  d: array [1..n,1..n] of integer;
  nmin,k,min,i,j : integer;
  b : array [1..n] of integer;
begin


  for i:=1 to n do
    begin
      for j:=1 to n do
        write(c[i,j]:4);
      writeln;
    end;

  for i:=1 to n do
    begin
      for j:=1 to n do
        if j>i then
        begin
        
          for k:=1 to n do
            b[k]:=c[i,k]+c[k,i]; //Находим суммы элементов столбца и строки
          for k:=1 to n do  //находим первый ненулевой элемент
            if b[k]<>0 then
              begin
               nmin:=k;
               break;
             end;
          min:=b[nmin];
          for k:=nmin to n do //ищем минимум среди ненулевых элементов
        if (b[k]<>0) and (min>b[k]) then
            min:=b[k];
        d[i,j]:=min;
      end;
  end;
  writeln;
  for i:=1 to n do
    begin
      for j:=1 to n do
        write(d[i,j]:4);
      writeln;
    end;

  readln;
end.