Поиск в пространстве состояний (поиск по графам тоже сюда!)

@Грымзик · Регистрация: 14.09.2009

Студворк — интернет-сервис помощи студентам

Поскольку данные темы очень часто появляются на форуме, то тут будут подробно рассмотрены стандартные виды поиска. Многое взято из книги Сошникова "Парадигма логического программирования", куда очень советую заглянуть. Буду выкладывать коды на SWI прологе и Visual Prolog 5.2/Turbo Prolog.

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

Поиск в пространстве состояний (поиск по графам тоже сюда!)

И мы хотим найти все пути от вершины а до вершины с.
Для начала надо задать правило одного шага move

Prolog
1
2
3
4
5
6
7
8
m(a,b).
m(b,c).
m(a,d).
m(b,d).
m(c,d).
m(c,e).
m(d,e).
move(A,B):-m(A,B);m(B,A). %поскольку граф неориентированный

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

Prolog
1
2
prolong([Temp|Tail],[New,Temp|Tail]):-
    move(Temp,New),not(member(New,[Temp|Tail])).

Теперь сам предикат поиска в глубину

Prolog
1
2
3
4
5
6
dpth([Finish|Tail],Finish,[Finish|Tail]). %если текущая вершина
%совпадает с конечной, то путь найден
dpth(TempWay,Finish,Way):-
    prolong(TempWay,NewWay), %пробуем сделать шаг 
    dpth(NewWay,Finish,Way).%продолжаем поиск уже 
    %с учетом сделанного шага

Вспомогательный предикат для удобства пользователя

Prolog
1
2
3
4
search_dpth(Start,Finish):-
    dpth([Start],Finish,Way),%вызываем поиск в глубину,
    %считая, что пока путь состоит только из начальной вершины
    show_answer(Way).%выводим путь на экран в наглядном виде

Для вывода пути на экран используется специальный предикат, в котором учитывается, что путь храниться в обратном порядке

Prolog
1
2
3
show_answer([_]):-!.
show_answer([A,B|Tail]):-
    show_answer([B|Tail]),nl,write(B),write(' -> '),write(A).

И теперь результатом работы
?- search_dpth(a,c).

a -> b
b -> c
true

Нахождение всех путей

?- search_dpth(a,c),nl,nl,nl,fail.

a -> b
b -> c

a -> b
b -> d
d -> e
e -> c

a -> b
b -> d
d -> c

a -> d
d -> e
e -> c

a -> d
d -> b
b -> c

a -> d
d -> c

false.

Чтобы изменить под другую задачу, то в большинстве случаев достаточно будет просто поменять предикат move. Например у нас есть шарики:

Каждый из них может перемещаться только в соседнее пустой поле, или перепрыгивать в пустое поле через один шарик противоположного цвета. Надо поменять шарики местами.

Prolog
1
2
3
4
5
6
7
8
move(A,B):-
    append(Begin,[b,'_'|End],A),append(Begin,['_',b|End],B).
move(A,B):-
    append(Begin,['_',w|End],A),append(Begin,[w,'_'|End],B).
move(A,B):-
    append(Begin,[b,w,'_'|End],A),append(Begin,['_',w,b|End],B).
move(A,B):-
    append(Begin,['_',b,w|End],A),append(Begin,[w,b,'_'|End],B).

Результат работы программы

?- search_dpth([b,b,b,'_',w,w,w],[w,w,w,'_',b,b,b]).

[b, b, b, _, w, w, w] -> [b, b, _, b, w, w, w]
[b, b, _, b, w, w, w] -> [b, b, w, b, _, w, w]
[b, b, w, b, _, w, w] -> [b, b, w, b, w, _, w]
[b, b, w, b, w, _, w] -> [b, b, w, _, w, b, w]
[b, b, w, _, w, b, w] -> [b, _, w, b, w, b, w]
[b, _, w, b, w, b, w] -> [_, b, w, b, w, b, w]
[_, b, w, b, w, b, w] -> [w, b, _, b, w, b, w]
[w, b, _, b, w, b, w] -> [w, b, w, b, _, b, w]
[w, b, w, b, _, b, w] -> [w, b, w, b, w, b, _]
[w, b, w, b, w, b, _] -> [w, b, w, b, w, _, b]
[w, b, w, b, w, _, b] -> [w, b, w, _, w, b, b]
[w, b, w, _, w, b, b] -> [w, _, w, b, w, b, b]
[w, _, w, b, w, b, b] -> [w, w, _, b, w, b, b]
[w, w, _, b, w, b, b] -> [w, w, w, b, _, b, b]
[w, w, w, b, _, b, b] -> [w, w, w, _, b, b, b]
true

Код целиком для SWI Prolog

Prolog
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
%m(a,b).
%m(b,c).
%m(a,d).
%m(b,d).
%m(c,d).
%m(c,e).
%m(d,e).
 
%move(A,B):-m(A,B);m(B,A). %поскольку граф неориентирован
 
move(A,B):-
    append(Begin,[b,'_'|End],A),append(Begin,['_',b|End],B).
move(A,B):-
    append(Begin,['_',w|End],A),append(Begin,[w,'_'|End],B).
move(A,B):-
    append(Begin,[b,w,'_'|End],A),append(Begin,['_',w,b|End],B).
move(A,B):-
    append(Begin,['_',b,w|End],A),append(Begin,[w,b,'_'|End],B).
 
search_dpth(Start,Finish):-dpth([Start],Finish,Way),show_answer(Way).
 
prolong([Temp|Tail],[New,Temp|Tail]):-
    move(Temp,New),not(member(New,[Temp|Tail])).
 
