tpProlog/anerouge/anerougeGrille.pl

   1 /* accesseurs sur ligne et colonne*/
   2 :-use_module(library(assoc)).
   3
   4 colonne(1,[A,_,_,_],A).
   5 colonne(2,[_,A,_,_],A).
   6 colonne(3,[_,_,A,_],A).
   7 colonne(4,[_,_,_,A],A).
   8
   9 ligne(1,[A,_,_,_,_],A).
  10 ligne(2,[_,A,_,_,_],A).
  11 ligne(3,[_,_,A,_,_],A).
  12 ligne(4,[_,_,_,A,_],A).
  13 ligne(5,[_,_,_,_,A],A).
  14
  15
  16 /* retourne le contenu "Contenu_case" de la case
  17 situé à la colonne "Col" et la ligne "Lig" du jeux en cours
  18 "Contenu_jeu" */
  19
  20 case(Lig,Col,Conf,Contenu) :-
  21     ligne(Lig,Conf,Ligne),
  22     colonne(Col,Ligne,Contenu).
  23
  24 changeContenuColonne(1,X,[_,B,C,D],[X,B,C,D]).
  25 changeContenuColonne(2,X,[A,_,C,D],[A,X,C,D]).
  26 changeContenuColonne(3,X,[A,B,_,D],[A,B,X,D]).
  27 changeContenuColonne(4,X,[A,B,C,_],[A,B,C,X]).
  28
  29 changeContenuLigne(1,X,[_,B,C,D,E],[X,B,C,D,E]).
  30 changeContenuLigne(2,X,[A,_,C,D,E],[A,X,C,D,E]).
  31 changeContenuLigne(3,X,[A,B,_,D,E],[A,B,X,D,E]).
  32 changeContenuLigne(4,X,[A,B,C,_,E],[A,B,C,X,E]).
  33 changeContenuLigne(5,X,[A,B,C,D,_],[A,B,C,D,X]).
  34
  35 changeContenu(Conf1,Piece,Y,X,Conf2):-
  36     ligne(Y,Conf1,Ligne),
  37     changeContenuColonne(X,Piece,Ligne,Lignep),
  38     changeContenuLigne(Y,Lignep,Conf1,Conf2).
  39
  40
  41 /*
  42 init([
  43     [j1,r1,ro,j1],
  44     [ja,ro,ro,ja],
  45     [n1,b1,bl,n1],
  46     [no,bo,bo,no],
  47     [ma,vi,vi,ma]]).
  48 */
  49
  50 init([
  51     [j1,r1,ro,j1],
  52     [ja,ro,ro,ja],
  53     [j1,b1,bl,j1],
  54     [ja,bo,bo,ja],
  55     [bo,vi,vi,bo]]).
  56
  57
  58 /*
  59 final([
  60     [_,_,_,_],
  61     [_,_,_,_],
  62     [_,_,_,_],
  63     [_,_,_,_],
  64     [_,b1,bl,_]]).
  65
  66 */
  67 /*
  68 final([
  69     [_,_,_,_],
  70     [_,_,_,_],
  71     [_,_,_,_],
  72     [_,j1,j1,_],
  73     [_,ja,ja,_]]).
  74 */
  75
  76 final([
  77     [_,_,_,_],
  78     [_,_,_,_],
  79     [_,_,_,_],
  80     [_,r1,ro,_],
  81     [_,ro,ro,_]]).
  82
  83 /* direction */
  84 directionh(d,1).
  85 directionh(g,-1).
  86 directionv(h,-1).
  87 directionv(b,1).
  88
  89
  90
  91 /*glissement rouge*/
  92 /* vers la droite */
  93 glissement(r1,d,Conf1,Conf2,Lig,Col):-
  94     case(Lig,Col,Conf1,r1),
  95     Ligp is Lig+1,
  96     Colp is Col+1,
  97     Colpp is Col+2,
  98     case(Lig,Colpp,Conf1,vi),
  99     case(Ligp,Colpp,Conf1,vi),
 100     changeContenu(Conf1,r1,Lig,Colp,Conf1a),
 101     changeContenu(Conf1a,ro,Lig,Colpp,Conf1b),
 102     changeContenu(Conf1b,vi,Lig,Col,Conf1c),
 103     changeContenu(Conf1c,ro,Ligp,Colpp,Conf1d),
 104     changeContenu(Conf1d,vi,Ligp,Col,Conf2).
 105
 106 /*vers la gauche */
 107 glissement(r1,g,Conf1,Conf2,Lig,Col):-
 108     case(Lig,Col,Conf1,r1),
 109     Ligp is Lig+1,
 110     Colm is Col-1,
 111     Colp is Col+1,
 112     case(Lig,Colm,Conf1,vi),
 113     case(Ligp,Colm,Conf1,vi),
 114     changeContenu(Conf1,r1,Lig,Colm,Conf1a),
 115     changeContenu(Conf1a,ro,Lig,Col,Conf1b),
 116     changeContenu(Conf1b,vi,Lig,Colp,Conf1c),
 117     changeContenu(Conf1c,ro,Ligp,Colm,Conf1d),
 118     changeContenu(Conf1d,vi,Ligp,Colp,Conf2).
 119
 120
 121 /* vers le bas */
 122 glissement(r1,b,Conf1,Conf2,Lig,Col):-
 123     case(Lig,Col,Conf1,r1),
 124     Ligp is Lig+1,
 125     Colp is Col+1,
 126     Ligpp is Lig+2,
 127     case(Ligpp,Col,Conf1,vi),
 128     case(Ligpp,Colp,Conf1,vi),
 129     changeContenu(Conf1,r1,Ligp,Col,Conf1b),
 130     changeContenu(Conf1b,vi,Lig,Col,Conf1c),
 131     changeContenu(Conf1c,ro,Ligpp,Col,Conf1d),
 132     changeContenu(Conf1d,ro,Ligpp,Colp,Conf1e),
 133     changeContenu(Conf1e,vi,Lig,Colp,Conf2).
 134
 135
 136 /* vers le haut */
 137 glissement(r1,h,Conf1,Conf2,Lig,Col):-
 138     case(Lig,Col,Conf1,r1),
 139     Ligp is Lig+1,
 140     Colp is Col+1,
 141     Ligm is Lig-1,
 142     case(Ligm,Col,Conf1,vi),
 143     case(Ligm,Colp,Conf1,vi),
 144     changeContenu(Conf1,r1,Ligm,Col,Conf1a),
 145     changeContenu(Conf1a,ro,Ligm,Colp,Conf1b),
 146     changeContenu(Conf1b,vi,Ligp,Col,Conf1c),
 147     changeContenu(Conf1c,ro,Lig,Col,Conf1d),
 148     changeContenu(Conf1d,vi,Ligp,Colp,Conf2).
 149
 150
 151
 152
 153
 154 /* glissement noire , jaune  droite ou gauche */
 155 glissement(Pc1,D,Conf1,Conf2,Lig,Col):-
 156     case(Lig,Col,Conf1,Pc1),
 157     ((Pc1= n1, Pc2= no); (Pc1= j1, Pc2= ja)),
 158     directionh(D,Delta),
 159     Ligp is Lig+1,
 160     Colp is Col+Delta,
 161     case(Lig,Colp,Conf1,vi),
 162     case(Ligp,Colp,Conf1,vi),
 163     changeContenu(Conf1,Pc1,Lig,Colp,Conf1a),
 164     changeContenu(Conf1a,Pc2,Ligp,Colp,Conf1b),
 165     changeContenu(Conf1b,vi,Lig,Col,Conf1c),
 166     changeContenu(Conf1c,vi,Ligp,Col,Conf2).
 167
 168
 169
 170
 171 /* vers le bas */
 172 glissement(Pc1,b,Conf1,Conf2,Lig,Col):-
 173     case(Lig,Col,Conf1,Pc1),
 174     ((Pc1= n1, Pc2= no); (Pc1= j1, Pc2= ja)),
 175     Ligp is Lig+1,
 176     Ligpp is Lig+2,
 177     case(Ligpp,Col,Conf1,vi),
 178     changeContenu(Conf1,Pc1,Ligp,Col,Conf1a),
 179     changeContenu(Conf1a,Pc2,Ligpp,Col,Conf1b),
 180     changeContenu(Conf1b,vi,Lig,Col,Conf2).
 181
 182 /* vers le haut */
 183 glissement(Pc1,h,Conf1,Conf2,Lig,Col):-
 184     case(Lig,Col,Conf1,Pc1),
 185     ((Pc1= n1, Pc2= no); (Pc1= j1, Pc2= ja)),
 186     Ligp is Lig+1,
 187     Ligm is Lig-1,
 188     case(Ligm,Col,Conf1,vi),
 189     changeContenu(Conf1,Pc1,Ligm,Col,Conf1a),
 190     changeContenu(Conf1a,Pc2,Lig,Col,Conf1b),
 191     changeContenu(Conf1b,vi,Ligp,Col,Conf2).
 192
 193 /* blanc, à droite */
 194 glissement(b1,d,Conf1,Conf2,Lig,Col):-
 195     case(Lig,Col,Conf1,b1),
 196     Colpp is Col+2,
 197     Colp is Col+1,
 198     case(Lig,Colpp,Conf1,vi),
 199     changeContenu(Conf1,b1,Lig,Colp,Conf1a),
 200     changeContenu(Conf1a,bl,Lig,Colpp,Conf1b),
 201     changeContenu(Conf1b,vi,Lig,Col,Conf2).
 202
 203 /* blanc, à gauche */
 204 glissement(b1,g,Conf1,Conf2,Lig,Col):-
 205     case(Lig,Col,Conf1,b1),
 206     Colm is Col-1,
 207     Colp is Col+1,
 208     case(Lig,Colm,Conf1,vi),
 209     changeContenu(Conf1,b1,Lig,Colm,Conf1a),
 210     changeContenu(Conf1a,bl,Lig,Col,Conf1b),
 211     changeContenu(Conf1b,vi,Lig,Colp,Conf2).
 212
 213
 214 /* blanc, haut ou  bas */
 215 glissement(b1,D,Conf1,Conf2,Lig,Col):-
 216     case(Lig,Col,Conf1,b1),
 217     directionv(D,Delta),
 218     Ligp is Lig+Delta,
 219     Colp is Col+1,
 220     case(Ligp,Col,Conf1,vi),
 221     case(Ligp,Colp,Conf1,vi),
 222     changeContenu(Conf1,b1,Ligp,Col,Conf1a),
 223     changeContenu(Conf1a,bl,Ligp,Colp,Conf1b),
 224     changeContenu(Conf1b,vi,Lig,Col,Conf1c),
 225     changeContenu(Conf1c,vi,Lig,Colp,Conf2).
 226
 227 /* bois ou marron, gauche ou droite*/
 228     glissement(PC,D,Conf1,Conf2,Lig,Col):-
 229     case(Lig,Col,Conf1,PC),
 230     (PC = ma; PC = bo),
 231     directionh(D,Delta),
 232     Colp is Col+Delta,
 233     case(Lig,Colp,Conf1,vi),
 234     changeContenu(Conf1,PC,Lig,Colp,Conf1a),
 235     changeContenu(Conf1a,vi,Lig,Col,Conf2).
 236
 237
 238 /* bois ou marron, haut ou bas*/
 239 glissement(PC,D,Conf1,Conf2,Lig,Col):-
 240     case(Lig,Col,Conf1,PC),
 241     (PC = ma; PC = bo),
 242     directionv(D,Delta),
 243     Ligp is Lig+Delta,
 244     case(Ligp,Col,Conf1,vi),
 245     changeContenu(Conf1,PC,Ligp,Col,Conf1a),
 246     changeContenu(Conf1a,vi,Lig,Col,Conf2).
 247
 248 gl_time(P,D,Confa,Confb,Lig,Col):-
 249     get_time(T2),
 250     glissement(P,D,Confa,Confb,Lig,Col),
 251     get_time(T3),
 252     DT3 is T3 - T2,
 253     write('depl : '),writeln(DT3).
 254
 255
 256 retour(L,Col,d,L,Cp,g):-
 257     Col is Cp-1.
 258 retour(L,Col,g,L,Cp,d):-
 259     Col is Cp+1.
 260 retour(Lig,C,h,Lp,C,b):-
 261     Lig is Lp+1.
 262     retour(Lig,C,b,Lp,C,h):-
 263     Lig is Lp-1.
 264
 265
 266 gl_ok(_,P,D,Confa,Confb,Lig,Col,[]):-
 267     glissement(P,D,Confa,Confb,Lig,Col).
 268 gl_ok(_,P,D,Confa,Confb,Lig,Col,[((Lp,Cp),Dp)|_]):-
 269     glissement(P,D,Confa,Confb,Lig,Col),
 270     not(retour(Lig,Col,D,Lp,Cp,Dp)).
 271
 272
 273
 274
 275 /* Tous les successeurs d une configuration */
 276 successeurs(Omis,Confa-Chemins,L):-
 277     findall(
 278         Confb-[((Lig,Col),D)|Chemins],
 279         gl_ok(Omis,_,D,Confa,Confb,Lig,Col,Chemins),
 280         /*glissement(_,D,Confa,Confb,Lig,Col),*/
 281         L).
 282
 283
 284 successeurs_liste(L,Visites,Sl):-
 285     /*write('Visites : '),writeln(Visites),
 286     maplist(filtre_conf,Visites,V2),
 287     write('V2 :'),writeln(V2),*/
 288     maplist(successeurs(_),L,Lp),
 289     flatten(Lp,Lpp),
 290     list_to_assoc(Lpp,A),
 291     assoc_to_list(A,Sl).
 292
 293
 294
 295 /* regarde si le premier parametre appartient
 296      à la liste donné en second parametre. Si c est le cas,
 297     retourne le chemin */
 298
 299
 300 filtre_confa(X-_,X).
 301 filtre_confb(X-_,Y):-
 302     equiv(X,Y).
 303
 304 equiv([[A1,A2,A3,A4],
 305        [B1,B2,B3,B4],
 306        [C1,C2,C3,C4],
 307        [D1,D2,D3,D4],
 308        [E1,E2,E3,E4]],
 309       [[A4,A3,A2,A1],
 310        [B4,B3,B2,B1],
 311        [C4,C3,C2,C1],
 312        [D4,D3,D2,D1],
 313        [E4,E3,E2,E1]]).
 314
 315
 316 appartient(Conf1-_,[Conf1-_|_]):-!.
 317 /*appartient(Conf1-_,[Conf1b-_|_]):-
 318     equiv(Conf1,Conf1b),
 319     !.*/
 320 appartient(Conf1-C,[_|L]):-
 321     appartient(Conf1-C,L).
 322
 323
 324 polit([],_,[]).
 325 polit([Conf-_|L1],L2,Res):-
 326     member(Conf,L2),
 327     /*appartient(El,L2),*/
 328     !,
 329     polit(L1,L2,Res).
 330 polit([El|L1],L2,[El|Res]):-
 331     polit(L1,L2,Res).
 332
 333
 334
 335
 336
 337
 338 but([Conf-Chemin|_],Chemin):-final(Conf),!.
 339 but([_|L],Chemin):-but(L,Chemin).
 340
 341
 342 largeur(Atraiter,_,_,Res):-
 343     but(Atraiter,Res),
 344     !.
 345 largeur(Atraiter,Visites,C,Res):-
 346     Cp is C+1,
 347     write('boucle'), writeln(C),
 348     maplist(filtre_confa,Atraiter,V1),
 349     maplist(filtre_confb,Atraiter,V2),
 350     append(V1,V2,V3),
 351     append(V3,Visites,Omis),
 352     successeurs_liste(Atraiter,_,Succ),
 353     polit(Succ,Omis,Atraiter2),
 354     length(Succ,SL),
 355     length(Atraiter2,OL),
 356     writeln(SL),
 357     writeln(OL),
 358     largeur(Atraiter2,Omis,Cp,Res).
 359
 360
 361
 362 resoud(_):-
 363     get_time(T0),
 364     init(X),
 365     largeur([X-[]],[],0,Res),
 366     writeln(Res),
 367     get_time(T1),
 368     DT1 is T1 - T0,
 369     write('duree : '),writeln(DT1).
 370
 371