first and last commit

This commit is contained in:
Raphaël LACROIX 2023-02-27 23:00:46 +01:00
commit 025860fc8f
5 changed files with 1242 additions and 0 deletions

172
TP1/aetoile.pl Normal file
View file

@ -0,0 +1,172 @@
%*******************************************************************************
% AETOILE
%*******************************************************************************
/*
Rappels sur l'algorithme
- structures de donnees principales = 2 ensembles : P (etat pendants) et Q (etats clos)
- P est dedouble en 2 arbres binaires de recherche equilibres (AVL) : Pf et Pu
Pf est l'ensemble des etats pendants (pending states), ordonnes selon
f croissante (h croissante en cas d'egalite de f). Il permet de trouver
rapidement le prochain etat a developper (celui qui a f(U) minimum).
Pu est le meme ensemble mais ordonne lexicographiquement (selon la donnee de
l'etat). Il permet de retrouver facilement n'importe quel etat pendant
On gere les 2 ensembles de fa<EFBFBD>on synchronisee : chaque fois qu'on modifie
(ajout ou retrait d'un etat dans Pf) on fait la meme chose dans Pu.
Q est l'ensemble des etats deja developpes. Comme Pu, il permet de retrouver
facilement un etat par la donnee de sa situation.
Q est modelise par un seul arbre binaire de recherche equilibre.
Predicat principal de l'algorithme :
aetoile(Pf,Pu,Q)
- reussit si Pf est vide ou bien contient un etat minimum terminal
- sinon on prend un etat minimum U, on genere chaque successeur S et les valeurs g(S) et h(S)
et pour chacun
si S appartient a Q, on l'oublie
si S appartient a Ps (etat deja rencontre), on compare
g(S)+h(S) avec la valeur deja calculee pour f(S)
si g(S)+h(S) < f(S) on reclasse S dans Pf avec les nouvelles valeurs
g et f
sinon on ne touche pas a Pf
si S est entierement nouveau on l'insere dans Pf et dans Ps
- appelle recursivement etoile avec les nouvelles valeurs NewPF, NewPs, NewQs
*/
%*******************************************************************************
:- ['avl.pl']. % predicats pour gerer des arbres bin. de recherche
:- ['taquin.pl']. % predicats definissant le systeme a etudier
%*******************************************************************************
main :-
writeln("Start"),
% on fixe la situation de départ S0
initial_state(S0),
% on calcule les différentes valeurs F0, H0, G0
heuristique2(S0, H0),
G0 is 0,
F0 is H0 + G0,
% on initialise Pf, Pu et Q
empty(Pf),
empty(Pu),
empty(Q),
% On insérer les noeuds F0, H0, G0, S0
insert([[F0,H0,G0], S0], Pf, Pf2),
insert([S0, [F0,H0,G0], nil, nil], Pu, Pu2),
% on lance Aetoile
writeln("Launching A*"),
aetoile(Pf2, Pu2, Q).
%*******************************************************************************
% =======
% Aetoile
% =======
% Cas Pf et Pu vides
aetoile(nil, nil, _) :- !, print("PAS DE SOLUTION : L'ETAT FINAL N'EST PAS ATTEIGNABLE !"), false.
% Cas F correspond à la situation terminale
aetoile(Pf, Pu, Q) :-
suppress_min([[F,H,G], U], Pf, _),
suppress([U, [F,H,G], Pere, Act], Pu, _),
final_state(U), !,
insert([U, Pere, Act],Q, Q_new),
writeln("Found a solution !"),
affiche_solution(Q_new).
% Cas général
aetoile(Pf, Pu, Q) :-
% supression des noeuds
suppress_min([[F,H,G], U], Pf, Pf_new),
suppress([U, [F,H,G], Pere, Act], Pu, Pu_new),
% developpement de U
expand(U,G,Pf_new,Pu_new,Q,Pf_new2, Pu_new2),
insert([U, Pere, Act],Q, Q_new),
aetoile(Pf_new2, Pu_new2, Q_new).
% Predicat pour trouver les actiosn menants a cet etat
get_pere(Fils, _Q, []) :-
initial_state(Fils).
get_pere(Fils, Q, L) :-
belongs([Fils,Pere,Act], Q),
append(L2, [Act], L),
get_pere(Pere, Q, L2).
% Affichage d'une liste d'action
display_actions([]).
display_actions([H|T]) :-
write(H),
write(" "),
display_actions(T).
% Affichage des solutions du taquin
affiche_solution(Q) :-
final_state(A),
get_pere(A, Q, List),
% affiche la suite d'action
display_actions(List).
% Recuperer les etats successures et calculer l'heuristique de chaque état
expand(U,G,Pf,Pu,Q,Pf_new, Pu_new) :-
findall(
[Act,U_futur,[F_futur,H_futur,G_futur]],
(rule(Act,1,U,U_futur),
heuristique2(U_futur, H_futur),
G_futur is G+1,
F_futur is H_futur + G_futur
),
L),
loop_sucessors(L,Q,Pu,Pf,U,Pu_new, Pf_new).
% Condition d'arrêt : plus de successeurs à explorer
loop_sucessors([],_,Pu,Pf,_,Pu,Pf).
% Verification de l'appartenance à Q du successeur
loop_sucessors([[_,U,[_,_,_]]|T],Q,Pu,Pf,Pere,Pu_result,Pf_result) :-
belongs([U,_,_], Q), !,
loop_sucessors(T,Q,Pu,Pf,Pere,Pu_result,Pf_result).
% Le successeur appartient a Pu
loop_sucessors([[Act,U,[F_proposal,H_proposal,G_proposal]]|T],Q,Pu,Pf,Pere,Pu_result,Pf_result) :-
belongs([U,_,_], Pu), !,
suppress([[F,H,G], U],Pf, Pf_new),
suppress([U,[F,H,G], _, _],Pu, Pu_new),
(H =< H_proposal ->
loop_sucessors(T,Q,Pu,Pf,Pere,Pu_result,Pf_result)
;
insert([[F_proposal,H_proposal,G_proposal], U],Pf_new, Pf_new_new),
insert([U, [F_proposal,H_proposal,G_proposal], Pere, Act],Pu_new, Pu_new_new),
loop_sucessors(T,Q,Pu_new_new,Pf_new_new,Pere,Pu_result,Pf_result)
).
% Le successur n'appartient ni a Q ni a Pu
loop_sucessors([[Act,U,[F,H,G]]|T],Q,Pu,Pf,Pere,Pu_result,Pf_result) :-
insert([[F,H,G], U],Pf, Pf_new),
insert([U, [F,H,G], Pere, Act],Pu, Pu_new),
loop_sucessors(T,Q,Pu_new,Pf_new,Pere,Pu_result,Pf_result).
% TESTS sur le temps en fonction des différentes heuristiques