dpth([Finish|Tail],Finish,[Finish|Tail]).
dpth(TempWay,Finish,Way):-
    prolong(TempWay,NewWay),dpth(NewWay,Finish,Way).
 
show_answer([_]):-!.
show_answer([A,B|Tail]):-
    show_answer([B|Tail]),nl,write(B),write(' -> '),write(A).

Код целиком для Визуал Пролог 5.2/Турбо Пролог для графа

Prolog
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
domains
slist=string*
 
predicates
m(string,string).
move(string,string).
search_dpth(string,string).
prolong(slist,slist).
dpth(slist,string,slist).
show_answer(slist).
member(string,slist).
 
clauses
m(a,b).
m(b,c).
m(a,d).
m(b,d).
m(c,d).
m(c,e).
m(d,e).
 
move(A,B):-m(A,B);m(B,A).
 
search_dpth(Start,Finish):-dpth([Start],Finish,Way),show_answer(Way).
 
member(H,[H|_]).
member(H,[_|Tail]):-member(H,Tail).
 
prolong([Temp|Tail],[New,Temp|Tail]):-
    move(Temp,New),not(member(New,[Temp|Tail])).
 
dpth([Finish|Tail],Finish,[Finish|Tail]).
dpth(TempWay,Finish,Way):-
    prolong(TempWay,NewWay),dpth(NewWay,Finish,Way).
 
show_answer([_]):-!.
show_answer([A,B|Tail]):-
    show_answer([B|Tail]),nl,write(B," -> ",A).
goal
search_dpth(a,c),nl,nl,nl,fail.

Код целиком для Визуал Пролог 5.2/Турбо Пролог для шариков

Prolog
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
domains
slist=string*
slistlist=slist*
 
predicates
move(slist,slist).
search_dpth(slist,slist).
prolong(slistlist,slistlist).
dpth(slistlist,slist,slistlist).
show_answer(slistlist).
member(slist,slistlist).
append(slist,slist,slist).
 
clauses
move(A,B):-
    append(Begin,[b,"_"|End],A),append(Begin,["_",b|End],B).
move(A,B):-
    append(Begin,["_",w|End],A),append(Begin,[w,"_"|End],B).
move(A,B):-
    append(Begin,[b,w,"_"|End],A),append(Begin,["_",w,b|End],B).
move(A,B):-
    append(Begin,["_",b,w|End],A),append(Begin,[w,b,"_"|End],B).
 
search_dpth(Start,Finish):-dpth([Start],Finish,Way),show_answer(Way).
 
member(H,[H|_]).
member(H,[_|Tail]):-member(H,Tail).
 
append([],B,B).
append([H|Tail],B,[H|NewTail]):-append(Tail,B,NewTail).
 
prolong([Temp|Tail],[New,Temp|Tail]):-
    move(Temp,New),not(member(New,[Temp|Tail])).
 
dpth([Finish|Tail],Finish,[Finish|Tail]).
dpth(TempWay,Finish,Way):-
    prolong(TempWay,NewWay),dpth(NewWay,Finish,Way).
 
show_answer([_]):-!.
show_answer([A,B|Tail]):-
    show_answer([B|Tail]),nl,write(B," -> ",A).
goal
search_dpth([b,b,b,"_",w,w,w],[w,w,w,"_",b,b,b]).

@Грымзик · 02.03.2011, 22:02 **[ТС]**

Поиск в ширину
Данный поиск также применяется только для не взвешенных графов, но может находить самый короткий (или при желании самый длинный) путь.
Теперь у нас будет храниться не один пройденный путь, а список всех возможных путей, которые мы могли пройти. Они будет располагаться от более коротких к более длинным. Каждый из них, так же как и в поиске в ширину будет записан в обратном порядке

Prolog
1
2
3
4
5
6
7
8
9
%если в текущем пути первая вершина совпадает с конечной,
%то данный путь является ответом.
bdth([[Finish|Tail]|_],Finish,[Finish|Tail]).
bdth([TempWay|OtherWays],Finish,Way):-
    findall(W,prolong(TempWay,W),Ways),%так же можем найти все способы,
    %которыми можно сделать шаг из текущего состояния первого пути
    append(OtherWays,Ways,NewWays),%добавляем все эти способы
    %в конец нашего списка путей
    bdth(NewWays,Finish,Way).%и продолжаем поиск

Поскольку все пути в нашем списке располагаются от более коротких к более длинным (хотя это громко сказано, их длина не отличается больше, чем на один шаг, поскольку после просмотра путь сразу отбрасывается), то когда первый раз выполниться правило bdth([[Finish|Tail]|_],Finish,[Finish|Tail]) найденный путь гарантированно будет самым коротким.
Также немного надо изменить вспомогательный предикат

Prolog
1
2
3
4
search_bdth(Start,Finish):-
    bdth([[Start]],Finish,Way),%изначально у нас список путей
    %состоит из одного пути, который состоит из начальной вершины
    show_answer(Way).

Все пути в графе в порядке возрастания длины

?- search_bdth(a,c),nl,nl,nl,fail.

a -> d
d -> c

a -> b
b -> c

a -> d
d -> e
e -> c

a -> d
d -> b
b -> c

a -> b
b -> d
d -> c

a -> b
b -> d
d -> e
e -> c

false.

Если хотим наоборот, самый длинный путь, то надо поменять местами правила bdth.

Все пути в графе в порядке уменьшения длины

?- search_bdth(a,c),nl,nl,nl,fail.

a -> b
b -> d
d -> e
e -> c

a -> b
b -> d
d -> c

a -> d
d -> b
b -> c

a -> d
d -> e
e -> c

a -> b
b -> c

