TP1 Intelligence Artificielle - 4IR

avl.pl

%***************************
% 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)).

taquin.pl

%***************************
% 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
  ).

tp_ia1_2015.pdf