367
TP1/avl.pl Normal file
View file

@ -0,0 +1,367 @@
%***************************
% Gestion d'un AVL en Prolog
%***************************
%***************************
% INSA TOULOUSE - P.ESQUIROL
% mars 2017
%***************************
%*************************
% unit tests : OK
% integration aetoile : OK
%*************************
% Les AVL sont des arbres BINAIRES DE RECHERCHE H-EQUILIBRES :
% La hauteur de l'avl A est d<EFBFBD>finie par :
% -1, si A est vide (A=nil)
% 1 + max( hauteur(ss_arbre_gauche(A)), hauteur(ss_arbre_droitee(A)) ) sinon
% Tout noeud de l'arbre est soit :
% - une feuille
% - un noeud interne tel que la diff<EFBFBD>rence de hauteur entre le sous-arbre droit
% et le sous-arbre gauche appartient <EFBFBD> [-1,0,+1]
%***********************************************
% PREDICATS EXPORTES ET COMPLEXITE ALGORITHMIQUE
%***********************************************
% soit N = nombre de noeuds de l'arbre % UTILITE POUR A*
% % ----------------
% empty(?Avl) O(1) %<<< initialisation de P et Q
% height(+Avl, ?Height) O(1)
% put_flat(+Avl) O(N)
% put_90(+Avl) O(N)
% belongs(+Elem, +Avl) O(log N) %<<< appartenance d'un noeud <EFBFBD> Q
% subtree(+Elem, +Avl, Ss_Avl) O(log N)
% insert(+Elem, +Avant, ?Apres) O(log N) %<<< insertion d'un nouveau noeud dans P ou dans Q
% suppress(+Elem,+Avant,?Apres) O(log N) %<<< mise <EFBFBD> jour <=> suppression puis insertion
% suppress_min(?Min,+Avant,?Apres) O(log N) %<<< supression du noeud minimal
% suppress_max(?Max,+Avant,?Apres) O(log N)
%****************************
% Pr<EFBFBD>dicats internes (prives)
%****************************
% left_rotate(+Avant, ?Apres) O(1)
% right_rotate(+Avant, ?Apres) O(1)
% left_balance(+Avant, ?Apres) O(1)
% right_balance(+Avant, ?Apres) O(1)
%------------------------------
% Constructeur et test AVL vide
%------------------------------
empty(nil).
%-----------------
% Hauteur d'un AVL
%-----------------
% par convention, un avl vide a une hauteur de -1
% sinon la hauteur est enregistree au meme niveau que la racine de l'avl
% elle n'est pas calculee recursivement "from scratch"
% elle est mise <EFBFBD> jour de fa<EFBFBD>on incr<EFBFBD>mentale, apres chaque insertion ou suppression
% d'ou sa complexit<EFBFBD> en O(1) :-)
height(nil, -1).
height(avl(_G,_R,_D, H), H).
%-------------------
% Affichage d'un AVL
%-------------------
% dans l'ordre croissant (lexicographique)
put_flat(nil):-!.
put_flat(avl(G,R,D,_H)) :-
put_flat(G),
nl, write(R),
put_flat(D).
%----------------------------
% Affichage (couch<EFBFBD>) d'un AVL
%----------------------------
put_90(Avl) :-
nl, writeln('----------------------------------'),
put_90(Avl,"").
put_90(nil,Str) :-
write(Str), write('.').
put_90(avl(G,R,D,_H),Str) :-
append_strings(Str, " ", Str2),
put_90(D,Str2),
nl, write(Str), write(R),nl,
put_90(G,Str2).
%-----------------------------------------
% Appartenance d'un element donne a un AVL
%-----------------------------------------
belongs(Elem, avl(G,Racine,D,_Hauteur)) :-
(Elem = Racine ->
true
;
(Elem @< Racine ->
belongs(Elem, G)
;
belongs(Elem, D) %Racine @< Elem
)
).
%------------------------------------------------------------
% Recherche du sous-arbre qui a comme racine un element donne
%------------------------------------------------------------
subtree(Elem, avl(G,Racine,D,H), A) :-
(Elem = Racine ->
A = avl(G,Racine,D,H)
;
(Elem @< Racine ->
subtree(Elem,G,A)
;
subtree(Elem,D,A) %Racine @< Elem
)
).
%----------------------
% Rotations dans un avl
%----------------------
% Les rotations ci-dessous d<EFBFBD>crivent uniquement les cas ou la rotation est possible.
% Dans les autres cas, ces relations <EFBFBD>chouent ; plus pr<EFBFBD>cis<EFBFBD>ment :
% a/ si l'arbre est un avl vide, alors aucune rotation n'est possible ;
% b/ si l'arbre est un avl non vide mais si son ss-arbre gauche est un avl vide
% alors la rotation droite n'est pas possible ;
% c/ si l'arbre est un avl non vide mais si son ss-arbre droite est un avl vide
% alors la rotation gauche n'est pas possible.
right_rotate(avl(G,R,D,_H), A_Apres) :-
height(D,HD),
G = avl(SG,RG,SD,_HG),
height(SD,HSD),
H_Inter is 1 + max(HSD, HD),
Inter = avl(SD,R,D,H_Inter),
height(SG,HSG),
H_Apres is 1 + max(HSG,H_Inter),
A_Apres = avl(SG,RG,Inter,H_Apres).
left_rotate(avl(G,R,D,_), A_Apres) :-
height(G,HG),
D = avl(SG,RD,SD,_),
height(SG,HSG),
H_Inter is 1 + max(HSG, HG),
Inter = avl(G,R,SG,H_Inter),
height(SD,HSD),
H_Apres is 1 + max(H_Inter,HSD),
A_Apres = avl(Inter,RD,SD,H_Apres).
%---------------------------------
% Insertion equilibree dans un avl
%---------------------------------
% On suppose que l'arbre avant insertion est equilibr<EFBFBD> (difference de hauteur
% entre les ss-arbres gauche et droite de 1 au maximum)
% L'insertion doit assurer qu'apres insertion l'arbre est toujours equilibre
% sinon les rotations necessaires sont effectuees.
% On suppose que les noeuds contiennent des informations que l'on peut comparer
% a l'aide d'une relation d'ordre lexicographique (la cle c'est l'info elle-meme)
% En prolog, c'est la relation '@<'
% On peut comparer par exemple des integer, des string, des constantes,
% des listes d'entiers, des listes de constantes, etc ... bref, des termes clos
% T1 @< T2 est vrai si T1 est lexicographiquement inf<EFBFBD>rieur a T2.
insert(Elem, nil, avl(nil,Elem,nil,0)).
insert(Elem, AVL, NEW_AVL) :-
AVL = avl(Gauche,Racine,Droite,_Hauteur),
(Elem = Racine ->
% l'<27>l<EFBFBD>ment est d<>j<EFBFBD> present, pas d'insertion possible
fail
;
(Elem @< Racine ->
% insertion dans le ss-arbre gauche
insert(Elem, Gauche, New_Gauche),
height(New_Gauche, New_HG),
height(Droite, HD),
H_Int is 1+max(New_HG, HD),
AVL_INT = avl(New_Gauche, Racine, Droite, H_Int),
right_balance(AVL_INT, NEW_AVL)
;
% Elem @> Racine
% insertion dans le ss-arbre droite
insert(Elem, Droite, New_Droite),
height(New_Droite, New_HD),
height(Gauche, HG),
H_Int is 1+max(New_HD, HG),
AVL_INT =avl(Gauche, Racine,New_Droite, H_Int),
left_balance(AVL_INT, NEW_AVL)
)
).
%------------------------------------------------
% Suppression d'un element quelconque dans un avl
%------------------------------------------------
% On suppose que l'<27>l<EFBFBD>ment <20> supprimer appartient bien <20> l'AVL,
% sinon le predicat <EFBFBD>choue (en particulier si l'AVL est vide).
suppress(Elem, AVL, NEW_AVL) :-
AVL = avl(Gauche, Racine, Droite, _Hauteur),
(Elem = Racine ->
% cas de la suppression de la racine de l'avl
(Gauche = nil -> % cas simple d'une feuille ou d'un avl sans fils gauche
NEW_AVL = Droite
;
(Droite = nil -> % cas simple d'un avl avec fils gauche mais sans fils droit
NEW_AVL = Gauche
;
% cas d'un avl avec fils gauche ET fils droit
%Gauche \= nil
%Droite \= nil
suppress_max(Max, Gauche, New_Gauche),
AVL_INT = avl(New_Gauche,Max,Droite,_),
left_balance(AVL_INT, NEW_AVL)
)
)
;
% cas des suppressions d'un element autre que la racine
(Elem @< Racine ->
% suppression dans le ss-arbre gauche
suppress(Elem, Gauche, New_Gauche),
AVL_INT = avl(New_Gauche, Racine, Droite,_),
left_balance(AVL_INT, NEW_AVL)
;
%Racine @< Droite
% suppression dans le ss-arbre droite
suppress(Elem, Droite, New_Droite),
AVL_INT = avl(Gauche, Racine, New_Droite,_),
right_balance(AVL_INT, NEW_AVL)
)
).
%-------------------------------------------------------
% Suppression du plus petit element dans un avl non vide
%-------------------------------------------------------
% Si l'avl est vide, le pr<EFBFBD>dicat <EFBFBD>choue
suppress_min(Min, AVL, NEW_AVL) :-
AVL = avl(Gauche,Racine,Droite, _Hauteur),
(Gauche = nil ->
Min = Racine,
NEW_AVL = Droite
;
% Gauche \= nil
suppress_min(Min, Gauche, New_Gauche),
AVL_INT = avl(New_Gauche, Racine, Droite,_),
left_balance(AVL_INT, NEW_AVL)
).
%-------------------------------------------------------
% Suppression du plus grand element dans un avl non vide
%-------------------------------------------------------
% Si l'avl est vide, le pr<EFBFBD>dicat <EFBFBD>choue
suppress_max(Max, AVL, NEW_AVL) :-
AVL = avl(Gauche,Racine,Droite, _Hauteur),
(Droite = nil ->
Max = Racine,
NEW_AVL = Gauche
;
% Droite \= nil
suppress_max(Max, Droite, New_Droite),
AVL_INT = avl(Gauche, Racine, New_Droite,_),
right_balance(AVL_INT, NEW_AVL)
).
%----------------------------------------
% Re-equilibrages d'un avl vers la gauche
%----------------------------------------
% - soit apres insertion d'un element dans le sous-arbre droite
% - soit apres suppression d'un <EFBFBD>l<EFBFBD>ment dans le sous-arbre gauche
%----------------------------------------------------------------
left_balance(Avl, New_Avl) :-
Avl = avl(Gauche, Racine, Droite, _Hauteur),
height(Gauche, HG),
height(Droite, HD),
(HG is HD-2 ->
% le sous-arbre droite est trop haut
Droite = avl(G_Droite, _R_Droite, D_Droite, _HD),
height(G_Droite, HGD),
height(D_Droite, HDD),
(HDD > HGD ->
% une simple rotation gauche suffit
left_rotate(Avl, New_Avl)
;
% il faut faire une rotation droite_gauche
right_rotate(Droite, New_Droite),
height(New_Droite, New_HD),
H_Int is 1+ max(HG, New_HD),
Avl_Int = avl(Gauche, Racine, New_Droite, H_Int),
left_rotate(Avl_Int, New_Avl)
)
;
% la suppression n'a pas desequilibre l'avl
New_Hauteur is 1+max(HG,HD),
New_Avl = avl(Gauche, Racine, Droite, New_Hauteur)
).
%----------------------------------------
% Re-equilibrages d'un avl vers la droite
%----------------------------------------
% - soit apres insertion d'un element dans le sous-arbre gauche
% - soit apres suppression d'un <EFBFBD>l<EFBFBD>ment dans le sous-arbre droite
%----------------------------------------------------------------
right_balance(Avl, New_Avl) :-
Avl = avl(Gauche, Racine, Droite, _Hauteur),
height(Gauche, HG),
height(Droite, HD),
(HD is HG-2 ->
% le sous-arbre gauche est trop haut
Gauche = avl(G_Gauche, _R_Gauche, D_Gauche, _HG),
height(G_Gauche, HGG),
height(D_Gauche, HDG),
(HGG > HDG ->
% une simple rotation droite suffit
right_rotate(Avl, New_Avl)
;
% il faut faire une rotation gauche_droite
left_rotate(Gauche, New_Gauche),
height(New_Gauche, New_HG),
H_Int is 1+ max(New_HG, HD),
Avl_Int = avl(New_Gauche, Racine, Droite, H_Int),
right_rotate(Avl_Int, New_Avl)
)
;
% la suppression n'a pas desequilibre l'avl
New_Hauteur is 1+max(HG,HD),
New_Avl = avl(Gauche, Racine, Droite, New_Hauteur)
).
%-----------------------------------------
% Arbres utilises pour les tests unitaires
%-----------------------------------------
avl_test(1, nil).
avl_test(2, avl(nil, 1, nil, 0)).
avl_test(3, avl(nil, 1, avl(nil,2,nil,0), 1)).
avl_test(4, avl(avl(nil,1,nil,0),2, nil, 1)).
avl_test(5, avl(avl(nil,1,nil,0), 2, avl(nil,3,nil,0),1) ).
avl_test(6, avl(avl(nil,5,nil,0), 6, avl(nil,7,nil,0),1) ).
avl_test(7, avl(G,4,D,2)) :-
avl_test(5,G),
avl_test(6,D).
avl_test(8, avl(G,5,D,2)) :-
D = avl(nil,6,nil,0),
avl_test(3,G).
avl_test(9, avl(G,3,D,2)) :-
G = avl(nil,1,nil,0),
avl_test(4,D).
/* Test uniquement valable avec ECLiPSe
avl_test(10, Final) :-
empty(Init),
(for(I,1,20), fromto(Init,In,Out,Final) do
insert(I,In,Out)
).
*/

243
TP1/taquin.pl Normal file
View file

@ -0,0 +1,243 @@
/* Fichier du probleme.
Doit contenir au moins 4 predicats qui seront utilises par A*
etat_initial(I) % definit l'etat initial
etat_final(F) % definit l'etat final
rule(Rule_Name, Rule_Cost, Before_State, After_State) % règles applicables
heuristique(Current_State, Hval) % calcul de l'heuristique
Les autres prédicats sont spécifiques au Taquin.
*/
lib(listut). % Laisser cette directive en commentaire si vous utilisez Swi-Prolog
% Sinon décommentez la ligne si vous utilisez ECLiPSe Prolog :
% -> permet de disposer du predicat nth1(N, List, E)
% -> permet de disposer du predicat sumlist(List, S)
% (qui sont predefinis en Swi-Prolog)
%***************************
%DESCRIPTION DU JEU DU TAKIN
%***************************
%********************
% ETAT INITIAL DU JEU
%********************
% format : initial_state(+State) ou State est une matrice (liste de listes)
initial_state([ [b, h, c], % C'EST L'EXEMPLE PRIS EN COURS
[a, f, d], %
[g,vide,e] ]). % h1=4, h2=5, f*=5
% AUTRES EXEMPLES POUR LES TESTS DE A*
/*
initial_state([ [ a, b, c],
[ g, h, d],
[vide,f, e] ]). % h2=2, f*=2
initial_state([ [b, c, d],
[a,vide,g],
[f, h, e] ]). % h2=10 f*=10
initial_state([ [f, g, a],
[h,vide,b],
[d, c, e] ]). % h2=16, f*=20
initial_state([ [e, f, g],
[d,vide,h],
[c, b, a] ]). % h2=24, f*=30
initial_state([ [a, b, c],
[g,vide,d],
[h, f, e]]). % etat non connexe avec l'etat final (PAS DE SOLUTION)
*/
%******************
% ETAT FINAL DU JEU
%******************
% format : final_state(+State) ou State est une matrice (liste de listes)
final_state([[a, b, c],
[h,vide, d],
[g, f, e]]).
%**
% AFFICHAGE D'UN ETAT
%**
% format : write_state(?State) ou State est une liste de lignes a afficher
write_state([]).
write_state([Line|Rest]) :-
writeln(Line),
write_state(Rest).
%**
% REGLES DE DEPLACEMENT (up, down, left, right)
%**
% format : rule(+Rule_Name, ?Rule_Cost, +Current_State, ?Next_State)
rule(up, 1, S1, S2) :-
vertical_permutation(_X,vide,S1,S2).
rule(down, 1, S1, S2) :-
vertical_permutation(vide,_X,S1,S2).
rule(left, 1, S1, S2) :-
horizontal_permutation(_X,vide,S1,S2).
rule(right,1, S1, S2) :-
horizontal_permutation(vide,_X,S1,S2).
%***********************
% Deplacement horizontal
%***********************
% format : horizontal_permutation(?Piece1,?Piece2,+Current_State, ?Next_State)
horizontal_permutation(X,Y,S1,S2) :-
append(Above,[Line1|Rest], S1),
exchange(X,Y,Line1,Line2),
append(Above,[Line2|Rest], S2).
%***********************************************
% Echange de 2 objets consecutifs dans une liste
%***********************************************
exchange(X,Y,[X,Y|List], [Y,X|List]).
exchange(X,Y,[Z|List1], [Z|List2] ):-
exchange(X,Y,List1,List2).
%*********************
% Deplacement vertical
%*********************
vertical_permutation(X,Y,S1,S2) :-
append(Above, [Line1,Line2|Below], S1), % decompose S1
delete(N,X,Line1,Rest1), % enleve X en position N a Line1, donne Rest1
delete(N,Y,Line2,Rest2), % enleve Y en position N a Line2, donne Rest2
delete(N,Y,Line3,Rest1), % insere Y en position N dans Rest1 donne Line3
delete(N,X,Line4,Rest2), % insere X en position N dans Rest2 donne Line4
append(Above, [Line3,Line4|Below], S2). % recompose S2
%***********************************************************************
% Retrait d'une occurrence X en position N dans une liste L (resultat R)
%***********************************************************************
% use case 1 : delete(?N,?X,+L,?R)
% use case 2 : delete(?N,?X,?L,+R)
delete(1,X,[X|L], L).
delete(N,X,[Y|L], [Y|R]) :-
delete(N1,X,L,R),
N is N1 + 1.
%*******************
% PARTIE A COMPLETER
%*******************
%*******************************************************************
% Coordonnees X(colonne),Y(Ligne) d'une piece P dans une situation U
%*******************************************************************
% format : coordonnees(?Coord, +Matrice, ?Element)
% Définit la relation entre des coordonnees [Ligne, Colonne] et un element de la matrice
/*
Exemples
?- coordonnees(Coord, [[a,b,c],[d,e,f]], e). % quelles sont les coordonnees de e ?
Coord = [2,2]
yes
?- coordonnees([2,3], [[a,b,c],[d,e,f]], P). % qui a les coordonnees [2,3] ?
P=f
yes
*/
coordonnees([L,C], U, X) :-
nth1(L, U, L1), nth1(C,L1,X).
:- initial_state(Ini), coordonnees([1,1], Ini, b).
%*************
% HEURISTIQUES
%*************
heuristique(U,H) :-
heuristique1(U, H). % au debut on utilise l'heuristique 1
% heuristique2(U, H). % ensuite utilisez plutot l'heuristique 2
%****************
%HEURISTIQUE no 1
%****************
% Nombre de pieces mal placees dans l'etat courant U
% par rapport a l'etat final F
% Suggestions : définir d'abord le prédicat coordonnees(Piece,Etat,Lig,Col) qui associe à une pièce présente dans Etat
% ses coordonnees (Lig= numero de ligne, Col= numero de Colonne)
% Definir ensuite le predicat malplace(P,U,F) qui est vrai si les coordonnes de P dans U et dans F sont differentes.
% On peut également comparer les pieces qui se trouvent aux mêmes coordonnees dans U et dans H et voir s'il sagit de la
% même piece.
% Definir enfin l'heuristique qui détermine toutes les pièces mal placées (voir prédicat findall)
% et les compte (voir prédicat length)
diff(vide,_) :- !, false.
diff(X,X) :- !, false.
diff(_,_) :- true.
heuristique1(U,H) :-
findall(X,
(final_state(Fin), coordonnees([L,C], U, X)
coordonnees([L,C], Fin, Y), diff(X,Y)),
Count),
length(Count, H).
:- initial_state(Ini), heuristique1(Ini, 4).
:- final_state(F), heuristique1(F, 0).
%****************
%HEURISTIQUE no 2
%****************
% Somme des distances de Manhattan à parcourir par chaque piece
% entre sa position courante et sa positon dans l'etat final
manhattan(_,vide,0) :- !.
manhattan(U, X, Resu) :-
coordonnees([Lstart, Cstart], U, X),
final_state(Fin), coordonnees([Lend,Cend], Fin, X),
Resu is abs(Lend - Lstart) + abs(Cend - Cstart).
:- initial_state(Ini), manhattan(Ini, vide, 0).
:- initial_state(Ini), manhattan(Ini, a, 1).
:- initial_state(Ini), manhattan(Ini, h, 2).
heuristique2(U, H) :-
findall(Resu,
(coordonnees(_,U,X), manhattan(U,X,Resu)),
Count),
sumlist(Count, H).
:- initial_state(Ini), heuristique2(Ini, 5).
:- final_state(F), heuristique2(F, 0).

216
TP2/negamax.pl Normal file
View file

@ -0,0 +1,216 @@
/*
Ce programme met en oeuvre l'algorithme Minmax (avec convention
negamax) et l'illustre sur le jeu du TicTacToe (morpion 3x3)
*/
:- [tictactoe].
/****************************************************
ALGORITHME MINMAX avec convention NEGAMAX : negamax/5
*****************************************************/
/*
negamax(+J, +Etat, +P, +Pmax, [?Coup, ?Val])
SPECIFICATIONS :
retourne pour un joueur J donne, devant jouer dans
une situation donnee Etat, de profondeur donnee P,
le meilleur couple [Coup, Valeur] apres une analyse
pouvant aller jusqu'a la profondeur Pmax.
Il y a 3 cas a decrire (donc 3 clauses pour negamax/5)
1/ la profondeur maximale est atteinte : on ne peut pas
developper cet Etat ;
il n'y a donc pas de coup possible a jouer (Coup = rien)
et l'evaluation de Etat est faite par l'heuristique.
2/ la profondeur maximale n'est pas atteinte mais J ne
peut pas jouer ; au TicTacToe un joueur ne peut pas jouer
quand le tableau est complet (totalement instancie) ;
il n'y a pas de coup a jouer (Coup = rien)
et l'evaluation de Etat est faite par l'heuristique.
3/ la profondeur maxi n'est pas atteinte et J peut encore
jouer. Il faut evaluer le sous-arbre complet issu de Etat ;
- on determine d'abord la liste de tous les couples
[Coup_possible, Situation_suivante] via le predicat
successeurs/3 (deja fourni, voir plus bas).
- cette liste est passee a un predicat intermediaire :
loop_negamax/5, charge d'appliquer negamax sur chaque
Situation_suivante ; loop_negamax/5 retourne une liste de
couples [Coup_possible, Valeur]
- parmi cette liste, on garde le meilleur couple, c-a-d celui
qui a la plus petite valeur (cf. predicat meilleur/2);
soit [C1,V1] ce couple optimal. Le predicat meilleur/2
effectue cette selection.
- finalement le couple retourne par negamax est [Coup, V2]
avec : V2 is -V1 (cf. convention negamax vue en cours).
A FAIRE : ECRIRE ici les clauses de negamax/5
.....................................
*/
% cas 1
negamax(J, Etat, Pmax, Pmax, [[], Val]) :-
heuristique(J, Etat, Val), !.
% cas 2
negamax(J, Etat, _, _, [[], Val]):-
ground(Etat),
heuristique(J, Etat, Val), !.
% cas 3
negamax(J, Etat, P, Pmax, [Coup, Val]):-
successeurs(J,Etat,Succ),
loop_negamax(J,P,Pmax,Succ, List),
meilleur(List, [Coup,MVal]),
Val is MVal*(-1).
/*******************************************
DEVELOPPEMENT D'UNE SITUATION NON TERMINALE
successeurs/3
*******************************************/
/*
successeurs(+J,+Etat, ?Succ)
retourne la liste des couples [Coup, Etat_Suivant]
pour un joueur donne dans une situation donnee
*/
successeurs(J,Etat,Succ) :-
copy_term(Etat, Etat_Suiv),
findall([Coup,Etat_Suiv],
successeur(J,Etat_Suiv,Coup),
Succ).
/*************************************
Boucle permettant d'appliquer negamax
a chaque situation suivante :
*************************************/
/*
loop_negamax(+J,+P,+Pmax,+Successeurs,?Liste_Couples)
retourne la liste des couples [Coup, Valeur_Situation_Suivante]
a partir de la liste des couples [Coup, Situation_Suivante]
*/
loop_negamax(_,_,_,[],[]).
loop_negamax(J,P,Pmax,[[Coup,Suiv]|Succ], [[Coup,Vsuiv]|Reste_Couples]) :-
loop_negamax(J,P,Pmax,Succ,Reste_Couples),
adversaire(J,A),
Pnew is P+1,
negamax(A,Suiv,Pnew,Pmax, [_,Vsuiv]).
/*
A FAIRE : commenter chaque litteral de la 2eme clause de loop_negamax/5,
en particulier la forme du terme [_,Vsuiv] dans le dernier
litteral ?
*/
/*
J --> Symbole du joueur
P --> profondeur actuelle
Pmax --> profondeur maximale
[[Coup, Suiv] | Succ] --> Itération sur la liste de couple (Coup avec l'état Suiv on arrive) puis le reste de la liste Succ
[[Coup,Vsuiv] | Reste_Couples] --> Liste de couple (Coup, VSuiv). VSuiv indique si c'est un bon ou mauvais coup à jouer
*/
/*********************************
Selection du couple qui a la plus
petite valeur V
*********************************/
/*
meilleur(+Liste_de_Couples, ?Meilleur_Couple)*/
/*
SPECIFICATIONS :
On suppose que chaque element de la liste est du type [C,V]
- le meilleur dans une liste a un seul element est cet element
- le meilleur dans une liste [X|L] avec L \= [], est obtenu en comparant
X et Y,le meilleur couple de L
Entre X et Y on garde celui qui a la petite valeur de V.
A FAIRE : ECRIRE ici les clauses de meilleur/2
*/
meilleur([[Coup, Valeur]], [Coup, Valeur]).
meilleur([[Coup, Valeur]|Succ], [MCoup,MValeur]):-
meilleur(Succ, [CX, VX]),
(Valeur < VX ->
MCoup = Coup,
MValeur = Valeur
;
MCoup = CX,
MValeur = VX
).
% Tests du prédicat meilleur
:- meilleur([[[3,4], 6]],[[3,4], 6]).
:- meilleur([[[1,2],7],[[1,4],8],[[2,2],2]],[[2,2],2]).
/******************
PROGRAMME PRINCIPAL
*******************/
% ?B --> meilleur coup / ?V --> valeur du meilleur coup
% Prédicat main
main(B,V,Pmax) :-
situation_initiale(SI),
negamax(x,SI,0,Pmax,[B,V]).
% Deuxieme predicat main avec posibilite de choisir le joueur J et la situation S
main2(J,S,B,V,Pmax):-
negamax(J,S,0,Pmax,[B,V]).
/*
A FAIRE :
Completer puis tester le programme principal pour plusieurs valeurs de la profondeur maximale.
Pmax = 1, 2, 3, 4 ...
Commentez les resultats obtenus.
*/
% Q1
% Tests sur la profondeur de Pmax
:- main([],0,0). % avec Pmax = 0 --> on ne lance pas la recherche de meilleur coup
:- main([2,2],4,1).
:- main([2,2], 1, 2).
:- main([2,2],3,5).
% main(B,V,9). --> débordement de pile
% Pour l'état initial, peu importe le nombre Pmax on obtient toujours la case du milieu en coup à jouer.
% Cependant, la valeur V change,on effet elle est plus petite quand P est pair (prise en compte plus forte du coup de l'adversaire)
% De plus la valeur V diminue également au fur et à mesure quand on se rapproche de la grille finale (9 coups joués) car si tous les jouoeurs jouent bien, il n'y a aucun gagnants.
% Exemple d'une partie ou les 2 joueurs jouent les coups optimaux --> pas de gagnants
:- A=[[_,_,_],[_,_,_],[_,_,_]], main2(x,A,[2,2],3,3).
:- A=[[_,_,_],[_,x,_],[_,_,_]], main2(o,A,[3,3],-1,3).
:- A=[[_,_,_],[_,x,_],[_,_,o]], main2(x,A,[2,1],3,3).
:- A=[[_,_,_],[x,x,_],[_,_,o]], main2(o,A,[2,3],-1,3).
:- A=[[_,_,_],[x,x,o],[_,_,o]], main2(x,A,[1,3],2,3).
:- A=[[_,_,x],[x,x,o],[_,_,o]], main2(o,A,[3,1],0,3).
:- A=[[_,_,x],[x,x,o],[o,_,o]], main2(x,A,[3,2],0,3).
:- A=[[_,_,x],[x,x,o],[o,x,o]], main2(o,A,[1,2],0,3).
:- A=[[_,o,x],[x,x,o],[o,x,o]], main2(x,A,[1,1],0,3).
:- A=[[x,o,x],[x,x,o],[o,x,o]], main2(x,A,[],0,3).
%Q2 en utilisant des rotations comme pour le jeu de bois du S1. On pourrait voir ainsi si la situation n'a pas deja ete
% calculee
% Q3 Que le coup gagnant soit quand on a 4 symboles identiques allignes. Il faudra aussi changer le predicat successeur
% (en effet on ne peut mettre des jetons que sur d'autres jetons ou sur le sol)
% Q4 // Insert alpha beta

244
TP2/tictactoe.pl Normal file
View file

@ -0,0 +1,244 @@
/*********************************
DESCRIPTION DU JEU DU TIC-TAC-TOE
*********************************/
/*
Une situation est decrite par une matrice 3x3.
Chaque case est soit un emplacement libre (Variable LIBRE), soit contient le symbole d'un des 2 joueurs (o ou x)
Contrairement a la convention du tp precedent, pour modeliser une case libre
dans une matrice on n'utilise pas une constante speciale (ex : nil, 'vide', 'libre','inoccupee' ...);
On utilise plut<EFBFBD>t un identificateur de variable, qui n'est pas unifiee (ex : X, A, ... ou _) .
La situation initiale est une "matrice" 3x3 (liste de 3 listes de 3 termes chacune)
o<EFBFBD> chaque terme est une variable libre.
Chaque coup d'un des 2 joureurs consiste a donner une valeur (symbole x ou o) a une case libre de la grille
et non a deplacer des symboles deja presents sur la grille.
Pour placer un symbole dans une grille S1, il suffit d'unifier une des variables encore libres de la matrice S1,
soit en ecrivant directement Case=o ou Case=x, ou bien en accedant a cette case avec les predicats member, nth1, ...
La grille S1 a change d'etat, mais on n'a pas besoin de 2 arguments representant la grille avant et apres le coup,
un seul suffit.
Ainsi si on joue un coup en S, S perd une variable libre, mais peut continuer a s'appeler S (on n'a pas besoin de la designer
par un nouvel identificateur).
*/
situation_initiale([ [_,_,_],
[_,_,_],
[_,_,_] ]).
% Convention (arbitraire) : c'est x qui commence
joueur_initial(x).
% Definition de la relation adversaire/2
adversaire(x,o).
adversaire(o,x).
/****************************************************
DEFINIR ICI a l'aide du predicat ground/1 comment
reconnaitre une situation terminale dans laquelle il
n'y a aucun emplacement libre : aucun joueur ne peut
continuer a jouer (quel qu'il soit).
****************************************************/
situation_terminale(_Joueur, Situation) :- ground(Situation).
:- situation_terminale(o,[[o,o,o],[x,x,x],[o,x,o]]).
:- not(situation_terminale(o,[[o,o,o],[x,x,x],[o,x,_]])).
/***************************
DEFINITIONS D'UN ALIGNEMENT
***************************/
alignement(L, Matrix) :- ligne(L,Matrix).
alignement(C, Matrix) :- colonne(C,Matrix,_).
alignement(D, Matrix) :- diagonale(D,Matrix).
/********************************************
DEFINIR ICI chaque type d'alignement maximal
existant dans une matrice carree NxN.
********************************************/
ligne(L, M) :- nth1(_,M,L).
colonne([],[],_).
colonne([E|C],[L|M],Nb) :-
nth1(Nb,L,E),
colonne(C,M,Nb).
/* Definition de la relation liant une diagonale D a la matrice M dans laquelle elle se trouve.
il y en a 2 sortes de diagonales dans une matrice carree(https://fr.wikipedia.org/wiki/Diagonale) :
- la premiere diagonale (principale) : (A I)
- la seconde diagonale : (Z R)
A . . . . . . . Z
. \ . . . . . / .
. . \ . . . / . .
. . . \ . / . . .
. . . . X . . .
. . . / . \ . . .
. . / . . . \ . .
. / . . . . . \ .
R . . . . . . . I
*/
diagonale(D, M) :-
premiere_diag(1,D,M).
diagonale(D, M) :-
length(M, L),
seconde_diag(L,D,M).
% Definition de la premiere diagonale (partant de (1,1) pour aller vers (NxN))
premiere_diag(_,[],[]).
premiere_diag(K,[E|D],[Ligne|M]) :-
nth1(K,Ligne,E),
K1 is K+1,
premiere_diag(K1,D,M).
% Definition de la deuxieme diagonale (partant de (1,N) pour aller vers (N,1))
seconde_diag(_,[],[]).
seconde_diag(K,[E|D],[Ligne|M]) :-
nth1(K,Ligne,E),
K1 is K-1,
seconde_diag(K1,D,M).
/*****************************
DEFINITION D'UN ALIGNEMENT
POSSIBLE POUR UN JOUEUR DONNE
*****************************/
possible([X|L], J) :- unifiable(X,J), possible(L,J).
possible([],_).
/* Attention
il faut juste verifier le caractere unifiable
de chaque emplacement de la liste, mais il ne
faut pas realiser l'unification.
*/
% On regarde si la variable X est libre ou si elle contient le symbole du joueur
unifiable(X,_):-
var(X), !.
unifiable(X,X).
/**********************************
DEFINITION D'UN ALIGNEMENT GAGNANT
OU PERDANT POUR UN JOUEUR DONNE J
**********************************/
/*
Un alignement gagnant pour J est un alignement
possible pour J qui n'a aucun element encore libre.
*/
/*
Remarque : le predicat ground(X) permet de verifier qu'un terme
prolog quelconque ne contient aucune partie variable (libre).
exemples :
?- ground(Var).
no
?- ground([1,2]).
yes
?- ground(toto(nil)).
yes
?- ground( [1, toto(nil), foo(a,B,c)] ).
no
*/
/* Un alignement perdant pour J est un alignement gagnant pour son adversaire. */
alignement_gagnant(Ali, J) :-
ground(Ali),
adversaire(J, Adv),
not(member(Adv, Ali)).
alignement_perdant(Ali, J) :-
ground(Ali),
not(member(J, Ali)).
% Quelques tests
:- alignement_gagnant([x,x,x], x).
:- not(alignement_gagnant([x,x,o], x)).
:- not(alignement_gagnant([x,x,_], x)).
:- not(alignement_perdant([x,x,_], x)).
:- not(alignement_perdant([x,x,x], x)).
:- alignement_perdant([o,o,o], x).
/* ****************************
DEFINITION D'UN ETAT SUCCESSEUR
****************************** */
/*
Il faut definir quelle operation subit la matrice
M representant l'Etat courant
lorsqu'un joueur J joue en coordonnees [L,C]
*/
successeur(J, Etat,[L,C]) :-
nth1(L, Etat, Ligne),
nth1(C, Ligne, Emplacement),
var(Emplacement),
nth1(L, Etat, Ligne),
nth1(C, Ligne, J).
/**************************************
EVALUATION HEURISTIQUE D'UNE SITUATION
**************************************/
/*
1/ l'heuristique est +infini si la situation J est gagnante pour J
2/ l'heuristique est -infini si la situation J est perdante pour J
3/ sinon, on fait la difference entre :
le nombre d'alignements possibles pour J
moins
le nombre d'alignements possibles pour l'adversaire de J
*/
% Cas gagant
heuristique(J,Situation,H) :-
H = 10000, % grand nombre approximant +infini
alignement(Alig,Situation),
alignement_gagnant(Alig,J), !.
% Cas perdant
heuristique(J,Situation,H) :-
H = -10000, % grand nombre approximant -infini
alignement(Alig,Situation),
alignement_perdant(Alig,J), !.
% on ne vient ici que si les cut precedents n'ont pas fonctionne,
% c-a-d si Situation n'est ni perdante ni gagnante.
% Cas général
heuristique(J,Situation,H) :-
adversaire(J,Adv),
findall(AligX,
(alignement(AligX,Situation),possible(AligX,J)),
CountX),
findall(AligY,
(alignement(AligY,Situation), possible(AligY,Adv)),
CountY),
length(CountX,LX),
length(CountY,LY),
H is LX - LY.
% Quelques tests
:- A=[[o,_,_],[_,o,_],[_,_,_]],heuristique(o,A,6).
:- A=[[o,_,_],[_,_,_],[_,_,_]],heuristique(x,A,-3).
:- A=[[_,_,_],[_,_,_],[_,_,_]],heuristique(x,A,0).
:- A=[[o,_,_],[o,o,o],[_,_,_]],heuristique(o,A,10000).