tpProlog/anerouge/anerouge.pl

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