a -> d
d -> c

false.

Опять же для большинства задач надо будет только переопределить предикат move, например для задачи о ханойских башнях он будет иметь вид

Prolog
1
2
3
4
5
6
7
8
9
menshe(_,[]).
menshe(A,[B|_]):-A<B.
 
move([[H|Tail],B,C],[Tail,[H|B],C]):-menshe(H,B).
move([[H|Tail],B,C],[Tail,B,[H|C]]):-menshe(H,C).
move([A,[H|Tail],C],[[H|A],Tail,C]):-menshe(H,A).
move([A,[H|Tail],C],[A,Tail,[H|C]]):-menshe(H,C).
move([A,B,[H|Tail]],[[H|A],B,Tail]):-menshe(H,A).
move([A,B,[H|Tail]],[A,[H|B],Tail]):-menshe(H,B).

Результат работы программы

?- search_bdth([[1,2,3],[],[]],[[],[],[1,2,3]]).

[[1, 2, 3], [], []] -> [[2, 3], [], [1]]
[[2, 3], [], [1]] -> [[3], [2], [1]]
[[3], [2], [1]] -> [[3], [1, 2], []]
[[3], [1, 2], []] -> [[], [1, 2], [3]]
[[], [1, 2], [3]] -> [[1], [2], [3]]
[[1], [2], [3]] -> [[1], [], [2, 3]]
[[1], [], [2, 3]] -> [[], [], [1, 2, 3]]
true

Код целиком для SWI Prolog

Prolog
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
%menshe(_,[]).
%menshe(A,[B|_]):-A<B.
 
%move([[H|Tail],B,C],[Tail,[H|B],C]):-menshe(H,B).
%move([[H|Tail],B,C],[Tail,B,[H|C]]):-menshe(H,C).
%move([A,[H|Tail],C],[[H|A],Tail,C]):-menshe(H,A).
%move([A,[H|Tail],C],[A,Tail,[H|C]]):-menshe(H,C).
%move([A,B,[H|Tail]],[[H|A],B,Tail]):-menshe(H,A).
%move([A,B,[H|Tail]],[A,[H|B],Tail]):-menshe(H,B).
 
m(a,d).
m(c,d).
m(c,e).
m(d,e).
m(a,b).
m(b,c).
m(b,d).
move(A,B):-m(A,B);m(B,A).
 
search_bdth(Start,Finish):-bdth([[Start]],Finish,Way),show_answer(Way).
 
prolong([Temp|Tail],[New,Temp|Tail]):-
    move(Temp,New),not(member(New,[Temp|Tail])).
 
 
bdth([[Finish|Tail]|_],Finish,[Finish|Tail]).
bdth([TempWay|OtherWays],Finish,Way):-
    findall(W,prolong(TempWay,W),Ways),
    append(OtherWays,Ways,NewWays),
    bdth(NewWays,Finish,Way).
 
show_answer([_]):-!.
show_answer([A,B|Tail]):-
    show_answer([B|Tail]),nl,write(B),write(' -> '),write(A).

Код целиком для Визуал Пролог 5.2/Турбо Пролог для графа

Prolog
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
domains
slist=string*
slistlist=slist*
 
predicates
m(string,string).
move(string,string).
search_bdth(string,string).
prolong(slist,slist).
bdth(slistlist,string,slist).
show_answer(slist).
member(string,slist).
append(slistlist,slistlist,slistlist).
 
clauses
m(a,d).
m(c,d).
m(c,e).
m(d,e).
m(a,b).
m(b,c).
m(b,d).
move(A,B):-m(A,B);m(B,A).
 
search_bdth(Start,Finish):-bdth([[Start]],Finish,Way),show_answer(Way).
 
member(H,[H|_]).
member(H,[_|Tail]):-member(H,Tail).
 
prolong([Temp|Tail],[New,Temp|Tail]):-
    move(Temp,New),not(member(New,[Temp|Tail])).
 
append([],B,B).
append([H|Tail],B,[H|NewTail]):-append(Tail,B,NewTail).
 
bdth([[Finish|Tail]|_],Finish,[Finish|Tail]).
bdth([TempWay|OtherWays],Finish,Way):-
    findall(W,prolong(TempWay,W),Ways),
    append(OtherWays,Ways,NewWays),
    bdth(NewWays,Finish,Way).
 
show_answer([_]):-!.
show_answer([A,B|Tail]):-
    show_answer([B|Tail]),nl,write(B),write(" -> "),write(A).
 
goal
search_bdth(a,c),nl,nl,nl,fail.

Код целиком для Визуал Пролог 5.2/Турбо Пролог про башни

Prolog
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
domains
ilist=integer*
sostoyanie=s(ilist,ilist,ilist)
sostoyaniya=sostoyanie*
searchlist=sostoyaniya*
 
predicates
menshe(integer,ilist).
move(sostoyanie,sostoyanie).
search_bdth(sostoyanie,sostoyanie).
prolong(sostoyaniya,sostoyaniya).
bdth(searchlist,sostoyanie,sostoyaniya).
show_answer(sostoyaniya).
member(sostoyanie,sostoyaniya).
append(searchlist,searchlist,searchlist).
 
clauses
menshe(_,[]).
menshe(A,[B|_]):-A<B.
 
move(s([H|Tail],B,C),s(Tail,[H|B],C)):-menshe(H,B).
move(s([H|Tail],B,C),s(Tail,B,[H|C])):-menshe(H,C).
move(s(A,[H|Tail],C),s([H|A],Tail,C)):-menshe(H,A).
move(s(A,[H|Tail],C),s(A,Tail,[H|C])):-menshe(H,C).
move(s(A,B,[H|Tail]),s([H|A],B,Tail)):-menshe(H,A).
move(s(A,B,[H|Tail]),s(A,[H|B],Tail)):-menshe(H,B).
 
