Last active
August 29, 2015 14:20
-
-
Save zyzo/91ae3d5e95e4fe2295eb to your computer and use it in GitHub Desktop.
TP1 Intelligence Artificielle - 4IR
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
%*************************** | |
% Gestion d'un AVL en Prolog | |
%*************************** | |
%*************************** | |
% INSA TOULOUSE - P.ESQUIROL | |
% mars 2015 | |
%*************************** | |
%************************* | |
% unit tests : OK | |
% integration aetoile : OK | |
%************************* | |
% Les AVL sont des arbres BINAIRES DE RECHERCHE H-EQUILIBRES : | |
% La hauteur de l'avl A est dé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érence de hauteur entre le sous-arbre droit | |
% et le sous-arbre gauche appartient à [-1,0,+1] | |
%*********************************************** | |
% PREDICATS EXPORTES ET COMPLEXITE ALGORITHMIQUE | |
%*********************************************** | |
% soit N = nombre de noeuds de l'arbre | |
% height(+Avl, ?Height) O(1) | |
% put_flat(+Avl) O(N) | |
% put_90(+Avl) O(N) | |
% belongs(+Elem, +Avl) O(log N) | |
% subtree(+Elem, +Avl, Ss_Avl) O(log N) | |
% insert(+Elem, +Avant, ?Apres) O(log N) | |
% suppress(+Elem,+Avant,?Apres) O(log N) | |
% suppress_min(?Min,+Avant,?Apres) O(log N) | |
% suppress_max(?Max,+Avant,?Apres) O(log N) | |
%**************************** | |
% Pré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 à jour de façon incrémentale, apres chaque insertion ou suppression | |
% d'ou sa complexité 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é) 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écrivent uniquement les cas ou la rotation est possible. | |
% Dans les autres cas, ces relations échouent ; plus précisé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é (difference de hauteur | |
% entre les ss-arbres gauche et droite de 1) | |
% L'insertion doit assurer qu'apres insertion l'arbre est toujours equilibre | |
% sinon les rotations necessaires sont effectuees. | |
% On suppose que les noeux 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é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'élément est déjà présent, 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'élément à supprimer appartient bien à l'AVL, | |
% sinon le predicat é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édicat é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édicat é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 élé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 élé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). | |
avl_test(10, Final) :- | |
empty(Init), | |
(for(I,1,20), fromto(Init,In,Out,Final) do insert(I,In,Out)). | |
avl_real_test(1, | |
avl(nil, [[[a, b, c], [vide, h, d], [g, f, e]], [4, 1, 3], [[a, b, c], [g, h, d], [vide, f, e]], up], nil, 0)). |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
%*************************** | |
% TP IA N°1 | |
% DANG Hai An - GOURRAUD Anthony | |
% 4IR-I-TD-B1 | |
%*************************** | |
:- include('avl'). | |
%:- lib(listut). % a placer en commentaire si on utilise Swi-Prolog | |
% (le predicat delete/3 est predefini) | |
% Indispensable dans le cas de ECLiPSe Prolog | |
% (le predicat delete/3 fait partie de la librairie listut) | |
%*************************** | |
%DESCRIPTION DU JEU DU TAKIN | |
%*************************** | |
%******************** | |
% ETAT INITIAL DU JEU | |
% h1 réprésente l'heuristique n°1 (nombre de pièces mal placées) | |
% h2 réprésente l'heuristique n°2 (somme sur l'ensemble des pieces des distances de Manhattan, | |
% càd distance entre la position courante de la piece | |
% et sa positon dans l'etat final) | |
%******************** | |
initial_state([ [a, b, c], | |
[g, h, d], | |
[vide,f,e] ]). % h1=2, h2=2, f*=2 | |
initial_state([ [b, h, c], % EXEMPLE | |
[a, f, d], % DU COURS | |
[g,vide,e] ]). % h1=4 , h2=5 = f*=5actions | |
initial_state([ [b, c, d], | |
[a,vide,g], | |
[f, h, e] ]). % h1=7, h2=10 f*=10 | |
initial_state([ [f, g, a], | |
[h,vide,b], | |
[d, c, e] ]). % h1=6, h2=16, f*=20 | |
initial_state([ [e, f, g], | |
[d,vide,h], | |
[c, b, a] ]). % h1=8, h=24, f*=30 | |
%****************** | |
% ETAT FINAL DU JEU | |
%****************** | |
final_state([[a, b, c], | |
[h,vide,d], | |
[g, f, e]]). | |
%******************** | |
% AFFICHAGE D'UN ETAT | |
%******************** | |
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 | |
%*********************** | |
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. | |
% choisir l'heuristique % utilisee ( 1 ou 2) | |
heuristique(U,H) :- | |
% heuristique1(U, H). | |
heuristique2(U, H). | |
%**************** | |
%HEURISTIQUE no 1 | |
%**************** | |
/* Calcul du nombre de pieces mal placees dans l'etat courant U | |
par rapport a l'etat final F */ | |
heuristique1(U, H) :- | |
final_state(F), % etat final à comparer (matrice référence) | |
heuristique_matrice(U, F, H). | |
/* Nombre total D de pièces mal placées entre 2 matrices M1 et M2 (de même taille) */ | |
heuristique_matrice([], [], 0). % matrices vides , distance = 0 | |
heuristique_matrice(M1, M2, D) :- | |
M1 = [L1|R1], % récupération première ligne de la première matrice | |
M2 = [L2|R2], % récupération première ligne de la deuxième matrice | |
heuristique_ligne(L1, L2, DL), | |
heuristique_matrice(R1, R2, DR), % récurrence | |
D is DL + DR. | |
/* Nombre total D de pièces mal placées entre 2 lignes L1 et L2 (de même taille) */ | |
heuristique_ligne([], [], 0). % listes vides , distance = 0 | |
heuristique_ligne(L1, L2, D) :- | |
L1 = [E1|R1], % récupération première élément de L1 | |
L2 = [E2|R2], % récupération première élément de L2 | |
heuristique_element(E1, E2, DE), | |
heuristique_ligne(R1, R2, DR), % récurrence | |
D is DE + DR. | |
/* Comparaison entre deux éléments */ | |
heuristique_element(vide, _E, 0). | |
heuristique_element(E,E,0) :- E \= vide . | |
heuristique_element(E1,E2,1) :- E1 \= vide , E1 \= E2 . | |
/* TESTS unitaires pour l'heuristique 1 | |
heuristique1([[e,f,g],[d,vide,h],[c,b,a]], H). | |
heuristique1([[vide,a,c],[h,b,d],[g,f,e]], H). | |
heuristique1([[a,vide,c],[h,b,d],[g,f,e]], H). | |
*/ | |
test_heuristique1(H, I) :- % calcul h1 pour chaque état initial déclaré | |
initial_state(I), | |
heuristique1(I, H). | |
%**************** | |
%HEURISTIQUE no 2 | |
%**************** | |
/* Calcul de la somme sur l'ensemble des pieces des distances de Manhattan | |
(différence entre la position courante de la piece et sa positon dans l'etat final) */ | |
heuristique2(U, H) :- | |
final_state(F), % etat final à comparer | |
distance_manhattan(U, F, H). | |
/* Somme H des distances de Manhattan, entre 2 matrices M1 et M2 (de même taille), | |
pour chaque pièce du jeu */ | |
distance_manhattan(M1, M2, H) :- | |
flatMap(M1, L), % obtenir en une liste toutes les pièces du jeu | |
distance_manhattan_matrice(L, M1, M2, H). % obtenir la somme H des distances de Manhattan pour chaque élément (pièce) de L | |
/* Transformer une matrice M (liste de liste) en une seule liste L */ | |
flatMap([], []). | |
flatMap(M, Liste) :- | |
M = [L|R], | |
findall(X, member(X,L), L1), | |
flatMap(R, L2), | |
append(L1, L2, Liste). | |
/* Calculer la somme H des distances de Manhattan pour chaque élément de la liste L | |
de la matrice M1 par rapport à M2 */ | |
distance_manhattan_matrice([], _, _, 0). % renvoie H = 0 si parcours fini | |
distance_manhattan_matrice(L, M1, M2, H) :- | |
L = [Piece|Reste], | |
(Piece \= vide -> % si la pièce n'est pas vide | |
calcPos(Piece, M1, Lig1, Col1) , % calculer les coordonnées (Ligne, Colonne) de la pièce en question dans M1 | |
calcPos(Piece, M2, Lig2, Col2) , % calculer les coordonnées (Ligne, Colonne) de la pièce en question dans M2 | |
H1 is abs(Lig1-Lig2) + abs(Col1-Col2) ; % calculer la différence (absolue) de ces 2 coordonnées | |
H1 is 0), % sinon (la pièce est vide) , indiquer que la différence de coordonnées est nulle | |
distance_manhattan_matrice(Reste, M1, M2, H2), % récurrence sur les pièces de L restantes | |
H is H1 + H2. | |
/* Retourner les coordonnées de l'élément Piece dans la matrice M | |
Lig, Col : coordonnées (Ligne, Colonne) de Piece | |
*/ | |
calcPos(Piece, M, Lig, Col) :- | |
append(Above, [L|_Below], M), % L est la ligne de la matrice contenant Piece | |
append(Before, [Piece|_After], L), | |
length(Above, Lig), % Lig = Nombre de lignes au dessus de la ligne contenant Piece ( = longueur de la liste de listes Above) % | |
length(Before, Col). % Col = Nombre de pièces dans la ligne L avant de trouver Piece ( = longueur de la liste Before) % | |
/* TESTS unitaires pour l'heuristique 2 | |
heuristique2([[e,f,g],[d,vide,h],[c,b,a]], H). | |
heuristique2([[vide,a,c],[h,b,d],[g,f,e]], H). | |
heuristique2([[a,vide,c],[h,b,d],[g,f,e]], H). | |
*/ | |
test_heuristique2(H, I) :- % calcul h2 pour chaque état initial déclaré | |
initial_state(I), | |
heuristique2(I, H). | |
main :- | |
initial_state(S0), | |
heuristique(S0, H0), | |
write("H = "), writeln(H0), | |
write("S = "), writeln(S0), | |
empty(Pf), empty(Pu), empty(Qs), | |
insert([[H0,H0,0], S0], Pf, Pf_Suiv), | |
insert([S0, [H0,H0,0], nil, nil], Pu, Pu_Suiv), | |
aetoile(Pf_Suiv, Pu_Suiv, Qs). | |
aetoile(Pf, Pu, Qs) :- | |
final_state(F), | |
suppress_min([Value, F], Pf, _Pf_Suiv), | |
suppress([F, Value, Pere, Action], Pu, _Pu_Suiv), | |
% write(Action), write(" "), write(F), nl, | |
affiche_solution([F, _, Pere, Action], Qs). | |
aetoile(Pf, Pu, Qs) :- | |
suppress_min([Val, U], Pf, Pf1), | |
suppress([U, Val, Pere, Action], Pu, Pu1), | |
insert([U, Val, Pere, Action], Qs, Qs1), | |
Val = [_, _, G], % recuperer G pour passer dans expand/3 | |
expand(U, G, Res), | |
% writeln(U), writeln("----------------"), | |
loop_successors(Res, Pf1, Pf2, Pu1, Pu2, Qs1), | |
aetoile(Pf2, Pu2, Qs1). | |
print_fgh([F, H, G]) :- | |
write("f = "), write(F), | |
write(", h = "), write(H), | |
write(", g = "), write(G), | |
writeln("."). | |
print_taquin([]). | |
print_taquin([X|R]) :- | |
writeln(X), | |
print_taquin(R). | |
affiche_solution(Elem, Qs) :- affiche_solution(Elem, Qs, 0). | |
affiche_solution([Pere, Value, nil, Action], _Qs, Memo) :- | |
print_fgh(Value), write("f* = "), writeln(Memo). | |
% :- | |
%writeln(Action), writeln("--------"), write_res(Pere), writeln("==========="). | |
affiche_solution(Elem, Qs, Memo) :- | |
Elem = [Current, Value, Pere, Action], | |
belongs([Pere, ValueP, PereP, ActionP], Qs), | |
Memo2 is Memo+1, | |
affiche_solution([Pere, ValueP, PereP, ActionP], Qs, Memo2), | |
writeln(Action), writeln("------------------------"), write_res(Current), writeln("------------------------"). | |
expand(Elem, G, Res) :- | |
% recuperer tous les deplacement possibles | |
% construire les termes avec le bon format et stocker dans Res | |
findall( | |
[F, [FF,H, GF], Elem, Name], | |
( | |
rule(Name, Cost, Elem, F), | |
GF is G+Cost, | |
heuristique(F, H), | |
FF is GF + H | |
), | |
Res | |
). | |
loop_successors([], Pf, Pf, Pu, Pu, _Qs). | |
loop_successors([X|R], Pf, Pf_Suiv, Pu, Pu_Suiv, Qs) :- | |
process_successor_i(X, Pf, Pf_aux, Pu, Pu_aux, Qs), | |
% writeln(X), | |
loop_successors(R, Pf_aux, Pf_Suiv, Pu_aux, Pu_Suiv, Qs). | |
/** | |
* process_successor/6, declarative style | |
**/ | |
% Si le terme deja traite (existe dans Qs) => ignorer le terme | |
/* | |
process_successor(X, Pf, Pf, Pu, Pu, Qs) :- | |
X = [Elem, Value, _, _], | |
belongs([Elem, _, _, _], Qs), ! | |
% ,writeln("case 1"), print_taquin(Elem) | |
. | |
% Si le terme connue dans Ps avec une meilleure evaluation => garder l'ancien terme. | |
process_successor(X, Pf, Pf, Pu, Pu, Qs) :- | |
X = [Elem, [FX, HX, _GX], _PereX, _ActionX], | |
%not(belongs([Elem, _, _, _], Qs)), | |
belongs([[FY, HY, _GY], Elem], Pf), | |
[FY, HY] @< [FX, HX], ! | |
% ,writeln("case 2")% print_taquin(Elem), | |
. | |
% Si le terme connue dans Ps avec une meilleure evaluation => remplacer par le nouveau | |
process_successor(X, Pf, Pf_Suiv, Pu, Pu_Suiv, Qs) :- | |
X = [Elem, [FX, _, _], PereX, ActionX], | |
suppress([_, Elem], Pf, Pf_aux), !, | |
%FY > FX, | |
suppress([Elem, _, _, _], Pu, Pu_aux), | |
insert([Value, Elem], Pf_aux, Pf_Suiv), | |
insert([Elem, Value, PereX, ActionX], Pu_aux, Pu_Suiv) | |
% ,writeln("case 3") %print_taquin(Elem), | |
. | |
% Si c'est une situation nouvelle, insérer le nouveau terme dans P | |
process_successor(X, Pf, Pf_Suiv, Pu, Pu_Suiv, Qs) :- | |
X = [Elem, Value, PereX, ActionX], | |
% not(belongs([Elem, _, _, _], Qs)), | |
% not(belongs([Elem, _, _, _, _], Pu)), | |
insert([Value, Elem], Pf, Pf_Suiv), | |
insert([Elem, Value, PereX, ActionX], Pu, Pu_Suiv) | |
% ,writeln("case 4")%, print_taquin(Elem) | |
. | |
*/ | |
/** | |
* process_successor_i/6, imperative style | |
**/ | |
process_successor_i(X, Pf, Pf_Suiv, Pu, Pu_Suiv, Qs) :- | |
X = [Elem, Value, Pere, Action], | |
Value = [F,H,G], | |
(belongs([Elem, _, _, _], Qs) -> | |
Pf_Suiv = Pf, | |
Pu_Suiv = Pu | |
%, write("Deja parcouru ") | |
; belongs([[FY, HY, _], Elem], Pf) -> | |
([FY, HY] @< [F, H] -> | |
% write("Pas mieux "), | |
Pf_Suiv = Pf, | |
Pu_Suiv = Pu | |
; | |
% write("Mieux "), | |
suppress([_, Elem], Pf, Pf_aux), | |
suppress([Elem, _, _, _], Pu, Pu_aux), | |
insert([Value,Elem], Pf_aux, Pf_Suiv), | |
insert(X, Pu_aux, Pu_Suiv) | |
) | |
; | |
insert([Value,Elem], Pf, Pf_Suiv), | |
insert(X, Pu, Pu_Suiv) | |
% , write("Nouveau ") | |
) | |
. | |
/* tests affichage solution */ | |
qs_test([[1, _ , 2, _], | |
[2, _, 3, _], | |
[3, _, 5, _], | |
[5, _, nil, _]]). | |
qs_avl_test([], _Arbre). | |
qs_avl_test([X|R], Arbre_Suiv) :- | |
qs_avl_test(R, Arbre), | |
insert(X, Arbre, Arbre_Suiv). | |
test_affiche_solution :- | |
qs_test(L), | |
qs_avl_test(L, A), | |
affiche_solution([7, _, 1, _], A). | |
/* tests expand */ | |
write_res([]). | |
write_res([X|R]) :- | |
write_res_line(X), | |
nl, write_res(R). | |
test_expand :- initial_state(I), heuristique(I,H), expand([I, [H,H,0], nil, _Action], 0, Res), write_res(Res). | |
write_res_line([]). | |
write_res_line([X|R]) :- | |
(X=vide -> write('x'); write(X)), | |
write_res_line(R). | |
/* tests loop_successors | |
Dependency : expand/3 | |
*/ | |
init_trees(Pf_Suiv, Pu_Suiv, Qs) :- | |
initial_state(S0), | |
heuristique(S0, H0), | |
empty(Pf), empty(Pu), empty(Qs), | |
insert([[H0,H0,0], S0], Pf, Pf_Suiv), | |
insert([S0, [H0,H0,0], nil, nil], Pu, Pu_Suiv). | |
test_loop_successors_data( | |
[ | |
[[a, b, c], [vide, h, d], [g, f, e]], | |
[4, 1, 3], | |
[[a, b, c], [g, h, d], [vide, f, e]], | |
up | |
]). | |
test_loop_successors :- | |
init_trees(Pf, Pu, Qs), | |
test_loop_successors_data(X), | |
insert(X, Qs, Qs1), | |
loop_successors([X], Pf1, Pf2, Pu, Pu2, Qs1, Qs2). | |
test_loop_successors3 :- | |
init_trees(Pf, Pu, Qs), | |
test_loop_successors_data(X), | |
insert(X, Pu, Pu1), | |
X = [Elem, Value, Pere, Action], | |
insert([Value, Elem], Pf, Pf1), | |
Value = [F, G, H], | |
F1 is F-1, | |
loop_successors([[Elem, [F1, G, H], Pere, Action]], Pf1, Pf2, Pu1, Pu2, Qs, Qs2). | |
test_loop_successors4 :- | |
init_trees(Pf, Pu, Qs), | |
test_loop_successors_data(X), | |
loop_successors([X], Pf, Pf2, Pu, Pu2, Qs, Qs2). | |
% Test avl.pl | |
test_suppress(AvlNo, Number) :- | |
avl_test(AvlNo, Tree), | |
put_90(Tree), | |
suppress(Number, Tree, NewTree), | |
put_90(NewTree). | |
test_suppress(3,1). | |
test_suppress(3,3). | |
test_belongs1(Number) :- | |
avl_test(Number, Tree), | |
belongs(3, Tree). | |
test_belongs1(2). | |
test_belongs1(3). | |
test_belongs2 :- | |
avl_real_test(1, T), | |
belongs( | |
[[[a, b, c], [vide, h, d], [g, f, e]], [4, 1, 3], [[a, b, c], [g, h, d], [vide, f, e]], up], | |
T | |
). |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment