Нахождение всех маршрутов в графе Опции

[biv171]

ребят помогите если можите,задача у меня такая:дано N городов и известны расстояния между ними.Не все города связаны с друг с другом.нужно найти все маршруты из города А в город В,заходя в каждый город только один раз.ИСПОЛЬЗОВАТЬ ПРИ ЭТОМ НАДО РЕКУРСИЮ.

я вот пытался решать,но всегда натыкался на какие-то варианты которые не работали,так в основном у меня проблемы с выводом всех маршрутов.

описание: у меня есть 3 массива: массив С-массив длин ребер,массив Х-массив меток(если мы посетили эту вершину то мы помечам ее как пройденную в моей проге=1(изначально этот массив я обнулил)) и последний массив S-массив маршрутов,т.е последовательность вершин от начальной точки(nac) к конечной точке (kon).

обхожу я граф с помощью метода в глубину с возвратом(т.е когда достигли конечную вершину(kon) мы возращаемся обратно к начальной,при этом проверяя нет ли еще каких-нибудь мршрутов);

пожайлуста помогите 3ью неделю пытаюсь сделать,идеи все иссякли...проблема с выводом ...помогите плиз

Program pyti;
Uses Crt;
const m=10;p=10;
Type
   Dmas = Array[1..m,1..m] Of Integer;
    Mas = Array[1..m] Of Integer;
   mpyt = array[1..m] of integer;
Var
   N,
   I,J,
   Nac,
   Kon,k,q,z,v: Integer;
     C: Dmas;
     x: mas;
     s:mpyt;

 Procedure Dlina;{заполняю матрицу длин ребер с экрана}
 Begin
  GotoXY(7,7);
  Write('Введите число вершин графа: ');
  Readln(N); {Задание значения числа вершин}
  For I:=1 To N Do Begin
                    Writeln;
                    For J:=1 To N Do
                     If I<>J Then Begin
                                   Write('Введите вес дуги [',I,',',J,']:= ');
                                   Readln(C[I,J]) {Ввод с клавиатуры значения длины дуги}
                                  End
                             Else If I=J Then C[I,J]:=-1;

                   End;
 end;


procedure pyt(nac:integer);
label M;
 var v:integer;
 begin
 x[nac]:=1;
 i:=i+1;
 if nac=kon then begin

                  x[nac]:=0;
                  s[i]:=nac;
                  for i:= 1 to n do write(s[i],' ');
                  writeln;
                  s[i]:=0;
                  goto M;
                 end;
  for v:=1 to n do if (c[nac,v]>0) and (x[v]=0) then begin
                                                      s[i]:= nac;

                                                      if s[i]=s[i-1] then
{
  данный цикл я сделал потому что у меня повторялись
  вершины т.е:если путь должен быть 1,2,3,5 то он
  мне выодил 1,2,2,3 при n=4(где n -число вершин)
}
                                                       begin
                                                        s[i]:=0;
                                                        i:=i-1;
                                                        s[i]:=nac;
                                                       end;

                                                      pyt(v);
                                                     end;

 M:
  z:=z+1;
  x[nac]:=0;
  i:=i-1;
  s[i]:=0;
  {i:=i-1;}

 end;




{osnovnai programma}
Begin
 Clrscr;
 Dlina;
 clrscr;
 k:=1;
 GotoXY(10,10);
  Write('Введите номер начальной вершины пути: '); Readln(Nac);
  GotoXY(10,12);
  Write('Введите номер конечной вершины пути: '); Readln(Kon);
  Writeln;
  q:=nac;
  z:=0;
  for i:=1 to N do x[i]:=0;
  clrscr;
  i:=0;
 pyt(nac);

     readln;
end.

[volvo]

biv171, почти правильно, НО:
1)

if nac=kon then begin
  x[nac]:=0;
  s[i]:=nac;
  for i:= 1 to n do write(s[i],' '); { <--- Значение I, что было ПЕРЕД циклом, утеряно безвозвратно }
  writeln;
  s[i]:=0;
  goto M;
end;

(Вводи еще одну, дополнительную переменную именно и только для цикла печати)

2)

if s[i]=s[i-1] then { <--- Опасно !!! }

Ты начинаешь с i = 0, то есть, здесь у тебя вполне может оказаться сравнение s[1] = s[0], а это вылет за пределы массива, надо поставить:

if (i > 1) and (s[i]=s[i-1]) then { <--- Вот это будет более безопасно }

3)

M:
z:=z+1;
x[nac]:=0;
i:=i-1;
s[i]:=0; { <--- Опасно по той же причине, что и в п.2 }

Ты начинал с i = 0, значит, на последнем "витке" раскручивания рекурсии придешь опять к i = 0, а это опять вылет за пределы массива. Опять проверять на i > 0, и только тогда делать обнуление s[ i ]...

P.S. От метки все-же лучше избавиться... Не Бейсик, все-таки.

