Форум программистов, компьютерный форум, киберфорум
Turbo Pascal
Войти
Регистрация
Восстановить пароль
 
Рейтинг 4.91/11: Рейтинг темы: голосов - 11, средняя оценка - 4.91
38 / 1 / 3
Регистрация: 16.11.2015
Сообщений: 103
1

Определить, можно ли попасть из одного заданного пункта в другой

18.12.2015, 17:54. Показов 2004. Ответов 14
Метки нет (Все метки)

Имеется n населенных пунктов, пронумерованных от 1 до n. Некоторые пары пунктов соединены дорогами (в том числе дорогами с односторонним движением). Определить, можно ли попасть по этим дорогам из одного заданного пункта в другой. (Для усложнения задачи можно предложить указать все возможные пути без петель и тупиков из одного пункта в другой).
Попробовал задать населенные пункты и расстояние в массиве d[t,r] ,где t начальный город , r - конечный ,а d[t,r] расстояние между ними ,потом с помощью рекурсии с возвратом найти минимальный путь в матрице,но похоже что так нельзя было делать
Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
const n= 5;
var d :array[1..n,1..n] of integer;
d2:array[1..n,1..n] of integer;
t,r,a1,b1,s:integer;
procedure pv (a,b :integer);
begin
 
 if (a>n) or (a<1)or(b>n)or (b<1)  then exit;
    if (d[a,b]<>d2[a,b]) and (d[a,b]<s+d[a,b]) then exit;
     if d[a,b]=0 then exit;
 s:=s+d[a,b];
       d[a,b]:=s;
      pv(a+1,b);
      pv(a,b+1);
      pv(a-1,b);
      pv(a,b-1);
 s:=s-d[a,b];
 end;
  begin
   s:=0;
  randomize;
 
for t:=1 to n do begin
 writeln;
 for r:=1 to n do
  if t<>r then    begin
  d[t,r]:=random(25);
   write(d[t,r]:2,' ');
   d2[t,r]:=d[t,r];
                 end;
                 end;
   readln(a1,b1);
           pv(a1,b1);
readln
end.
Добавлено через 2 минуты
ФедосеевПавел, в теме перешел по ссылке чтоб скачать эту программу но в архиве тех файлов что вы описывали не было ,был только один
0
Programming
Эксперт
94731 / 64177 / 26122
Регистрация: 12.04.2006
Сообщений: 116,782
18.12.2015, 17:54
Ответы с готовыми решениями:

Определить, можно ли попасть по дорогам из одного города в другой
Имеется n городов, пронумерованных от 1 до n. Некоторые пары городов соединены дорогами. ...

Определить, можно ли попасть по дорогам из 1-го пункта в n-ый
помогите. вообще не знаю как сделать 3. Имеется n населенных пунктов, пронумерованных от 1 до n...

Определить, можно ли попасть по дорогам из l-того пункта в m-ый
Имеется n населенных пунктов, пронумерованных от 1 до n (n=10). Некоторые пары пунктов соединены...

Определить, можно ли попасть по дорогам из первого пункта в n-й
На карте местности имеется N населенных пунктов, пронумерованных от 1 до N (N&lt;= 10). Некоторые из...

14
Модератор
Эксперт по электронике
7527 / 3715 / 1457
Регистрация: 01.02.2015
Сообщений: 11,557
Записей в блоге: 2
18.12.2015, 18:23 2
По ссылке вы попадаете на http://jedicodeformat.sourceforge.net/
На этой странице самая первая ссылка Download Executables and Source Code ведёт на закачку sourceforge. Там выбираете "jedicodeformat v2", переходите на похожую страницу и выбираете "2.43". Попадаете на похожую страницу, где предлагаются к загрузке два архива (exe и исходники) jcf_243_exe.zip и Jcf_243_source.zip.

Добавлено через 10 минут
--------------------------------
Задача решается без рекурсии при помощи:
- если перед решением заданы два города - алгоритма Дейкстры (или его упрощением, т.к. задача минимизации длины пути не стоит)
- если нужно получить общую картину достижимости - алгоритмом Флойда-Уоршелла (или его упрощением, т.к. задача минимизации длины пути не стоит)

