:- use_module(library(clpfd)). :- use_module(library(lists)). /* accesseurs sur ligne et colonne*/ repr(1,'j'). repr(2,'j'). repr(3,'j'). repr(4,'j'). repr(5,'r'). repr(6,'r'). repr(7,'r'). repr(8,'r'). repr(9,'m'). repr(10,'m'). repr(11,'n'). repr(12,'n'). repr(13,'n'). repr(14,'n'). repr(15,'b'). repr(16,'b'). repr(17,'w'). repr(18,'w'). repr(19,' '). repr(20,' '). piece(1,jaunea1). piece(2,jaunea2). piece(3,jauneb1). piece(4,jauneb2). piece(5,rouge1). piece(6,rouge2). piece(7,rouge3). piece(8,rouge4). piece(9,marron1). piece(10,marron2). piece(11,noira1). piece(12,noira2). piece(13,noirb1). piece(14,noirb2). piece(15,blanc1). piece(16,blanc2). piece(17,bois1). piece(18,bois2). piece(19,vide1). piece(20,vide2). dir(d,1). dir(g,-1). dir(h,+1). dir(b,-1). piece_abs(1,1). piece_abs(2,1). piece_abs(3,1). piece_abs(4,1). piece_abs(5,5). piece_abs(6,5). piece_abs(7,5). piece_abs(8,5). piece_abs(9,9). piece_abs(10,9). piece_abs(11,11). piece_abs(12,11). piece_abs(13,11). piece_abs(14,11). piece_abs(15,15). piece_abs(16,15). piece_abs(17,9). piece_abs(18,9). piece_abs(19,19). piece_abs(20,19). line_abs([],[]). line_abs([X|R],[Y|Rp]):- line_abs(R,Rp), piece_abs(X,Y). conf_abs([],[]). conf_abs([X|R],[Y|Rp]):- conf_abs(R,Rp), line_abs(X,Y). equiv(Conf1,Conf2):- conf_abs(Conf1,C), conf_abs(Conf2,C). colonne(1,[A,_,_,_],A). colonne(2,[_,A,_,_],A). colonne(3,[_,_,A,_],A). colonne(4,[_,_,_,A],A). ligne(1,[A,_,_,_,_],A). ligne(2,[_,A,_,_,_],A). ligne(3,[_,_,A,_,_],A). ligne(4,[_,_,_,A,_],A). ligne(5,[_,_,_,_,A],A). /* retourne le contenu "Contenu_case" de la case situé à la colonne "Col" et la ligne "Lig" du jeux en cours "Contenu_jeu" */ case(Lig,Col,Conf,Contenu) :- ligne(Lig,Conf,Ligne), colonne(Col,Ligne,Contenu). changeContenuColonne(1,X,[_,B,C,D],[X,B,C,D]). changeContenuColonne(2,X,[A,_,C,D],[A,X,C,D]). changeContenuColonne(3,X,[A,B,_,D],[A,B,X,D]). changeContenuColonne(4,X,[A,B,C,_],[A,B,C,X]). changeContenuLigne(1,X,[_,B,C,D,E],[X,B,C,D,E]). changeContenuLigne(2,X,[A,_,C,D,E],[A,X,C,D,E]). changeContenuLigne(3,X,[A,B,_,D,E],[A,B,X,D,E]). changeContenuLigne(4,X,[A,B,C,_,E],[A,B,C,X,E]). changeContenuLigne(5,X,[A,B,C,D,_],[A,B,C,D,X]). changeContenu(Conf1,Piece,Y,X,Conf2):- ligne(Y,Conf1,Ligne), changeContenuColonne(X,Piece,Ligne,Lignep), changeContenuLigne(Y,Lignep,Conf1,Conf2). /*equiv(X,X). equiv(X,Z):- equiv(X,Y),equiv(Y,Z). equiv(Conf1,Conf2):- ((piece(P1,jaunea1),piece(P2,jauneb1)); (piece(P1,noira1),piece(P2,noirb1))), P1p is P1+1, P2p is P2+1, case(Lig1,Col1,Conf1,P1), Lig1p is Lig1 +1, case(Lig2,Col2,Conf1,P2), Lig2p is Lig2 +1, changeContenu(Conf1,P1,Lig2,Col2,Conf1b), changeContenu(Conf1b,P1p,Lig2p,Col2,Conf1c), changeContenu(Conf1c,P2,Lig1,Col1,Conf1d), changeContenu(Conf1d,P2p,Lig1p,Col1,Conf2). equiv(Conf1,Conf2):- ((piece(P1,bois1),piece(P2,bois2)); (piece(P1,marron1),piece(P2,marron2))), case(Lig1,Col1,Conf1,P1), case(Lig2,Col2,Conf1,P2), changeContenu(Conf1,P1,Lig2,Col2,Conf1b), changeContenu(Conf1b,P2,Lig1,Col1,Conf2). */ mapto_el([],[]). mapto_el([Xp|Lp],[X|L]):- mapto_el(Lp,L), piece(Xp,X). mapto([],[]). mapto([Xp|Lp],[X|L]):- mapto_el(Xp,X), mapto(Lp,L). initC([ [jaunea1,rouge1,rouge2,jauneb1], [jaunea2,rouge3,rouge4,jauneb2], [noira1,blanc1,blanc2,noirb1], [noira2,bois1,bois2,noirb2], [marron1,vide1,vide2,marron2]]). /* initC([ [jaunea1,rouge1,rouge2,jauneb1], [jaunea2,rouge3,rouge4,jauneb2], [blanc1,blanc2,marron1,noira1], [bois1,noirb1,bois2,noira2], [marron2,noirb2,vide1,vide2]]). */ init(X):- initC(Y),mapto(X,Y). /*final([ [jaunea1,rouge1,rouge2,jauneb1], [jaunea2,rouge3,rouge4,jauneb2], [noira1,blanc1,blanc2,noirb1], [noira2,bois,bois,noirb2], [marron1,vide1,vide2,marron2]]). final([ [_,_,_,_], [_,_,_,_], [_,_,_,_], [_,rouge1,rouge2,_], [_,rouge3,rouge4,_]]). */ finalC([ [_,_,_,_], [_,_,_,_], [_,_,_,_], [_,noira1,noirb1,_], [_,noira2,noirb2,_]]). final(X):- finalC(Y), mapto(X,Y). jauneaOK(Conf):- case(Lig,Col,Conf,P), piece(P,jaunea1), piece(Pp,jaunea2), Ligp is Lig +1, case(Ligp,Col,Conf,Pp). jaunebOK(Conf):- case(Lig,Col,Conf,P), piece(P,jauneb1), piece(Pp,jauneb2), Ligp is Lig +1, case(Ligp,Col,Conf,Pp). noiraOK(Conf):- case(Lig,Col,Conf,P), piece(P,noira1), piece(Pp,noira2), Ligp is Lig +1, case(Ligp,Col,Conf,Pp). noirbOK(Conf):- case(Lig,Col,Conf,P), piece(P,noirb1), piece(Pp,noirb2), Ligp is Lig +1, case(Ligp,Col,Conf,Pp). rougeOK(Conf):- case(Lig,Col,Conf,P1), piece(P1,rouge1), piece(P2,rouge2), piece(P3,rouge3), piece(P4,rouge4), Ligp is Lig +1, Colp is Col + 1, case(Lig,Colp,Conf,P2), case(Ligp,Col,Conf,P3), case(Ligp,Colp,Conf,P4). blancOK(Conf):- case(Lig,Col,Conf,P), piece(P,blanc1), piece(Pp,blanc2), Colp is Col+1, case(Lig,Colp,Conf,Pp). couleurOK(Conf):- jauneaOK(Conf),jaunebOK(Conf),noiraOK(Conf),noirbOK(Conf),rougeOK(Conf), blancOK(Conf). /*** Une configuration est correcte si - chaque case est remplie - avec une piece différente - en respectant les contraintes de couleur ***/ correct(Conf):- Conf = [[A1,A2,A3,A4], [B1,B2,B3,B4], [C1,C2,C3,C4], [D1,D2,D3,D4], [E1,E2,E3,E4]], ins([A1,A2,A3,A4,B1,B2,B3,B4,C1,C2,C3,C4,D1,D2,D3,D4,E1,E2,E3,E4], 1..20), all_distinct([A1,A2,A3,A4,B1,B2,B3,B4,C1,C2,C3,C4,D1,D2,D3,D4,E1,E2,E3,E4]), couleurOK(Conf). /*glissement rouge*/ /* vers la droite */ glissement(PR1,d,Conf1,Conf2):- case(Lig,Col,Conf1,PR1), piece(PR1,rouge1), piece(PR2,rouge2), piece(PR3,rouge3), piece(PR4,rouge4), Ligp is Lig+1, Colp is Col+1, Colpp is Col+2, case(Lig,Colpp,Conf1,PV1), case(Ligp,Colpp,Conf1,PV2), ((piece(PV1,vide1),piece(PV1,vide2)); (piece(PV2,vide2),piece(PV2,vide1))), changeContenu(Conf1,PR1,Lig,Colp,Conf1a), changeContenu(Conf1a,PR2,Lig,Colpp,Conf1b), changeContenu(Conf1b,PV1,Lig,Col,Conf1c), changeContenu(Conf1c,PR3,Ligp,Colp,Conf1d), changeContenu(Conf1d,PR4,Ligp,Colpp,Conf1e), changeContenu(Conf1e,PV2,Ligp,Col,Conf2). /*vers la gauche */ glissement(PR1,g,Conf1,Conf2):- case(Lig,Col,Conf1,PR1), piece(PR1,rouge1), piece(PR2,rouge2), piece(PR3,rouge3), piece(PR4,rouge4), Ligp is Lig+1, Colm is Col-1, Colp is Col+1, case(Lig,Colm,Conf1,PV1), case(Ligp,Colm,Conf1,PV2), ((piece(PV1,vide1),piece(PV2,vide2)); (piece(PV1,vide2),piece(PV2,vide1))), changeContenu(Conf1,PR1,Lig,Colm,Conf1a), changeContenu(Conf1a,PR2,Lig,Col,Conf1b), changeContenu(Conf1b,PV1,Lig,Colp,Conf1c), changeContenu(Conf1c,PR3,Ligp,Colm,Conf1d), changeContenu(Conf1d,PR4,Ligp,Col,Conf1e), changeContenu(Conf1e,PV2,Ligp,Colp,Conf2). /* vers le bas */ glissement(PR1,b,Conf1,Conf2):- case(Lig,Col,Conf1,PR1), piece(PR1,rouge1), piece(PR2,rouge2), piece(PR3,rouge3), piece(PR4,rouge4), Ligp is Lig+1, Colp is Col+1, Ligpp is Lig+2, case(Ligpp,Col,Conf1,PV1), case(Ligpp,Colp,Conf1,PV2), ((piece(PV1,vide1),piece(PV2,vide2)); (piece(PV1,vide2),piece(PV2,vide1))), changeContenu(Conf1,PR1,Ligp,Col,Conf1a), changeContenu(Conf1a,PR2,Ligp,Colp,Conf1b), changeContenu(Conf1b,PV1,Lig,Col,Conf1c), changeContenu(Conf1c,PR3,Ligpp,Col,Conf1d), changeContenu(Conf1d,PR4,Ligpp,Colp,Conf1e), changeContenu(Conf1e,PV2,Lig,Colp,Conf2). /* vers le haut */ glissement(PR1,h,Conf1,Conf2):- case(Lig,Col,Conf1,PR1), piece(PR1,rouge1), piece(PR2,rouge2), piece(PR3,rouge3), piece(PR4,rouge4), Ligp is Lig+1, Colp is Col+1, Ligm is Lig-1, case(Ligm,Col,Conf1,PV1), case(Ligm,Colp,Conf1,PV2), ((piece(PV1,vide1),piece(PV2,vide2)); (piece(PV1,vide2),piece(PV2,vide1))), changeContenu(Conf1,PR1,Ligm,Col,Conf1a), changeContenu(Conf1a,PR2,Ligm,Colp,Conf1b), changeContenu(Conf1b,PV1,Ligp,Col,Conf1c), changeContenu(Conf1c,PR3,Lig,Col,Conf1d), changeContenu(Conf1d,PR4,Lig,Colp,Conf1e), changeContenu(Conf1e,PV2,Ligp,Colp,Conf2). /* glissement noir,jaune */ /* vers la droite */ glissement(Pc1,d,Conf1,Conf2):- case(Lig,Col,Conf1,Pc1), (piece(Pc1,noira1);piece(Pc1,noirb1);piece(Pc1,jaunea1);piece(Pc1,jauneb1)), Pc2 is Pc1 +1, Ligp is Lig+1, Colp is Col+1, case(Lig,Colp,Conf1,PV1), case(Ligp,Colp,Conf1,PV2), ((piece(PV1,vide1),piece(PV2,vide2)); (piece(PV1,vide2),piece(PV2,vide1))), changeContenu(Conf1,Pc1,Lig,Colp,Conf1a), changeContenu(Conf1a,Pc2,Ligp,Colp,Conf1b), changeContenu(Conf1b,PV1,Lig,Col,Conf1c), changeContenu(Conf1c,PV2,Ligp,Col,Conf2). /* vers la gauche */ glissement(Pc1,g,Conf1,Conf2):- case(Lig,Col,Conf1,Pc1), (piece(Pc1,noira1);piece(Pc1,noirb1);piece(Pc1,jaunea1);piece(Pc1,jauneb1)), Pc2 is Pc1 +1, Ligp is Lig+1, Colp is Col-1, case(Lig,Colp,Conf1,PV1), case(Ligp,Colp,Conf1,PV2), ((piece(PV1,vide1),piece(PV2,vide2)); (piece(PV1,vide2),piece(PV2,vide1))), changeContenu(Conf1,Pc1,Lig,Colp,Conf1a), changeContenu(Conf1a,Pc2,Ligp,Colp,Conf1b), changeContenu(Conf1b,PV1,Lig,Col,Conf1c), changeContenu(Conf1c,PV2,Ligp,Col,Conf2). /* vers le bas */ glissement(Pc1,b,Conf1,Conf2):- case(Lig,Col,Conf1,Pc1), (piece(Pc1,noira1);piece(Pc1,noirb1);piece(Pc1,jaunea1);piece(Pc1,jauneb1)), Pc2 is Pc1 +1, Ligp is Lig+1, Ligpp is Lig+2, case(Ligpp,Col,Conf1,PV), (piece(PV,vide1);piece(PV,vide2)), changeContenu(Conf1,Pc1,Ligp,Col,Conf1a), changeContenu(Conf1a,Pc2,Ligpp,Col,Conf1b), changeContenu(Conf1b,PV,Lig,Col,Conf2). /* vers le haut */ glissement(Pc1,h,Conf1,Conf2):- case(Lig,Col,Conf1,Pc1), (piece(Pc1,noira1);piece(Pc1,noirb1);piece(Pc1,jaunea1);piece(Pc1,jauneb1)), Pc2 is Pc1 +1, Ligp is Lig+1, Ligm is Lig-1, case(Ligm,Col,Conf1,PV), (piece(PV,vide1);piece(PV,vide2)), changeContenu(Conf1,Pc1,Ligm,Col,Conf1a), changeContenu(Conf1a,Pc2,Lig,Col,Conf1b), changeContenu(Conf1b,PV,Ligp,Col,Conf2). /* glissement du blanc */ /* vers la droite */ glissement(PB1,d,Conf1,Conf2):- case(Lig,Col,Conf1,PB1), piece(PB1,blanc1), piece(PB2,blanc2), Colpp is Col+2, Colp is Col+1, case(Lig,Colpp,Conf1,PV), (piece(PV,vide1);piece(PV,vide2)), changeContenu(Conf1,PB1,Lig,Colp,Conf1a), changeContenu(Conf1a,PB2,Lig,Colpp,Conf1b), changeContenu(Conf1b,PV,Lig,Col,Conf2). /* vers la gauche */ glissement(PB1,g,Conf1,Conf2):- case(Lig,Col,Conf1,PB1), piece(PB1,blanc1), piece(PB2,blanc2), Colm is Col-1, Colp is Col+1, case(Lig,Colm,Conf1,PV), (piece(PV,vide1);piece(PV,vide2)), changeContenu(Conf1,PB1,Lig,Colm,Conf1a), changeContenu(Conf1a,PB2,Lig,Col,Conf1b), changeContenu(Conf1b,PV,Lig,Colp,Conf2). /*vers le bas */ glissement(PB1,b,Conf1,Conf2):- case(Lig,Col,Conf1,PB1), piece(PB1,blanc1), piece(PB2,blanc2), Ligp is Lig+1, Colp is Col+1, case(Ligp,Col,Conf1,PV1), case(Ligp,Colp,Conf1,PV2), ((piece(PV1,vide1),piece(PV2,vide2)); (piece(PV1,vide2),piece(PV2,vide1))), changeContenu(Conf1,PB1,Ligp,Col,Conf1a), changeContenu(Conf1a,PB2,Ligp,Colp,Conf1b), changeContenu(Conf1b,PV1,Lig,Col,Conf1c), changeContenu(Conf1c,PV2,Lig,Colp,Conf2). /*vers le haut*/ glissement(PB1,h,Conf1,Conf2):- case(Lig,Col,Conf1,PB1), piece(PB1,blanc1), piece(PB2,blanc2), Ligm is Lig-1, Colp is Col+1, case(Ligm,Col,Conf1,PV1), case(Ligm,Colp,Conf1,PV2), ((piece(PV1,vide1),piece(PV2,vide2)); (piece(PV1,vide2),piece(PV2,vide1))), changeContenu(Conf1,PB1,Ligm,Col,Conf1a), changeContenu(Conf1a,PB2,Ligm,Colp,Conf1b), changeContenu(Conf1b,PV1,Lig,Col,Conf1c), changeContenu(Conf1c,PV2,Lig,Colp,Conf2). /* vers la gauche*/ glissement(PC,g,Conf1,Conf2):- case(Lig,Col,Conf1,PC), (piece(PC,bois1);piece(PC,bois2);piece(PC,marron1);piece(PC,marron2)), Colp is Col-1, case(Lig,Colp,Conf1,PV), (piece(PV,vide1);piece(PV,vide2)), changeContenu(Conf1,PC,Lig,Colp,Conf1a), changeContenu(Conf1a,PV,Lig,Col,Conf2). /* vers la droite */ glissement(PC,d,Conf1,Conf2):- case(Lig,Col,Conf1,PC), (piece(PC,bois1);piece(PC,bois2);piece(PC,marron1);piece(PC,marron2)), Colp is Col+1, case(Lig,Colp,Conf1,PV), (piece(PV,vide1);piece(PV,vide2)), changeContenu(Conf1,PC,Lig,Colp,Conf1a), changeContenu(Conf1a,PV,Lig,Col,Conf2). /* vers le haut*/ glissement(PC,h,Conf1,Conf2):- case(Lig,Col,Conf1,PC), (piece(PC,bois1);piece(PC,bois2);piece(PC,marron1);piece(PC,marron2)), Ligp is Lig-1, case(Ligp,Col,Conf1,PV), (piece(PV,vide1);piece(PV,vide2)), changeContenu(Conf1,PC,Ligp,Col,Conf1a), changeContenu(Conf1a,PV,Lig,Col,Conf2). /* vers le bas */ glissement(PC,b,Conf1,Conf2):- case(Lig,Col,Conf1,PC), (piece(PC,bois1);piece(PC,bois2);piece(PC,marron1);piece(PC,marron2)), Ligp is Lig+1, case(Ligp,Col,Conf1,PV), (piece(PV,vide1);piece(PV,vide2)), changeContenu(Conf1,PC,Ligp,Col,Conf1a), changeContenu(Conf1a,PV,Lig,Col,Conf2). /*resoud(Conf,[Conf]) :- init(Conf). resoud(Conf,[Conf|Historique]) :- correct(Conf), glissement(Conf,Confp), resoud(Confp,Historique), not(member(Conf,Historique)). test(Depl):- correct(X), final(X), resoud(X,Depl). */ /* ajoute la nouvelle paire (Conf, deplacements) à la fin en s'assurant que la conf n'a pas encore été visitéé */ insert_fin((X,Y),[],[(X,Y)]). insert_fin((X,_),[(Y,K)|R1],[(Y,K)|R1]):- equiv(X,Y),!. insert_fin(X,[T|R1],[T|R2]):- insert_fin(X,R1,R2). insert_fin_liste([],L,L). insert_fin_liste([X|R],L,Res):- insert_fin_liste(R,L,Resp), insert_fin(X,Resp,Res). display_ligne([]). display_ligne([El|R]):- repr(El,Rep_el), write(Rep_el), display_ligne(R). display_conf([]). display_conf([L|R]):- display_ligne(L), writeln(''), display_conf(R). display_chemin(L):- write(L). display_conf_chemin((Conf,Chemin)):- display_conf(Conf),display_chemin(Chemin). display_conf_chemin_liste([]). display_conf_chemin_liste([CL|R]):- display_conf_chemin(CL), writeln(''), display_conf_chemin_liste(R). /* Tous les successeurs d une configuration */ successeurs((Confa,Chemins),L):- findall( (Confb,[(P,D)|Chemins]), glissement(P,D,Confa,Confb), L). successeurs_liste([],[]). successeurs_liste([Ca|Cs],ConfsSucc):- successeurs(Ca,L), successeurs_liste(Cs,ConfsSuccInter), insert_fin_liste(L,ConfsSuccInter,ConfsSucc). /* regarde si le premier parametre appartient à la liste donné en second parametre. Si c est le cas, retourne le chemin */ appartient((Conf1,_),[(Conf2,_)|_]):- equiv(Conf1,Conf2),!. appartient((Conf1,C),[_|L]):- appartient((Conf1,C),L). difference([],_,[]). difference([El|L1],L2,[El|Res]):- difference(L1,L2,Res), not(appartient(El,L2)). difference([El|L1],L2,Res):- difference(L1,L2,Res), appartient(El,L2). but([(Conf,Chemin)|_],Chemin):-final(Conf). but([_|L],Chemin):-but(L,Chemin). largeur(Atraiter,_,Res):- but(Atraiter,Res),!. largeur(Atraiter,Visites,Res):- successeurs_liste(Atraiter,Succ), difference(Succ,Visites,Atraiter2), insert_fin_liste(Atraiter,Visites,Visites2), largeur(Atraiter2,Visites2,Res). resoud(Res):- init(X), largeur([(X,[])],[],Res). /* resoud(L,):- ne_contient_pas_la_conf_finalle(X,L,Chemin), successeurs_liste(L,Lp), resoud(Lp,Chemin). */