% prog_listswap/2
% Write a DCG for manipulating list elements. The first symbol in every word is
% [begin], followed by any sequence of "instruction" symbols from the set
% {left, right, swap}, and finally [end]. The starting symbol should be named
% prog_listswap.
%
% Example words: [begin,right,swap,end], [begin,right,left,end].
prog_listswap --> [begin], instructs, [end].
instructs --> instr.
instructs --> instr, instructs.
instr --> [left].
instr --> [right].
instr --> [swap].
% prog_listswap/3
% Write a DCG for manipulating list elements. The first symbol in every word is
% [begin], followed by any sequence of "instruction" symbols from the set
% {left, right, swap}, and finally [end]. The starting symbol should be named
% prog_listswap.
%
% The meaning of a word (program) in this language has the form In-->Out,
% mapping from input to output lists. Besides the list contents, internal
% states also hold the current cursor position. The left and right instructions
% move the cursor one step in the given direction, while the swap instruction
% swaps the element under the cursor with its left neighbor (and fails if
% cursor is currently pointing to the first element of the list).
%
% ?- prog_listswap([1,2,3,4]-->Out, [begin,right,swap,end], []).
% Out = [2,1,3,4].
% helper predicate: swap the Ith element with its left neighbor in List
swap([H1,H2|T], 1, [H2,H1|T]).
swap([H|T], C0, [H|NewT]) :-
C0 > 1,
C is C0 - 1,
swap(T, C, NewT).
% start symbol
prog_listswap(In-->Out) -->
[begin], instructs((In,1)-->(Out,_)), [end].
% one instruction
instructs((R0,C0)-->(R,C)) -->
instr((R0,C0)-->(R,C)).
% sequence of instructions
instructs((R0,C0)-->(R,C)) -->
instr((R0,C0)-->(R1,C1)),
instructs((R1,C1)-->(R,C)).
% "left" and "right" instructions move the cursor
% (but not outside list bounds)
instr((R0,C0)-->(R0,C)) -->
[left], { C0 > 1, C is C0 - 1 ; C0 =< 1, C is C0 }. % cursor should not be smaller than 1
instr((R0,C0)-->(R0,C)) -->
[right], { length(R0, LenR0), % cursor should not be greater than list length
( C0 < LenR0, C is C0 + 1 ; C0 >= LenR0, C is C0 ) }.
% "swap" instruction swaps the element under cursor with the element immediately to the left
instr((R0,C0)-->(R,C0)) -->
[swap], {swap(R0,C0,R)}.
% prog_8puzzle/2
% Write a DCG for solving 8-puzzles. The first symbol in every word is [begin],
% followed by any sequence of "instruction" symbols from the set {left, right,
% up, down}, and finally [end]. The starting symbol should be named
% prog_8puzzle.
%
% Example words: [begin,left,down,right,end], [begin,down,end].
prog_8puzzle --> [begin], instructs, [end].
instructs --> instr.
instructs --> instr, instructs.
instr --> [left].
instr --> [right].
instr --> [up].
instr --> [down].
% prog_8puzzle/3
% Write a DCG for solving 8-puzzles. The syntax for this language should be the
% same as in the previous exercise: the first symbol in every word is [begin],
% followed by any sequence of "instruction" symbols from the set {left, right,
% up, down}, and finally [end]. The starting symbol should be named
% prog_8puzzle.
%
% The meaning of a word (program) in this language has the form In-->Out,
% mapping from input to output states. Each state is a (permuted) list of
% numbers from 0 to 8, where 0 stands for the empty square and other numbers
% for the corresponding tiles. The first three numbers in the list correspond
% to the top row of the 8-puzzle, the next three numbers to the middle row, and
% the last three numbers to the last row. The meaning of instructions left,
% right, up and down is to move the blank tile in the given direction.
%
% ?- prog_8puzzle([0,1,2,3,4,5,6,7,8]-->Out, [begin,down,right,end], []).
% Out = [3,1,2,4,0,5,6,7,8].
% helper predicate: swap the Ith and Jth elements in List
swap(R, I1, I2, NewR) :-
( I1 < I2, !,
Ix1 = I1, Ix2 = I2
;
Ix1 = I2, Ix2 = I1), % Ix1 is the smaller index, Ix2 the higher
Cut1 is Ix1 - 1,
Cut2 is Ix2 - Ix1 - 1,
len(LBef, Cut1),
len(LMid, Cut2),
conc(LBef, [E1|RRest], R),
conc(LMid, [E2|LAft], RRest),
conc(LBef, [E2|RIntermediate], NewR),
conc(LMid, [E1|LAft], RIntermediate).
% helper predicate: return the 1-based index I of the element 0 in List
findblank(R, Bx) :-
findblank(R, 1, Bx).
findblank([0|_], Bx, Bx) :- !.
findblank([_|T], Cx, Bx) :-
Cx1 is Cx + 1,
findblank(T, Cx1, Bx).
% start symbol
prog_8puzzle(R0 --> R) -->
[begin],
{ findblank(R0,C0) },
instructs((R0,C0) --> (R,_C)),
[end].
instructs((R0,C0) --> (R,C)) -->
instr((R0,C0) --> (R,C)).
instructs((R0,C0) --> (R,C)) -->
instr((R0,C0) --> (R1,C1)), instructs((R1,C1) --> (R,C)).
instr((R0,C0) --> (R,C)) -->
[left], { Pos is (C0-1) mod 3,
( Pos>0, C is C0-1, swap(R0,C0,C,R)
;
Pos=0, C=C0, R=R0 ) }.
instr((R0,C0) --> (R,C)) -->
[right], { Pos is (C0-1) mod 3,
( Pos<2, C is C0+1, swap(R0,C0,C,R)
;
Pos=2, C=C0, R=R0 ) }.
instr((R0,C0) --> (R,C)) -->
[up], { ( C0>3, C is C0-3, swap(R0,C0,C,R)
;
C0=<3, C=C0, R=R0 ) }.
instr((R0,C0) --> (R,C)) -->
[down], { ( C0=<6, C is C0+3, swap(R0,C0,C,R)
;
C0>6, C=C0, R=R0 ) }.