Описания алгоритмов я находил на e-maxx и на algolist.manual.ru, а также в википедии.
0
38 / 1 / 3
Регистрация: 16.11.2015
Сообщений: 103
18.12.2015, 18:30  [ТС] 3
Цитата Сообщение от ФедосеевПавел Посмотреть сообщение
Там выбираете "jedicodeformat v2"
аа ,понятно
Цитата Сообщение от ФедосеевПавел Посмотреть сообщение
Задача решается без рекурсии при помощи:
спасибо
0
38 / 1 / 3
Регистрация: 16.11.2015
Сообщений: 103
19.12.2015, 20:57  [ТС] 4
Описание алгоритма брал от сюда :
http://habrahabr.ru/post/111361/
Работает вроде правильно ,но как потом выбрать все пути не понятно ,и как можно упростить программу?очень много массивов ,переменных
Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
const n=5 ;
var mx :array[1..n,1..n] of integer;
  mt1 :array[1..n] of integer;  {промежуточный массив для зачеркиваний очередной вершины}
mt :array[1..n] of integer;
 p :array[1..n] of integer;
q,v,c,z,m1,min,j,s:integer;
 
 begin
 min:=30000;
  writeln('1');
   readln(c);
    writeln('2');
   readln(z) ;
       for q:=1 to n do
        for v:=1 to n do
       if q<>v then    begin   {матрица}
       writeln(q,',',v,'=');
    readln(mx[q,v]);
                      end;
 
   for q:=1 to n do //чтоб найти кратчайший путь
    p[q]:=1;
 
   mt[c]:=0;     mt1[c]:=0;     {метка начальной вершине}
      for q:=1 to n do
       if q<>c then begin      {метки остальным вершинам}
       mt[q]:=30000;
       mt1[q]:=30000;
                    end;       v:=c;     j:=0;
          while j<n do begin
                     j:=j+1;
 
          for q:=1 to n do
    if (q<>v) and (mx[v,q]>0)and (mt1[v]<30000) then//если есть дорога,то
          if mt[v]+mx[v,q]<mt[q] then begin    {если полученная сумма меньше }
            mt[q]:=mt[v]+mx[v,q];//пред.знач. метки
             mt1[q]:=mt1[v]+mx[v,q];
             p[q]:=v;
             end;
         mt1[v]:=30000;  {зачеркиеваем очередную вершину}
 
 
 
            for m1:=n downto 1 do            {из оставшихся вершин выбираем}
                if mt1[m1]<min then        //наименьшую
                begin
                v:=m1;
                min:=mt1[m1];
                        end;
                end;
                    for v:=1 to n do
                    write(mt[v],' ');
                    writeln;
                    for v:=1 to n do
                    write(p[v],' ');
                   // s:=mt[p[z]]+mt[z];
                   // writeln('дороги нет!') else
            //writeln('Расстояние равно ',mt[z]);
readln
end.
Добавлено через 32 секунды
вместо бесконечности писал 30 000

Добавлено через 2 минуты
пробовал запустить программу форматирования кода ,выбивает ошибку
Кликните здесь для просмотра всего текста
Processing directory C:\Program Files\JCF\
Formatting file C:\Program Files\JCF\410.pas
Exception TEParseError Expected program, package, library, unit
Near CONST near line 1 col 1
Aborted due to error
0
Модератор
Эксперт по электронике
7527 / 3715 / 1457
Регистрация: 01.02.2015
Сообщений: 11,557
Записей в блоге: 2
19.12.2015, 22:30 5
Лучший ответ Сообщение было отмечено msk19 как решение

Решение

Выбиваемую ошибку нужно забить первой строкой "program SuperProg;".

Ощущение перевода на Pascal.
Покажу, как я когда-то решал эту задачу.
Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
{
V - множество вершин графа (vertex)
E - множество рёбер графа
w[i,j] - вес (длина) ребра ij
a - вершина, расстояния от которой ищутся
U - множество посещённых вершин (used)
d[u] - по окончании работы алгоритма равно
       длине кратчайшего пути из a до вершины u (distance)
p[u] - по окончании работы алгоритма содержит кратчайший путь из a в u
       (предшествующий u элемент, previous)
}
const
  INFINITY  = MaxInt;
  UNDEFINED = -1;
 
const
  Nmax = 6;
