Prolog-TP-IA/TP1/aetoile.pl
2023-02-27 23:00:46 +01:00

172 lines
5.2 KiB
Prolog
Raw Blame History

%*******************************************************************************
% 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<66>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