Browse Source

Initial commit

Yohan Simard 3 years ago
commit
f79dad09fd
5 changed files with 967 additions and 0 deletions
  1. 107
    0
      tp1/aetoile.pl
  2. 367
    0
      tp1/avl.pl
  3. 177
    0
      tp1/taquin.pl
  4. 125
    0
      tp2/negamax.pl
  5. 191
    0
      tp2/tictactoe.pl

+ 107
- 0
tp1/aetoile.pl View File

@@ -0,0 +1,107 @@
1
+:- include('avl.pl').       % predicats pour gerer des arbres bin. de recherche   
2
+:- include('taquin.pl').    % predicats definissant le systeme a etudier
3
+
4
+main :-
5
+    % Calcul de H pour la situation de départ
6
+    initial_state(U0),
7
+    heuristique(U0, H0),
8
+
9
+	% initialisations Pf, Pu et Q 
10
+    insert([ [H0, H0, 0], U0 ], nil, Pf),
11
+    insert([U0, [H0, H0, 0], nil, nil], nil, Pu),
12
+    empty(Q),
13
+	!,
14
+	
15
+	% lancement de Aetoile
16
+    aetoile(Pf, Pu, Q).
17
+
18
+%*******************************************************************************
19
+
20
+afficher_solution(_, nil).
21
+
22
+afficher_solution(Q, S) :-
23
+    belongs([S, [_,_,G], Pere, Action], Q),
24
+    !,
25
+    write_state(S),
26
+    print(Action),
27
+    print(' ('),
28
+    print(G),
29
+    print(')'),
30
+    nl, nl,
31
+    afficher_solution(Q, Pere).
32
+
33
+%*******************************************************************************
34
+
35
+% Cas arbres vides -> plus d'état à développer -> pas de solution
36
+aetoile(Pf, _, _) :-
37
+    empty(Pf),
38
+    !,
39
+    print('Pas de solution : l\'état final n\'est pas atteignable !\n').
40
+
41
+% Cas état final -> solution trouvée
42
+aetoile(Pf, Pu, Q) :-
43
+	suppress_min([[F, H, G], Sf], Pf, _),
44
+    final_state(Sf),
45
+    !,
46
+	suppress([Sf, [F, H, G], Pere, A], Pu, _),
47
+	insert([Sf, [F, H, G], Pere, A], Q, Q1),
48
+    print('Solution trouvée :\n'),
49
+    afficher_solution(Q1, Sf).
50
+
51
+aetoile(Pf, Pu, Q) :-
52
+	suppress_min([[F, H, G], S], Pf, Pf1),
53
+	suppress([S, [F, H, G], Pere, A], Pu, Pu1),
54
+    expand(S, G, Successors),
55
+    loop_successors(Successors, S, Pf1, Pu1, Q, Pf2, Pu2),
56
+    insert([S, [F, H, G], Pere, A], Q, Q1),
57
+    aetoile(Pf2, Pu2, Q1).
58
+    
59
+%*******************************************************************************
60
+
61
+expand(S, Gs, Successors) :-
62
+    findall([Successor, [F, H, G], Action], (
63
+        rule(Action, Cost, S, Successor),
64
+        G is Gs + Cost,
65
+        heuristique(Successor, H),
66
+        F is G + H
67
+    ), Successors).
68
+
69
+%*******************************************************************************
70
+
71
+% Cas pas de successseurs
72
+loop_successors([], _,Pf, Pu, _, Pf, Pu) :- !.
73
+
74
+% Cas successeur déjà traité : on ignore
75
+loop_successors([[S,_,_] | Rest], Pere, Pf, Pu, Q, Pf_new, Pu_new) :-
76
+    belongs([S,_,_,_], Q),
77
+    %!,
78
+    loop_successors(Rest, Pere, Pf, Pu, Q, Pf_new, Pu_new),
79
+    !.
80
+
81
+% Cas successeur déjà connu : on met à jour le coût
82
+loop_successors([[S, [F, H, G], Action] | Rest], Pere, Pf, Pu, Q, Pf_new, Pu_new) :-
83
+    belongs([S, [F_old,_,_], _, _], Pu),
84
+    %!,
85
+    update_trees(S, H, [F, G, Pere, Action], F_old, Pf, Pf1, Pu, Pu1),
86
+    loop_successors(Rest, Pere, Pf1, Pu1, Q, Pf_new, Pu_new), 
87
+    !.
88
+
89
+% Cas successeur inconnu : on l'ajoute à P
90
+loop_successors([[S, [F, H, G], Action] | Rest], Pere, Pf, Pu, Q, Pf_new, Pu_new) :-
91
+    insert([S, [F, H, G], Pere, Action], Pu, Pu1),
92
+    insert([[F, H, G], S], Pf, Pf1),
93
+    loop_successors(Rest, Pere, Pf1, Pu1, Q, Pf_new, Pu_new).
94
+
95
+%*******************************************************************************
96
+
97
+% Mise à jour des coûts et des parents seulement si plus faible
98
+update_trees(S, H, [F, G, Pere, Action], F_old, Pf, Pf2, Pu, Pu2) :-
99
+    (F_old is min(F, F_old) -> 
100
+		Pf = Pf2,
101
+		Pu = Pu2
102
+	;
103
+		suppress([S,_,_,_], Pu, Pu1),
104
+		insert([S, [F, H, G], Pere, Action], Pu1, Pu2),
105
+		suppress([[F_old,_,_], S], Pf, Pf1),
106
+		insert([[F, H, G], S], Pf1, Pf2)
107
+	).