type
  TMatrix = array[0..Nmax - 1, 0..Nmax - 1] of integer;
  TVertexList = array[0..Nmax - 1] of integer;
  TDistance = array[0..Nmax - 1] of integer;
  TUsed = array[0..Nmax - 1] of boolean;
 
  function MinOf(const a: TDistance; const m: TUsed): integer;
  var
    i: integer;
    Imin: integer;
    Min: integer;
  begin
    i := low(a);
    while i <= high(a) do
    begin
      if not m[i] then
      begin
        Imin := i;
        Min  := a[i];
        break;
      end;
      inc(i);
    end;
    for i := Imin + 1 to high(a) do
      if (Min > a[i]) and not m[i] then
      begin
        Imin := i;
        Min  := a[i];
      end;
    MinOf := Imin;
  end;
 
  procedure DijkstrasAlgorithm(const W: TMatrix; a: integer;
  var D: TDistance; var P: TVertexList);
  var
    v: integer;
    U: TUsed;
    i, j: integer;
  begin
    {initialization    
      d[a]:=0; p[a]:=0;
      d[v]:=INFINITY; p[v]:=UNDEFINED; для всех вершин отличных от a
    }
    for v := low(D) to high(D) do
    begin
      if v = a then
      begin
        D[v] := 0;
        P[v] := UNDEFINED;
      end
      else
      begin
        D[v] := INFINITY;
        P[v] := UNDEFINED;
      end;
      U[v] := False;
    end;
    {основной цикл}
    for i := low(D) to high(D) do {пока есть нерассмотренные вершины}
    begin
      v := MinOf(D, U); {берём непосещённую вершину с минимальным d[v]}
      U[v] := True;     {отмечаем её как посещённую}
      for j := low(D) to high(D) do
        if W[v, j] <> INFINITY then
          if D[j] > D[v] + W[v, j] then
          begin
            D[j] := D[v] + W[v, j];
            P[j] := v;
          end;
    end;
  end;
 
  procedure ShowPath(A, B: integer; const P: TVertexList; const D: TDistance);
  var
    Q: TVertexList;
    Len: integer;
    v: integer;
  begin
    Len := 0;
    if D[B] = INFINITY then
      writeln('There is not exist path from ', A, ' to ', B, '.')
    else
    begin
      v := B;
      repeat
        Q[Len] := v;
        Inc(Len);
        v := P[v];
      until v=UNDEFINED;
      write('A path from ', A, ' to ', B, ' is <');
      for v := Len - 1 downto 0 do
        Write(Q[v]: 4);
      writeln('>.');
    end;
  end;
В чём разница:
1. В самом алгоритме два вложенных for
2. Определение следующей вершины вынесено в процедуру и вызывается до внутреннего for, а не после.
3. Интерфейс пользователя отделён от реализации алгоритма.
4. Используется нормальный булевский тип вместо целочисленного эрзаца. Используются именованные константы.

И ещё совет - при отладке, чтобы не вводить по 25 чисел используйте типизированные константы (или чтение из файла).

Пути выбирают исходя из соображения, что
p[u] - по окончании работы алгоритма содержит кратчайший путь из a в u (предшествующий u элемент, previous), т.е. p[u] содержит номер вершины (города) из которого попадают в u.

Упростить программу можно за счёт декомпозиции - вынесения вычислений в процедуры.
1
38 / 1 / 3
Регистрация: 16.11.2015
Сообщений: 103
20.12.2015, 01:07  [ТС] 6
Цитата Сообщение от ФедосеевПавел Посмотреть сообщение
Выбиваемую ошибку нужно забить первой строкой "program SuperProg;".
сработало,спасибо

Добавлено через 1 час 53 минуты
Нашел тут программу , написанную по алгоритму поиск в глубину.Изменил ее чучуть чтоб выдавала есть вообще дорога из одного пункта в другой или нет.
Возможно ли изменить ее чтоб находила все возможные пути и расстояние от начальной точки до конечной?Или хотя бы просто расстояние любой дороги которая подходит ?
Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
program DepthFirstSearch;
 
const
n=5;
var
i, j, start,finish: integer;
hn:boolean;
visited: array[1..n] of boolean;
const graph: array[1..n,1..n] of byte =
((0, 1, 30,50, 10),
(0, 0, 0, 0, 0),
(0, 0, 0, 0, 10),
(0, 0, 20, 0, 0),
(10, 0, 10, 30, 0));
{поиск в глубину}
procedure DFS(st: integer);
var r: integer;
begin
if st=finish then  hn:=true;
write(st:3);
visited[st]:=true;
for r:=1 to n do
if (graph[st, r]<>0) and (not visited[r]) then DFS(r);
end;
{основной блок программы}
begin
                 hn:=false;
writeln('Матрица смежности:');
for i:=1 to n do
begin
visited[i]:=false;
for j:=1 to n do
write(graph[i, j],' ');
writeln;
end;
writeln('Стартовая вершина >> '); readln(start);
writeln('Финишная вершина >>');readln (finish);
writeln('Результат обхода'); DFS(start);
writeln;
if hn=true then writeln('Дорога есть') else
 writeln('Дороги нет!');
