Поиск маршрутов между двумя городами между n городов

[DorianMark]

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

Условие:


Написаный на данное время код:

program god_TV;
uses crt;
var
   map: array [1..10,1..10] of integer;
   map2: array [1..10,1..10] of integer;
   inc: array [1..10] of integer;      
   road: array [1..10] of integer;    
   roadinc: array [1..10] of integer; 
   n,k,i,j,g1,g2,tg,km,kgm,sum,s1,s2,include,s3,s4,s5,s6,s7,p1,p2,p3,p4,p5,p6,p7,true: integer;
begin
     clrscr;
     map[1,2]:=1;map[1,3]:=1;map[1,4]:=1;
     map[2,1]:=1;
     map[3,1]:=1;map[3,4]:=1;map[3,7]:=1;
     map[4,1]:=1;map[4,3]:=1;map[4,6]:=1;
     map[5,6]:=1;map[5,7]:=1;
     map[6,4]:=1;map[6,5]:=1;map[6,7]:=1;
     map[7,3]:=1;map[7,5]:=1;map[7,6]:=1;
     k:=9;
     n:=7;
     g1:=1;
     g2:=7;
     for i:=1 to n do      {Проверка точек на тупиковость}
         begin
              sum:=0;
              for j:=1 to n do
              begin
                   map2[i,j]:=map[i,j];
                   sum:=sum+map[i,j];
              end;
              if sum<=1 then inc[i]:=2;
         end;
     for s1:=1 to k do
     begin
          kgm:=1;
          road[kgm]:=g1;
          roadinc[km+1]:=roadinc[km+1] + sqr(g1);
          tg:=g1;
          inc[g1]:=1;
          kgm:=2;
          for i:=1 to n do
          begin
               for j:=1 to n do
               begin
                    if (map2[tg,j]=1) and (inc[j]=0) then
                    begin
                         road[kgm]:=j;
                         roadinc[km+1]:=roadinc[km+1] + sqr(j);
                         tg:=j;
                         kgm:=kgm+1;
                         inc[j]:=1;
                         for s2:=1 to k do
                         begin{Проверка на наличие подобного маршрута}
                              if (roadinc[km+1]=roadinc[s2]) and (s2<>km+1) then true:=1;
                         end;
                         if (j=g2) and (true=0) then
                         begin
                              i:=n;
                              km:=km+1;
                              for s2:=1 to kgm-1 do
                              begin
                                   gotoxy(s2*2,1+km); write(road[s2]);
                              end;
                              for s2:=1 to n do
                              begin
                                   if inc[s2]=2 then inc[s2]:=2 else inc[s2]:=0;
                              end;
                         end;
                         true:=0;
                         j:=n;
                    end;
               end;
          end;
     end;
     readkey;
end.

[DorianMark]

Пардон. Забыл условие.
Дано N городов, соеденённых между собой дорогами, из одного в другой можно попасть различными маршрутами. Необходимо найти для двух указаных городов все возможные маршруты.

Пример входных:
7 -количество городов
9- количество соедин
1 2 - пара соеденённых городов
1 3 - пара соеденённых городов
1 4 - пара соеденённых городов
3 4 - пара соеденённых городов
3 7 - пара соеденённых городов
4 6 - пара соеденённых городов
5 6 - пара соеденённых городов
5 7 - пара соеденённых городов
6 7 - пара соеденённых городов
1 7 - маршрут

Выходные данные:
4 - кол-во маршрутов
1 4 3 7
1 3 7
1 4 6 7
1 4 6 5 7

[TinMan]

Что-то у тебя с условием не так.
"Соединение" можно понимать двояко: как однонаправленное (можно только из первого города во второй, из второго в первый нельзя) и как двунаправленное (можно и в ту, и в другую сторону). Так вот, если:
- однонаправленное, то в примере в ответе первый маршрут невозможен (нет пути из 4 в 3)
- двунаправленное, то в примере в ответе не хватает двух маршрутов (1 3 4 6 5 7 и 1 3 4 6 7).

По сути, мое решение очень легко переделать под любой случай - надо просто убрать/добавить одну строку (можно даже настраивать параметром), она помечена в коде комментарием.

Короче - voila! enjoy ))

{ finding all the routs between two towns
  by TinMan, programmersforum.ru }

{$H+}

const
  m= 70;

var
  map: array[1..m,1..m] of boolean;
  trace: array[1..m] of boolean;
  n,start,finish,total,a,b,i,k: integer;
  f: text;
  path,all: string;

