Игра "Восемь" (пятнашки) [Visual Prolog 5.2]

domains
 
kletka=c(integer,integer)
list=kletka*
list1=list*
list2=integer*
 
predicates
 
state(list)
mandist(kletka,kletka,integer)
poisk(list,list1)
diff(integer,integer,integer)
goal_state(list)
select(list1,list,integer,list)
generate(list,list1,list1)
member(list,list1)
member(integer,list2)
score(kletka,kletka,integer)
totdist(list,list,integer)
seq(list,integer)
seq(list,kletka,integer)
swap(list,list,kletka,kletka)
s(list,list)
h(list,integer)
invert(list1,list1)
invert(list1,list1,list1)
writeresult(list1)
write_pos(list)
num(kletka,list,integer)
run
 
clauses
goal_state([c(2,2),c(1,3),c(2,3),c(3,3),c(3,2),c(3,1),c(2,1),c (1,1),c(1,2)]).
state([c(3,3),c(1,3),c(2,2),c(2,3),c(3,2),c(3,1),c(2,1),c (1,1),c(1,2)]).
poisk(S,R):- goal_state(S),invert(R,R1),writeresult(R1),nl.
poisk (S, R) :-
generate (S,[],R1),
select(R1,S1,1000,S),
poisk( S1, [S1|R]).
generate (S,R,RR):-
s(S,S1),
not(member(S1,R)),
generate(S,[S1|R],RR).
generate(_,R,R).
 
mandist ( c(X1,Y1), c(X2,Y2), D):-
diff(X1,Y1,DX),diff(X2,Y2,DY),
D=DX+DY.
diff(X,Y,Z):-Z=X-Y,Z>0;
Z=Y-X.
 
select([],SS,_,SS):- !.
select([S1|T],SS,N,_S):-
h(S1,H),
H<N,
select(T,SS,H,S1).
select([_|T],SS,N,S):-
select(T,SS,N,S).
 
totdist([],[],0).
totdist([S1|T],[S|T1],SS):-
totdist(T,T1,T2),
mandist(S1,S,M),SS=M+T2.
 
score(c(2,2),_,1).
score(c(1,3),c(2,3),0).
score(c(2,3),c(3,3),0).
score(c(3,2),c(3,1),0).
score(c(2,1),c(1,1),0).
score(c(1,1),c(1,2),0).
score(c(1,2),c(1,3),0).
score(_,_,2).
 
h([_E|S1],H):-goal_state([_E1|S]),
totdist(S1,S,T),
seq(S1,SS),
H=T+SS*3.
 
seq([First|Tail],S):-
seq([First|Tail],First,S).
 
seq([X,Y|Tail],First,S):-
score(X,Y,K),
seq([Y|Tail],First,S1),
S=S1+K.
seq([Lost],First,S):-
score(Lost,First,S).
[COLOR="Red"]s([Empty|Tail1],[Node|Tail2]):-
swap(Tail1,Tail2,Empty,Node).
swap([Node|Tail],[Empty|Tail],Empty,Node):-
mandist(Node,Empty,1).
swap([H|Tail1],[H|Tail2],Empty,Node):-
swap(Tail1,Tail2,Empty,Node).[/COLOR]
 
member(Name,[Name|_]).
member(Name,[_|Tail]):-member(Name,Tail).
 
write_pos(S):-
member(Y,[3,2,1]),nl,
member(X,[1,2,3]),
num(c(X,Y),S,N),
write(N," "),
fail.
write_pos(_):-nl,nl.
 
num(S,[S|_],0): - !.
num(S,[_|R],N): -
num(S,R,N1),N=N1+1.
 
writeresult([]): - !.
 
writeresult([S|R]): -
write_pos(S),writeresult(R).
 
invert(X,Y):-invert(X,[],Y).
invert([],L,L): - !.
invert([H|T1],T2,T3): -
invert(T1,[H|T2],T3).
run :- state(S),
poisk(S,[S]).
 
goal
 
run.

write_pos(S):-
member(Y,[3,2,1]),nl,
member(X,[1,2,3]),
num(c(X,Y),S,N),
write(N," "),
fail.
write_pos(_):-nl,nl.

% S- это какой-то список, который проверяется в процедуре num
write_pos(S):-
% проверяем X,Y на принадлежность соответствующим спискам
member(Y,[3,2,1]),nl,
member(X,[1,2,3]),
% заносим в процедуру num какой-то параметр "c" с соответствующими X,Y
% Исходя из того, какое у нас "с" и входной список S, получаем какую-то чиселку N
num(c(X,Y),S,N), 
write(N," "), % пишем все его значения.
fail.
write_pos(_):-nl,nl. % При любом параметре печатаем две пустых строки.