readln
end.
0
Модератор
Эксперт по электронике
7527 / 3715 / 1457
Регистрация: 01.02.2015
Сообщений: 11,557
Записей в блоге: 2
20.12.2015, 08:59 7
Отчего же нет?
0
38 / 1 / 3
Регистрация: 16.11.2015
Сообщений: 103
21.12.2015, 13:16  [ТС] 8
Цитата Сообщение от ФедосеевПавел Посмотреть сообщение
Отчего же нет?
а как?)

Добавлено через 2 часа 8 минут
И если можно еще тоже самое только с поиском в ширину,хочу разобрать уже с этими двумя алгоритмами.
Программа находит тоже самое что и предыдущая , а мне надо что бы находила все пути из данной точки в конечную ,и самый кратчайший из них
Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
program BreadthFirstSearch;
 
const n=5;
type
MassivInt=array[1..n, 1..n] of integer;
MassivBool=array[1..n] of boolean;
var
i, j, start: integer;
visited: MassivBool;
{матрица смежности графа}
const GM: MassivInt =
((0,1,30,50,10),
(0, 0, 0,0,0),
(0, 0, 0, 0,10),
(0, 0,20,0,0),
(10,0,10, 30,0));
{поиск в ширину}
procedure BFS(visited: MassivBool; _unit: integer);
var
queue: array[1..n] of integer;
count, head: integer;
begin
for i:=1 to n do queue[i]:=0;
count:=0; head:=0;
count:=count+1;
queue[count]:=_unit;
visited[_unit]:=true;
while head<count do
begin
head:=head+1;
_unit:=queue[head];
write(_unit, ' ');
for i:=1 to n do
begin
if (GM[_unit, i]<>0) and (not visited[i]) then
begin
count:=count+1;
queue[count]:=i;
visited[i]:=true;
end;
end;
end;
end;
{основной блок программы}
begin
 
write('Стартовая вершина >> '); readln(start);
writeln('Матрица смежности графа: ');
for i:=1 to n do
begin
visited[i]:=false;
for j:=1 to n do
write(' ', GM[i, j]);
writeln;
end;
write('Порядок обхода: ');
BFS(visited, start);
readln
end.
0
38 / 1 / 3
Регистрация: 16.11.2015
Сообщений: 103
22.12.2015, 15:50  [ТС] 9
?????????????????????????
0
Модератор
Эксперт по электронике
7527 / 3715 / 1457
Регистрация: 01.02.2015
Сообщений: 11,557
Записей в блоге: 2
23.12.2015, 22:46 10
Поиск в ширину остановится по достижении целевого города. И не даст перебора всех путей, но зато даст кратчайший.

Цитата Сообщение от msk19 Посмотреть сообщение
что бы находила все пути из данной точки в конечную ,и самый кратчайший из них
Это перебор всех вариантов с выбором наилучшего. Подойдёт и рекурсивная DFS.

Разные цели - разные инструменты.
0
38 / 1 / 3
Регистрация: 16.11.2015
Сообщений: 103
24.12.2015, 00:51  [ТС] 11
Цитата Сообщение от ФедосеевПавел Посмотреть сообщение
Поиск в ширину остановится по достижении целевого города
а как можно переделать данную программу ?Она выдает просто все смежные точки с начальной , и останавливается когда доходит до заданной точки и не учитывает что ребра имеют вес, а как потом восстановить кратчайший путь?
Если из начальной точки есть несколько дорог в конечную программа не учитывает все дороги а берет только одну
Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
program BreadthFirstSearch;
 
const n=5;
type
MassivInt=array[1..n, 1..n] of integer;
MassivBool=array[1..n] of boolean;
var
i, j, start,fn: integer;
visited: MassivBool;
{матрица смежности графа}
const GM: MassivInt =
((0, 10, 30,50, 10),
(0, 0, 0, 0, 0),
(0, 0, 0, 0, 10),
(0, 40, 20, 0, 0),
(10, 0, 10, 30, 0));
{поиск в ширину}
procedure BFS(visited: MassivBool; _unit: integer);
var
queue: array[1..n] of integer;
count, head,head1: integer;
begin
for i:=1 to n do queue[i]:=0;
 
count:=0; head:=0;
count:=count+1;
queue[count]:=_unit;
visited[_unit]:=true;
 
while (head<count)and (fn<>_unit) do
begin
 
head:=head+1;
_unit:=queue[head];
    write(_unit, ' ');
for i:=1 to n do
begin
 
if (GM[_unit, i]<>0) and (not visited[i]) then
begin
count:=count+1;
queue[count]:=i;
visited[i]:=true;
 
