Skip to content

Instantly share code, notes, and snippets.

@zyzo zyzo/avl.pl
Last active Aug 29, 2015

Embed
What would you like to do?
TP1 Intelligence Artificielle - 4IR
%***************************
% 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)).
%***************************
% 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
).
Sorry, something went wrong. Reload?
Sorry, we cannot display this file.
Sorry, this file is invalid so it cannot be displayed.
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
You can’t perform that action at this time.