home *** CD-ROM | disk | FTP | other *** search
/ rtsi.com / 2014.01.www.rtsi.com.tar / www.rtsi.com / OS9 / OSK / EFFO / forum16.lzh / SOFTWARE / PROLOG / EXAMPLES / puzzle.pro next >
Text File  |  1991-03-24  |  5KB  |  198 lines

  1. /* 
  2.   Loesung fuer Schiebepuzzles suchen
  3.   (PUZZLE.PRO)
  4.  
  5.   Autor: M. Moser
  6.   Datum: 3.2.91
  7.   Version: 1.1
  8.  
  9.   Historie:
  10.     Version 1.0 am 3.2.91: Urversion
  11.     Version 1.1 am 13.2.91: Cut in bestMove eingebaut und delete korri-
  12.                             giert, so dass Loesungen stets nur einmal 
  13.                             gefunden werden.   
  14. */
  15.  
  16.  
  17. /* Ein Schiebepuzzle fuer ein Feld der Kantenlaenge n besteht aus   */
  18. /* aus einer Liste, die als erstes Element die Position p(x, y) des */
  19. /* freien Feldes enthaelt.  Die restlichen n^2 - 1 Elemente der     */
  20. /* Liste beschreiben die Steine 1 bis n^2 - 1.  Die Beschreibung    */
  21. /* eines Steins hat die Form n(b, p, q, h).  Der Term b ist der Be- */
  22. /* zeichner des Steins und darf beliebig gewaehlt werden.  Das      */
  23. /* zweite Element p legt die Zielposition des Steins fest und muss  */
  24. /* die Form p(x, y) haben.  Die Werte von x und y muessen zwischen  */
  25. /* 1 und n liegen, Grenzen eingeschlossen.  Die aktuelle Position   */
  26. /* eines Steins wird durch q festgelegt.  Fuer q gelten dieselben   */
  27. /* Einschraenkungen wie fuer p.  Der Wert h schliesslich ist ein    */
  28. /* heuristischer Schaetzwert fuer die Entfernung des Steins von     */
  29. /* seiner Zielposition.  Als Heuristiken wurden die Manhatten-Dis-  */
  30. /* tanz und die Quadratsumme der horizontalen und vertikalen Dis-   */
  31. /* tanzen implementiert.                                            */
  32.  
  33. /* Die Loesungen fuer ein Puzzle P --- sofern welche existieren --- */
  34. /* lassen sich durch einen Aufruf der folgenden Form finden:        */
  35. /*     puzzle(P, h, M).                                             */
  36. /* Der Wert von h muss der Bezeichner einer heuristischen Funktion  */
  37. /* sein.  Derzeit sind 'manhattan' fuer die Manhattan-Distanz und   */
  38. /* 'sqrSum' fuer die Quadratsumme definiert.  Der Aufruf von puzzle */
  39. /* liefert als Ergebnis in der Variablen M eine Liste von Zuegen,   */
  40. /* um die Steine in ihre Ausgangspositionen zu bringen, falls eine  */
  41. /* solche Zugfolge existiert.                                       */
  42.  
  43.  
  44. /* Beispiele fuer 3 x 3 Schiebepuzzle */
  45. p1([p(2, 2),
  46.    n(1, p(1, 1), p(1, 1), 0), 
  47.    n(2, p(2, 1), p(3, 3), 5),
  48.    n(3, p(3, 1), p(2, 1), 1),
  49.    n(4, p(3, 2), p(3, 1), 1), 
  50.    n(5, p(3, 3), p(2, 3), 1),
  51.    n(6, p(2, 3), p(3, 2), 2),
  52.    n(7, p(1, 3), p(1, 3), 0), 
  53.    n(8, p(1, 2), p(1, 2), 0)]).
  54.  
  55.  
  56. p2([p(1, 2),
  57.    n(1, p(1, 1), p(2, 1), 1), 
  58.    n(2, p(2, 1), p(1, 3), 5),
  59.    n(3, p(3, 1), p(3, 1), 0),
  60.    n(4, p(3, 2), p(3, 2), 0), 
  61.    n(5, p(3, 3), p(3, 3), 0),
  62.    n(6, p(2, 3), p(2, 2), 1),
  63.    n(7, p(1, 3), p(2, 3), 1), 
  64.    n(8, p(1, 2), p(1, 1), 1)]).
  65.  
  66.  
  67. p3([p(2, 1),
  68.    n(1, p(1, 1), p(1, 2), 1), 
  69.    n(2, p(2, 1), p(2, 3), 4),
  70.    n(3, p(3, 1), p(1, 1), 4),
  71.    n(4, p(3, 2), p(3, 1), 1), 
  72.    n(5, p(3, 3), p(3, 2), 1),
  73.    n(6, p(2, 3), p(3, 3), 1),
  74.    n(7, p(1, 3), p(1, 3), 0), 
  75.    n(8, p(1, 2), p(2, 2), 1)]).
  76.  
  77.  
  78. p4([p(2, 3),
  79.    n(1, p(1, 1), p(1, 2), 1), 
  80.    n(2, p(2, 1), p(2, 2), 1),
  81.    n(3, p(3, 1), p(1, 1), 4),
  82.    n(4, p(3, 2), p(2, 1), 2), 
  83.    n(5, p(3, 3), p(3, 1), 4),
  84.    n(6, p(2, 3), p(3, 2), 2),
  85.    n(7, p(1, 3), p(3, 3), 4), 
  86.    n(8, p(1, 2), p(1, 3), 1)]).
  87.  
  88.  
  89. /* Loesungspraedikat */
  90. puzzle(L, HF, M) :-
  91.     puzzleSol(L, HF, [], M).
  92.     
  93.  
  94. puzzleSol([BP | L], _, _, []) :-
  95.     allInPlace(L).
  96.     
  97. puzzleSol([BP | L], HF, L1, [M | L2]) :-
  98.     not(allInPlace(L)),
  99.     length(L1, X),
  100.     not(X > 32),
  101.     moveBlank([BP | L], HF, M, L3),
  102.     M = m(N, CP, NP),
  103.     not(member(m(N, NP, CP), L1)),
  104.     puzzleSol(L3, HF, [M | L1], L2).
  105.     
  106.     
  107. allInPlace([]).
  108.  
  109. allInPlace([n(_, p(X, Y), p(X, Y), _) | L]) :-
  110.     allInPlace(L).
  111.  
  112.  
  113. moveBlank([BP | L], HF, M, L1) :-
  114.     neighborList(BP, L, NL),
  115.     bestMove(NL, N),
  116.     N = n(N1, _, CP, _),
  117.     M = m(N1, CP, BP),
  118.     exchange(N, [BP | L], HF, L1).
  119.     
  120.  
  121. neighborList(BP, [], []).
  122.  
  123. neighborList(BP, [N | L], [N | NL]) :-
  124.     N = n(_, _, CP, _),
  125.     neighbor(BP, CP),
  126.     neighborList(BP, L, NL).
  127.     
  128. neighborList(BP, [N | L], NL) :-
  129.     N = n(_, _, CP, _),
  130.     not(neighbor(BP, CP)),
  131.     neighborList(BP, L, NL).
  132.  
  133.  
  134. bestMove(NL, N) :-
  135.     member(N1, NL),
  136.     N1 = n(M, OP, CP, H),
  137.     bestH(H, NL), !, 
  138.     allMoves(N1, NL, N).
  139.  
  140.  
  141. allMoves(N, _, N).
  142.  
  143. allMoves(N, NL, N1) :-
  144.     delete(N, NL, NL1),
  145.     bestMove(NL1, N1).
  146.  
  147.  
  148. neighbor(p(X1, Y1), p(X2, Y2)) :-
  149.     X1 is X2,     Y1 is Y2 - 1;
  150.     X1 is X2,     Y1 is Y2 + 1;
  151.     X1 is X2 - 1, Y1 is Y2;
  152.     X1 is X2 + 1, Y1 is Y2.
  153.  
  154.  
  155. bestH(_, []).
  156.  
  157. bestH(H, [n(_, _, _, H1) | L]) :-
  158.     H >= H1,
  159.     bestH(H, L).
  160.     
  161.     
  162. delete(X, [X | L], L).
  163.  
  164. delete(X, [Y | L], [Y | L1]) :-
  165.     delete(X, L, L1).
  166.     
  167.  
  168. exchange(N, [BP, N | L], HF, [CP, N1 | L]) :-
  169.     N  = n(M, OP, CP, _),
  170.     N1 = n(M, OP, BP, H),
  171.     h(HF, OP, BP, H).
  172.  
  173. exchange(N, [BP, N1 | L], HF, [BP1, N1 | L1]) :-
  174.     N  = n(M, _, _, _),
  175.     N1 = n(M1, _, _, _),
  176.     not(M = M1),
  177.     exchange(N, [BP | L], HF, [BP1 | L1]).
  178.     
  179.  
  180. h(sqrSum, p(X1, Y1), p(X2, Y2), H) :-
  181.     DX is X1 - X2,
  182.     DY is Y1 - Y2,
  183.     H  is DX * DX + DY * DY.
  184.  
  185. h(manhattan, p(X1, Y1), p(X2, Y2), H) :-
  186.     absDiff(X1, X2, DX),
  187.     absDiff(Y1, Y2, DY),
  188.     H is DX + DY.
  189.  
  190.  
  191. absDiff(X, Y, Z) :-
  192.     X >= Y,
  193.     Z is X - Y.
  194.  
  195. absDiff(X, Y, Z) :-
  196.     X < Y,
  197.     Z is Y - X.
  198.