end;
end;
 
end;
end;
{основной блок программы}
begin
 
write('Стартовая вершина >> '); readln(start);
readln(fn);
writeln('Матрица смежности графа: ');
for i:=1 to n do
begin
visited[i]:=false;
for j:=1 to n do
write(' ', GM[i, j]);
writeln;
end;
write('Порядок обхода: ');
BFS(visited, start);
readln
end.
Добавлено через 24 минуты
Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
program DepthFirstSearch;
 
const
n=5;
var
i, j, start,finish: integer;
hn:boolean;
visited: array[1..n] of boolean;
const graph: array[1..n,1..n] of byte =
((0, 1, 30,50, 10),
(0, 0, 0, 0, 0),
(0, 0, 0, 0, 10),
(0, 0, 20, 0, 0),
(10, 0, 10, 30, 0));
{поиск в глубину}
procedure DFS(st: integer);
var r: integer;
begin
if st=finish then  hn:=true;
write(st:3);
visited[st]:=true;
for r:=1 to n do
if (graph[st, r]<>0) and (not visited[r]) then DFS(r);
end;
{основной блок программы}
begin
                 hn:=false;
writeln('Матрица смежности:');
for i:=1 to n do
begin
visited[i]:=false;
for j:=1 to n do
write(graph[i, j],' ');
writeln;
end;
writeln('Стартовая вершина >> '); readln(start);
writeln('Финишная вершина >>');readln (finish);
writeln('Результат обхода'); DFS(start);
writeln;
if hn=true then writeln('Дорога есть') else
 writeln('Дороги нет!');
readln
end.
Цитата Сообщение от ФедосеевПавел Посмотреть сообщение
Это перебор всех вариантов с выбором наилучшего
Как можно модифицировать данную программу ,чтоб перебирались и запоминались все варианты?
Здесь очередная точка помечается как посещенная .Если две дороги ведут к одной точке , то при прохождении по 1 дороге эта конечная точка помечается как посещенная и 2 дорога уже не рассматривается
0
Модератор
Эксперт по электронике
7527 / 3715 / 1457
Регистрация: 01.02.2015
Сообщений: 11,557
Записей в блоге: 2
24.12.2015, 20:56 12
Цитата Сообщение от msk19 Посмотреть сообщение
а как можно переделать данную программу ?Она выдает просто все смежные точки с начальной , и останавливается когда доходит до заданной точки и не учитывает что ребра имеют вес, а как потом восстановить кратчайший путь?
Ой, прошу прощения. Я выпал из контекста, и забыл изначальное условие задачи.

Для задачи вида:
Взвешенный граф задан матрицей смежности и матрицей весов связей (часто матрица весов является попутно и матрицей смежности). Для этого графа найти путь наименьшего веса, соединяющий вершины А и В.
Имеется алгоритм Дейкстры. Результатом алгоритма являются:
1) массив длин путей из вершины А ко всем другим вершинам;
2) массив, хранящий путь от всех вершин к вершине А (так для вершины С в массиве P[C] хранится номер вершины, с которой был произведен переход на вершину С при движении от А к С).
Выше я уже приводил реализацию как алгоритма Дейкстры, так и восстановления пути от вершины А в произвольную вершину В. Во всех учебниках отмечается, что наилучшее время поиска будет при использовании приоритетной кучи, а не минимальной из вершин (как реализовано у меня). По поводу эффективного поиска кратчайшего пути от одной вершины ко всем другим мне больше нечего сказать.

Если стоит задача перебора всех возможных путей и выбора наилучшего по какому-либо критерию, то вопрос об эффективности снимается с повестки (все перестановки это n! и здесь ничего не изменить и не уменьшить). Для решения подойдёт, среди прочих, и DFS. Нужно только перед выходом из рекурсивной процедуры "восстановить невинность" текущей вершины.
Как я это реализовывал Упорядочить строки матрицы в порядке возрастания диагональных элементов. Сделал массив путей RowOrder - локальный для Sort, но глобальный для всех Trying (=DFS). Текущая длина пути i (количество вершин) передаётся параметром в Trying, в которой на основе RowOrder (аналог visited) выбирается следующая незанятая вершина, и если выполняется некоторое условие, то поиск завершается. После выхода из Trying, восстанавливалось предыдущее значение i для "родительской" Trying. Там была задача найти любое подходящее решение. Но если это дополнить ещё условием, то текущее наилучшее решение можно сохранять в дополнительном массиве (TheBestPath).

