Форум программистов, компьютерный форум, киберфорум
Наши страницы
Prolog
Войти
Регистрация
Восстановить пароль
 
Рейтинг 4.98/112: Рейтинг темы: голосов - 112, средняя оценка - 4.98
Грымзик
2482 / 1458 / 35
Регистрация: 14.09.2009
Сообщений: 2,742
1

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

01.03.2011, 19:19. Просмотров 20997. Ответов 4
Метки нет (Все метки)

Поскольку данные темы очень часто появляются на форуме, то тут будут подробно рассмотрены стандартные виды поиска. Многое взято из книги Сошникова "Парадигма логического программирования", куда очень советую заглянуть. Буду выкладывать коды на 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]).
13
Similar
Эксперт
41792 / 34177 / 6122
Регистрация: 12.04.2006
Сообщений: 57,940
01.03.2011, 19:19
Ответы с готовыми решениями:

Составление кубиков, поиск в пространстве состояний, монотонный поиск в ширину [Turbo Prolog]
Помогите решить задачу с кубиками в турбо прологе с несложной визуализацией. ...

Поиск в пространстве состояний
Поиск пространств и состояний (в глубину, в ширину,евристический поиск) Поиск...

Задача на поиск плана в пространстве состояний
Есть поле из 10 ячеек и 9 фишек. Надо из начального состояния перевести фишки...

Поиск в пространстве состояния
Железнодорожный сортировочный узел устроен так, как показано на рисунке. На...

Планирование состояний в пространстве. Задача о кувшинах
Есть два кувшины: один емкостью 5 литров, другой - 3. Источник воды ограничено....

4
Грымзик
2482 / 1458 / 35
Регистрация: 14.09.2009
Сообщений: 2,742
02.03.2011, 22:02  [ТС] 2
Поиск в ширину
Данный поиск также применяется только для не взвешенных графов, но может находить самый короткий (или при желании самый длинный) путь.
Теперь у нас будет храниться не один пройденный путь, а список всех возможных путей, которые мы могли пройти. Они будет располагаться от более коротких к более длинным. Каждый из них, так же как и в поиске в ширину будет записан в обратном порядке
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])).
8
Грымзик
2482 / 1458 / 35
Регистрация: 14.09.2009
Сообщений: 2,742
03.03.2011, 00:25  [ТС] 3
Поиск с итерационным заглублением
Также создан для не взвешенных графов. Главным недостатком поиска в ширину является большой объем используемой памяти, а поиск с итерационным заглублением наоборот использует ее экономно. Смысл данного поиска заключается в том, что мы перебираем максимальную глубину поиска начиная от 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(left)],[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.
7
Грымзик
2482 / 1458 / 35
Регистрация: 14.09.2009
Сообщений: 2,742
07.03.2011, 00:46  [ТС] 4
Поиск на основе весовой функции
Теперь рассмотрим поиски для нагруженных графов. Расставим веса для рассмотренного нами графа.
Поиск в пространстве состояний (поиск по графам тоже сюда!)

Теперь на прологе он будет выглядеть так
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.
6
Грымзик
2482 / 1458 / 35
Регистрация: 14.09.2009
Сообщений: 2,742
07.03.2011, 23:29  [ТС] 5
Жадный алгоритм поиска

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

Эвристикой будем выступать геометрическое расстояние между ними.
Данную структуру можно задать как набор точек с их координатами, и набор связывающих их линий
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.
12
07.03.2011, 23:29
MoreAnswers
Эксперт
37091 / 29110 / 5898
Регистрация: 17.06.2006
Сообщений: 43,301
07.03.2011, 23:29

Поиск в лабиринте (эвристический поиск)
Помогите плиз!!Срочно надо) лабиринт представляет собой систему...

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

Задача на переливание (поиск в пространстве состояний)
Уважаемые Форумчане! Пишу, вероятно, не в тот раздел, но раздела CLIPS здесь...


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

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

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