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 >
Wrap
Text File
|
1991-03-24
|
5KB
|
198 lines
/*
Loesung fuer Schiebepuzzles suchen
(PUZZLE.PRO)
Autor: M. Moser
Datum: 3.2.91
Version: 1.1
Historie:
Version 1.0 am 3.2.91: Urversion
Version 1.1 am 13.2.91: Cut in bestMove eingebaut und delete korri-
giert, so dass Loesungen stets nur einmal
gefunden werden.
*/
/* Ein Schiebepuzzle fuer ein Feld der Kantenlaenge n besteht aus */
/* aus einer Liste, die als erstes Element die Position p(x, y) des */
/* freien Feldes enthaelt. Die restlichen n^2 - 1 Elemente der */
/* Liste beschreiben die Steine 1 bis n^2 - 1. Die Beschreibung */
/* eines Steins hat die Form n(b, p, q, h). Der Term b ist der Be- */
/* zeichner des Steins und darf beliebig gewaehlt werden. Das */
/* zweite Element p legt die Zielposition des Steins fest und muss */
/* die Form p(x, y) haben. Die Werte von x und y muessen zwischen */
/* 1 und n liegen, Grenzen eingeschlossen. Die aktuelle Position */
/* eines Steins wird durch q festgelegt. Fuer q gelten dieselben */
/* Einschraenkungen wie fuer p. Der Wert h schliesslich ist ein */
/* heuristischer Schaetzwert fuer die Entfernung des Steins von */
/* seiner Zielposition. Als Heuristiken wurden die Manhatten-Dis- */
/* tanz und die Quadratsumme der horizontalen und vertikalen Dis- */
/* tanzen implementiert. */
/* Die Loesungen fuer ein Puzzle P --- sofern welche existieren --- */
/* lassen sich durch einen Aufruf der folgenden Form finden: */
/* puzzle(P, h, M). */
/* Der Wert von h muss der Bezeichner einer heuristischen Funktion */
/* sein. Derzeit sind 'manhattan' fuer die Manhattan-Distanz und */
/* 'sqrSum' fuer die Quadratsumme definiert. Der Aufruf von puzzle */
/* liefert als Ergebnis in der Variablen M eine Liste von Zuegen, */
/* um die Steine in ihre Ausgangspositionen zu bringen, falls eine */
/* solche Zugfolge existiert. */
/* Beispiele fuer 3 x 3 Schiebepuzzle */
p1([p(2, 2),
n(1, p(1, 1), p(1, 1), 0),
n(2, p(2, 1), p(3, 3), 5),
n(3, p(3, 1), p(2, 1), 1),
n(4, p(3, 2), p(3, 1), 1),
n(5, p(3, 3), p(2, 3), 1),
n(6, p(2, 3), p(3, 2), 2),
n(7, p(1, 3), p(1, 3), 0),
n(8, p(1, 2), p(1, 2), 0)]).
p2([p(1, 2),
n(1, p(1, 1), p(2, 1), 1),
n(2, p(2, 1), p(1, 3), 5),
n(3, p(3, 1), p(3, 1), 0),
n(4, p(3, 2), p(3, 2), 0),
n(5, p(3, 3), p(3, 3), 0),
n(6, p(2, 3), p(2, 2), 1),
n(7, p(1, 3), p(2, 3), 1),
n(8, p(1, 2), p(1, 1), 1)]).
p3([p(2, 1),
n(1, p(1, 1), p(1, 2), 1),
n(2, p(2, 1), p(2, 3), 4),
n(3, p(3, 1), p(1, 1), 4),
n(4, p(3, 2), p(3, 1), 1),
n(5, p(3, 3), p(3, 2), 1),
n(6, p(2, 3), p(3, 3), 1),
n(7, p(1, 3), p(1, 3), 0),
n(8, p(1, 2), p(2, 2), 1)]).
p4([p(2, 3),
n(1, p(1, 1), p(1, 2), 1),
n(2, p(2, 1), p(2, 2), 1),
n(3, p(3, 1), p(1, 1), 4),
n(4, p(3, 2), p(2, 1), 2),
n(5, p(3, 3), p(3, 1), 4),
n(6, p(2, 3), p(3, 2), 2),
n(7, p(1, 3), p(3, 3), 4),
n(8, p(1, 2), p(1, 3), 1)]).
/* Loesungspraedikat */
puzzle(L, HF, M) :-
puzzleSol(L, HF, [], M).
puzzleSol([BP | L], _, _, []) :-
allInPlace(L).
puzzleSol([BP | L], HF, L1, [M | L2]) :-
not(allInPlace(L)),
length(L1, X),
not(X > 32),
moveBlank([BP | L], HF, M, L3),
M = m(N, CP, NP),
not(member(m(N, NP, CP), L1)),
puzzleSol(L3, HF, [M | L1], L2).
allInPlace([]).
allInPlace([n(_, p(X, Y), p(X, Y), _) | L]) :-
allInPlace(L).
moveBlank([BP | L], HF, M, L1) :-
neighborList(BP, L, NL),
bestMove(NL, N),
N = n(N1, _, CP, _),
M = m(N1, CP, BP),
exchange(N, [BP | L], HF, L1).
neighborList(BP, [], []).
neighborList(BP, [N | L], [N | NL]) :-
N = n(_, _, CP, _),
neighbor(BP, CP),
neighborList(BP, L, NL).
neighborList(BP, [N | L], NL) :-
N = n(_, _, CP, _),
not(neighbor(BP, CP)),
neighborList(BP, L, NL).
bestMove(NL, N) :-
member(N1, NL),
N1 = n(M, OP, CP, H),
bestH(H, NL), !,
allMoves(N1, NL, N).
allMoves(N, _, N).
allMoves(N, NL, N1) :-
delete(N, NL, NL1),
bestMove(NL1, N1).
neighbor(p(X1, Y1), p(X2, Y2)) :-
X1 is X2, Y1 is Y2 - 1;
X1 is X2, Y1 is Y2 + 1;
X1 is X2 - 1, Y1 is Y2;
X1 is X2 + 1, Y1 is Y2.
bestH(_, []).
bestH(H, [n(_, _, _, H1) | L]) :-
H >= H1,
bestH(H, L).
delete(X, [X | L], L).
delete(X, [Y | L], [Y | L1]) :-
delete(X, L, L1).
exchange(N, [BP, N | L], HF, [CP, N1 | L]) :-
N = n(M, OP, CP, _),
N1 = n(M, OP, BP, H),
h(HF, OP, BP, H).
exchange(N, [BP, N1 | L], HF, [BP1, N1 | L1]) :-
N = n(M, _, _, _),
N1 = n(M1, _, _, _),
not(M = M1),
exchange(N, [BP | L], HF, [BP1 | L1]).
h(sqrSum, p(X1, Y1), p(X2, Y2), H) :-
DX is X1 - X2,
DY is Y1 - Y2,
H is DX * DX + DY * DY.
h(manhattan, p(X1, Y1), p(X2, Y2), H) :-
absDiff(X1, X2, DX),
absDiff(Y1, Y2, DY),
H is DX + DY.
absDiff(X, Y, Z) :-
X >= Y,
Z is X - Y.
absDiff(X, Y, Z) :-
X < Y,
Z is Y - X.