Un petit programme en prolog qui résoud le solitaire à alvéoles

Sous le prolog ciao-prolog  : la source du programme sol6

% Solution of 45-peg solitaire
%                      76 77 78
%                      67 68 69
%                      58 59 60
% 46 47 48 49 50 51 52 53 54
% 37 38 39 40 41 42 43 44 45
% 28 29 30 31 32 33 34 35 36
%                      22 23 24
%                      13 14 15
%                         4 5 6

:- use_module(library(lists)).
:- use_module(library(numlists)).
:- use_module(library(aggregates)).
:- use_module(library(sort)).
:- use_module(library(random)).

initial_state(sol,sol([4,5,6,13,14,15,22,23,24,
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,
58,59,60,67,68,69,76,77],[78])).
final_state(sol([_,_,_,_,_,_,_,_,_,_,_,_,_],[_,_,_,_,_,_,_,_,_,
_,_,_,_,_,_,_,_,_,
_,_,_,_,_,_,_,_,_,
_,_,_,_,_])).
deplacement(3,X,Y,Z):-
Z=\=46,
Z=\=47,
Z=\=37,
Z=\=38,
Y is Z – 1,
X is Z – 2.
deplacement(1,X,Y,Z):-
Y is Z – 9,
X is Z – 18.
deplacement(2,X,Y,Z):-
Y is Z + 9,
X is Z + 18.
deplacement(4,X,Y,Z):-
Z=\=45,
Z=\=44,
Z=\=36,
Z=\=35,
Y is Z + 1,
X is Z + 2.

move(sol(V,W),deplacement(_,X,Y,Z)):-
member(Z,W),
deplacement(_,X,Y,Z),
member(X,V),
member(Y,V).

update(sol(V,W),deplacement(_,X,Y,Z),sol(V1,W1)):-
delete(V,X,V2),
delete(V2,Y,V3),
V4 = [Z|V3],
sort(V4,V1),
delete(W,Z,W2),
W3=[X,Y|W2],
sort(W3,W1).
value(4,1).
value(5,1).
value(32,1).
value(40,1).
value(58,1).
value(13,2).
value(14,2).
value(31,2).
value(34,2).
value(39,2).
value(50,3).
value(59,3).
value(78,3).
value(22,4).
value(42,4).
value(45,4).
value(47,4).
value(77,4).
value(29,5).
value(30,5).
value(35,5).
value(51,5).
value(54,5).
value(67,5).
value(6,6).
value(15,6).
value(24,6).
value(37,6).
value(49,7).
value(76,7).
value(33,8).
value(36,8).
value(44,8).
value(48,8).
value(23,9).
value(38,9).
value(43,9).
value(60,9).
value(69,9).
value(28,10).
value(41,10).
value(46,10).
value(52,10).
value(53,10).
value(68,10).

produce_value(X):-
random(1,4,Value),
assertz(value(X,Value)).
produce_all_values([]).
produce_all_values([X|Xs]):-
produce_value(X),
produce_all_values(Xs).

evaluate([],[]).
evaluate([Boule|Board],[V|Value]):-
value(Boule,V),
evaluate(Board,Value).
evaluate_board(sol(Board,_),Value):-
evaluate(Board,ListValue),
sum_list(ListValue,Value).
inserts([Value|Values],Frontier,Frontier1):-
insert(Value,Frontier,Frontier0),
inserts(Values,Frontier0,Frontier1).
inserts([],Frontier,Frontier).

insert(State,[],[State]).
insert(State,[State1|States],[State,State1|States]):-
lesseq_value(State,State1).
insert(State,[State1|States],[State|States]):-
equals(State,State1).
insert(State,[State1|States],[State1|States1]):-
greater_value(State,State1),
insert(State,States,States1).

equals(state(S,_,V),state(S,_,V)).
lesseq_value(state(S1,_,V1),state(S2,_,V2)):- nocontainsx([S2],S1),V2>=V1.
greater_value(state(_,_,V1),state(_,_,V2)):-V1>V2.

update_frontier([M|Ms],State,Path,History,F,F1):-
update(State,M,State1),
evaluate_board(State1,Value),
\+ member(State1,History),
insert(state(State1,[M|Path],Value),F,F0),
update_frontier(Ms,State,Path,History,F0,F1).
update_frontier([],_,_,_,F,F).

solve_best([state(State,Path,_)|_],_,Moves):-
final_state(State),
reverse(Path,[],Moves).
solve_best([state(State,Path,_)|Frontier],History,FinalPath):-
findall(M,move(State,M),Moves),
update_frontier(Moves,State,Path,History,Frontier,Frontier1),
solve_best(Frontier1,[State|History],FinalPath).

test_bfs(Problem,Moves):-
initial_state(Problem,State),
solve_best([state(State,[],[])],[State],Moves).

board(Xs,Ynew):-
board10([deplacement(_,X1,X2,X3)|Xs],Y),!,
delete(Y,X1,Y1),
delete(Y1,X2,Y2),
Y3 = [X3|Y2],
sort(Y3,Ynew).
board(Xs,Ynew):-
board([deplacement(_,X1,X2,X3)|Xs],Y),
delete(Y,X1,Y1),
delete(Y1,X2,Y2),
Y3 = [X3|Y2],
sort(Y3,Ynew).

jeu(Y,Z,[Move]):-
member(X3,Z),
deplacement(_,X1,X2,X3),
member(X1,Y),
member(X2,Y),
delete(Y,X1,Y1),
delete(Y1,X2,Y2),
Y3 = [X3|Y2],
length(Y3,1),
Move = deplacement(_,X1,X2,X3).

jeu(Y,Z,[Move|Moves]):-
member(X3,Z),
deplacement(_,X1,X2,X3),
member(X1,Y),
member(X2,Y),
delete(Y,X1,Y1),
delete(Y1,X2,Y2),
Y3 = [X3|Y2],
sort(Y3,Y4),
delete(Z,X3,Z1),
Z2 = [X1,X2|Z1],
sort(Z2,Z3),
Move = deplacement(_,X1,X2,X3),
jeu(Y4,Z3,Moves).

 

main(S):-
test_bfs(sol,X),
retractall(board10(_,_)),
assertz(board10(X,[4,5,6,13,14,15,22,23,24,
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,
58,59,60,67,68,69,76,77])),
board([],Y),
difference([4,5,6,13,14,15,22,23,24,
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,
58,59,60,67,68,69,76,77,78],Y,Z),
jeu(Y,Z,Moves),
append(X,Moves,S).