Добавлено через 38 минут
Когда я был электронщиком, в ремонт ко мне поступали ТЭЗ - электронные платы с цифровыми микросхемами. Этих ТЭЗ поступало очень много, но номенклатура была ограничена. Поэтому мы всем отделом сделали автоматический стенд для ремонта, в который программа из компьютера выставляла на входах ТЭЗ тестовый набор 0 и 1, а потом считывала выходы из ТЭЗ, сравнивала с эталоном и отображала на экране. Так вот, для одного из ТЭЗ появилась нетривиальная задача. ТЭЗ имел 3 входа - сброс сдвигового регистра, один бит данных, строб записи этого бита и сдвигющий остальные биты регистра. Зато выходов было много, но они комбинировались на основе разрядов этого регистра. Перебрать все состояния регистра можно было просто записывая по одному биту (16*4=64 карты - долго и муторно) или найдя такую входную комбинацию 0 и 1, чтобы на регистре перебрались все числа от 0 до 16. Ещё не зная теорию графов я решил перебором с возвратом
Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
{
Программа предназначена для решения задачи, возникшей при составлении
карт проверки для тестирования ТЭЗа, содержащего сдвиговый регистр.
"Сердцем" схемы ТЭЗа является четырёхразрядный сдвиговый регистр.
Он может принимать 16 значений, и имеет схему сброса всех разрядов в 0.
Последовательно подавая на вход данных 0 или 1, а потом синхроимпульс
можно изменять состояние регистра. Естественно, что в отличие от
непосредственной записи в регистр хранения, в сдвиговом регистре
невозможно изменять состояния последовательно от 0 до 15.
Задача состоит в нахождении кратчайшего пути, перебирающего все
состояния регистра. Это очень похоже на нахождение максимального
цикла в графе, но в данном случае совсем не обязательно, чтобы
из шага пути 15 был возможен переход на шаг пути 0.
}
PROGRAM ShiftReg2;
 
CONST
  InitialState  = 0;             {начальное состояние регистра сдвига}
  N             = 4;             {количество разрядов в регистре сдвига}
  Mask          = (1 SHL N) - 1; {битовая маска состояний регистра сдвига}
  NN            = (1 SHL N);     {количество комбинаций в регистре}
  NNN           = NN-1;          {номер последнего индекса матрицы переходов}
TYPE
  TMatrixM      = array [0..NNN, 0..NNN] of Byte;
  TMatrixT      = array [0..NNN, 0..1  ] of Byte;
  TArray        = array [0..NNN]         of Byte;
 
{---------------------------------------------------------------------------}
{Заполнение матрицы переходов T и матрицы смежности M}
PROCEDURE CreateMatrix( VAR M : TMatrixM;
                        VAR T : TMatrixT
                      );
VAR
  i, j  : Integer;
  Next  : Byte;
BEGIN
  for i:=0 to NNN do begin
    for j:=0 to NNN do M[i, j]:=0;
    Next:=(i SHL 1) AND Mask;
    M[i, Next]:=1;
    T[i, 0]:= Next;
    Next:=Next OR 1;
    M[i, Next]:=1;
    T[i, 1]:= Next;
  end;
END;
{---------------------------------------------------------------------------}
{Вывод на экран матрицы смежности M}
PROCEDURE ShowMatrixM ( VAR M : TMatrixM
                      );
VAR
  i, j  : Integer;
BEGIN
  for i:=0 to NNN do begin
    for j:=0 to NNN do begin
      Write(M[i, j]:2);
    end;
    WriteLn;
  end;
END;
{Вывод на экран матрицы матрицы переходов T}
PROCEDURE ShowMatrixT ( VAR T : TMatrixT
                      );
VAR
  i, j  : Integer;
BEGIN
  for i:=0 to NNN do begin
    for j:=0 to 1 do begin
      Write(T[i, j]:3);
    end;
    WriteLn;
  end;
END;
{Вывод на экран найденного пути}
PROCEDURE ShowPath( Path : TArray);
VAR
  i     : Integer;
BEGIN
  Write('Path : ');
  for i:=0 to NNN do begin
    Write(Path[i]:2);
    if i<>NNN then Write('->');
  end;
  WriteLn;
END;
{---------------------------------------------------------------------------}
{Процедура поиска пути}
FUNCTION  LookingFor (VAR T : TMatrixT) : BOOLEAN;
VAR
  Path    : TArray;   {найденный путь}
  PathLen : Integer;  {длина пути}
  i       : Integer;
{Функция IsInPath возвращает TRUE если значение Number присутствует
 в пути Path}