search_bdth(Start,Finish):-bdth([[Start]],Finish,Way),show_answer(Way).
 
member(H,[H|_]).
member(H,[_|Tail]):-member(H,Tail).
 
prolong([Temp|Tail],[New,Temp|Tail]):-
    move(Temp,New),not(member(New,[Temp|Tail])).
 
append([],B,B).
append([H|Tail],B,[H|NewTail]):-append(Tail,B,NewTail).
 
bdth([[Finish|Tail]|_],Finish,[Finish|Tail]).
bdth([TempWay|OtherWays],Finish,Way):-
    findall(W,prolong(TempWay,W),Ways),
    append(OtherWays,Ways,NewWays),
    bdth(NewWays,Finish,Way).
 
show_answer([_]):-!.
show_answer([A,B|Tail]):-
    show_answer([B|Tail]),nl,write(B),write(" -> "),write(A).
 
goal
search_bdth(s([1,2,3],[],[]),s([],[],[1,2,3])).

@Грымзик · 03.03.2011, 00:25 **[ТС]**

Поиск с итерационным заглублением
Также создан для не взвешенных графов. Главным недостатком поиска в ширину является большой объем используемой памяти, а поиск с итерационным заглублением наоборот использует ее экономно. Смысл данного поиска заключается в том, что мы перебираем максимальную глубину поиска начиная от 1 и до какого-то ограничивающего числа, и для каждой такой максимальной глубины запускаем поиск в глубину с соответствующим ограничением. Таким образом сначала ищутся все пути длины 1, потом все пути длины 2, все пути длины 3 и тд. Как только обнаружиться решений, то данный найденный путь и будет кратчайший.
Для начала определим предикат, генерирующий максимальную глубину поиска, т.е целые числа от 1 и дальше.

Prolog
1
2
int(1).
int(N):-int(M),N is M+1.

После этого немного изменим предикат dpth из поиска в глубину, уже с учетом, что глубина поиска будет ограничена.

Prolog
1
2
3
4
id([Finish|Tail],Finish,[Finish|Tail],0).
id(TempWay,Finish,Way,N):-N>0,
    prolong(TempWay,NewWay),N1 is N-1,
    id(NewWay,Finish,Way,N1).

И наконец главный предикат, который перебирает ограничения глубины и вызывает предикат id.

Prolog
1
2
3
4
5
6
7
search_id(Start,Finish):-
    int(Level),%выбираем очередное значение ограничения глубины
    (Level>100,!;%обязательно надо поставить ограничение на нее
    %поскольку если пути вообще не существует, то без этой проверки
    %программа просто зациклиться
    id([Start],Finish,Way,Level),%если глубина допустима, то вызываем поиск
    show_answer(Way)).

Также можно использовать для поиска всех путей в порядке возврастания.
В качестве примера могу привести результат, что для ханойских башен с 5 дисками данный алгоритм работает (хотя подождать придется), а поиск в ширину уже вылетает с переполнением стека памяти. Продолжительное время работы вызвано тем, что на каждом шаге (т.е при каждом новом ограничением глубины погружения) все предыдущие результаты забываются.
Рассмотрим задачу переправы через реку отца и двух сыновей. Предикат одного шага будет выглядеть так:

Prolog
1
2
3
4
5
6
7
opp(left,right).
opp(right,left).
 
move([otec(A),sin1(X),sin2(Y),plot(A)],[otec(B),sin1(X),sin2(Y),plot(B)]):-opp(A,B).
move([otec(X),sin1(A),sin2(Y),plot(A)],[otec(X),sin1(B),sin2(Y),plot(B)]):-opp(A,B).
move([otec(X),sin1(Y),sin2(A),plot(A)],[otec(X),sin1(Y),sin2(B),plot(B)]):-opp(A,B).
move([otec(X),sin1(A),sin2(A),plot(A)],[otec(X),sin1(B),sin2(B),plot(B)]):-opp(A,B).

Результат работы программы

?- search_id([otec(left),sin1(left),sin2(left),plot(le ft)],[otec(right),sin1(right),sin2(right),plot (right)]),nl,nl,nl,fail.

[otec(left), sin1(left), sin2(left), plot(left)] -> [otec(left), sin1(right), sin2(right), plot(right)]
[otec(left), sin1(right), sin2(right), plot(right)] -> [otec(left), sin1(left), sin2(right), plot(left)]
[otec(left), sin1(left), sin2(right), plot(left)] -> [otec(right), sin1(left), sin2(right), plot(right)]
[otec(right), sin1(left), sin2(right), plot(right)] -> [otec(right), sin1(left), sin2(left), plot(left)]
[otec(right), sin1(left), sin2(left), plot(left)] -> [otec(right), sin1(right), sin2(right), plot(right)]

[otec(left), sin1(left), sin2(left), plot(left)] -> [otec(left), sin1(right), sin2(right), plot(right)]
[otec(left), sin1(right), sin2(right), plot(right)] -> [otec(left), sin1(right), sin2(left), plot(left)]
[otec(left), sin1(right), sin2(left), plot(left)] -> [otec(right), sin1(right), sin2(left), plot(right)]
[otec(right), sin1(right), sin2(left), plot(right)] -> [otec(right), sin1(left), sin2(left), plot(left)]
[otec(right), sin1(left), sin2(left), plot(left)] -> [otec(right), sin1(right), sin2(right), plot(right)]

Код целиком для SWI Prolog

Prolog
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
opp(left,right).
opp(right,left).
 