[biv171]

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

[volvo]

не понял я поповоду 1го пункта,зачем нам предыдущее значение i

Затем, что ты после цикла пишешь s[ i ] := 0, а чему в этот момент равно i, ты знаешь? Уж никак не тому самому, чему равнялось в момент, когда делалось s[ i ]:=nac (а ведь эти значения i как раз должны быть равны, иначе у тебя получится черт знает что...)

как должно быть?

Я ж написал, что нужно делать... Вот процедура pyt полностью:

procedure pyt(nac:integer);
label M;

var
  v, ii: integer;
begin
  x[nac] := 1;
  i := i+1;

  if nac=kon then begin
    x[nac] := 0;
    s[i]:=nac;

    { Это - чтоб лишние нули не печатались }
    ii := 1;
    while (ii <= high(s)) and (s[ii] > 0) do begin
      write(s[ii]:4); inc(ii);
    end;
    writeln;

    s[i]:=0;
    goto M;
  end;

  for v:=1 to n do if (c[nac,v]>0) and (x[v]=0) then begin
    s[i]:= nac;
    if (i > 1) and (s[i]=s[i-1]) then begin
      s[i]:=0;
      i:=i-1;
      s[i]:=nac;
    end;

    pyt(v);
  end;

M:
  z:=z+1;
  x[nac]:=0;
  i:=i-1;
  if i > 0 then s[i]:=0;
end;

Проверялось на матрице:

const
  m=8;
  p=m;
  C: Dmas = (
    (-1,  2,  2,  8, -1, -1, -1, -1),
    (-1, -1, -1, -1, -1,  5, -1, -1),
    (-1, -1, -1,  9,  5, -1, -1, -1),
    (-1, -1, -1, -1, -1,  7, -1, 11),
    (-1, -1, -1, -1, -1, 11, -1, -1),
    (-1, -1, -1, -1, -1, -1,  4, 12),
    (-1, -1, -1, -1, -1, -1, -1,  4),
    (-1, -1, -1, -1, -1, -1, -1, -1)
  );

(как программа поведет себя на графе с двухсторонними связями вершин - не знаю, проверяй)

[Гость]

Господи,volvo-ты бог,огромное тебе спасибо,извини за мою тупость...СПАСИБО ЧТО ПОМОГ... ТЫ ЛУЧШИЙ!!!

[biv171]

Volvo,подкинь идейку плиз,мне нужно еще вывести самый короткий и самый длинный маршрут,как мне лучше это сделать?может быть присвоить к примеру :d[k]:=s[ii] а потом делая проверку на минимальный и максимальный маршрут выводить?так или еще как-то можно..посоветуй...

[volvo]

мне нужно еще вывести самый короткий и самый длинный маршрут

Описать еще 4 глобальные переменные:

smin, smax: mpyt;
minlen, maxlen: integer;

, и в процедуре поиска немного изменить кусок, где выводится путь (добавить подсчет длины выводимого пути и сравнение с мин/макс длиной на данный момент):

  if nac=kon then begin
    x[nac] := 0;
    s[i]:=nac;

    ii := 1;
    len := 0; { <--- Добавлено, описать локальной переменной }
    while (ii <= high(s)) and (s[ii] > 0) do begin
      if ii > 1 then inc(len, C[ s[ii-1], s[ii] ]); { <--- Вот так считаем суммарную длину пути }
      write(s[ii]:4); inc(ii); { <--- Увеличиваем Len }
    end;
    writeln;

    if len > maxlen then begin { и сравниваем... }
      maxlen := len; smax := s;
    end;
    if len < minlen then begin
      minlen := len; smin := s;
    end;

    s[i]:=0;
    goto M;
  end;

В результате у тебя в переменной smin будет самый короткий путь (длина = minlen), а в smax - самый длинный (длина = maxlen). Если есть несколько путей с минимальной/максимальной длиной, то запомнится первый из них...

P.S. не забудь перед вызовом pyt сделать:

...
minlen := maxint; maxlen := 0; { <--- вот это }
pyt(nac);
...

Сообщение отредактировано: volvo - 13.11.2008 14:54

[biv171]

я наверно не правильно сказал,извини Volvo,я имел ввиду минимальный маршрут и максимальный маршрут вводимых данных,т.е мы смотрим и оцениваем не длину нашего маршрута s[ii],а смотрим по матрице c[i,j]:
т.е предположим нашли путь (1 итерация) :1-2 он равен по нашей матрице 100км,нашли еще один путь 1-3-4-2 суммарно он равен 70км,третий путь 1-4-2 равен 80км,т.е самый длинный маршрут равен 1-2,самый короткий 1-3-4-2....извини что запутал!помоги..

[volvo]

Все правильно, это я не то скопировал... Посмотри, я исправил, и показал где именно...

[biv171]

Все правильно, это я не то скопировал... Посмотри, я исправил, и показал где именно...

спасибо огромное..