+ 367
- 0
tp1/avl.pl View File

@@ -0,0 +1,367 @@
1
+%***************************
2
+% Gestion d'un AVL en Prolog
3
+%***************************
4
+
5
+%***************************
6
+% INSA TOULOUSE - P.ESQUIROL
7
+% mars 2017
8
+%***************************
9
+
10
+%*************************
11
+% unit tests          : OK
12
+% integration aetoile : OK
13
+%*************************
14
+
15
+% Les AVL sont des arbres BINAIRES DE RECHERCHE H-EQUILIBRES : 
16
+% La hauteur de l'avl A est définie par :
17
+%  -1, si A est vide (A=nil)
18
+%  1 + max( hauteur(ss_arbre_gauche(A)), hauteur(ss_arbre_droitee(A)) ) sinon
19
+
20
+% Tout noeud de l'arbre est soit :
21
+% - une feuille
22
+% - un noeud interne tel que la différence de hauteur entre le sous-arbre droit
23
+% 	et le sous-arbre gauche appartient à  [-1,0,+1]
24
+
25
+
26
+%***********************************************
27
+% PREDICATS EXPORTES ET COMPLEXITE ALGORITHMIQUE
28
+%***********************************************
29
+% soit N = nombre de noeuds de l'arbre				%   UTILITE POUR A*
30
+%													%   ----------------													
31
+% empty(?Avl)						O(1)			%<<< initialisation de P et Q
32
+% height(+Avl, ?Height)             O(1)			
33
+% put_flat(+Avl)                    O(N)			
34
+% put_90(+Avl)                      O(N)			
35
+% belongs(+Elem, +Avl)              O(log N)		%<<< appartenance d'un noeud à Q
36
+% subtree(+Elem, +Avl, Ss_Avl)      O(log N)
37
+% insert(+Elem, +Avant, ?Apres)     O(log N)		%<<< insertion d'un nouveau noeud dans P ou dans Q
38
+% suppress(+Elem,+Avant,?Apres)     O(log N)		%<<< mise  à jour <=> suppression puis insertion
39
+% suppress_min(?Min,+Avant,?Apres)  O(log N)		%<<< supression du noeud minimal
40
+% suppress_max(?Max,+Avant,?Apres)  O(log N)
41
+
42
+%****************************
43
+% Prédicats internes (prives)
44
+%****************************
45
+
46
+% left_rotate(+Avant, ?Apres)		O(1)
47
+% right_rotate(+Avant, ?Apres)		O(1)
48
+% left_balance(+Avant, ?Apres)      O(1)
49
+% right_balance(+Avant, ?Apres)     O(1)
50
+
51
+
52
+
53
+	%------------------------------
54
+	% Constructeur et test AVL vide
55
+	%------------------------------
56
+
57
+empty(nil).
58
+
59
+	%-----------------
60
+	% Hauteur d'un AVL
61
+	%-----------------
62
+	% par convention, un avl vide a une hauteur de -1
63
+	% sinon la hauteur est enregistree au meme niveau que la racine de l'avl
64
+	% elle n'est pas calculee recursivement "from scratch"
65
+	% elle est mise à jour de façon incrémentale, apres chaque insertion ou suppression
66
+	% d'ou sa complexité en O(1)  :-)
67
+
68
+height(nil,             -1).
69
+height(avl(_G,_R,_D, H), H).
70
+
71
+	%-------------------
72
+	% Affichage d'un AVL
73
+	%-------------------
74
+	% dans l'ordre croissant (lexicographique)
75
+
76
+put_flat(nil).
77
+put_flat(avl(G,R,D,_H)) :-
78
+	put_flat(G),
79
+	nl, write(R), 
80
+	put_flat(D).
81
+
82
+	%----------------------------
83
+	% Affichage (couché) d'un AVL
84
+	%----------------------------
85
+
86
+put_90(Avl) :-
87
+	nl, writeln('----------------------------------'),
88
+	put_90(Avl,"").
89
+
90
+put_90(nil,Str) :-
91
+	write(Str), write('.').
92
+put_90(avl(G,R,D,_H),Str) :-
93
+	append_strings(Str, "   ", Str2),
94
+	put_90(D,Str2),
95
+	nl, write(Str), write(R),nl,
96
+	put_90(G,Str2).
97
+
98
+	%-----------------------------------------
99
+	% Appartenance d'un element donne a un AVL	
100
+	%-----------------------------------------
101
+
102
+belongs(Elem, avl(G,Racine,D,_Hauteur)) :-
103
+	(Elem = Racine ->
104
+		true
105
+	;
106
+		(Elem @< Racine ->
107
+			belongs(Elem, G)
108
+		;
109
+			belongs(Elem, D) 		%Racine @< Elem
110
+		)
111
+	).
112
+	
113
+	%------------------------------------------------------------
114
+	% Recherche du sous-arbre qui a comme racine un element donne	
115
+	%------------------------------------------------------------
116
+
117
+subtree(Elem, avl(G,Racine,D,H), A) :-
118
+	(Elem = Racine ->
119
+		A = avl(G,Racine,D,H)
120
+	;
121
+		(Elem @< Racine ->
122
+			subtree(Elem,G,A)
123
+		;
124
+			subtree(Elem,D,A) 		%Racine @< Elem
125
+		)
126
+	).
127
+	
128
+	%----------------------
129
+	% Rotations dans un avl
130
+	%----------------------
131
+	% Les rotations ci-dessous décrivent uniquement les cas ou la rotation est possible.
132
+	% Dans les autres cas, ces relations échouent ; plus précisément :
133
+	% a/ si l'arbre est un avl vide, alors aucune rotation n'est possible ;
134
+	% b/ si l'arbre est un avl non vide mais si son ss-arbre gauche est un avl vide
135
+	%    alors la rotation droite n'est pas possible ;
136
+	% c/ si l'arbre est un avl non vide mais si son ss-arbre droite est un avl vide
137
+	%    alors la rotation gauche n'est pas possible.
138
+
139
+right_rotate(avl(G,R,D,_H), A_Apres) :-
140
+	height(D,HD),
141
+	G       = avl(SG,RG,SD,_HG),
142
+	height(SD,HSD),
143
+	H_Inter is 1 + max(HSD, HD),
144
+	Inter   = avl(SD,R,D,H_Inter),
145
+	height(SG,HSG),
146
+	H_Apres is 1 + max(HSG,H_Inter),
147
+	A_Apres = avl(SG,RG,Inter,H_Apres).
148
+	
149
+left_rotate(avl(G,R,D,_), A_Apres) :-
150
+	height(G,HG),
151
+	D       = avl(SG,RD,SD,_),
152
+	height(SG,HSG),
153
+	H_Inter is 1 + max(HSG, HG),
154
+	Inter   = avl(G,R,SG,H_Inter),
155
+	height(SD,HSD),
156
+	H_Apres is 1 + max(H_Inter,HSD),
157
+	A_Apres = avl(Inter,RD,SD,H_Apres).	
158
+
159
+	%---------------------------------
160
+	% Insertion equilibree dans un avl
161
+	%---------------------------------
162
+	% On suppose que l'arbre avant insertion est equilibré (difference de hauteur
163
+	% entre les ss-arbres gauche et droite de 1 au maximum)
164
+	% L'insertion doit assurer qu'apres insertion l'arbre est toujours equilibre
165
+	% sinon les rotations necessaires sont effectuees.
166
+
167
+	% On suppose que les noeuds contiennent des informations que l'on peut comparer
168
+	% a l'aide d'une relation d'ordre lexicographique (la cle c'est l'info elle-meme)
169
+	% En prolog, c'est la relation '@<'
170
+	% On peut comparer par exemple des integer, des string, des constantes,
171
+	% des listes d'entiers, des listes de constantes, etc ... bref, des termes clos
172
+	% T1 @< T2 est vrai si T1 est lexicographiquement inférieur a T2.
173
+
174
+insert(Elem, nil, avl(nil,Elem,nil,0)).
175
+insert(Elem, AVL, NEW_AVL) :-
176
+	AVL = avl(Gauche,Racine,Droite,_Hauteur),
177
+	(Elem = Racine ->
178
+			% l'élément est déjà present, pas d'insertion possible
179
+		fail
180
+	;
181
+		(Elem @< Racine ->
182
+			% insertion dans le ss-arbre gauche
183
+			insert(Elem, Gauche, New_Gauche),
184
+			height(New_Gauche, New_HG),
185
+			height(Droite, HD),
186
+			H_Int is 1+max(New_HG, HD),
187
+			AVL_INT = avl(New_Gauche, Racine, Droite, H_Int), 
188
+			right_balance(AVL_INT, NEW_AVL)
189
+		;
190
+	    % Elem @> Racine
191
+			% insertion dans le ss-arbre droite
192
+			insert(Elem, Droite, New_Droite),
193
+			height(New_Droite, New_HD),
194
+			height(Gauche, HG),
195
+			H_Int is 1+max(New_HD, HG),
196
+			AVL_INT =avl(Gauche, Racine,New_Droite, H_Int),
197
+			left_balance(AVL_INT, NEW_AVL)
198
+		)
199
+	).
200
+	
201
+	%------------------------------------------------
202
+	% Suppression d'un element quelconque dans un avl
203
+	%------------------------------------------------
204
+	% On suppose que l'élément à supprimer appartient bien à l'AVL,
205
+	% sinon le predicat échoue (en particulier si l'AVL est vide).
206
+	
207
+suppress(Elem, AVL, NEW_AVL) :-
208
+	AVL = avl(Gauche, Racine, Droite, _Hauteur),
209
+	(Elem = Racine ->
210
+		% cas de la suppression de la racine de l'avl
211
+		(Gauche = nil -> % cas simple d'une feuille ou d'un avl sans fils gauche
212
+			NEW_AVL = Droite
213
+		; 
214
+			(Droite = nil -> % cas simple d'un avl avec fils gauche mais sans fils droit
215
+				NEW_AVL = Gauche
216
+			;
217
+				% cas d'un avl avec fils gauche ET fils droit 
218
+				%Gauche \= nil
219
+				%Droite \= nil
220
+				suppress_max(Max, Gauche, New_Gauche),
221
+				AVL_INT = avl(New_Gauche,Max,Droite,_),
222
+				left_balance(AVL_INT, NEW_AVL)
223
+			)
224
+		)
225
+	;
226
+		% cas des suppressions d'un element autre que la racine 
227
+		(Elem @< Racine ->
228
+			% suppression dans le ss-arbre gauche
229
+			suppress(Elem, Gauche, New_Gauche),
230
+			AVL_INT = avl(New_Gauche, Racine, Droite,_),
231
+			left_balance(AVL_INT, NEW_AVL)
232
+		;
233
+		%Racine @< Droite
234
+			% suppression dans le ss-arbre droite 
235
+			suppress(Elem, Droite, New_Droite),
236
+			AVL_INT = avl(Gauche, Racine, New_Droite,_),
237
+			right_balance(AVL_INT, NEW_AVL)
238
+		)
239
+	).
240
+	
241
+	%-------------------------------------------------------
242
+	% Suppression du plus petit element dans un avl non vide
243
+	%-------------------------------------------------------
244
+	% Si l'avl est vide, le prédicat échoue
245
+
246
+suppress_min(Min, AVL, NEW_AVL) :-
247
+	AVL = avl(Gauche,Racine,Droite, _Hauteur),
248
+	(Gauche = nil ->
249
+		Min = Racine,
250
+		NEW_AVL = Droite
251
+	;
252
+		% Gauche \= nil
253
+		suppress_min(Min, Gauche, New_Gauche),
254
+		AVL_INT = avl(New_Gauche, Racine, Droite,_),
255
+		left_balance(AVL_INT, NEW_AVL)
256
+	).
257
+
258
+	%-------------------------------------------------------
259
+	% Suppression du plus grand element dans un avl non vide
260
+	%-------------------------------------------------------
261
+	% Si l'avl est vide, le prédicat échoue
262
+
263
+suppress_max(Max, AVL, NEW_AVL) :-
264
+	AVL = avl(Gauche,Racine,Droite, _Hauteur),
265
+	(Droite = nil ->
266
+		Max = Racine,
267
+		NEW_AVL = Gauche
268
+	;
269
+		% Droite \= nil
270
+		suppress_max(Max, Droite, New_Droite),
271
+		AVL_INT = avl(Gauche, Racine, New_Droite,_),
272
+		right_balance(AVL_INT, NEW_AVL)
273
+	).
274
+	
275
+	%----------------------------------------
276
+	% Re-equilibrages d'un avl vers la gauche
277
+	%----------------------------------------
278
+	% - soit apres insertion   d'un element dans le sous-arbre droite
279
+	% - soit apres suppression d'un élément dans le sous-arbre gauche
280
+	%----------------------------------------------------------------
281
+
282
+left_balance(Avl, New_Avl) :-
283
+	Avl = avl(Gauche, Racine, Droite, _Hauteur),
284
+	height(Gauche, HG),
285
+	height(Droite, HD),
286
+	(HG is HD-2 ->
287
+	% le sous-arbre droite est trop haut 
288
+		Droite = avl(G_Droite, _R_Droite, D_Droite, _HD),
289
+		height(G_Droite, HGD),
290
+		height(D_Droite, HDD),
291
+		(HDD > HGD ->
292
+		% une simple rotation gauche suffit
293
+			left_rotate(Avl, New_Avl)
294
+		;
295
+		% il faut faire une rotation droite_gauche
296
+			right_rotate(Droite, New_Droite),
297
+			height(New_Droite, New_HD),
298
+			H_Int is 1+ max(HG, New_HD),
299
+			Avl_Int = avl(Gauche, Racine, New_Droite, H_Int),
300
+			left_rotate(Avl_Int, New_Avl)
301
+		)
302
+	;
303
+	% la suppression n'a pas desequilibre l'avl
304
+		New_Hauteur is 1+max(HG,HD),
305
+		New_Avl = avl(Gauche, Racine, Droite, New_Hauteur)
306
+	).
307
+
308
+	%----------------------------------------
309
+	% Re-equilibrages d'un avl vers la droite
310
+	%----------------------------------------
311
+	% - soit apres insertion   d'un element dans le sous-arbre gauche
312
+	% - soit apres suppression d'un élément dans le sous-arbre droite
313
+	%----------------------------------------------------------------
314
+	
315
+right_balance(Avl, New_Avl) :-
316
+	Avl = avl(Gauche, Racine, Droite, _Hauteur),
317
+	height(Gauche, HG),
318
+	height(Droite, HD),
319
+	(HD is HG-2 ->
320
+	% le sous-arbre gauche est trop haut 
321
+		Gauche = avl(G_Gauche, _R_Gauche, D_Gauche, _HG),
322
+		height(G_Gauche, HGG),
323
+		height(D_Gauche, HDG),
324
+		(HGG > HDG ->
325
+		% une simple rotation droite suffit
326
+			right_rotate(Avl, New_Avl)
327
+		;
328
+		% il faut faire une rotation gauche_droite
329
+			left_rotate(Gauche, New_Gauche),
330
+			height(New_Gauche, New_HG),
331
+			H_Int is 1+ max(New_HG, HD),
332
+			Avl_Int = avl(New_Gauche, Racine, Droite, H_Int),
333
+			right_rotate(Avl_Int, New_Avl)
334
+		)
335
+	;
336
+	% la suppression n'a pas desequilibre l'avl
337
+		New_Hauteur is 1+max(HG,HD),
338
+		New_Avl = avl(Gauche, Racine, Droite, New_Hauteur)
339
+	).
340
+	
341
+%-----------------------------------------
342
+% Arbres utilises pour les tests unitaires
343
+%-----------------------------------------
344
+avl_test(1, nil).
345
+avl_test(2, avl(nil, 1, nil,              0)).
346
+avl_test(3, avl(nil, 1, avl(nil,2,nil,0), 1)).
347
+avl_test(4, avl(avl(nil,1,nil,0),2, nil,  1)).
348
+avl_test(5, avl(avl(nil,1,nil,0), 2, avl(nil,3,nil,0),1)	).
349
+avl_test(6, avl(avl(nil,5,nil,0), 6, avl(nil,7,nil,0),1)	).
350
+avl_test(7,  avl(G,4,D,2)) :-
351
+	avl_test(5,G),
352
+	avl_test(6,D).
353
+avl_test(8, avl(G,5,D,2)) :-
354
+	D = avl(nil,6,nil,0),
355
+	avl_test(3,G).
356
+avl_test(9, avl(G,3,D,2)) :-
357
+	G = avl(nil,1,nil,0),
358
+	avl_test(4,D).
359
+	
360
+/* Test uniquement valable avec ECLiPSe
361
+
362
+avl_test(10, Final) :-
363
+   empty(Init),
364
+   (for(I,1,20), fromto(Init,In,Out,Final) do
365
+     insert(I,In,Out)
366
+   ).
367
+*/

+ 177
- 0
tp1/taquin.pl View File

@@ -0,0 +1,177 @@
1
+/*
2
+Doit contenir au moins 4 predicats qui seront utilises par A*
3
+   etat_initial(I)                                         % definit l'etat initial
4
+   etat_final(F)                                           % definit l'etat final  
5
+   rule(Rule_Name, Rule_Cost, Before_State, After_State)   % règles applicables
6
+   heuristique(Current_State, Hval)				           % calcul de l'heuristique 
7
+*/
8
+
9
+%********************
10
+% ETAT INITIAL DU JEU
11
+%********************   
12
+% format :  initial_state(+State) ou State est une matrice (liste de listes)
13
+   
14
+/*
15
+initial_state([ [b, h, c],       % C'EST L'EXEMPLE PRIS EN COURS
16
+                [a, f, d],       % 
17
+                [g,vide,e] ]).   % h1=4,   h2=5,   f*=5*/
18
+
19
+/*
20
+
21
+initial_state([ [ a, b, c],        
22
+                [ g, h, d],
23
+                [vide,f, e] ]). % h2=2, f*=2
24
+
25
+initial_state([ [b, c, d],
26
+                [a,vide,g],
27
+                [f, h, e]  ]). % h2=10 f*=10
28
+			
29
+initial_state([ [f, g, a],
30
+                [h,vide,b],
31
+                [d, c, e]  ]). % h2=16, f*=20
32
+initial_state([ [e, f, g],
33
+                [d,vide,h],
34
+                [c, b, a]  ]). % h2=24, f*=30 
35
+*/
36
+/*
37
+initial_state([ [a, b, c],
38
+                [g,vide,d],
39
+                [h, f, e]]). % etat non connexe avec l'etat final (PAS DE SOLUTION)
40
+  
41
+*/
42
+initial_state([[ d , l , n , g ],
43
+               [ vide , b , a , c ],
44
+               [ e , m , k , h ],
45
+               [ j , f , i , o]]).
46
+
47
+%******************
48
+% ETAT FINAL DU JEU
49
+%******************
50
+% format :  final_state(+State) ou State est une matrice (liste de listes)
51
+
52
+/*
53
+final_state([ [a, b,  c],
54
+			  [h,vide,d],
55
+              [g, f,  e]]). % etat non connexe avec l'etat final (PAS DE SOLUTION)
56
+*/
57
+final_state([[ a , b , c , d ],
58
+             [ e , f , g , h ],
59
+             [ i , j , k , l ],
60
+             [ m , n , o , vide]]).
61
+
62
+%********************
63
+% AFFICHAGE D'UN ETAT
64
+%********************
65
+% format : write_state(?State) ou State est une liste de lignes a afficher
66
+write_state([]).
67
+write_state([Line|Rest]) :-
68
+   print(Line),
69
+   nl,
70
+   write_state(Rest).
71
+
72
+%**********************************************
73
+% REGLES DE DEPLACEMENT (up, down, left, right)             
74
+%**********************************************
75
+% format : rule(+Rule_Name, ?Rule_Cost, +Current_State, ?Next_State)
76
+rule(down , 1, S1, S2) :-
77
+   vertical_permutation(_X,vide,S1,S2).
78
+
79
+rule(up   , 1, S1, S2) :-
80
+   vertical_permutation(vide,_X,S1,S2).
81
+
82
+rule(right, 1, S1, S2) :-
83
+   horizontal_permutation(_X,vide,S1,S2).
84
+
85
+rule(left , 1, S1, S2) :-
86
+   horizontal_permutation(vide,_X,S1,S2).
87
+
88
+%***********************
89
+% Deplacement horizontal            
90
+%***********************
91
+% format : horizontal_permutation(?Piece1,?Piece2,+Current_State, ?Next_State)
92
+horizontal_permutation(X,Y,S1,S2) :-
93
+   append(Above,[Line1|Rest], S1),
94
+   exchange(X,Y,Line1,Line2),
95
+   append(Above,[Line2|Rest], S2).
96
+
97
+%***********************************************
98
+% Echange de 2 objets consecutifs dans une liste             
99
+%***********************************************
100
+exchange(X,Y,[X,Y|List], [Y,X|List]).
101
+exchange(X,Y,[Z|List1],  [Z|List2] ):-
102
+   exchange(X,Y,List1,List2).
103
+
104
+%*********************
105
+% Deplacement vertical            
106
+%*********************
107
+vertical_permutation(X,Y,S1,S2) :-
108
+   append(Above, [Line1,Line2|Below], S1), % decompose S1
109
+   delete(N,X,Line1,Rest1),    % enleve X en position N a Line1,   donne Rest1
110
+   delete(N,Y,Line2,Rest2),    % enleve Y en position N a Line2,   donne Rest2
111
+   delete(N,Y,Line3,Rest1),    % insere Y en position N dans Rest1 donne Line3
112
+   delete(N,X,Line4,Rest2),    % insere X en position N dans Rest2 donne Line4
113
+   append(Above, [Line3,Line4|Below], S2). % recompose S2 
114
+
115
+%***********************************************************************
116
+% Retrait d'une occurrence X en position N dans une liste L (resultat R) 
117
+%***********************************************************************
118
+% use case 1 :   delete(?N,?X,+L,?R)
119
+% use case 2 :   delete(?N,?X,?L,+R)   
120
+delete(1,X,[X|L], L).
121
+delete(N,X,[Y|L], [Y|R]) :-
122
+   delete(N1,X,L,R),
123
+   N is N1 + 1.
124
+
125
+%*******************************************************************
126
+% Coordonnees X(colonne),Y(Ligne) d'une piece P dans une situation U
127
+%*******************************************************************
128
+% Associe un état State et une pièce P à ses coordonnées X et Y
129
+coordonnees(State, P, X, Y) :-
130
+        nth1(Y, State, Ligne),
131
+        nth1(X, Ligne, P).
132
+										 
133
+%*************
134
+% HEURISTIQUES
135
+%*************
136
+heuristique(U,H) :-
137
+   heuristique2(U, H). 
138
+   
139
+%****************
140
+%HEURISTIQUE 1
141
+%****************
142
+% Nombre de pieces mal placees dans l'etat courant U
143
+% par rapport a l'etat final F
144
+heuristique1(U, H) :- 
145
+    final_state(F),
146
+    findall([X, Y], meme_piece(U, F, X, Y), BienPlacees),
147
+    length(BienPlacees, NbBienPlacees),
148
+    length(U, N),
149
+    H is N*N - NbBienPlacees.	% On considère que les taquins seront toujours carré
150
+
151
+% Détermine si la pièce aux coord X,Y en S1 est la même que celle en S2
152
+meme_piece(S1, S2, X, Y) :-
153
+    coordonnees(S1, P, X, Y),
154
+    coordonnees(S2, P, X, Y),
155
+    P \= vide,
156
+    !.
157
+
158
+% Cas particulier : on ne compte pas 'vide'
159
+meme_piece(S1, _, X, Y) :-
160
+    coordonnees(S1, vide, X, Y).
161
+
162
+%****************
163
+%HEURISTIQUE no 2
164
+%****************
165
+% Somme des distances de Manhattan à parcourir par chaque piece
166
+% entre sa position courante et sa positon dans l'etat final
167
+heuristique2(U, H) :- 
168
+    final_state(F),
169
+    findall(Dist, manhattan(U, F, _, Dist), ListDist),
170
+    sum_list(ListDist, H).
171
+
172
+manhattan(S1, S2, P, Dist) :-
173
+    coordonnees(S1, P, X1, Y1),
174
+    coordonnees(S2, P, X2, Y2),
175
+	P \= vide,
176
+    Dist is abs(X1 - X2) + abs(Y1 - Y2).
177
+    

+ 125
- 0
tp2/negamax.pl View File

@@ -0,0 +1,125 @@
1
+:- include('tictactoe.pl'). 
2
+
3
+% Algorithme MinMax avec convention Negamax. Retourne pour un joueur J donné, devant jouer dans une situation donnée Etat, de profondeur donnée P, le meilleur couple [Coup, Valeur] apres une analyse pouvant aller jusqu'à la profondeur Pmax.
4
+
5
+% Cas 1 : Profondeur max atteinte -> éval par heuristique
6
+negamax(J, Etat, P, Pmax, [rien, Val]) :-
7
+    P >= Pmax, 
8
+    !,
9
+    heuristique(J, Etat, Val).
10
+
11
+% Cas 2 : Aucun coup possible -> éval par heuristique
12
+negamax(J, Etat, _, _, [rien, Val]) :-
13
+    successeurs(J, Etat, Succ),
14
+    length(Succ, 0),
15
+    !,
16
+    heuristique(J, Etat, Val).
17
+
18
+% Cas 3 : Évaluation du sous-arbre et retour du meilleur couple [Coup, Valeur]
19
+negamax(J, Etat, P, Pmax, [Coup, Val]) :-
20
+    successeurs(J, Etat, Succ),
21
+    !,
22
+    loop_negamax(J, P, Pmax, Succ, ListCouples),
23
+    meilleur(ListCouples, [Coup, V1]),
24
+    Val is -V1.
25
+    
26
+%*******************************************************
27
+
28
+% retourne la liste des couples [Coup, Etat_Suivant] pour la situation Etat
29
+successeurs(J, Etat, Succ) :-
30
+	copy_term(Etat, Etat_Suiv),
31
+	findall([Coup,Etat_Suiv],
32
+		    successeur(J, Etat_Suiv, Coup),
33
+		    Succ).
34
+		    
35
+testSuccesseur :-
36
+	situation_initiale(S),
37
+	successeurs(x, S, LSucc),
38
+	forall(member([Coup, Succ], LSucc), 
39
+		(write(Coup), nl, 
40
+		printState(Succ), nl)
41
+	).
42
+
43
+%*******************************************************
44
+
45
+% retourne la liste des couples [Coup, Valeur_Situation_Suivante] à partir de la liste des [Coup, Situation_Suivante], en appliquant l'algorithme negamax sur chacun d'entre eux.
46
+loop_negamax(_, _, _ ,[], []) :- !.
47
+
48
+loop_negamax(J, P, Pmax, [[Coup, Suiv] | Succ], [[Coup, Vsuiv] | Reste_Couples]) :-
49
+	% Récursion pour traiter le reste des successeurs
50
+	loop_negamax(J, P, Pmax, Succ, Reste_Couples),
51
+	% Récupération de l'adversaire de J
52
+	adversaire(J, A),
53
+	% Incrément de la profondeur avant l'appel de négamax
54
+	Pnew is P+1,
55
+	% Calcul de la valeur de negamax pour la situation Suiv.
56
+	% On n'a pas besoin de connaitre le coup de l'adversaire en profondeur P+1 qui donne cette valeur, seul le coup de J en P nous intéresse (et on le connait déjà). D'ou le _ dans les arguments passés à negamax.
57
+	negamax(A, Suiv, Pnew, Pmax, [_, Vsuiv]).
58
+
59
+%*******************************************************
60
+
61
+% Retourne le couple [Coup, Valeur] dont la valeur est la plus faible (car convention negamax)
62
+meilleur([E], E) :- !.
63
+
64
+meilleur([[C,V] | RestCouples], [BestC, BestV]) :-
65
+    meilleur(RestCouples, [TempC, TempV]),
66
+    min([TempC,TempV], [C,V], [BestC, BestV]).
67
+    
68
+min([C1,V1], [C2,V2], [C,V]) :-
69
+	(V1 < V2) -> 
70
+		V = V1,
71
+		C = C1
72
+	;
73
+		V = V2,
74
+		C = C2.
75
+
76
+testMeilleur :-
77
+	meilleur([[[1,2], -5], [[3,2], 2], [[3,3], -6], [[1,1], 7]], [[3,3], -6]),
78
+	meilleur([[[1,2], 5]], [[1,2], 5]).
79
+
80
+%*******************************************************
81
+
82
+% Retourne le coup et la valeur retournés par Negamax depuis l'état initial
83
+main(BestMove, Value, Pmax) :-
84
+	situation_initiale(S0),
85
+	joueur_initial(J),
86
+	negamax(J, S0, 1, Pmax, [BestMove, Value]).
87
+
88
+% Bug pour I = 9
89
+testMain :-
90
+	forall(between(1, 9, I), (
91
+		main(B, V, I),
92
+		write('I = '), write(I), nl,
93
+		write('B = '), write(B), nl,
94
+		write('V = '), write(V), nl, nl
95
+	)).
96
+	
97
+%*******************************************************
98
+
99
+% Applique Negamax et joue le coup suggéré successivement jusqu'à remplissage de la grille
100
+testNegamax :-
101
+	situation_initiale(S0),
102
+	joueur_initial(J),
103
+	iter(J, S0).
104
+	
105
+iter(_, S) :-
106
+	situation_terminale(S),
107
+	!,
108
+	write('Match nul !'), nl.
109
+	
110
+iter(_, S) :-
111
+	alignement(Ali, S),
112
+	alignement_gagnant(Ali, J), 
113
+	!,
114
+	write(Ali), nl,
115
+	write(S), nl,
116
+	write(J), write(' a gagné !'), nl.
117
+	
118
+iter(J, S) :-
119
+	negamax(J, S, 1, 9, [BestMove, Val]),
120
+	successeur(J, S, BestMove),
121
+	write(BestMove), write(' -> '), write(Val), nl,
122
+	printState(S), nl,
123
+	adversaire(J, A),
124
+	iter(A, S).
125
+	

+ 191
- 0
tp2/tictactoe.pl View File

@@ -0,0 +1,191 @@
1
+/*********************************
2
+DESCRIPTION DU JEU DU TIC-TAC-TOE
3
+*********************************/
4
+
5
+situation_initiale([ [_,_,_],
6
+                     [_,_,_],
7
+                     [_,_,_] ]) .
8
+
9
+% Convention (arbitraire) : c'est x qui commence
10
+joueur_initial(x).
11
+
12
+% Definition de la relation adversaire/2
13
+adversaire(x,o).
14
+adversaire(o,x).
15
+
16
+situation_terminale(Situation) :-
17
+	ground(Situation).
18
+
19
+/***************************
20
+DEFINITIONS D'UN ALIGNEMENT
21
+***************************/
22
+alignement(L, Matrix) :- ligne(L,Matrix).
23
+alignement(C, Matrix) :- colonne(C,Matrix).
24
+alignement(D, Matrix) :- diagonale(D,Matrix).
25
+
26
+ligne(L, M) :- 
27
+	nth1(_, M, L).
28
+ 
29
+colonne(C, M) :-
30
+    colonne(C, M, _).
31
+
32
+colonne([E | Crest], [L | Mrest], Ncol) :-
33
+    nth1(Ncol, L, E),
34
+    colonne(Crest, Mrest, Ncol).
35
+
36
+colonne([], [], _).
37
+		
38
+diagonale(D, M) :- 
39
+	premiere_diag(1,D,M).
40
+
41
+diagonale(D, M) :-
42
+    length(M, N),
43
+   	seconde_diag(N,D,M).
44
+	
45
+premiere_diag(_, [], []).
46
+premiere_diag(K, [E | D], [Ligne | M]) :-
47
+	nth1(K, Ligne, E),
48
+	K1 is K + 1,
49
+	premiere_diag(K1, D, M).
50
+
51
+seconde_diag(_,[],[]).
52
+seconde_diag(K, [E | D], [Ligne | M]) :-
53
+	nth1(K, Ligne, E),
54
+	K1 is K - 1,
55
+	seconde_diag(K1, D, M).
56
+
57
+% Alignement potentiel possible pour le joueur J
58
+possible([X | L], J) :- unifiable(X, J), possible(L, J), !.
59
+possible([], _).
60
+
61
+unifiable(X, _) :- 
62
+    var(X),
63
+    !.
64
+unifiable(_, J) :- 
65
+    var(J), 
66
+    !.
67
+unifiable(X, J) :- 
68
+    X == J.
69
+
70
+% Vérifie que Ali est un alignement gagnant pour J
71
+alignement_gagnant(Ali, J) :- 
72
+    ground(Ali),
73
+    maplist(=(J), Ali).
74
+
75
+% Un alignement perdant pour J est un alignement gagnant pour son adversaire
76
+alignement_perdant(Ali, J) :- 
77
+    adversaire(J, O),
78
+    alignement_gagnant(Ali, O).
79
+
80
+
81
+/* ****************************
82
+DEFINITION D'UN ETAT SUCCESSEUR
83
+****************************** */
84
+successeur(J, Etat, [Nl, Nc]) :- 
85
+     nth1(Nl, Etat, L),
86
+     nth1(Nc, L, Current),
87
+     \+ ground(Current),
88
+     Current = J.
89
+
90
+/**************************************
91
+EVALUATION HEURISTIQUE D'UNE SITUATION
92
+**************************************/
93
+
94
+/*
95
+1/ l'heuristique est +infini si la situation J est gagnante pour J
96
+2/ l'heuristique est -infini si la situation J est perdante pour J
97
+3/ sinon, on fait la difference entre :
98
+	le nombre d'alignements possibles pour J
99
+moins
100
+	le nombre d'alignements possibles pour l'adversaire de J
101
+*/
102
+
103
+%1
104
+heuristique(J, Situation, H) :-
105
+    alignement(Alig, Situation),
106
+    alignement_gagnant(Alig, J),
107
+    H = 10000,				% grand nombre approximant +infini
108
+    !.
109
+
110
+% 2
111
+heuristique(J, Situation, H) :-
112
+    alignement(Alig, Situation),
113
+    alignement_perdant(Alig, J),
114
+    H = -10000,				% grand nombre approximant -infini
115
+    !.
116
+
117
+% 3
118
+heuristique(J, Situation, H) :-    % cas 3
119
+    findall(Alig, alignement(Alig, Situation), L),
120
+    adversaire(J, O),
121
+    findall(AligPoss, (member(AligPoss, L), possible(AligPoss, J)), LpossJ),
122
+    findall(AligPoss, (member(AligPoss, L), possible(AligPoss, O)), LpossO),
123
+    length(LpossJ, NbJ),
124
+    length(LpossO, NbO),
125
+    H is NbJ - NbO.
126
+    
127
+% Affiche la grille
128
+printState([]).
129
+printState([R | Rest]) :-
130
+	printRow(R),
131
+	nl,
132
+	printState(Rest).
133
+	
134
+printRow([]).
135
+printRow([X | Rest]) :-
136
+	(ground(X) ->
137
+		write(X) 
138
+	;
139
+		write('_')
140
+	),
141
+	printRow(Rest).
142
+	
143
+	
144
+% ----- Tests unitaires -----
145
+
146
+testPossible :-
147
+	A = [_,_,_], 
148
+	possible(A, x),
149
+	B = [x,_,x], 
150
+	possible(B, x),
151
+	C = [_,o,x], 
152
+	\+ possible(C, x).
153
+	
154
+testAlignementGagnant :-
155
+	A = [o,x,o],
156
+	B = [o,_,o],
157
+	C = [o,o,o],
158
+	\+ alignement_gagnant(A, o),
159
+	\+ alignement_gagnant(B, o),
160
+	\+ alignement_gagnant(A, _).
161
+	alignement_gagnant(C, o),
162
+	alignement_gagnant(C, J),
163
+	J == o,
164
+
165
+testHeuristique :-
166
+    LS = [
167
+          [[[ _,_,_ ],
168
+            [ _,_,_ ],
169
+            [ _,_,_ ]], 0],
170
+
171
+          [[[ _,_,_ ],
172
+            [ _,o,_ ],
173
+            [ _,_,_ ]], 4],
174
+
175
+          [[[ x,x,o ],
176
+            [ o,o,x ],
177
+            [ x,o,x ]], 0],
178
+            
179
+          [[[ x,_,_ ],
180
+            [ o,o,x ],
181
+            [ x,o,x ]], -1],
182
+
183
+          [[[ x,x,x ],
184
+            [ o,o,x ],
185
+            [ x,o,o ]], -10000]
186
+         ],
187
+    forall(member([S, Ho], LS), (
188
+        heuristique(o, S, Ho),
189
+        Hx is -Ho,
190
+        heuristique(x, S, Hx)
191
+    )).

Loading…
Cancel
Save