move([otec(A),sin1(X),sin2(Y),plot(A)],[otec(B),sin1(X),sin2(Y),plot(B)]):-opp(A,B).
move([otec(X),sin1(A),sin2(Y),plot(A)],[otec(X),sin1(B),sin2(Y),plot(B)]):-opp(A,B).
move([otec(X),sin1(Y),sin2(A),plot(A)],[otec(X),sin1(Y),sin2(B),plot(B)]):-opp(A,B).
move([otec(X),sin1(A),sin2(A),plot(A)],[otec(X),sin1(B),sin2(B),plot(B)]):-opp(A,B).
 
prolong([Temp|Tail],[New,Temp|Tail]):-
        move(Temp,New),not(member(New,[Temp|Tail])).
 
int(1).
int(N):-int(M),N is M+1.
 
search_id(Start,Finish):-
    int(Level),(Level>100,!;id([Start],Finish,Way,Level),show_answer(Way)).
 
id([Finish|Tail],Finish,[Finish|Tail],0).
id(TempWay,Finish,Way,N):-N>0,
    prolong(TempWay,NewWay),N1 is N-1,
    id(NewWay,Finish,Way,N1).
 
show_answer([_]):-!.
show_answer([A,B|Tail]):-
        show_answer([B|Tail]),nl,write(B),write(' -> '),write(A).

Код целиком для Визуал Пролог 5.2/Турбо Пролог

Prolog
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
domains
polozenie=otec(string);sin1(string);sin2(string);plot(string)
polozeniya=polozenie*
peremesheniya=polozeniya*
 
predicates
opp(string,string).
move(polozeniya,polozeniya).
prolong(peremesheniya,peremesheniya).
search_id(polozeniya,polozeniya).
id(peremesheniya,polozeniya,peremesheniya,integer).
show_answer(peremesheniya).
member(polozeniya,peremesheniya).
for(integer,integer,integer).
 
clauses
opp(left,right).
opp(right,left).
 
move([otec(A),sin1(X),sin2(Y),plot(A)],[otec(B),sin1(X),sin2(Y),plot(B)]):-opp(A,B).
move([otec(X),sin1(A),sin2(Y),plot(A)],[otec(X),sin1(B),sin2(Y),plot(B)]):-opp(A,B).
move([otec(X),sin1(Y),sin2(A),plot(A)],[otec(X),sin1(Y),sin2(B),plot(B)]):-opp(A,B).
move([otec(X),sin1(A),sin2(A),plot(A)],[otec(X),sin1(B),sin2(B),plot(B)]):-opp(A,B).
 
member(H,[H|_]).
member(H,[_|Tail]):-member(H,Tail).
 
prolong([Temp|Tail],[New,Temp|Tail]):-
        move(Temp,New),not(member(New,[Temp|Tail])).
 
for(A,A,_).
for(I,A,B):-A<B,A1=A+1,for(I,A1,B).
 
search_id(Start,Finish):-
    for(Level,1,100),id([Start],Finish,Way,Level),show_answer(Way).
 
id([Finish|Tail],Finish,[Finish|Tail],0).
id(TempWay,Finish,Way,N):-N>0,
    prolong(TempWay,NewWay),N1 = N-1,
    id(NewWay,Finish,Way,N1).
 
show_answer([_]):-!.
show_answer([A,B|Tail]):-
        show_answer([B|Tail]),nl,write(B),write(" -> "),write(A).
 
goal
search_id([otec(left),sin1(left),sin2(left),plot(left)],[otec(right),sin1(right),sin2(right),plot(right)]),nl,nl,nl,fail.

@Грымзик · 07.03.2011, 00:46 **[ТС]**

Поиск на основе весовой функции
Теперь рассмотрим поиски для нагруженных графов. Расставим веса для рассмотренного нами графа.

Теперь на прологе он будет выглядеть так

Prolog
1
2
3
4
5
6
7
8
m(a,b,10).
m(b,c,7).
m(a,d,3).
m(b,d,5).
m(c,d,15).
m(c,e,7).
m(d,e,5).
move(A,B,C):-m(A,B,C);m(B,A,C).

И теперь мы будем хранить не только пройденный путь, но и его длину в виде
Длина:[ТекущаяВершина, ПредыдущаяВершина.....НачальнаяВершина].
На Visual Prolog так нельзя, поэтому в виде
w(Длина, [ТекущаяВершина, ПредыдущаяВершина.....НачальнаяВершина]), но это я только в конечном коде выложу.

Теперь у нас все рассмотренные пути будут отсортированы в списке не по количество узлов, а по их длине, для этого введем дополнительные предикаты.
Предикат, добавляющий новый путь в список уже сгенерированных путей на нужное место.

Prolog
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
%Предикат placeone принимает в качестве параметра новый путь,
%а также сгенерированные до этого пути, которые уже отсортированы
%относительно их длины, и возвращает новый список путей,
%полученный после добавления первого параметра в список путей
%на нужное место, т.е сохраняя отсортированность
 
%если длина нового пути не превосходит длину пути, находящегося
%на первом месте, то этот новый путь помещаем на первое место
placeone(Length:Way,[LengthH:WayH|Tail],[Length:Way,LengthH:WayH|Tail]):-Length=<LengthH,!.
%из-за отсечения сюда попадаем только если 1 правило не выполнилось,
%значит первый путь в списке короче добавляемого, поэтому
%рекурсивно добавляем его в хвост
placeone(LengthWay,[LengthHWayH|Tail],[LengthHWayH|NewTail]):-placeone(LengthWay,Tail,NewTail).
%отдельно надо рассмотреть случай, когда список путей пуст
placeone(LengthWay,[],[LengthWay]).