procedure Go(town: word; path: string);
var
  s: string;
  t: word;
begin
  trace[town]:= true;
  Str(town,s);
  path:= path+s+' ';
  if town=finish then begin
    all:= all + #$D + #$A + path;
    inc(total)
  end
  else
    for t:=1 to n do if map[town,t] and not Trace[t] then Go(t,path);
  trace[town]:= false
end;

begin
  total:= 0;
  all:= '';
  Assign(f,'in.txt');
  Reset(f);
  readln(f,n);
  for a:=1 to n do begin
    trace[a]:= false;
    for b:=1 to n do map[a,b]:= false
  end;
  readln(f,k);
  for i:=1 to k do begin
    readln(f,a,b);
    map[a,b]:= true;
    map[b,a]:= true  // if one-way, comment this line
  end;
  readln(f,start,finish);
  Close(f);
  Assign(f,'out.txt');
  Go(start,'');
  Rewrite(f);
  writeln(f,total,all);
  Close(f)
end.

А если ты все же хочешь добить свой путь решения - пиши, я постараюсь вникнуть.

[DorianMark]

эм... такой вопрос. эта программа в турбо паскале будет работать?) а то так с пол-тыка не могу понять, как ты её реализовал.

З.ы. в каждом городе можно побывать только один раз. ходить из одного города в другой можео как угодно.

[DorianMark]

вот еще вопрос. можно ли как -то обойтись без создания текстового файла? дело в том что у меня нету прав доступа((

[DorianMark]

хм... создал на своем компьютере

{ finding all the routs between two towns
  by TinMan, programmersforum.ru }

{$H+}

const
  m= 70;

var
  map: array[1..m,1..m] of boolean;
  trace: array[1..m] of boolean;
  n,start,finish,total,a,b,i,k: integer;
  f: text;
  path,all: string;

procedure Go(town: word; path: string);
var
  s: string;
  t: word;
begin
  trace[town]:= true;       {тут вылетает ошибка 201 - ошибка проверки диапазона}
  Str(town,s);
  path:= path+s+' ';
  if town=finish then begin
    all:= all + #$D + #$A + path;
    inc(total)
  end
  else
    for t:=1 to n do if map[town,t] and not Trace[t] then Go(t,path);
  trace[town]:= false
end;

begin
  total:= 0;
  all:= '';
  Assign(f,'in.txt');
  Reset(f);
  readln(f,n);
  for a:=1 to n do begin
    trace[a]:= false;
    for b:=1 to n do map[a,b]:= false
  end;
  readln(f,k);
  for i:=1 to k do begin
    readln(f,a,b);
    map[a,b]:= true;
    map[b,a]:= true  // if one-way, comment this line
  end;
  readln(f,start,finish);
  Close(f);
  Assign(f,'out.txt');
  Go(start,'');
  Rewrite(f);
  writeln(f,total,all);
  Close(f)
end.

[TinMan]

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

эм... такой вопрос. эта программа в турбо паскале будет работать?) а то так с пол-тыка не могу понять, как ты её реализовал.

Дык. Я этому всю жизнь учился - а ты хочешь с полтыка? ))
Я писал в FreePascal (FP). В ТР она работать вроде должна, я ничего такого экстраординарного не использовал. Но две оговорки:
1. комментарии // нужно переделать на {}
2. поскольку длина строки в TP ограничена 255, то общее решение (сумма строк всех путей) не должно превышать этот размер. Длинные решения будут обрезаны. Но если выпечатывать отдельные пути на каждом шаге, то этого можно избежать. Но тогда общее количество найденных путей надо печатать В КОНЦЕ, а не в начале (как в условии).

З.ы. в каждом городе можно побывать только один раз. ходить из одного города в другой можео как угодно.

Ну это-то ясно.. Я про хождения в разных направлениях. Перечитай и вникни.

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

вот еще вопрос. можно ли как -то обойтись без создания текстового файла? дело в том что у меня нету прав доступа((

Конечно, можно. Либо перенаправь вывод, либо просто убери f в операторах write (и убери открытие/закрытие файла).

[DorianMark]

А почему ошибка вылетает?

ошибка 201 - ошибка проверки диапазона

[TinMan]

в какой строке? это Турбо?
пиши как можно подробнее, у меня нет Турбо, так что только с твоих слов.

[DorianMark]

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

в какой строке? это Турбо?
пиши как можно подробнее, у меня нет Турбо, так что только с твоих слов.

я нашел ошибку.

...

const
  m= 70;

...

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