1 :- use_module(library(clpfd)).
2 :- use_module(library(lists)).
4 /* accesseurs sur ligne et colonne*/
78 line_abs([X|R],[Y|Rp]):-
83 conf_abs([X|R],[Y|Rp]):-
93 colonne(1,[A,_,_,_],A).
94 colonne(2,[_,A,_,_],A).
95 colonne(3,[_,_,A,_],A).
96 colonne(4,[_,_,_,A],A).
98 ligne(1,[A,_,_,_,_],A).
99 ligne(2,[_,A,_,_,_],A).
100 ligne(3,[_,_,A,_,_],A).
101 ligne(4,[_,_,_,A,_],A).
102 ligne(5,[_,_,_,_,A],A).
108 /* retourne le contenu "Contenu_case" de la case
109 situé à la colonne "Col" et la ligne "Lig" du jeux en cours
112 case(Lig,Col,Conf,Contenu) :-
113 ligne(Lig,Conf,Ligne),
114 colonne(Col,Ligne,Contenu).
117 changeContenuColonne(1,X,[_,B,C,D],[X,B,C,D]).
118 changeContenuColonne(2,X,[A,_,C,D],[A,X,C,D]).
119 changeContenuColonne(3,X,[A,B,_,D],[A,B,X,D]).
120 changeContenuColonne(4,X,[A,B,C,_],[A,B,C,X]).
123 changeContenuLigne(1,X,[_,B,C,D,E],[X,B,C,D,E]).
124 changeContenuLigne(2,X,[A,_,C,D,E],[A,X,C,D,E]).
125 changeContenuLigne(3,X,[A,B,_,D,E],[A,B,X,D,E]).
126 changeContenuLigne(4,X,[A,B,C,_,E],[A,B,C,X,E]).
127 changeContenuLigne(5,X,[A,B,C,D,_],[A,B,C,D,X]).
131 changeContenu(Conf1,Piece,Y,X,Conf2):-
132 ligne(Y,Conf1,Ligne),
133 changeContenuColonne(X,Piece,Ligne,Lignep),
134 changeContenuLigne(Y,Lignep,Conf1,Conf2).
141 equiv(X,Y),equiv(Y,Z).
143 ((piece(P1,jaunea1),piece(P2,jauneb1));
144 (piece(P1,noira1),piece(P2,noirb1))),
147 case(Lig1,Col1,Conf1,P1),
149 case(Lig2,Col2,Conf1,P2),
151 changeContenu(Conf1,P1,Lig2,Col2,Conf1b),
152 changeContenu(Conf1b,P1p,Lig2p,Col2,Conf1c),
153 changeContenu(Conf1c,P2,Lig1,Col1,Conf1d),
154 changeContenu(Conf1d,P2p,Lig1p,Col1,Conf2).
157 ((piece(P1,bois1),piece(P2,bois2));
158 (piece(P1,marron1),piece(P2,marron2))),
159 case(Lig1,Col1,Conf1,P1),
160 case(Lig2,Col2,Conf1,P2),
161 changeContenu(Conf1,P1,Lig2,Col2,Conf1b),
162 changeContenu(Conf1b,P2,Lig1,Col1,Conf2).
167 mapto_el([Xp|Lp],[X|L]):-
172 mapto([Xp|Lp],[X|L]):-
180 [jaunea1,rouge1,rouge2,jauneb1],
181 [jaunea2,rouge3,rouge4,jauneb2],
182 [noira1,blanc1,blanc2,noirb1],
183 [noira2,bois1,bois2,noirb2],
184 [marron1,vide1,vide2,marron2]]).
187 [jaunea1,rouge1,rouge2,jauneb1],
188 [jaunea2,rouge3,rouge4,jauneb2],
189 [blanc1,blanc2,marron1,noira1],
190 [bois1,noirb1,bois2,noira2],
191 [marron2,noirb2,vide1,vide2]]).
197 [jaunea1,rouge1,rouge2,jauneb1],
198 [jaunea2,rouge3,rouge4,jauneb2],
199 [noira1,blanc1,blanc2,noirb1],
200 [noira2,bois,bois,noirb2],
201 [marron1,vide1,vide2,marron2]]).
209 [_,rouge3,rouge4,_]]).
217 [_,noira2,noirb2,_]]).
227 case(Lig,Col,Conf,P),
231 case(Ligp,Col,Conf,Pp).
233 case(Lig,Col,Conf,P),
237 case(Ligp,Col,Conf,Pp).
239 case(Lig,Col,Conf,P),
243 case(Ligp,Col,Conf,Pp).
245 case(Lig,Col,Conf,P),
249 case(Ligp,Col,Conf,Pp).
251 case(Lig,Col,Conf,P1),
258 case(Lig,Colp,Conf,P2),
259 case(Ligp,Col,Conf,P3),
260 case(Ligp,Colp,Conf,P4).
262 case(Lig,Col,Conf,P),
266 case(Lig,Colp,Conf,Pp).
271 jauneaOK(Conf),jaunebOK(Conf),noiraOK(Conf),noirbOK(Conf),rougeOK(Conf),
275 /*** Une configuration est correcte si
276 - chaque case est remplie
277 - avec une piece différente
278 - en respectant les contraintes de couleur
281 Conf = [[A1,A2,A3,A4],
286 ins([A1,A2,A3,A4,B1,B2,B3,B4,C1,C2,C3,C4,D1,D2,D3,D4,E1,E2,E3,E4],
288 all_distinct([A1,A2,A3,A4,B1,B2,B3,B4,C1,C2,C3,C4,D1,D2,D3,D4,E1,E2,E3,E4]),
297 glissement(PR1,d,Conf1,Conf2):-
298 case(Lig,Col,Conf1,PR1),
306 case(Lig,Colpp,Conf1,PV1),
307 case(Ligp,Colpp,Conf1,PV2),
308 ((piece(PV1,vide1),piece(PV1,vide2));
309 (piece(PV2,vide2),piece(PV2,vide1))),
310 changeContenu(Conf1,PR1,Lig,Colp,Conf1a),
311 changeContenu(Conf1a,PR2,Lig,Colpp,Conf1b),
312 changeContenu(Conf1b,PV1,Lig,Col,Conf1c),
313 changeContenu(Conf1c,PR3,Ligp,Colp,Conf1d),
314 changeContenu(Conf1d,PR4,Ligp,Colpp,Conf1e),
315 changeContenu(Conf1e,PV2,Ligp,Col,Conf2).
318 glissement(PR1,g,Conf1,Conf2):-
319 case(Lig,Col,Conf1,PR1),
327 case(Lig,Colm,Conf1,PV1),
328 case(Ligp,Colm,Conf1,PV2),
329 ((piece(PV1,vide1),piece(PV2,vide2));
330 (piece(PV1,vide2),piece(PV2,vide1))),
331 changeContenu(Conf1,PR1,Lig,Colm,Conf1a),
332 changeContenu(Conf1a,PR2,Lig,Col,Conf1b),
333 changeContenu(Conf1b,PV1,Lig,Colp,Conf1c),
334 changeContenu(Conf1c,PR3,Ligp,Colm,Conf1d),
335 changeContenu(Conf1d,PR4,Ligp,Col,Conf1e),
336 changeContenu(Conf1e,PV2,Ligp,Colp,Conf2).
339 glissement(PR1,b,Conf1,Conf2):-
340 case(Lig,Col,Conf1,PR1),
348 case(Ligpp,Col,Conf1,PV1),
349 case(Ligpp,Colp,Conf1,PV2),
350 ((piece(PV1,vide1),piece(PV2,vide2));
351 (piece(PV1,vide2),piece(PV2,vide1))),
352 changeContenu(Conf1,PR1,Ligp,Col,Conf1a),
353 changeContenu(Conf1a,PR2,Ligp,Colp,Conf1b),
354 changeContenu(Conf1b,PV1,Lig,Col,Conf1c),
355 changeContenu(Conf1c,PR3,Ligpp,Col,Conf1d),
356 changeContenu(Conf1d,PR4,Ligpp,Colp,Conf1e),
357 changeContenu(Conf1e,PV2,Lig,Colp,Conf2).
361 glissement(PR1,h,Conf1,Conf2):-
362 case(Lig,Col,Conf1,PR1),
370 case(Ligm,Col,Conf1,PV1),
371 case(Ligm,Colp,Conf1,PV2),
372 ((piece(PV1,vide1),piece(PV2,vide2));
373 (piece(PV1,vide2),piece(PV2,vide1))),
374 changeContenu(Conf1,PR1,Ligm,Col,Conf1a),
375 changeContenu(Conf1a,PR2,Ligm,Colp,Conf1b),
376 changeContenu(Conf1b,PV1,Ligp,Col,Conf1c),
377 changeContenu(Conf1c,PR3,Lig,Col,Conf1d),
378 changeContenu(Conf1d,PR4,Lig,Colp,Conf1e),
379 changeContenu(Conf1e,PV2,Ligp,Colp,Conf2).
385 /* glissement noir,jaune */
387 glissement(Pc1,d,Conf1,Conf2):-
388 case(Lig,Col,Conf1,Pc1),
389 (piece(Pc1,noira1);piece(Pc1,noirb1);piece(Pc1,jaunea1);piece(Pc1,jauneb1)),
393 case(Lig,Colp,Conf1,PV1),
394 case(Ligp,Colp,Conf1,PV2),
395 ((piece(PV1,vide1),piece(PV2,vide2));
396 (piece(PV1,vide2),piece(PV2,vide1))),
397 changeContenu(Conf1,Pc1,Lig,Colp,Conf1a),
398 changeContenu(Conf1a,Pc2,Ligp,Colp,Conf1b),
399 changeContenu(Conf1b,PV1,Lig,Col,Conf1c),
400 changeContenu(Conf1c,PV2,Ligp,Col,Conf2).
403 glissement(Pc1,g,Conf1,Conf2):-
404 case(Lig,Col,Conf1,Pc1),
405 (piece(Pc1,noira1);piece(Pc1,noirb1);piece(Pc1,jaunea1);piece(Pc1,jauneb1)),
409 case(Lig,Colp,Conf1,PV1),
410 case(Ligp,Colp,Conf1,PV2),
411 ((piece(PV1,vide1),piece(PV2,vide2));
412 (piece(PV1,vide2),piece(PV2,vide1))),
413 changeContenu(Conf1,Pc1,Lig,Colp,Conf1a),
414 changeContenu(Conf1a,Pc2,Ligp,Colp,Conf1b),
415 changeContenu(Conf1b,PV1,Lig,Col,Conf1c),
416 changeContenu(Conf1c,PV2,Ligp,Col,Conf2).
421 glissement(Pc1,b,Conf1,Conf2):-
422 case(Lig,Col,Conf1,Pc1),
423 (piece(Pc1,noira1);piece(Pc1,noirb1);piece(Pc1,jaunea1);piece(Pc1,jauneb1)),
427 case(Ligpp,Col,Conf1,PV),
428 (piece(PV,vide1);piece(PV,vide2)),
429 changeContenu(Conf1,Pc1,Ligp,Col,Conf1a),
430 changeContenu(Conf1a,Pc2,Ligpp,Col,Conf1b),
431 changeContenu(Conf1b,PV,Lig,Col,Conf2).
434 glissement(Pc1,h,Conf1,Conf2):-
435 case(Lig,Col,Conf1,Pc1),
436 (piece(Pc1,noira1);piece(Pc1,noirb1);piece(Pc1,jaunea1);piece(Pc1,jauneb1)),
440 case(Ligm,Col,Conf1,PV),
441 (piece(PV,vide1);piece(PV,vide2)),
442 changeContenu(Conf1,Pc1,Ligm,Col,Conf1a),
443 changeContenu(Conf1a,Pc2,Lig,Col,Conf1b),
444 changeContenu(Conf1b,PV,Ligp,Col,Conf2).
448 /* glissement du blanc */
450 glissement(PB1,d,Conf1,Conf2):-
451 case(Lig,Col,Conf1,PB1),
456 case(Lig,Colpp,Conf1,PV),
457 (piece(PV,vide1);piece(PV,vide2)),
458 changeContenu(Conf1,PB1,Lig,Colp,Conf1a),
459 changeContenu(Conf1a,PB2,Lig,Colpp,Conf1b),
460 changeContenu(Conf1b,PV,Lig,Col,Conf2).
463 glissement(PB1,g,Conf1,Conf2):-
464 case(Lig,Col,Conf1,PB1),
469 case(Lig,Colm,Conf1,PV),
470 (piece(PV,vide1);piece(PV,vide2)),
471 changeContenu(Conf1,PB1,Lig,Colm,Conf1a),
472 changeContenu(Conf1a,PB2,Lig,Col,Conf1b),
473 changeContenu(Conf1b,PV,Lig,Colp,Conf2).
477 glissement(PB1,b,Conf1,Conf2):-
478 case(Lig,Col,Conf1,PB1),
483 case(Ligp,Col,Conf1,PV1),
484 case(Ligp,Colp,Conf1,PV2),
485 ((piece(PV1,vide1),piece(PV2,vide2));
486 (piece(PV1,vide2),piece(PV2,vide1))),
487 changeContenu(Conf1,PB1,Ligp,Col,Conf1a),
488 changeContenu(Conf1a,PB2,Ligp,Colp,Conf1b),
489 changeContenu(Conf1b,PV1,Lig,Col,Conf1c),
490 changeContenu(Conf1c,PV2,Lig,Colp,Conf2).
494 glissement(PB1,h,Conf1,Conf2):-
495 case(Lig,Col,Conf1,PB1),
500 case(Ligm,Col,Conf1,PV1),
501 case(Ligm,Colp,Conf1,PV2),
502 ((piece(PV1,vide1),piece(PV2,vide2));
503 (piece(PV1,vide2),piece(PV2,vide1))),
504 changeContenu(Conf1,PB1,Ligm,Col,Conf1a),
505 changeContenu(Conf1a,PB2,Ligm,Colp,Conf1b),
506 changeContenu(Conf1b,PV1,Lig,Col,Conf1c),
507 changeContenu(Conf1c,PV2,Lig,Colp,Conf2).
512 glissement(PC,g,Conf1,Conf2):-
513 case(Lig,Col,Conf1,PC),
514 (piece(PC,bois1);piece(PC,bois2);piece(PC,marron1);piece(PC,marron2)),
516 case(Lig,Colp,Conf1,PV),
517 (piece(PV,vide1);piece(PV,vide2)),
518 changeContenu(Conf1,PC,Lig,Colp,Conf1a),
519 changeContenu(Conf1a,PV,Lig,Col,Conf2).
522 glissement(PC,d,Conf1,Conf2):-
523 case(Lig,Col,Conf1,PC),
524 (piece(PC,bois1);piece(PC,bois2);piece(PC,marron1);piece(PC,marron2)),
526 case(Lig,Colp,Conf1,PV),
527 (piece(PV,vide1);piece(PV,vide2)),
528 changeContenu(Conf1,PC,Lig,Colp,Conf1a),
529 changeContenu(Conf1a,PV,Lig,Col,Conf2).
534 glissement(PC,h,Conf1,Conf2):-
535 case(Lig,Col,Conf1,PC),
536 (piece(PC,bois1);piece(PC,bois2);piece(PC,marron1);piece(PC,marron2)),
538 case(Ligp,Col,Conf1,PV),
539 (piece(PV,vide1);piece(PV,vide2)),
540 changeContenu(Conf1,PC,Ligp,Col,Conf1a),
541 changeContenu(Conf1a,PV,Lig,Col,Conf2).
545 glissement(PC,b,Conf1,Conf2):-
546 case(Lig,Col,Conf1,PC),
547 (piece(PC,bois1);piece(PC,bois2);piece(PC,marron1);piece(PC,marron2)),
549 case(Ligp,Col,Conf1,PV),
550 (piece(PV,vide1);piece(PV,vide2)),
551 changeContenu(Conf1,PC,Ligp,Col,Conf1a),
552 changeContenu(Conf1a,PV,Lig,Col,Conf2).
556 /*resoud(Conf,[Conf]) :- init(Conf).
558 resoud(Conf,[Conf|Historique]) :-
560 glissement(Conf,Confp),
561 resoud(Confp,Historique),
562 not(member(Conf,Historique)).
572 /* ajoute la nouvelle paire (Conf, deplacements) à la fin en s'assurant
573 que la conf n'a pas encore été visitéé */
575 insert_fin((X,Y),[],[(X,Y)]).
576 insert_fin((X,_),[(Y,K)|R1],[(Y,K)|R1]):-
578 insert_fin(X,[T|R1],[T|R2]):-
581 insert_fin_liste([],L,L).
582 insert_fin_liste([X|R],L,Res):-
583 insert_fin_liste(R,L,Resp),
584 insert_fin(X,Resp,Res).
589 display_ligne([El|R]):-
595 display_conf([L|R]):-
603 display_conf_chemin((Conf,Chemin)):-
604 display_conf(Conf),display_chemin(Chemin).
606 display_conf_chemin_liste([]).
607 display_conf_chemin_liste([CL|R]):-
608 display_conf_chemin(CL),
610 display_conf_chemin_liste(R).
616 /* Tous les successeurs d une configuration */
617 successeurs((Confa,Chemins),L):-
619 (Confb,[(P,D)|Chemins]),
620 glissement(P,D,Confa,Confb),
624 successeurs_liste([],[]).
625 successeurs_liste([Ca|Cs],ConfsSucc):-
627 successeurs_liste(Cs,ConfsSuccInter),
628 insert_fin_liste(L,ConfsSuccInter,ConfsSucc).
631 /* regarde si le premier parametre appartient
632 à la liste donné en second parametre. Si c est le cas,
633 retourne le chemin */
636 appartient((Conf1,_),[(Conf2,_)|_]):-
637 equiv(Conf1,Conf2),!.
638 appartient((Conf1,C),[_|L]):-
639 appartient((Conf1,C),L).
642 difference([El|L1],L2,[El|Res]):-
643 difference(L1,L2,Res),
644 not(appartient(El,L2)).
645 difference([El|L1],L2,Res):-
646 difference(L1,L2,Res),
651 but([(Conf,Chemin)|_],Chemin):-final(Conf).
652 but([_|L],Chemin):-but(L,Chemin).
655 largeur(Atraiter,_,Res):-
657 largeur(Atraiter,Visites,Res):-
658 successeurs_liste(Atraiter,Succ),
659 difference(Succ,Visites,Atraiter2),
660 insert_fin_liste(Atraiter,Visites,Visites2),
661 largeur(Atraiter2,Visites2,Res).
666 largeur([(X,[])],[],Res).
681 ne_contient_pas_la_conf_finalle(X,L,Chemin),
682 successeurs_liste(L,Lp),