Предикат, расставляющий пути из списка по нужным местам.

Prolog
1
2
3
4
5
6
7
8
9
10
%Предикат place принимает в качестве параметров только что сгенерированные пути
%(которые расположены в случайном относительно их длины порядке),
%до этого сгенерированные пути (которые наоборот уже отсортированы),
%и расставляет пути из первого списка во второй список
%на нужные места, чтобы отсортированность сохранялась.
 
place([],SortedWays,SortedWays).%если список пуст, то текущий список и будет ответом
place([Way|Tail],PrevWays,SortedWays):-
    placeone(Way,PrevWays,PrevWays1),%иначе вставляем на нужное место первый путь
    place(Tail,PrevWays1,SortedWays).%и продолжаем расставлять остальные

Далее надо изменить сам предикат поиска, добавив в него вышеописанный предикат расстановки.

Prolog
1
2
3
4
5
6
bst([Length:[Finish|Tail]|_],Finish,Length:[Finish|Tail]).
bst([TempWay|OtherWays],Finish,Way):-
    findall(W,prolong(TempWay,W),Ways),
    place(Ways,OtherWays,NewWays),%вот отличие от поиска в ширину
    %Новые пути не добавляются в конец, а расставляются по нужным местам
    bst(NewWays,Finish,Way).

И не забываем изменить вспомогательный предикат поиска, в котором будем считать, что начальная длина пути равна 0

Prolog
1
2
3
search_bst(Start,Finish):-
    bst([0:[Start]],Finish,Length:Way),
    show_answer(Way),nl,write('Length of way: '),write(Length).

Результат работы программы:
?- search_bst(a,c).

a -> d
d -> e
e -> c
Length of way: 15
true

Все пути в порядке возрастания длины

?- search_bst(a,c),nl,nl,nl,fail.

a -> d
d -> e
e -> c
Length of way: 15

a -> d
d -> b
b -> c
Length of way: 15

a -> b
b -> c
Length of way: 17

a -> d
d -> c
Length of way: 18

a -> b
b -> d
d -> e
e -> c
Length of way: 27

a -> b
b -> d
d -> c
Length of way: 30

false.

Код целиком для SWI Prolog

Prolog
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
m(a,b,10).
m(b,c,7).
m(a,d,3).
m(b,d,5).
m(c,d,15).
m(c,e,7).
m(d,e,5).
move(A,B,C):-m(A,B,C);m(B,A,C).
 
prolong(Length:[Temp|Tail],NewLength:[New,Temp|Tail]):-
    move(Temp,New,C),not(member(New,[Temp|Tail])),NewLength is Length+C.
 
place([],SortedWays,SortedWays).
place([Way|Tail],PrevWays,SortedWays):-
    placeone(Way,PrevWays,PrevWays1),
    place(Tail,PrevWays1,SortedWays).
 
placeone(Length:Way,[LengthH:WayH|Tail],[Length:Way,LengthH:WayH|Tail]):-Length=<LengthH,!.
placeone(LengthWay,[LengthHWayH|Tail],[LengthHWayH|NewTail]):-placeone(LengthWay,Tail,NewTail).
placeone(LengthWay,[],[LengthWay]).
 
search_bst(Start,Finish):-
    bst([0:[Start]],Finish,Length:Way),
    show_answer(Way),nl,write('Length of way: '),write(Length).
 
bst([Length:[Finish|Tail]|_],Finish,Length:[Finish|Tail]).
bst([TempWay|OtherWays],Finish,Way):-
    findall(W,prolong(TempWay,W),Ways),
    place(Ways,OtherWays,NewWays),bst(NewWays,Finish,Way).
 
show_answer([_]):-!.
show_answer([A,B|Tail]):-
    show_answer([B|Tail]),nl,write(B),write(' -> '),write(A).

Код целиком для Визуал Пролог 5.2/Турбо Пролог

Prolog
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
domains
slist=string*
way=w(integer,slist)
ways=way*
 
predicates
m(string,string,integer).
move(string,string,integer).
prolong(way,way).
place(ways,ways,ways).
placeone(way,ways,ways).
search_bst(string,string).
bst(ways,string,way).
show_answer(slist).
member(string,slist).
 
clauses
m(a,b,10).
m(b,c,7).
m(a,d,3).
m(b,d,5).
m(c,d,15).
m(c,e,7).
m(d,e,5).
move(A,B,C):-m(A,B,C);m(B,A,C).
 
member(H,[H|_]).
member(H,[_|Tail]):-member(H,Tail).
 
prolong(w(Length,[Temp|Tail]),w(NewLength,[New,Temp|Tail])):-
    move(Temp,New,C),not(member(New,[Temp|Tail])),NewLength=Length+C.
 
place([],SortedWays,SortedWays).
place([Way|Tail],PrevWays,SortedWays):-
    placeone(Way,PrevWays,PrevWays1),
    place(Tail,PrevWays1,SortedWays).
 
placeone(w(Length,Way),[w(LengthH,WayH)|Tail],[w(Length,Way),w(LengthH,WayH)|Tail]):-Length<=LengthH,!.
placeone(LengthWay,[LengthHWayH|Tail],[LengthHWayH|NewTail]):-placeone(LengthWay,Tail,NewTail).
placeone(LengthWay,[],[LengthWay]).
 
search_bst(Start,Finish):-
    bst([w(0,[Start])],Finish,w(Length,Way)),
    show_answer(Way),nl,write("Length of way: "),write(Length).
 