FUNCTION  IsInPath ( Number : Byte) : BOOLEAN;
VAR
  i     : Integer;
  Res   : BOOLEAN;
BEGIN
  Res:=FALSE;
  for i:=0 to PathLen-1 do
    if Number=Path[i] then Res:=TRUE;
  IsInPath:=Res;
END;
 
FUNCTION  Poisk( Current : Byte) : BOOLEAN;
VAR
  Res   : BOOLEAN;
  x     : Integer;
  Next    : Byte;
BEGIN
  {Добавление значения Current в путь}
  Path[PathLen]:=Current;
  Inc(PathLen);
  {Если длина пути максимальна - вывести путь, иначе продолжить поиск}
  if PathLen=NN
  then
    ShowPath(Path)
  else begin
    for x:=0 to 1 do begin
      Next:=T[Current, x];
      if NOT IsInPath(Next)
        then Poisk(Next);
    end;
  end;
  {Извлечь значение Current из пути Path}
  Dec(PathLen);
  Path[PathLen]:=0;
END;
 
BEGIN
  {Очистка переменной Path}
  for i:=0 to NNN do Path[i]:=0;
  PathLen:=0;
  {Поиск с начального состояния}
  Poisk(InitialState);
END;
 
VAR
  M     : TMatrixM;
  T     : TMatrixT;
BEGIN
  {Заполнение матриц смежности M и переходов T}
  CreateMatrix(M, T);
  {Вывод матриц на экран}
  ShowMatrixM(M);
  ShowMatrixT(T);
  {Поиск пути и вывод на экран}
  LookingFor(T);
END.
В процедуре Poisk (=DFS) перебираются все пути. Сам путь хранится в Path длиной PathLen. Если бы добавлялся какой-либо критерий, то я бы сохранял лучший вариант в отдельном массиве.

Добавлено через 29 минут
Если можете - подождите до воскресенья, освобожусь и попробую с DFS. Просто у меня нет заготовок - никогда не изучал теорию графов, только решая на форумах.
Но лучше попытайтесь самостоятельно - ведь как понимаю, это подобие самоподготовки, а не задание на оценку.
0
38 / 1 / 3
Регистрация: 16.11.2015
Сообщений: 103
24.12.2015, 21:43  [ТС] 13
Цитата Сообщение от ФедосеевПавел Посмотреть сообщение
это подобие самоподготовки
типо того)
0
Модератор
Эксперт по электронике
7527 / 3715 / 1457
Регистрация: 01.02.2015
Сообщений: 11,557
Записей в блоге: 2
27.12.2015, 20:29 14
Лучший ответ Сообщение было отмечено msk19 как решение

Решение

С DFS
Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
program DFS_for_paths;
 
const
  Nmax = 6;
type
  TVertex = integer;
  TWeight = integer;
  TWeightMatrix = array [0..Nmax - 1, 0..Nmax - 1] of TWeight;
  TVertexList = array [0..Nmax {- 1}] of TVertex;
  TUsed = array [0..Nmax - 1] of boolean;
const
  INFINITY = MaxInt; {отсутствие пути}
 
  procedure ShowPath(const Path: TVertexList; PathLength: integer);
  var
    i: integer;
  begin
    Write('<');
    for i := 0 to PathLength do
      Write(Path[i]: 3);
    writeln('>');
  end;
 
