VPF::матрицы достижимостей - Форум программистов

MrDmitry

Дата 6.4.2015, 20:12 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 556
Регистрация: 10.11.2006

Репутация: нет
Всего: нет

Помогите решить следующее задание
Для заданного графа найти матрицы достижимостей и контрадостижимостей произвольной длины, c ограничением длины 5 ребер и с ограничением веса пути 16.

Сам граф

Как я делал. Создал текстовый файл в который занес соединенные ребра

0 0 5 0 0 0 0 0
9 0 0 0 6 0 0 0
0 0 0 7 0 0 0 0
3 0 0 0 0 0 4 0
0 0 0 2 2 0 0 0
0 4 0 0 9 0 0 8
0 0 2 0 0 0 0 0
0 0 0 0 0 0 9 0

1 шагом загружаю такую матрицу в stringrid

Код


procedure TForm2.Button4Click(Sender: TObject);
var
 FileOfMatrix:TStringList;
 i, j, k:integer;
 str:string;
begin
OpenDialog1.Execute();
if FileExists(OpenDialog1.FileName) then
 begin
  FileOfMatrix:=TStringList.Create;
  FileOfMatrix.LoadFromFile(OpenDialog1.FileName);
  str:=FileOfMatrix[1];
  for i := 1 to length(str) do
   begin
    if str[i]=' ' then
    delete(str,i,1);
   end;
  StringGrid1.RowCount:=FileOfMatrix.count;
  StringGrid1.ColCount:=length(str)-1;
   for i := 0 to FileOfMatrix.Count-1 do
    begin
     str:=FileOfMatrix[i];
     for j := 0 to length(str)-1 do
      begin
       if str[j]=' ' then
        delete(str, j, 1);
       end;
       for k := 1 to length(str) do
        begin
         StringGrid1.Cells[k-1,i]:=str[k];
        end;
      end;
    end;
 end;

а дальше проблема вот так пытаюсь составить матрицу достижимости

Код


var
Matrix:array of array of integer;
weight,step:integer;
....
procedure TForm2.Button2Click(Sender: TObject);
var
 i, j:integer;
begin
 SetLength(Matrix,StringGrid1.RowCount, StringGrid1.ColCount);
 weight:=StrToInt(LabeledEdit1.Text);
 step:=StrToInt(LabeledEdit2.Text);
  for i := 0 to StringGrid1.RowCount-1 do
  begin
   for j := 0 to StringGrid1.ColCount-1 do
    begin
    if (StringGrid1.Cells[i,j]<>'0') and (step>0) and (StrToInt(StringGrid1.Cells[i,j])<=weight) then
     begin
      Matrix[i,j]:=1;
      SearchMatrix(j,i);
     end;
    end;
    step:=StrToInt(LabeledEdit2.Text);
    weight:=StrToInt(LabeledEdit1.Text);
  end;
end;

procedure TForm2.SearchMatrix(x,y:integer);
var
 i:integer;
begin
   for i := 0 to StringGrid1.ColCount-1 do
    begin
    if (StringGrid1.Cells[x,i]<>'0') and (StrToInt(StringGrid1.Cells[x,i])<weight) then
     begin
      if  step>=0 then
       begin
        weight:=weight+StrToInt(StringGrid1.Cells[x,i]);
        Matrix[y,x]:=1;
        dec(step);
        SearchMatrix(i,y);
       end
      else
     end;
    end;
  end;