bst([w(Length,[Finish|Tail])|_],Finish,w(Length,[Finish|Tail])).
bst([TempWay|OtherWays],Finish,Way):-
    findall(W,prolong(TempWay,W),Ways),
    place(Ways,OtherWays,NewWays),bst(NewWays,Finish,Way).
 
show_answer([_]):-!.
show_answer([A,B|Tail]):-
    show_answer([B|Tail]),nl,write(B),write(" -> "),write(A).
 
goal
search_bst(a,c),nl,nl,nl,fail.

@Грымзик · 07.03.2011, 23:29 **[ТС]**

Жадный алгоритм поиска

При поиске пути можно как-то учитывать насколько близко от финишного состояния(в смысле какого-то критерия) находиться текущее состояние. Этот критерий называется эвристической функцией или просто эвристикой. Он ставит в соответствие двум состоянием определенное число, которое характеризует "расстояние" между ними. Например для известной задачи о передвижении мебели эвристикой может быть количество предметов, которые на данном этапе стоят не на желаемых местах, а для точек на плоскости просто геометрическое расстояние между ними.
В данном алгоритме поиска приоритет пути определяется не его суммарной длиной (она вообще не подсчитывается), а близостью конечной вершиной пути и заданной финишной вершиной.
Допустим у нас есть набор точек на плоскости, некоторые из которых соединены между собой

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

Prolog
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
point(a,2,5).
point(b,4,5).
point(c,0,0).
point(d,4,10).
point(e,7,8).
point(f,12,7).
point(g,14,4).
 
r(a,c).
r(c,b).
r(b,g).
r(g,f).
r(g,d).
r(f,d).
r(e,d).
r(a,e).
 
road(A,B):-r(A,B);r(B,A).

Путь у нас опять же будет представлен списком вершин, немного изменить функция одного шага

Prolog
1
prolong([Temp|Tail],[New,Temp|Tail]):-road(Temp,New),not(member(New,[Temp|Tail])).

И введем эвристическую функцию, в которой нам важны текущая и конечная вершины пути

Prolog
1
2
wt([TempPoint|_],FinishPoint,L):-point(TempPoint,XA,YA),point(FinishPoint,XB,YB),
    Sum is (XA-XB)*(XA-XB)+(YA-YB)*(YA-YB), L is sqrt(Sum).

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

Prolog
1
2
3
4
%теперь сравниваются эвристики конечных вершин пути
placeone(Way,[WayH|Tail],Finish,[Way,WayH|Tail]):-wt(Way,Finish,A),wt(WayH,Finish,B),A=<B,!.
placeone(Way,[WayH|Tail],Finish,[WayH|NewTail]):-placeone(Way,Tail,Finish,NewTail).
placeone(Way,[],_,[Way]).

В остальном поиск не отличается от поиска на основе весовой функции.
Результат работы программы:
?- search_grd(g,a).

g -> b
b -> c
c -> a
true .

Но этот результат не правилен, правильным ответом является
?- search_bst(g,a).

g -> d
d -> e
e -> a
Length of way: 21.0984
true

Т.е как мы видим, данный алгоритм не гарантирует правильности результатов. Программа получила такой ответ потому что из путей в одну дорогу наиболее приоритетным является путь g-b, т.к b ближе к финишной вершине, чем f или d. Путь g-b можно продлить только единственным способом g-b-c, и вершина c опять же оказывается не менее приоритетной, чем f или d, после чего мы просто завершаем путь. И вот получилось, что b близка к финишной, c не далеко от финишной, а то, что они друг от друга далеки, совсем не учитывалось, что и привело к ошибке.
Но на практике такой алгоритм часто можно использовать, ведь, например, если бы выполнялся поиск пути между двумя реальными городами, то результат был бы скорее всего верным, из-за равномерного распределения городков/поселков/деревень и соответствующих дорог между ними.

Сравнение порядка путей, полученных разными алгоритмами

Результат жадного алгоритма
?- search_grd(g,a),nl,nl,nl,fail.

g -> b
b -> c
c -> a

g -> d
d -> e
e -> a

g -> f
f -> d
d -> e
e -> a

Результат поиска на основе весовой функции
?- search_bst(g,a),nl,nl,nl,fail.

g -> d
d -> e
e -> a
Length of way: 21.0984

g -> f
f -> d
d -> e
e -> a
Length of way: 21.5861

g -> b
b -> c
c -> a
Length of way: 21.8382

Код целиком для SWI Prolog

Prolog
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
point(a,2,5).
point(b,4,5).
point(c,0,0).
point(d,4,10).
point(e,7,8).
point(f,12,7).
point(g,14,4).
 
r(a,c).
r(c,b).
r(b,g).
r(g,f).
r(g,d).
r(f,d).
r(e,d).
r(a,e).
 
road(A,B):-r(A,B);r(B,A).
 
prolong([Temp|Tail],[New,Temp|Tail]):-road(Temp,New),not(member(New,[Temp|Tail])).
 
wt([TempPoint|_],FinishPoint,L):-point(TempPoint,XA,YA),point(FinishPoint,XB,YB),
    Sum is (XA-XB)*(XA-XB)+(YA-YB)*(YA-YB), L is sqrt(Sum).
 
place([],SortedWays,_,SortedWays).
place([Way|Tail],PrevWays,Finish,SortedWays):-
    placeone(Way,PrevWays,Finish,PrevWays1),place(Tail,PrevWays1,Finish,SortedWays).
 
placeone(Way,[WayH|Tail],Finish,[Way,WayH|Tail]):-wt(Way,Finish,A),wt(WayH,Finish,B),A=<B,!.
placeone(Way,[WayH|Tail],Finish,[WayH|NewTail]):-placeone(Way,Tail,Finish,NewTail).
placeone(Way,[],_,[Way]).
 