{перебор всех путей от A к B по матрице весов W.
Результаты:
Максимально длинный (тяжёлый) путь
LongestPath - список вершин в длиннейшем пути
NLongestPath - количество вершин на этом пути
LongestWeight - длинна (вес) максимального пути
Наикратчайший путь
ShortestPath - список вершин в кратчайшем пути
NShortestPath - количество вершин на этом пути
ShortestWeight - длинна (вес) кратчайшего пути
}
  procedure PathFinder(const W: TWeightMatrix; A, B: TVertex;
  var LongestPath: TVertexList; var NLongestPath: integer;
  var LongestWeight: TWeight; var ShortestPath: TVertexList;
  var NShortestPath: integer; var ShortestWeight: TWeight);
 
  var
    CurrentPath: TVertexList;    {состав вершин в текущем пути от A к B}
    //CurrentLength: integer;      {количество вершин в текущем варианте пути}
    CurrentWeight: TWeight;      {вес текущего варианта пути}
    Used: TUsed;
 
    procedure DFS(CurrentLength: integer);
    var
      v: integer;
      PrevVertex: TVertex;
    begin
      PrevVertex := CurrentPath[CurrentLength - 1 + low(CurrentPath)];
      for v := low(TVertexList) to high(TVertexList) do
      begin
        if (not Used[v]) and (W[PrevVertex, v] <> INFINITY) then
        begin
          {если вершина подходящая (не использовалась ранее и в неё есть дорога)}
          {то помечаем её как использованную, 
           помещаем в список, 
           вычисляем текущий вес пути}
          Used[v] := True;
          CurrentPath[CurrentLength] := v;
          CurrentWeight := CurrentWeight + W[PrevVertex, v];
          {если пришли к финальной вершине}
          if v = B then
          begin
            {показываем путь}
            ShowPath(CurrentPath, CurrentLength);
            {если этот путь длиннее (тяжелее) предыдущей оценки, то запоминаем новую оценку}
            if (NLongestPath = 0) or (LongestWeight < CurrentWeight) then
            begin
              LongestPath  := CurrentPath;
              NLongestPath := CurrentLength;
              LongestWeight := CurrentWeight;
            end;
            {если этот путь короче (легче) предыдущей оценки, то запоминаем новую оценку}
            if (NShortestPath = 0) or (ShortestWeight > CurrentWeight) then
            begin
              ShortestPath  := CurrentPath;
              NShortestPath := CurrentLength;
              ShortestWeight := CurrentWeight;
            end;
          end
          else
            {если это не финальная вершина, то пробуем найти дальнейший путь}
            DFS(CurrentLength + 1);
          Used[v] := False;
          CurrentWeight := CurrentWeight - W[PrevVertex, v];
        end;
      end;
    end;
 
  var
    v: TVertex;
  begin
    {длины экстремальных маршрутов нулевые}
    NLongestPath  := 0;
    NShortestPath := 0;
    {инициализация}
    for v := low(TUsed) to high(TUsed) do
      Used[v] := False;
    CurrentWeight := 0;
    //CurrentLength := 1;
    CurrentPath[0] := A;
    Used[A] := True;
    DFS(1);
  end;
 
const
  W: TWeightMatrix = (
    (INFINITY, 07, 09, INFINITY, INFINITY, 14),
    (07, INFINITY, 10, 15, INFINITY, INFINITY),
    (09, 10, INFINITY, 11, INFINITY, 02),
    (INFINITY, 15, 11, INFINITY, 06, INFINITY),
    (INFINITY, INFINITY, INFINITY, 06, INFINITY, 09),
    (14, INFINITY, 02, INFINITY, 09, INFINITY)
    );
var
  A, B: TVertex;
  LongestPath: TVertexList;
  NLongestPath: integer;
  LongestWeight: TWeight;
  ShortestPath: TVertexList;
  NShortestPath: integer;
  ShortestWeight: TWeight;
begin
  A := 0;
  B := 5;
  PathFinder(W, A, B, LongestPath, NLongestPath, LongestWeight, ShortestPath,
    NShortestPath, ShortestWeight);
  writeln('Longest path (', LongestWeight, ') is: ');
  ShowPath(LongestPath, NLongestPath);
  writeln('Shortest path (', ShortestWeight, ') is: ');
  ShowPath(ShortestPath, NShortestPath);
end.
1
38 / 1 / 3
Регистрация: 16.11.2015
Сообщений: 103
27.12.2015, 21:40  [ТС] 15
ФедосеевПавел, спасибо большое ,буду разбираться
0
IT_Exp
Эксперт
87844 / 49110 / 22898
Регистрация: 17.06.2006
Сообщений: 92,604
27.12.2015, 21:40

Заказываю контрольные, курсовые, дипломные работы и диссертации здесь.

Определить, можно ли попасть по дорогам из 1-го пункта в n-ный.
Помогите составить программы. 3.1. Описать рекурсивную функцию pow(x,n) от вещественного...

Используя рекурсию, определить, можно ли по дорогам попасть из 1-го пункта в N-ый
Имеется 10 населенных пунктов. Дана последовательность пар чисел пар чисел I и J (I&lt;J),...

Определить, можно ли попасть по этим дорогам из l-того пункта в m-ый
1. Имеется n населенных пунктов, пронумерованных от 1 до n (n=10). Некоторые пары пунктов...

Определить, можно ли попасть по этим дорогам из первого пункта в n-й
Всем привет, помогите пожалуйста с программой. Или хотя бы подскажите, что с чем нужно сравнивать....


Искать еще темы с ответами

Или воспользуйтесь поиском по форуму:
15
Ответ Создать тему
Опции темы

КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin® Version 3.8.9
Copyright ©2000 - 2021, vBulletin Solutions, Inc.