]> AND Private Git Repository - cours-maths-dis.git/blob - tpProlog/diaballik/prolog/diaballik.pl
Logo AND Algorithmique Numérique Distribuée

Private GIT Repository
ajout fichier pch
[cours-maths-dis.git] / tpProlog / diaballik / prolog / diaballik.pl
1 :-use_module(library(clpfd)).
2 :- assert(lookahead(2)).
3 :- dynamic spy/0.  % debug calls to alpha_beta
4 :- assert(spy).    % Comment out stop spy.
5
6
7 /* init7(Coul,Jeu),successeurs(Jeu,Coul,L),length(L,N),aff_coup_possible(L). 
8 init3(Coul,Jeu),successeurs(Jeu,Coul,L),length(L,N),aff_coup_possible(L).
9 init5(Coul,Jeu),successeurs(Jeu,Coul,L),length(L,N),aff_coup_possible(L). */
10
11 /***************/
12 /* aritmétique */
13 /***************/
14
15 abs(X,X):-
16     X >= 0. 
17 abs(X,A):-
18     A is 0 - X.
19
20 min(X,Y,X):-
21     X =< Y. 
22 min(_,Y,Y). 
23
24 max(X,Y,X):-
25     X > Y .
26 max(_,Y,Y). 
27
28
29
30 /* types de case 
31   v : vide
32   b : blanc
33   n : noire
34   bb: blanc + balle 
35   nb: noire + balle
36 */
37     
38
39 /*****************************/
40 /* Colonnes, lignes et cases */
41 /*****************************/
42
43 /* accesseurs sur ligne et colonne*/
44
45 ligcol(1,[A,_,_,_,_,_,_],A).
46 ligcol(2,[_,A,_,_,_,_,_],A).
47 ligcol(3,[_,_,A,_,_,_,_],A).
48 ligcol(4,[_,_,_,A,_,_,_],A).
49 ligcol(5,[_,_,_,_,A,_,_],A).
50 ligcol(6,[_,_,_,_,_,A,_],A).
51 ligcol(7,[_,_,_,_,_,_,A],A).
52
53 ligcol(1,[A,_,_,_,_],A).
54 ligcol(2,[_,A,_,_,_],A).
55 ligcol(3,[_,_,A,_,_],A).
56 ligcol(4,[_,_,_,A,_],A).
57 ligcol(5,[_,_,_,_,A],A).
58
59 ligcol(1,[A,_,_],A).
60 ligcol(2,[_,A,_],A).
61 ligcol(3,[_,_,A],A).
62
63
64
65
66
67
68
69
70 /* retourne le contenu "Contenu_case" de la case  
71 situé à la colonne "Col" et la ligne "Lig" du jeux en cours
72 "Contenu_jeu" */
73  
74 case(Lig,Col,Contenu_jeu,Contenu_case) :- 
75     ligcol(Lig,Contenu_jeu,Ligne),
76     ligcol(Col,Ligne,Contenu_case).
77
78
79
80
81 changeContenuLigCol(1,X,[_,B,C,D,E,F,G],[X,B,C,D,E,F,G]).
82 changeContenuLigCol(2,X,[A,_,C,D,E,F,G],[A,X,C,D,E,F,G]).
83 changeContenuLigCol(3,X,[A,B,_,D,E,F,G],[A,B,X,D,E,F,G]).
84 changeContenuLigCol(4,X,[A,B,C,_,E,F,G],[A,B,C,X,E,F,G]).
85 changeContenuLigCol(5,X,[A,B,C,D,_,F,G],[A,B,C,D,X,F,G]).
86 changeContenuLigCol(6,X,[A,B,C,D,E,_,G],[A,B,C,D,E,X,G]).
87 changeContenuLigCol(7,X,[A,B,C,D,E,F,_],[A,B,C,D,E,F,X]).
88
89 changeContenuLigCol(1,X,[_,B,C,D,E],[X,B,C,D,E]).
90 changeContenuLigCol(2,X,[A,_,C,D,E],[A,X,C,D,E]).
91 changeContenuLigCol(3,X,[A,B,_,D,E],[A,B,X,D,E]).
92 changeContenuLigCol(4,X,[A,B,C,_,E],[A,B,C,X,E]).
93 changeContenuLigCol(5,X,[A,B,C,D,_],[A,B,C,D,X]).
94
95 changeContenuLigCol(1,X,[_,B,C],[X,B,C]).
96 changeContenuLigCol(2,X,[A,_,C],[A,X,C]).
97 changeContenuLigCol(3,X,[A,B,_],[A,B,X]).
98
99
100
101
102
103 changeContenu(Conf1,Piece,Y,X,Conf2):-
104     ligcol(Y,Conf1,Ligne),
105     changeContenuLigCol(X,Piece,Ligne,Lignep),
106     changeContenuLigCol(Y,Lignep,Conf1,Conf2).
107
108
109
110     
111 sans_balle(b).
112 sans_balle(n).
113
114
115 /*********************/
116 /* position initiale */
117 /*********************/
118
119 init7(b,
120      [[b,b,b,bb,b,b,b], 
121       [v,v,v,v,v,v,v],
122       [v,v,v,v,v,v,v],
123       [v,v,v,v,v,v,v],
124       [v,v,v,v,v,v,v],
125       [v,v,v,v,v,v,v], 
126       [n,n,n,nb,n,n,n]]).
127
128 init7_2(b,
129      [[b,n,b,bb,b,n,b], 
130       [v,v,v,v,v,v,v],
131       [v,v,v,v,v,v,v],
132       [v,v,v,v,v,v,v],
133       [v,v,v,v,v,v,v],
134       [v,v,v,v,v,v,v], 
135       [n,b,n,nb,n,b,n]]).
136
137 init7_test1(b,
138      [[v,n,v,v,v,n,b],  
139       [v,v,v,v,v,v,v],
140       [b,v,b,b,b,bb,v],
141       [v,v,v,v,v,v,v],
142       [v,v,v,v,v,v,v],
143       [v,v,v,v,n,b,n], 
144       [n,v,n,nb,v,v,v]]).
145
146
147 init7_test_victoire(b,
148      [[v,n,v,v,v,n,b],  
149       [v,v,v,v,v,v,v],
150       [b,v,b,b,b,b,v],
151       [v,v,v,v,v,v,v],
152       [v,v,v,v,v,v,v],
153       [v,v,v,v,n,b,n], 
154       [n,bb,n,nb,v,v,v]]).
155
156 init7_test_victoire2(b,
157      [[v,n,v,v,v,nb,b], 
158       [v,v,v,v,v,v,v],
159       [b,v,b,v,b,b,v],
160       [v,v,v,v,v,v,v],
161       [v,v,v,v,v,v,v],
162       [v,v,v,v,n,b,n], 
163       [n,bb,n,n,v,v,v]]).
164
165
166 init5(b,
167      [[b,b,bb,b,b],     
168       [v,v,v,v,v],
169       [v,v,v,v,v],
170       [v,v,v,v,v], 
171       [n,n,nb,n,n]]).
172
173 init5_2(b,
174      [[n,b,bb,b,n],     
175       [v,v,v,v,v],
176       [v,v,v,v,v],
177       [v,v,v,v,v], 
178       [b,n,nb,n,b]]).
179
180
181 init3(b,
182      [[b,bb,b], 
183       [v,v,v],
184       [n,nb,n]]).
185
186 init3_2(b,
187      [[n,bb,n], 
188       [v,v,v],
189       [b,nb,b]]).
190
191
192
193
194
195 /* affichage */
196
197 affligne:-write('-----------------------------'),nl.
198
199 affiche(Jeu):-
200     affligne,
201     affiche2(Jeu).
202
203 affiche2([]).
204
205 affiche2([Prem_ligne|Reste]):-
206     write('|'),affpions(Prem_ligne),nl,affligne,
207     affiche2(Reste).
208
209 affpions([]).
210
211 affpions([b|R]):-
212     write(' b |'),
213     affpions(R).
214
215 affpions([v|R]):-
216     write('   |'),
217     affpions(R).
218
219 affpions([n|R]):-
220     write(' n |'),
221     affpions(R).
222
223 affpions([bb|R]):-
224     write(' bb|'),
225     affpions(R).
226
227 affpions([nb|R]):-
228     write(' nb|'),
229     affpions(R).
230
231
232
233
234 aff_coup_possible([]).
235
236 aff_coup_possible([P|R]):-
237     affiche(P),
238     aff_coup_possible(R).
239
240
241 /* victoire */
242
243
244 test_victoire(Coul,Jeu,true):-
245                 victoire(Coul,Jeu).
246
247 test_victoire(Coul,Jeu,false):-
248                 not(victoire(Coul,Jeu)).
249
250
251
252 victoire(n,Contenu_jeu):-            
253     case(1,_,Contenu_jeu,nb).   
254
255 victoire(b,Contenu_jeu):-
256     case(7,_,Contenu_jeu,bb).
257
258
259 /*************************/
260 /* deplacement possibles */
261 /*************************/
262
263 deplacement(0,_,Contenu_jeu,Contenu_jeu).
264
265
266 /*monter un */ 
267 deplacement(1,Coul,Contenu_jeu,Nouv_Contenu_jeu):-
268     case(Lig,Col,Contenu_jeu,Coul),
269     Ligp is Lig-1, Ligp >= 1, 
270     case(Ligp,Col,Contenu_jeu,v),
271                 changeContenu(Contenu_jeu,v,Lig,Col,Contenu_jeu1),
272                 changeContenu(Contenu_jeu1,Coul,Ligp,Col,Nouv_Contenu_jeu).
273
274
275 /*gauche un */ 
276 deplacement(1,Coul,Contenu_jeu,Nouv_Contenu_jeu):-
277     case(Lig,Col,Contenu_jeu,Coul),
278     Colp is Col-1, Colp >= 1, 
279     case(Lig,Colp,Contenu_jeu,v),
280                 changeContenu(Contenu_jeu,v,Lig,Col,Contenu_jeu1),
281                 changeContenu(Contenu_jeu1,Coul,Lig,Colp,Nouv_Contenu_jeu).
282
283
284
285
286 /* descendre */
287
288 depl(X,Coul,Contenu_jeu,Nouv_Contenu_jeu):-
289                 deplacement(X,Coul,Contenu_jeu,Nouv_Contenu_jeu).
290 depl(X,Coul,Contenu_jeu,Nouv_Contenu_jeu):-
291                 deplacement(X,Coul,Nouv_Contenu_jeu,Contenu_jeu).
292
293
294 /*************************/
295 /* lancer de balle       */
296 /*************************/
297
298 amis(n,n).
299
300 amis(n,v).
301 amis(b,b).
302
303 amis(b,v).
304
305
306 ma_couleur(b,b).
307 ma_couleur(b,bb).
308
309 ma_couleur(n,n).
310 ma_couleur(n,nb).
311
312 balon(n,nb).
313 balon(b,bb).
314
315 aucun_adversaire_ligne(_,_,_,_,0).
316 aucun_adversaire_ligne(Coul,Lig,Col,Contenu_jeu,Delta):-      
317     Colp is Col + Delta, 
318     case(Lig,Colp,Contenu_jeu,Coulp),
319     amis(Coul,Coulp),
320     Deltap is Delta -1,
321     aucun_adversaire_ligne(Coul,Lig,Col,Contenu_jeu,Deltap).
322
323 aucun_adversaire_col(_,_,_,_,0).
324 aucun_adversaire_col(Coul,Lig,Col,Contenu_jeu,Delta):-
325     Ligp is Lig + Delta, 
326     case(Ligp,Col,Contenu_jeu,Coulp),
327     amis(Coul,Coulp),
328     Deltap is Delta -1,
329     aucun_adversaire_col(Coul,Lig,Col,Contenu_jeu,Deltap).
330
331
332
333
334
335 sign(x,1):- x >= 0.
336 sign(x,-1):- x < 0.
337
338
339 aucun_adversaire_diag1(_,_,_,_,0).
340 aucun_adversaire_diag1(Coul,Lig,Col,Contenu_jeu,Delta):-
341     Ligp is Lig + Delta, Colp is Col + Delta,
342     case(Ligp,Colp,Contenu_jeu,Coulp),
343     amis(Coul,Coulp),
344                 sign(Delta,s),
345     Deltap is Delta -s,
346     aucun_adversaire_diag1(Coul,Lig,Col,Contenu_jeu,Deltap).
347
348 aucun_adversaire_diag2(_,_,_,_,0).
349 aucun_adversaire_diag2(Coul,Lig,Col,Contenu_jeu,Delta):-
350     Ligp is Lig + Delta, Colp is Col - Delta,
351     case(Ligp,Colp,Contenu_jeu,Coulp),
352     amis(Coul,Coulp),
353                 sign(Delta,s),
354     Deltap is Delta -s,
355     aucun_adversaire_diag2(Coul,Lig,Col,Contenu_jeu,Deltap).
356
357
358
359
360
361 /* horizontal */
362 lancerh(Coul,Contenu_jeu,Nouv_Contenu_jeu):-       
363     balon(Coul,Coulb),
364     case(Lig,Col,Contenu_jeu,Coulb),
365     case(Lig,Colp,Contenu_jeu,Coul),
366     min(Col,Colp,Min),
367     max(Col,Colp,Max),
368     Delta is Max-Min -1,
369     aucun_adversaire_ligne(Coul,Lig,Min,Contenu_jeu,Delta),
370
371                 changeContenu(Contenu_jeu,Coul,Lig,Col,Contenu_jeu1),
372                 changeContenu(Contenu_jeu1,Coulb,Lig,Colp,Nouv_Contenu_jeu).
373
374 /*    case(Lig,Col,Nouv_Contenu_jeu,Coul),
375     case(Lig,Colp,Nouv_Contenu_jeu,Coulb).*/
376     
377
378 /* vertical */
379 lancerv(Coul,Contenu_jeu,Nouv_Contenu_jeu):-
380     balon(Coul,Coulb),
381     case(Lig,Col,Contenu_jeu,Coulb),
382     case(Ligp,Col,Contenu_jeu,Coul),
383     min(Lig,Ligp,Min),
384     max(Lig,Ligp,Max),
385     Delta is Max-Min -1,
386     aucun_adversaire_col(Coul,Lig,Min,Contenu_jeu,Delta),
387    
388                 changeContenu(Contenu_jeu,Coul,Lig,Col,Contenu_jeu1),
389                 changeContenu(Contenu_jeu1,Coulb,Ligp,Col,Nouv_Contenu_jeu).
390                 /*case(Lig,Col,Nouv_Contenu_jeu,Coul),
391     case(Ligp,Col,Nouv_Contenu_jeu,Coulb).*/
392
393
394 /* diag haut droite */
395 lancerd1(Coul,Contenu_jeu,Nouv_Contenu_jeu):-
396     balon(Coul,Coulb),
397     case(Lig,Col,Contenu_jeu,Coulb),
398     case(Ligp,Colp,Contenu_jeu,Coul),
399     Delta is Ligp-Lig -1,
400     Delta is Colp-Col -1,
401     aucun_adversaire_diag1(Coul,Lig,Col,Contenu_jeu,Delta),
402                 
403                 changeContenu(Contenu_jeu,Coul,Lig,Col,Contenu_jeu1),
404                 changeContenu(Contenu_jeu1,Coulb,Ligp,Colp,Nouv_Contenu_jeu).
405
406     /*case(Lig,Col,Nouv_Contenu_jeu,Coul),
407     case(Ligp,Colp,Nouv_Contenu_jeu,Coulb).*/
408     
409
410
411
412
413 /* diag haut gauche */
414 lancerd2(Coul,Contenu_jeu,Nouv_Contenu_jeu):-
415     balon(Coul,Coulb),
416     case(Lig,Col,Contenu_jeu,Coulb),
417     case(Ligp,Colp,Contenu_jeu,Coul),
418     Delta is -(Ligp-Lig -1),
419     Delta is Colp-Col -1,
420     aucun_adversaire_diag2(Coul,Lig,Col,Contenu_jeu,Delta),
421     
422                 changeContenu(Contenu_jeu,Coul,Lig,Col,Contenu_jeu1),
423                 changeContenu(Contenu_jeu1,Coulb,Ligp,Colp,Nouv_Contenu_jeu).
424
425     /*case(Lig,Col,Nouv_Contenu_jeu,Coul),
426     case(Ligp,Colp,Nouv_Contenu_jeu,Coulb).*/
427
428     
429
430
431 lancer(0,_,Contenu_jeu,Contenu_jeu).
432
433 lancer(1,Coul,Contenu_jeu,Nouv_Contenu_jeu):-
434                 lancerv(Coul,Contenu_jeu,Nouv_Contenu_jeu);
435     lancerh(Coul,Contenu_jeu,Nouv_Contenu_jeu);
436     lancerd1(Coul,Contenu_jeu,Nouv_Contenu_jeu);
437     lancerd2(Coul,Contenu_jeu,Nouv_Contenu_jeu).
438
439
440
441 coup(Coul,Contenu_Jeu,Nouv_Contenu_jeu):-
442                 lancer(L1,Coul,Contenu_Jeu,Contenu_jeu1),
443                 depl(D1,Coul,Contenu_jeu1,Contenu_jeu2),
444                 lancer(L2,Coul,Contenu_jeu2,Contenu_jeu3),
445                 depl(D2,Coul,Contenu_jeu3,Contenu_jeu4),
446                 lancer(L3,Coul,Contenu_jeu4,Nouv_Contenu_jeu),
447                 L is L1+L2+L3,
448                 L=<1,
449                 D is    D1+D2,
450                 D =< 2.
451
452 /* tour */
453 joueur_suivant(n,b).
454 joueur_suivant(b,n).
455
456
457
458
459 /************ TODO à affiner **********/
460
461
462 valeur(Conf,1000):-
463     victoire(b,Conf).
464
465 valeur(Conf,T):-
466     victoire(n,Conf),
467     T is -1000.
468
469 valeur(Conf,T):-
470     valeur_b(Conf,T1),
471     valeur_n(Conf,T2),
472     T is T1 + T2.
473
474
475 valeur_b(Conf,T):- 
476     maplist(nb_ele(b),Conf,L1),
477     length(Conf,N),
478     numlist(1,N,L2),
479     maplist(poids_ligne,L1,L2,L3),
480     sumlist(L3,T),!.
481
482
483 valeur_n(Conf,Tp):- 
484     maplist(nb_ele(n),Conf,L1),
485     length(Conf,N),
486     numlist(1,N,L2),
487     maplist(poids_ligne2(N),L1,L2,L3),
488     sumlist(L3,T),
489     Tp is -T,
490     !.
491
492
493     /* pour une ligne de poids X, de rang Y, son poids est N */
494 poids_ligne(X,Y,N):-
495     N is 10*X*Y,!.
496
497
498 poids_ligne2(N,X,Y,R):-
499     R is (N+1-Y)*10*X,!.
500
501     /*nbre d elements N de la couleur Coul dans la liste L */
502 nb_ele(Coul,L,N):-
503     sublist(ma_couleur(Coul),L,Lp),
504     length(Lp,N).
505
506 successeurs(N,Coul,L) :- 
507     findall(NP,coup(Coul,N,NP),Lp),
508     list_to_set(Lp,Lpp),
509     filtre_sym(Lpp,L),
510     length(L,Taille),
511     maplist(valeur,L,L2),
512     write(L2),
513     writef('successeurs de taille %w \n',[Taille]).
514
515     /*
516       choisit la meilleur conf à partir de Conf parmi les susccesseurs 
517       alpha est la valeur minimum estimée jusqu'à présent
518       beta  est la valeur maximum estimée jusqu'à présent
519     */
520
521 evaluate_and_choose(Coul,[Succ|Succs],Conf,Depth,Alpha,Beta,Record,MeilleurSuccVal):-
522     joueur_suivant(Coul,Coulp),
523     alpha_beta(Coulp,Depth,Succ,Alpha,Beta,_,Valeur),
524     /*writef(' Conf : %w \n Valeur : %w \n\n',[Succ,Valeur]),*/
525     Valeurp is -Valeur,
526     cutoff(Coul,Succ,Valeurp,Depth,Alpha,Beta,Succs,Conf,Record,MeilleurSuccVal).
527
528 evaluate_and_choose(_,[],_,_,Alpha,_,Record,(Record,Alpha)).
529
530
531 /* implantation alpha beta du minimax */
532 alpha_beta(_,0,Conf,_,_,_,Valeur) :- 
533     valeur(Conf,Valeur).
534
535 alpha_beta(Coul,Depth,Conf,Alpha,Beta,Succ,Valeur) :- 
536     Depth > 0,
537     successeurs(Conf,Coul,Succs),
538     Alpha1 is -Beta,
539     Beta1 is -Alpha,
540     D1 is Depth-1, 
541     evaluate_and_choose(Coul,Succs,Conf,D1,Alpha1,Beta1,nil,(Succ,Valeur)).
542
543
544 cutoff(_,Succ,Valeur,_,_,Beta,_,_,_,(Succ,Valeur)):- 
545     writef('Valeur : %w  \n Beta : %w \n\n',[Valeur,Beta]), 
546     Valeur >= Beta,
547     write('Cutof 1 \n'),
548     !.
549 cutoff(Coul,Succ,Valeur,Depth,Alpha,Beta,Succs,Conf,_Record,MeilleurSuccVal):- 
550     writef('Valeur : %w   Beta : %w Alpha : %w \n\n',[Valeur,Beta,Alpha]), 
551     Alpha < Valeur, Valeur < Beta,
552     write('Cutof 2 \n'),
553     evaluate_and_choose(Coul,Succs,Conf,Depth,Valeur,Beta,Succ,MeilleurSuccVal).
554 cutoff(Coul,_,Valeur,Depth,Alpha,Beta,Succs,Conf,Record,MeilleurSuccVal) :- 
555     Valeur =< Alpha,!, 
556     evaluate_and_choose(Coul,Succs,Conf,Depth,Alpha,Beta,Record,MeilleurSuccVal).
557
558
559 symetrique(
560     [
561      [A1,A2,A3,A4,A5,A6,A7],
562      [B1,B2,B3,B4,B5,B6,B7],
563      [C1,C2,C3,C4,C5,C6,C7],
564      [D1,D2,D3,D4,D5,D6,D7],
565      [E1,E2,E3,E4,E5,E6,E7],
566      [F1,F2,F3,F4,F5,F6,F7],
567      [G1,G2,G3,G4,G5,G6,G7]],
568     [[A7,A6,A5,A4,A3,A2,A1],
569      [B7,B6,B5,B4,B3,B2,B1],
570      [C7,C6,C5,C4,C3,C2,C1],
571      [D7,D6,D5,D4,D3,D2,D1],
572      [E7,E6,E5,E4,E3,E2,E1],
573      [F7,F6,F5,F4,F3,F2,F1],
574      [G7,G6,G5,G4,G3,G2,G1]]).
575
576 symetrique(
577     [
578      [A1,A2,A3,A4,A5],
579      [B1,B2,B3,B4,B5],
580      [C1,C2,C3,C4,C5],
581      [D1,D2,D3,D4,D5],
582      [E1,E2,E3,E4,E5]],
583     [[A5,A4,A3,A2,A1],
584      [B5,B4,B3,B2,B1],
585      [C5,C4,C3,C2,C1],
586      [D5,D4,D3,D2,D1],
587      [E5,E4,E3,E2,E1]]).
588
589 symetrique(
590     [
591      [A1,A2,A3],
592      [B1,B2,B3],
593      [C1,C2,C3]],
594     [[A3,A2,A1],
595      [B3,B2,B1],
596      [C3,C2,C1]]).
597
598 non_symetrique_de(X,Y):- not(symetrique(X,Y)).
599
600 filtre_sym([],[]).
601 filtre_sym([X|T],[X|R]):-
602     sublist(non_symetrique_de(X),T,Ns),
603     filtre_sym(Ns,R).
604
605
606 /*
607 tour(Contenu_Jeu, Coul) :-
608                 victoire(Coul,Contenu_Jeu).
609
610 tour(Contenu_Jeu, Coul) :-
611                 coup(Coul,Contenu_Jeu,Nouv_Contenu_jeu),
612                 victoire(Coul,Nouv_Contenu_jeu).
613                 
614
615 tour(Contenu_Jeu, Coul) :-
616                 coup(Coul,Contenu_Jeu,Nouv_Contenu_jeu),
617                 joueur_suivant(Coul,Coulp),
618                 not(victoire(Coul,Nouv_Contenu_jeu)),
619                 tour(Nouv_Contenu_jeu,Coulp).
620 */
621
622
623
624