search_grd(Start,Finish):-
    grd([[Start]],Finish,Way),show_answer(Way).
 
grd([[Finish|Tail]|_],Finish,[Finish|Tail]).
grd([TempWay|OtherWays],Finish,Way):-
    findall(W,prolong(TempWay,W),Ways),
    place(Ways,OtherWays,Finish,NewWays),grd(NewWays,Finish,Way).
 
show_answer([_]):-!.
show_answer([A,B|Tail]):-
    show_answer([B|Tail]),nl,write(B),write(' -> '),write(A).

Код целиком для Визуал Пролог 5.2/Турбо Пролог

Prolog
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
domains
way=string*
ways=way*
 
predicates
point(string,real,real).
r(string,string).
road(string,string).
prolong(way,way).
wt(way,string,real).
place(ways,ways,string,ways).
placeone(way,ways,string,ways).
search_grd(string,string).
grd(ways,string,way).
show_answer(way).
member(string,way).
 
clauses
point(a,2,5).
point(b,4,5).
point(c,0,0).
point(d,4,10).
point(e,7,8).
point(f,12,7).
point(g,14,4).
 
r(a,c).
r(c,b).
r(b,g).
r(g,f).
r(g,d).
r(f,d).
r(e,d).
r(a,e).
 
road(A,B):-r(A,B);r(B,A).
 
prolong([Temp|Tail],[New,Temp|Tail]):-road(Temp,New),not(member(New,[Temp|Tail])).
 
member(H,[H|_]).
member(H,[_|Tail]):-member(H,Tail).
 
wt([TempPoint|_],FinishPoint,L):-point(TempPoint,XA,YA),point(FinishPoint,XB,YB),
    Sum = (XA-XB)*(XA-XB)+(YA-YB)*(YA-YB), L = sqrt(Sum).
 
place([],SortedWays,_,SortedWays).
place([Way|Tail],PrevWays,Finish,SortedWays):-
    placeone(Way,PrevWays,Finish,PrevWays1),place(Tail,PrevWays1,Finish,SortedWays).
 
placeone(Way,[WayH|Tail],Finish,[Way,WayH|Tail]):-wt(Way,Finish,A),wt(WayH,Finish,B),A<=B,!.
placeone(Way,[WayH|Tail],Finish,[WayH|NewTail]):-placeone(Way,Tail,Finish,NewTail).
placeone(Way,[],_,[Way]).
 
search_grd(Start,Finish):-
    grd([[Start]],Finish,Way),show_answer(Way).
 
grd([[Finish|Tail]|_],Finish,[Finish|Tail]).
grd([TempWay|OtherWays],Finish,Way):-
    findall(W,prolong(TempWay,W),Ways),
    place(Ways,OtherWays,Finish,NewWays),grd(NewWays,Finish,Way).
 
show_answer([_]):-!.
show_answer([A,B|Tail]):-
    show_answer([B|Tail]),nl,write(B),write(" -> "),write(A).
 
goal
search_grd(g,a),nl,nl,nl,fail.

Новые блоги и статьи Все статьи Все блоги /
Access VikBal 11.12.2025 Помогите пожалуйста !! Как объединить 2 одинаковые БД Access с разными данными.	Новый ноутбук volvo 07.12.2025 Всем привет. По скидке в "черную пятницу" взял себе новый ноутбук Lenovo ThinkBook 16 G7 на Амазоне: Ryzen 5 7533HS 64 Gb DDR5 1Tb NVMe 16" Full HD Display Win11 Pro	Музыка, написанная Искусственным Интеллектом volvo 04.12.2025 Всем привет. Некоторое время назад меня заинтересовало, что уже умеет ИИ в плане написания музыки для песен, и, собственно, исполнения этих самых песен. Стихов у нас много, уже вышли 4 книги, еще 3. . .	От async/await к виртуальным потокам в Python IndentationError 23.11.2025 Армин Ронахер поставил под сомнение async/ await. Создатель Flask заявляет: цветные функции - провал, виртуальные потоки - решение. Не threading-динозавры, а новое поколение лёгких потоков. Откат?. . .	Поиск "дружественных имён" СОМ портов Argus19 22.11.2025 Поиск "дружественных имён" СОМ портов На странице: https:/ / norseev. ru/ 2018/ 01/ 04/ comportlist_windows/ нашёл схожую тему. Там приведён код на С++, который показывает только имена СОМ портов, типа,. . .
Сколько Государство потратило денег на меня, обеспечивая инсулином. Programma_Boinc 20.11.2025 Сколько Государство потратило денег на меня, обеспечивая инсулином. Вот решила сделать интересный приблизительный подсчет, сколько государство потратило на меня денег на покупку инсулинов. . . .	Ломающие изменения в C#.NStar Alpha Etyuhibosecyu 20.11.2025 Уже можно не только тестировать, но и пользоваться C#. NStar - писать оконные приложения, содержащие надписи, кнопки, текстовые поля и даже изображения, например, моя игра "Три в ряд" написана на этом. . .	Мысли в слух kumehtar 18.11.2025 Кстати, совсем недавно имел разговор на тему медитаций с людьми. И обнаружил, что они вообще не понимают что такое медитация и зачем она нужна. Самые базовые вещи. Для них это - когда просто люди. . .	Создание Single Page Application на фреймах krapotkin 16.11.2025 Статья исключительно для начинающих. Подходы оригинальностью не блещут. В век Веб все очень привыкли к дизайну Single-Page-Application . Быстренько разберем подход "на фреймах". Мы делаем одну. . .	Фото: Daniel Greenwood kumehtar 13.11.2025