Собственно конечный результат не правильный (

Это сообщение отредактировал(а) MrDmitry - 6.4.2015, 21:33

MrDmitry

Дата 7.4.2015, 17:54 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 556
Регистрация: 10.11.2006

Репутация: нет
Всего: нет

Ни у какого не каких мыслей? Если вы заметили я пытался делать при помощи рекурсии(по крайней мере как я это понимаю), но не вышло...

ФедосеевПавел

Дата 7.4.2015, 19:25 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 291
Регистрация: 7.2.2009

Репутация: 1
Всего: 10

Мне кажется, что здесь нужна не рекурсия, а модификации метода Флойда-Уоршелла.
1. Для произвольной длины - чистый Ф-У.
2. c ограничением длины 5 ребер. Сделать все веса одинаковыми (и равными 1) и Ф-У. После этого проверить длины (=весам) и те, что длиннее (=тяжелее) 5 удалить из матрицы достижимости.
3. ограничением веса пути 16. После чистого Ф-У проверить оптимальные длины веса и те, что больше 16 - исключить.

Флойд-Уоршелл - просто 3 вложенных цикла. Я реализовывал алгоритм по материалам из сети, в частности из e-maxx.

Код

{Реализация алгоритма Флойда-Уоршелла}
program FloydWarshall;

const
  n = 5; {количество вершин графа}
  INFINITY = MaxInt;
type
  TRow = array [0..n - 1] of integer;
  TVertex = array [0..n - 1] of TRow;
const
  Vertex1: TVertex =
    (
    (0, 0, 5, 0, 0),
    (7, 0, 0, 0, 10),
    (0, 7, 0, 0, 0),
    (0, 0, 6, 0, 4),
    (0, 0, 1, 0, 0)
    );
  Vertex2: TVertex =
    (
    (0, 3, 2, 0, 0),
    (0, 0, 0, 4, 0),
    (0, 0, 0, 6, 0),
    (0, 0, 0, 0, 2),
    (0, 0, 0, 0, 0)
    );

  procedure FloydWarshall(v: TVertex; n: integer; var d, p: TVertex);
  var
    i, j, k: integer;
  begin
    {
    матрицу веса дуги преобразуем в требуемый для алгоритма вид
    - если i=j, то d[i, j]:=0
    - если из i в j нет ребра, то d[i, j]:=INFINITY (бесконечности)
    - иначе d[i, j] равно весу ребра из i в j
    подготовим матрицу для восстановления пути p
    }
    d := v;
    for i := 0 to pred(n) do
      for j := 0 to pred(n) do
      begin
        if d[i, j] = 0 then
          d[i, j] := INFINITY;
        if i = j then
          d[i, j] := 0;
        p[i, j] := j;
      end;
    for k := 0 to pred(n) do
    begin
      for i := 0 to pred(n) do
      begin
        for j := 0 to pred(n) do
        begin
          if (d[i, k] <> INFINITY) and (d[k, j] <> INFINITY) then
          begin
            if (d[i, j] > d[i, k] + d[k, j]) then
            begin
              d[i, j] := d[i, k] + d[k, j];
              p[i, j] := p[i, k];
            end;
          end;
        end;
      end;
    end;
  end;

  procedure RestorePath(const D, P: TVertex; n: integer; A, B: integer);
  var
    k: integer;
  begin
    if A >= n then
    begin
      writeln('The vertex A is out of range.');
      exit;
    end;
    if B >= n then
    begin
      writeln('The vertex B is out of range.');
      exit;
    end;
    if D[A, B] = INFINITY then
    begin
      writeln('There is not a path from vertex ', A, ' to vertex ', B, '.');
      exit;
    end;
    Write('The path from vertex ', A, ' to vertex ', B, ' is: <');
    Write(A: 4);
    k := A;
    while k <> B do
    begin
      k := p[k, B];
      Write(k: 4);
    end;
    writeln('>');
  end;

  procedure ShowMatrix(const M: TVertex; n: integer);
  var
    i, j: integer;
  begin
    for i := 0 to pred(n) do
    begin
      for j := 0 to pred(n) do
      begin
        if M[i, j] <> INFINITY then
          Write(M[i, j]: 4)
        else
          Write('inf': 4);
      end;
      writeln;
    end;
  end;

  procedure TestAlgoFW(const Vertex: TVertex; n: integer);
  var
    D, P: TVertex;
  begin
    FloydWarshall(Vertex, n, D, P);
    writeln('Vertex matrix:');
    ShowMatrix(Vertex, n);
    writeln('Distance matrix:');
    ShowMatrix(D, n);
    writeln('Path matrix:');
    ShowMatrix(P, n);
    RestorePath(D, P, n, 3, 1);
    RestorePath(D, P, n, 0, 3);
    RestorePath(D, P, n, 3, 3);
  end;

begin
  TestAlgoFW(Vertex1, n);
  TestAlgoFW(Vertex2, n);
end.

Добавлено @ 19:29
1. Для произвольной длины - можно алгоритм Ли (волновой) - разновидность поиска в ширину - Флойд-Уоршелл
2. c ограничением длины 5 ребер - волновой - Флойд-Уоршелл.
3. ограничением веса пути 16 - Флойд-Уоршелл.

Это сообщение отредактировал(а) ФедосеевПавел - 7.4.2015, 21:23

0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Delphi: Общие вопросы \| Следующая тема »