Системы продукций. И-ИЛИ графы

Листинг основного модуля эвристического поиска

/* Основная программа. Файл euro.pro */

constants

fmax=100 % больше f-оценки любой вершины

domains

/************** Домены модуля euro8.pro **************/

int = integer

lint = int*

coord = c(int,int) % координаты фишки

p = poz(char,coord) % пара (фишка, координаты)

lpoz = p*

prob = coord* % координаты "дырки" и 8 фишек

lp = prob* % путь (список состояний)

/************ Домены модуля euro.pro **************/

est = e(int,int) % пара (f(u),g(u)), где f(u)=g(u)+h(u)

tr=l(prob,est); % лист

t(prob,est,tlist) % дерево с корнем

% и упорядоченным списком поддеревьев

tlist=tr* % список деревьев

son = s(prob,int) % пара (преемник,вес дуги)

lson = son* % список преемников

/*******************************************************/

predicates

/*Описание предикатов игры в "8" находится в euro8.dat */

/* Предикаты эвристического поиска */

solve(prob,lp) % решить

expo(lp,tr,int,tr,int,lp) % расширить дерево

optf(tlist,int) % оценка min дерева

f(tr,int) % f - оценка вершины

h(prob,int) % эвристика вершины

sons(int,lson,tlist) % сыновья вершины

prolong(lp,tr,int,tr,int,int,lp) % продолжить

continue(prob,lp,son) % поиск соседней вершины - сына

end(prob) % целевое состояние

go(prob,prob,int) % дуга со стоимостью хода

into(tr,tlist,tlist) % внести в упорядоченный список

member(prob,lp)

min(int,int,int)

/*******************************************************/

/***** Подключение модуля с правилами игры в "8" ******/

include "euro8.dat"

/*******************************************************/

goal

clearwindow,

start1(A),

solve(A,S),

show_sol(S),nl.

clauses

/************ ЭВРИСТИЧЕСКИЙ ПОИСК ******************/

solve(A,S):-

expo([],l(A,e(0,0)),fmax,_,1,S).

expo(Way,l(X,_),_,_,1,[X|Way]):-

end(X).

expo(Way,l(X,e(F,G)),Limit,D1,Yes,Sol):-

F<=Limit,

findall(Y,continue(X,Way,Y),Lsons),!,

sons(G,Lsons,DD),

optf(DD,F1),

expo(Way,t(X,e(F1,G),DD),Limit,D1,Yes,Sol).

expo(Way,l(X,e(F,G)),Limit,D1,Yes,Sol):-

F<=Limit,

Yes= -1. % нет преемников - тупик

expo(Way,t(X,e(F,G),[D|DD]),Limit,Dr1,Yes,Sol):-

F<=Limit,

optf(DD,OF),

min(Limit,OF,Limit1),

expo([X|Way],D,Limit1,D1,Yes1,Sol),

prolong(Way,t(X,e(F,G),[D1|DD]),Limit,Dr1,Yes1,Yes,Sol).

expo(_,t(_,_,[]),_,_,-1,_):-!. % тупиковое дерево

expo(_,D,Limit,D,0,_):-

f(D,F),

F>Limit. % рост остановлен

continue(X,Way,s(Y,C)):-

go(X,Y,C),

not(member(Y,Way)).

prolong(_,_,_,_,1,1,Sol).

prolong(Way,t(X,e(F,G),[D1|DD]),Limit,Dr1,Yes1,Yes,Sol):-

Yes1=0, into(D1,DD,DD1),

optf(DD1,F1),

expo(Way,t(X,e(F1,G),DD1),Limit,Dr1,Yes,Sol).

prolong(Way,t(X,e(F,G),[D1|DD]),Limit,Dr1,Yes1,Yes,Sol):-

Yes1= -1, DD1=DD,

optf(DD1,F1),

expo(Way,t(X,e(F1,G),DD1),Limit,Dr1,Yes,Sol).

sons(_,[],[]).

sons(G0,[ s(X,C)|TX ],DD):-

G=G0+C,

h(X,H),

F=G+H,

sons(G0,TX,DD1),

into(l(X,e(F,G)),DD1,DD).

% вставка дерева D в список DD

% с сохранением упорядоченности f-оценок

into(D,DD,[D|DD]):-

f(D,F), optf(DD,F1),

F<=F1,!.

into(D,[D1|DD],[D1|DD1]):-

into(D,DD,DD1).

f(l(_,e(F,_)),F).

f(t(_,e(F,_),_),F).

optf([D|_],F):-

f(D,F).

optf([],fmax).

min(X,Y,X):-

X<=Y,!.

min(X,Y,Y).

member(H,[H|_]):-!.

member(H,[_|T]):-

member(H,T).

Задание. Написать модуль euro8.pro, содержащий правила и эвристики для игры в «8» и подключить его к основному модулю эвристического поиска. Определить значение эвристической константы C, при которой эвристический поиск в заключительную конфигурацию за минимальное число шагов.

Дата добавления: 2015-06-27