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.
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). */
39 /*****************************/
40 /* Colonnes, lignes et cases */
41 /*****************************/
43 /* accesseurs sur ligne et colonne*/
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).
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).
70 /* retourne le contenu "Contenu_case" de la case
71 situé à la colonne "Col" et la ligne "Lig" du jeux en cours
74 case(Lig,Col,Contenu_jeu,Contenu_case) :-
75 ligcol(Lig,Contenu_jeu,Ligne),
76 ligcol(Col,Ligne,Contenu_case).
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]).
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]).
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]).
103 changeContenu(Conf1,Piece,Y,X,Conf2):-
104 ligcol(Y,Conf1,Ligne),
105 changeContenuLigCol(X,Piece,Ligne,Lignep),
106 changeContenuLigCol(Y,Lignep,Conf1,Conf2).
115 /*********************/
116 /* position initiale */
117 /*********************/
147 init7_test_victoire(b,
156 init7_test_victoire2(b,
197 affligne:-write('-----------------------------'),nl.
205 affiche2([Prem_ligne|Reste]):-
206 write('|'),affpions(Prem_ligne),nl,affligne,
234 aff_coup_possible([]).
236 aff_coup_possible([P|R]):-
238 aff_coup_possible(R).
244 test_victoire(Coul,Jeu,true):-
247 test_victoire(Coul,Jeu,false):-
248 not(victoire(Coul,Jeu)).
252 victoire(n,Contenu_jeu):-
253 case(1,_,Contenu_jeu,nb).
255 victoire(b,Contenu_jeu):-
256 case(7,_,Contenu_jeu,bb).
259 /*************************/
260 /* deplacement possibles */
261 /*************************/
263 deplacement(0,_,Contenu_jeu,Contenu_jeu).
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).
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).
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).
294 /*************************/
295 /* lancer de balle */
296 /*************************/
315 aucun_adversaire_ligne(_,_,_,_,0).
316 aucun_adversaire_ligne(Coul,Lig,Col,Contenu_jeu,Delta):-
318 case(Lig,Colp,Contenu_jeu,Coulp),
321 aucun_adversaire_ligne(Coul,Lig,Col,Contenu_jeu,Deltap).
323 aucun_adversaire_col(_,_,_,_,0).
324 aucun_adversaire_col(Coul,Lig,Col,Contenu_jeu,Delta):-
326 case(Ligp,Col,Contenu_jeu,Coulp),
329 aucun_adversaire_col(Coul,Lig,Col,Contenu_jeu,Deltap).
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),
346 aucun_adversaire_diag1(Coul,Lig,Col,Contenu_jeu,Deltap).
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),
355 aucun_adversaire_diag2(Coul,Lig,Col,Contenu_jeu,Deltap).
362 lancerh(Coul,Contenu_jeu,Nouv_Contenu_jeu):-
364 case(Lig,Col,Contenu_jeu,Coulb),
365 case(Lig,Colp,Contenu_jeu,Coul),
369 aucun_adversaire_ligne(Coul,Lig,Min,Contenu_jeu,Delta),
371 changeContenu(Contenu_jeu,Coul,Lig,Col,Contenu_jeu1),
372 changeContenu(Contenu_jeu1,Coulb,Lig,Colp,Nouv_Contenu_jeu).
374 /* case(Lig,Col,Nouv_Contenu_jeu,Coul),
375 case(Lig,Colp,Nouv_Contenu_jeu,Coulb).*/
379 lancerv(Coul,Contenu_jeu,Nouv_Contenu_jeu):-
381 case(Lig,Col,Contenu_jeu,Coulb),
382 case(Ligp,Col,Contenu_jeu,Coul),
386 aucun_adversaire_col(Coul,Lig,Min,Contenu_jeu,Delta),
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).*/
394 /* diag haut droite */
395 lancerd1(Coul,Contenu_jeu,Nouv_Contenu_jeu):-
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),
403 changeContenu(Contenu_jeu,Coul,Lig,Col,Contenu_jeu1),
404 changeContenu(Contenu_jeu1,Coulb,Ligp,Colp,Nouv_Contenu_jeu).
406 /*case(Lig,Col,Nouv_Contenu_jeu,Coul),
407 case(Ligp,Colp,Nouv_Contenu_jeu,Coulb).*/
413 /* diag haut gauche */
414 lancerd2(Coul,Contenu_jeu,Nouv_Contenu_jeu):-
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),
422 changeContenu(Contenu_jeu,Coul,Lig,Col,Contenu_jeu1),
423 changeContenu(Contenu_jeu1,Coulb,Ligp,Colp,Nouv_Contenu_jeu).
425 /*case(Lig,Col,Nouv_Contenu_jeu,Coul),
426 case(Ligp,Colp,Nouv_Contenu_jeu,Coulb).*/
431 lancer(0,_,Contenu_jeu,Contenu_jeu).
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).
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),
459 /************ TODO à affiner **********/
476 maplist(nb_ele(b),Conf,L1),
479 maplist(poids_ligne,L1,L2,L3),
484 maplist(nb_ele(n),Conf,L1),
487 maplist(poids_ligne2(N),L1,L2,L3),
493 /* pour une ligne de poids X, de rang Y, son poids est N */
498 poids_ligne2(N,X,Y,R):-
501 /*nbre d elements N de la couleur Coul dans la liste L */
503 sublist(ma_couleur(Coul),L,Lp),
506 successeurs(N,Coul,L) :-
507 findall(NP,coup(Coul,N,NP),Lp),
511 maplist(valeur,L,L2),
513 writef('successeurs de taille %w \n',[Taille]).
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
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]),*/
526 cutoff(Coul,Succ,Valeurp,Depth,Alpha,Beta,Succs,Conf,Record,MeilleurSuccVal).
528 evaluate_and_choose(_,[],_,_,Alpha,_,Record,(Record,Alpha)).
531 /* implantation alpha beta du minimax */
532 alpha_beta(_,0,Conf,_,_,_,Valeur) :-
535 alpha_beta(Coul,Depth,Conf,Alpha,Beta,Succ,Valeur) :-
537 successeurs(Conf,Coul,Succs),
541 evaluate_and_choose(Coul,Succs,Conf,D1,Alpha1,Beta1,nil,(Succ,Valeur)).
544 cutoff(_,Succ,Valeur,_,_,Beta,_,_,_,(Succ,Valeur)):-
545 writef('Valeur : %w \n Beta : %w \n\n',[Valeur,Beta]),
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,
553 evaluate_and_choose(Coul,Succs,Conf,Depth,Valeur,Beta,Succ,MeilleurSuccVal).
554 cutoff(Coul,_,Valeur,Depth,Alpha,Beta,Succs,Conf,Record,MeilleurSuccVal) :-
556 evaluate_and_choose(Coul,Succs,Conf,Depth,Alpha,Beta,Record,MeilleurSuccVal).
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]]).
598 non_symetrique_de(X,Y):- not(symetrique(X,Y)).
601 filtre_sym([X|T],[X|R]):-
602 sublist(non_symetrique_de(X),T,Ns),
607 tour(Contenu_Jeu, Coul) :-
608 victoire(Coul,Contenu_Jeu).
610 tour(Contenu_Jeu, Coul) :-
611 coup(Coul,Contenu_Jeu,Nouv_Contenu_jeu),
612 victoire(Coul,Nouv_Contenu_jeu).
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).