fork(1) download
  1. :- initialization(main).
  2.  
  3.  
  4. board_size(20).
  5. in_board(X*Y) :- board_size(N), between(1,N,Y), between(1,N,X).
  6.  
  7.  
  8. % express jump-graph in dynamic "move"-rules
  9. make_graph :-
  10. findall(_, (in_board(P), assert_moves(P)), _).
  11.  
  12. % where
  13. assert_moves(P) :-
  14. findall(_, (can_move(P,Q), asserta(move(P,Q))), _).
  15.  
  16. can_move(X*Y,Q) :-
  17. ( one(X,X1), two(Y,Y1) ; two(X,X1), one(Y,Y1) )
  18. , Q = X1*Y1, in_board(Q)
  19. . % where
  20. one(M,N) :- succ(M,N) ; succ(N,M).
  21. two(M,N) :- N is M + 2 ; N is M - 2.
  22.  
  23.  
  24.  
  25. hamiltonian(P,Pn) :-
  26. board_size(N), Size is N * N
  27. , hamiltonian(P,Size,[],Ps), enumerate(Size,Ps,Pn)
  28. .
  29. % where
  30. enumerate(_, [] , [] ).
  31. enumerate(N, [P|Ps], [N:P|Pn]) :- succ(M,N), enumerate(M,Ps,Pn).
  32.  
  33.  
  34. hamiltonian(P,N,Ps,Res) :-
  35. N =:= 1 -> Res = [P|Ps]
  36. ; warnsdorff(Ps,P,Q), succ(M,N)
  37. , hamiltonian(Q,M,[P|Ps],Res)
  38. .
  39. % where
  40. warnsdorff(Ps,P,Q) :-
  41. moves(Ps,P,Qs), maplist(next_moves(Ps), Qs, Xs)
  42. , keysort(Xs,Ys), member(_-Q,Ys)
  43. .
  44. next_moves(Ps,Q,L-Q) :- moves(Ps,Q,Rs), length(Rs,L).
  45.  
  46. moves(Ps,P,Qs) :-
  47. findall(Q, (move(P,Q), \+ member(Q,Ps)), Qs).
  48.  
  49.  
  50.  
  51. show_path(Pn) :- findall(_, (in_board(P), show_cell(Pn,P)), _).
  52. % where
  53. show_cell(Pn,X*Y) :-
  54. member(N:X*Y,Pn), format('%4.0d',[N]), board_size(X), nl.
  55.  
  56.  
  57. % gprolog-1.3.1 compatibilily
  58. succ(M,N) :- var(M) -> M is N - 1 ; N is M + 1.
  59.  
  60. between(M,N,X) :- X = M ; M < N -> M1 is M + 1, between(M1,N,X).
  61.  
  62. maplist(_,[],[]).
  63. maplist(F,[X|Xs],[Y|Ys]) :- call(F,X,Y), maplist(F,Xs,Ys).
  64.  
  65. main :- make_graph, hamiltonian(5*3,Pn), show_path(Pn), halt.
Success #stdin #stdout 0.91s 68608KB
stdin
Standard input is empty
stdout
  47  44  41   2  99  52  39 160  97  54  37  80  65  56  35  72  63  58  33  74
  42   3  46  51  40 161  98  53  38 159  96  55  36  79  64  57  34  73  62  59
  45  48  43 162   1 100 165 168 189 180  81 158  95  66  83  78  71  60  75  32
   4 105  50 101 164 169 190 179 166 187 206 181  82 157  94  67  84  77  70  61
  49 102 163 170 191 178 167 188 205 210 341 186 207 182  85 154  93  68  31  76
 106   5 104 177 172 193 204 211 214 217 208 339 346 153 156 183  86 151  90  69
 103 174 171 192 203 212 215 218 209 340 345 342 185 350 347 152 155  92  87  30
   6 107 176 173 194 219 324 213 216 225 338 351 344 395 184 145 348  89 150  91
 175 200 195 220 325 202 223 226 335 352 343 394 365 370 349 396 149 146  29  88
 108   7 284 201 222 323 326 333 224 337 364 369 390 393 398 371 144 379 140 147
 199 196 221 322 285 328 227 336 353 334 391 366 399 372 389 380 397 148 143  28
   8 109 198 283 228 321 332 327 316 363 368 373 392 387 400 375 382 141 378 139
 197 262 229 276 329 286 281 320 331 354 315 386 367 374 381 388 377 358  27 142
 110   9 274 261 282 277 330 299 314 317 362 355 312 385 376 357 306 383 138 131
 259 230 263 252 275 298 287 280 319 300 313 292 361 356 311 384 359 130 307  26
  10 111 260 273 264 249 278 297 288 267 318 301 310 291 360 305 308 137 132 129
 231 258 251 112 253 272 265 248 279 296 289 246 293 302 309 244 133 304  25 122
  14  11 234 257 250 113 254 271 266 247 268 295 290 245 134 303 136 123 128 125
 235 232  13  16 237 256 115  18 239 270 117  20 241 294 119  22 243 126 121  24
  12  15 236 233 114  17 238 255 116  19 240 269 118  21 242 135 120  23 124 127