PROLOG-REQUEST@SUSHI.STANFORD.EDU (Chuck Restivo, The Moderator) (12/31/87)
PROLOG Digest Friday, 1 Jan 1988 Volume 6 : Issue 1
Today's Topics:
Administration - Archives,
Puzzles - Tick & Baskett
----------------------------------------------------------------------
Date: Thu 31 Dec 87 06:27:29-PST
From: Chuck Restivo <Restivo@Sushi.Stanford.EDU>
Subject: Archives
We are entering the sixth year the Digest has been produced. Archives
for all past issues are available for FT from {SU-SUSHI.STANFORD.EDU}
under the <PROLOG.DIGEST> directory. Each year's issues are organized
in an individual volume. The volume's can be read with MM but will
still be useful if your site does not support that utility. {SUSHI:}
observes typical anonymous login conventions.
The Stanford Crew are a swell bunch of guys. I would like to thank
the Computer Science Department at Stanford University for continuing
to provide the resources that we have all benefited from. Special
thanks are in order to Lester Earnest and Professor McCarthy.
-- ed
SUSHI:<PROLOG.DIGEST>
.VOLUME1.1;P770000 188 478729(7) 23-Jan-87 19:41:48 RESTIVO
.VOLUME2.1;P770000 189 482235(7) 24-Jan-87 10:00:54 RESTIVO
.VOLUME3.1;P770000 221 563713(7) 24-Jan-87 10:39:33 RESTIVO
.VOLUME4P1.1;P770000 121 308281(7) 24-Jan-87 10:43:32 RESTIVO
.VOLUME4P2.1;P770000 281 719256(7) 23-Dec-86 00:04:48 RESTIVO
.VOLUME5P1.1;P775202 177 451342(7) 29-Oct-87 03:19:57 RESTIVO
.VOLUME5P2.1;P775202 278 711647(7) 31-Dec-87 05:22:34 RESTIVO
Total of 1638 pages in 9 files
------------------------------
Date: Thu, 31 Dec 87 11:35:58 PST
From: <udi%WISDOM.BITNET@CNUCE-VM.ARPA>
Subject: Evan's puzzle
In a recent note Evan Tick suggested that the fate of concurrent logic
programming languages is endangered by a certain benchmark problem,
Forest Baskett's puzzle. He said that he tried implementing it in
FGHC, but failed: either the program ran for four hours without
solving the problem, or it ran out of space.
Enclosed are two solutions to the problem, written in FCP. The first
is a manual partial-evaluation of a variant of the Or-Parallel Prolog
interpreter written in FCP (see reference below), with respect to
Evan's original Prolog program that solves the puzzle. The
interpreter used differs from the original interpreter in the that it
employs parallel depth-first, rather then parallel breadth-first,
search strategy, and stops after the first solution is found. This is
according to the problem specification. The number of processors
participating in the search is a program parameter.
The program solves the puzzle (with one processor) in about 4.5 CPU
minutes on a Sun-3/50, and in 85 CPU seconds on a CCI Power/6.
For comparison, Evan's Prolog program runs interpreted under
Quintus Prolog Version 1.0 on the Sun-3/50 for 55 seconds,
and compiled 12 seconds, and under C-Prolog on the CCI
for 11 CPU seconds. The FCP program was not yet ported to the parallel
implementation of FCP on the iPSC Hypercube, but experience with
previous programs suggest that with 16 processors a speedup of about
10 is attainable (after scaling processor speeds, of course).
The second solution is a brute-force depth-first Or-parallel Prolog
interpreter, which, instead of recomputing alternative branches,
simply freezes the state on each choice point, and melts it for the
alternative choices. It solves the puzzle in 3.8 CPU minutes on a
Sun-3/50 (60 seconds on the CCI). It was not ported to the iPSC Hypercube
either, but I expect smaller speedup, since instead of communicating prefixes,
which are lists of small integers, it communicates frozen states, which are
a much bigger data-structure.
I will report the performance results for the hypercube when we port
these programs, probably after Steve Taylor returns from the U.S.
in February.
Evan was mainly interested in an FGHC solution. Unfortunately, the
FCP solution can not be easily ported to FGHC, since the program
uses full test-unification in an essential way, inheriting
it from Evan's original Prolog program. This is a manifestation of
the general statement, made in the "Or-Parallel Prolog in FCP" paper,
concerning the inadequacy of GHC and PARLOG to interpret Prolog,
because of their weaker notion of unification.
The paper appeared in "Logic Programming: Proc. of the Fourth
International Conference", (JL Lassez, ed.), and (slightly revised) in
"Concurrent Prolog: Collected Papers" (E. Shapiro, ed.), both by MIT
Press.
-- Ehud Shapiro
udi@wisdom.{bitnet,csnet}
p.s. There is a discrepancy between Evan's verbal description of the problem
("All 2005 solutions must be calculated and counted, but not
printed.") and the Prolog program he wrote, which finds the first solution,
and counts the (2005) steps leading to it. Perhaps he tried solving
in FGHC the `all-solutions' problem, which has of course a much larger
search space. The FCP programs follow Evan's Prolog code rather then
his verbal description.
A note on the programs:
It will probably be hard to understand the programs without first reading
Evan's Prolog program and the Or-Parallel Prolog in FCP.
The programs are a bit more cumbersome then needed, since they also
solve a simpler puzzle that was used for debugging.
The programs are written in Typed FCP. They can be run on older versions
of Logix that do not support Typed FCP by commenting out the type
definitions and declarations.
*** Evan's original Prolog program:
%------------------------------------------------------------------------------
% Benchmark Program - Puzzle (Quintus Prolog Version)
% Lisp vs. Prolog Study
%
% Copyright by Evan Tick
% Date: October 30 1985
%
% To test or collect statistics: run test/0.
% Should print "2005 trials".
%------------------------------------------------------------------------------
:- dynamic count/1.
test :-
make_board(Board),
initialize(Board,Pieces),
play(Board,Pieces).
initialize([Spot|_],[[b,c,d,e,f,g,h,i,j,k,l,m],[n,o,p],[q],[r]]) :-
(retract(count(_));true),assert(count(1)),
p1(a,Spot). % first move fixed
play([],_) :- % game over
count(N),write(N),write(' trials'),nl.
play([s(V,_,_,_)|Rest],Pieces) :- % spot already filled
nonvar(V),!,
play(Rest,Pieces).
play([Spot|Rest],Pieces) :-
fill(Spot,Pieces,NewPieces), % spot empty - try to fill
incr,
play(Rest,NewPieces).
incr :-
retract(count(Count)),NCount is Count+1,
% write(Count),nl,
assert(count(NCount)),!.
fill(Spot,[[Mark|P1]|T],[P1|T]) :- p1(Mark,Spot).
fill(Spot,[P1,[Mark|P2]|T],[P1,P2|T]) :- p2(Mark,Spot).
fill(Spot,[P1,P2,[Mark|P3]|T],[P1,P2,P3|T]) :- p3(Mark,Spot).
fill(Spot,[P1,P2,P3,[Mark|P4]|T],[P1,P2,P3,P4|T]) :- p4(Mark,Spot).
% piece templates:
% p1 = 4x2x1: 6 orientations
% 4-2-1
p1(M,s(M,s(M,s(M,s(M,_,C13,_),C12,_),C11,_),s(M,C11,_,_),_)) :-
C13 = s(M, _,_,_),
C12 = s(M,C13,_,_),
C11 = s(M,C12,_,_).
% 2-1-4
p1(M,s(M,s(M,_,_,C11),_,s(M,C11,_,s(M,C12,_,s(M,C13,_,_))))) :-
C13 = s(M,_,_, _),
C12 = s(M,_,_,C13),
C11 = s(M,_,_,C12).
% 1-4-2
p1(M,s(M,_,s(M,_,s(M,_,s(M,_,_,C13),C12),C11),s(M,_,C11,_))) :-
C13 = s(M,_, _,_),
C12 = s(M,_,C13,_),
C11 = s(M,_,C12,_).
% 2-4-1
p1(M,s(M,s(M,_,C11,_),s(M,C11,s(M,C12,s(M,C13,_,_),_),_),_)) :-
C13 = s(M,_, _,_),
C12 = s(M,_,C13,_),
C11 = s(M,_,C12,_).
% 4-1-2
p1(M,s(M,s(M,s(M,s(M,_,_,C13),_,C12),_,C11),_,s(M,C11,_,_))) :-
C13 = s(M, _,_,_),
C12 = s(M,C13,_,_),
C11 = s(M,C12,_,_).
% 1-2-4
p1(M,s(M,_,s(M,_,_,C11),s(M,_,C11,s(M,_,C12,s(M,_,C13,_))))) :-
C13 = s(M,_,_, _),
C12 = s(M,_,_,C13),
C11 = s(M,_,_,C12).
/*
p1(M,C00) :- % 4-2-1
C00 = s(M,C01,C10,_), C10 = s(M,C11,_,_),
C01 = s(M,C02,C11,_), C11 = s(M,C12,_,_),
C02 = s(M,C03,C12,_), C12 = s(M,C13,_,_),
C03 = s(M, _,C13,_), C13 = s(M, _,_,_).
p1(M,C00) :- % 2-1-4
C00 = s(M,C10,_,C01), C10 = s(M,_,_,C11),
C01 = s(M,C11,_,C02), C11 = s(M,_,_,C12),
C02 = s(M,C12,_,C03), C12 = s(M,_,_,C13),
C03 = s(M,C13,_, _), C13 = s(M,_,_, _).
p1(M,C00) :- % 1-4-2
C00 = s(M,_,C01,C10), C10 = s(M,_,C11,_),
C01 = s(M,_,C02,C11), C11 = s(M,_,C12,_),
C02 = s(M,_,C03,C12), C12 = s(M,_,C13,_),
C03 = s(M,_, _,C13), C13 = s(M,_, _,_).
p1(M,C00) :- % 2-4-1
C00 = s(M,C10,C01,_), C10 = s(M,_,C11,_),
C01 = s(M,C11,C02,_), C11 = s(M,_,C12,_),
C02 = s(M,C12,C03,_), C12 = s(M,_,C13,_),
C03 = s(M,C13, _,_), C13 = s(M,_, _,_).
p1(M,C00) :- % 4-1-2
C00 = s(M,C01,_,C10), C10 = s(M,C11,_,_),
C01 = s(M,C02,_,C11), C11 = s(M,C12,_,_),
C02 = s(M,C03,_,C12), C12 = s(M,C13,_,_),
C03 = s(M, _,_,C13), C13 = s(M, _,_,_).
p1(M,C00) :- % 1-2-4
C00 = s(M,_,C10,C01), C10 = s(M,_,_,C11),
C01 = s(M,_,C11,C02), C11 = s(M,_,_,C12),
C02 = s(M,_,C12,C03), C12 = s(M,_,_,C13),
C03 = s(M,_,C13, _), C13 = s(M,_,_, _).
*/
% p2 = 3x1x1: 3 orientations
p2(M,s(M,s(M,s(M,_,_,_),_,_),_,_)).
p2(M,s(M,_,s(M,_,s(M,_,_,_),_),_)).
p2(M,s(M,_,_,s(M,_,_,s(M,_,_,_)))).
%p2(C00,M) :- C00 = s(M,C01,_,_), C01 = s(M,C02,_,_), C02 = s(M,_,_,_).
%p2(C00,M) :- C00 = s(M,_,C01,_), C01 = s(M,_,C02,_), C02 = s(M,_,_,_).
%p2(C00,M) :- C00 = s(M,_,_,C01), C01 = s(M,_,_,C02), C02 = s(M,_,_,_).
% p3 = 2x2x1: 3 orientations
p3(M,s(M,s(M,_,C,_),s(M,C,_,_),_)) :- % 2-2-1
C = s(M,_,_,_).
p3(M,s(M,s(M,_,_,C),_,s(M,C,_,_))) :- % 2-1-2
C = s(M,_,_,_).
p3(M,s(M,_,s(M,_,_,C),s(M,_,C,_))) :- % 1-2-2
C = s(M,_,_,_).
%p3(M,C00) :- % 2-2-1
% C00 = s(M,C10,C01,_), C10 = s(M,_,C11,_),
% C01 = s(M,C11, _,_), C11 = s(M,_, _,_).
%p3(M,C00) :- % 1-2-2
% C00 = s(M,_,C10,C01), C10 = s(M,_,_,C11),
% C01 = s(M,_,C11, _), C11 = s(M,_,_, _).
% p4 = 2x2x2: 1 orientation
p4(M,s(M,s(M,_,C110,C101),s(M,C110,_,s(M,C111,_,_)),s(M,C101,C011,_))) :-
C110 = s(M, _, _,C111),
C101 = s(M, _,C111, _),
C011 = s(M,C111, _, _),
C111 = s(M, _, _, _).
/*
p4(M,C000) :-
C000 = s(M,C100,C010,C001),
C100 = s(M, _,C110,C101),
C010 = s(M,C110, _,C011),
C110 = s(M, _, _,C111),
C001 = s(M,C101,C011, _),
C101 = s(M, _,C111, _),
C011 = s(M,C111, _, _),
C111 = s(M, _, _, _).
*/
make_board(Level0) :-
make_level(Level0-Level1,Level1-_),
make_level(Level1-Level2,Level2-_),
make_level(Level2-Level3,Level3-_),
make_level(Level3-Level4,Level4-_),
make_level(Level4-[],[ z,z,z,z,z,
z,z,z,z,z,
z,z,z,z,z,
z,z,z,z,z,
z,z,z,z,z]-[]).
make_level(C-Link,Z-L) :-
C= [C00,C10,C20,C30,C40,
C01,C11,C21,C31,C41,
C02,C12,C22,C32,C42,
C03,C13,C23,C33,C43,
C04,C14,C24,C34,C44|Link],
Z= [Z00,Z10,Z20,Z30,Z40,
Z01,Z11,Z21,Z31,Z41,
Z02,Z12,Z22,Z32,Z42,
Z03,Z13,Z23,Z33,Z43,
Z04,Z14,Z24,Z34,Z44|L],
C00 = s(_,C10,C01,Z00),
C10 = s(_,C20,C11,Z10),
C20 = s(_,C30,C21,Z20),
C30 = s(_,C40,C31,Z30),
C40 = s(_, z,C41,Z40),
C01 = s(_,C11,C02,Z01),
C11 = s(_,C21,C12,Z11),
C21 = s(_,C31,C22,Z21),
C31 = s(_,C41,C32,Z31),
C41 = s(_, z,C42,Z41),
C02 = s(_,C12,C03,Z02),
C12 = s(_,C22,C13,Z12),
C22 = s(_,C32,C23,Z22),
C32 = s(_,C42,C33,Z32),
C42 = s(_, z,C43,Z42),
C03 = s(_,C13,C04,Z03),
C13 = s(_,C23,C14,Z13),
C23 = s(_,C33,C24,Z23),
C33 = s(_,C43,C34,Z33),
C43 = s(_, z,C44,Z43),
C04 = s(_,C14, z,Z04),
C14 = s(_,C24, z,Z14),
C24 = s(_,C34, z,Z24),
C34 = s(_,C44, z,Z34),
C44 = s(_, z, z,Z44).
/*
portray(board(Board)) :- !,write_board(Board),!.
portray([s(V,_,_,_)|T]) :- !,write_board([s(V,_,_,_)|T]),!.
portray(s(V,_,_,_)) :- !,write(s(V)),!.
write_board(Board) :-
nl,write_board(Board,0),nl.
write_board(V,_) :-
var(V),!,write(V).
write_board([],_).
write_board([s(V,_,_,_)|T],N) :-
(N mod 5 =\= 0 ; write(' ')),
(N mod 25 =\= 0 ; nl),
(var(V) -> write('_') ; write(V)),
N1 is N+1,
write_board(T,N1).
*/
*** First FCP program:
%------------------------------------------------------------------------------
% Benchmark Program - Puzzle (Quintus Prolog Version)
% Lisp vs. Prolog Study
%
% Copyright by Evan Tick
% Date: October 30 1985
%
% Adapted to Typed FCP by Ehud Shapiro, December 21st, 1987.
% Multiprocessor version, depth first search using
% the recomputation strategy.
%
% To execute:
% board#make_board(BoardIndex,Board) :- to compute Board.
%
% run(BoardIndex,N,Board,Queries) :- to solve with N processors.
% To find the current number of trials during execution, send the query:
% Queries=[trial(T^)|Queries1].
%------------------------------------------------------------------------------
-language(typed_fcp).
-syntax(typed_fcp).
-mode(trust).
-export([run/4,queue/3]).
Board ::= board#Board.
BoardIndex ::= board#BoardIndex.
Id ::= board#Id.
Cell ::= board#Cell.
InitialBoard ::= board#InitialBoard.
FrozenBoard ::= String.
Restart ::= restart(FrozenBoard,Pieces).
Pieces ::= [PiecesOfAKind|[PiecesOfAKind]].
PiecesOfAKind ::= [Id|[Id]].
Move ::= Integer ; last.
MoveAttempt ::= Move ; failed.
Path ::= [Move].
Trail ::= [Move].
Continuation ::= Integer.
Trial ::= Integer.
Processors ::= Integer.
ToQueue ::= [QueueRequest|[QueueRequest]].
EnQDeQ ::=
enqueue(QueueElement) ;
dequeue(QueueElement).
QueueRequest ::=
EnQDeQ ;
solution;
trial(Trial).
ToQueueMerger ::= [QueueMergerRequest] ; None.
QueueMergerRequest ::= QueueRequest ; merge(ToQueue).
QueueElement ::= (Path,Continuation).
Queue ::= [EnQDeQ].
procedure run(BoardIndex,Processors,Board,Integer).
run(BoardIndex,Processors,Board,ToQueue1) :-
freeze#freeze(Board,FrozenBoard,_),
pieces(BoardIndex,Pieces),
processors(Processors,restart(FrozenBoard?,Pieces),ToQueueMerger),
stream#merger([merge(ToQueue1)|ToQueueMerger],ToQueue),
initial_continuation(BoardIndex?,QueueElement),
queue([enqueue(QueueElement)|ToQueue],[],0).
procedure initial_continuation(BoardIndex,QueueElement).
initial_continuation(1,([],1)).
initial_continuation(5,([1,0,0,0],1)). % first move fixed.
procedure pieces(BoardIndex,Pieces).
pieces(1,[[a],[m,n,o,p],[],[]]).
pieces(5,[[a,b,c,d,e,f,g,h,i,j,k,l,m],[n,o,p],[q],[r]]).
procedure queue(ToQueue,Queue,Trial).
queue([dequeue(X)|In],[enqueue(X)|Queue],Trial) :-
queue(In?,Queue,Trial?).
queue([dequeue(X)|In],Queue,Trial) :-
otherwise | % Queue empty or first request is dequeue(_).
queue(In?,[dequeue(X)|Queue],Trial).
queue([enqueue(X)|In],[dequeue(X)|Queue],Trial) :-
queue(In?,Queue,Trial).
queue([enqueue(X)|In],Queue,Trial) :-
otherwise | % Queue empty or first request is enqueue(_).
queue(In?,[enqueue(X)|Queue],Trial).
queue([trial|In],Queue,Trial) :-
Trial1 := Trial+1,
queue(In?,Queue,Trial1?).
queue([solution|In],Queue,Trial) :-
screen#display(solution_after(Trial)).
queue([trial(Trial)|In],Queue,Trial) :-
queue(In?,Queue,Trial).
procedure processors(Processors,Restart,ToQueueMerger).
processors(0,_,[]).
processors(N,Restart,[merge(ToQueue)|ToQueue1]) :-
N>0 |
processor(ToQueue,Restart), % @here
N1:=N-1,
processors(N1?,Restart,ToQueue1). % @next
procedure processor(ToQueue,Restart).
processor([dequeue((Path,Cont))|ToQ],restart(FrozenBoard,Pieces)) :-
freeze#melt(FrozenBoard,Board,_),
trace(Path?,Board?,Pieces?,Cont?,Path,restart(FrozenBoard?,Pieces),ToQ).
procedure trace(Path,InitialBoard,Pieces,Continuation,Path,Restart,ToQueue).
trace([Move|Moves],[Spot|Rest],Pieces,Cont,Path,Restart,ToQ) :-
Move =\= 0 |
fill(Move,0,Spot,Pieces,NewPieces),
trace(Moves?,Rest,NewPieces,Cont,Path,Restart,ToQ).
trace([0|Moves],[Spot|Rest],Pieces,Cont,Path,Restart,ToQ) :-
trace(Moves?,Rest,Pieces,Cont,Path,Restart,ToQ).
trace([],[Spot|Rest],Pieces,Cont,Path,Restart,ToQ) :-
fill(Move,Cont,Spot,Pieces,NewPieces),
continue(Move?,Rest,NewPieces,Path,[],Restart,ToQ).
procedure continue(MoveAttempt,Board,Pieces,Path,Trail,Restart,ToQueue).
continue(failed,Rest,NewPieces,Path,Trail,Restart,ToQ) :-
processor(ToQ,Restart).
continue(last,Rest,NewPieces,Path,Trail,Restart,ToQ) :-
explore(Rest,NewPieces,Path,[last|Trail],Restart,ToQ).
continue(Move,Rest,NewPieces,Path,Trail,Restart,
[enqueue((NewPath?,Cont?))|ToQ]
) :-
Move =\= failed, Move =\= last |
Cont := Move+1,
append_reverse(Path?,Trail?,NewPath),
explore(Rest,NewPieces?,Path,[Move|Trail],Restart,ToQ).
procedure explore(Board,Pieces,Path,Trail,Restart,ToQueue).
explore([],_,_,_,Restart,[solution|ToQ]). % Thats's it for me.
explore([{V,_,_,_}|Rest],Pieces,Path,Trail,Restart,ToQ) :-
% spot already filled
known(V) |
explore(Rest?,Pieces,Path,[0|Trail],Restart,ToQ).
explore([{V?,X,Y,Z}|Rest],Pieces,Path,Trail,Restart,[trial|ToQ]) :-
% spot empty - try to fill
fill(Move,0,{V,X,Y,Z},Pieces,NewPieces),
continue(Move?,Rest,NewPieces?,Path,Trail,Restart,ToQ).
procedure fill(MoveAttempt,Continuation,Cell,Pieces,Pieces).
% p1 = 4x2x1: 6 orientations
fill(1,Cont,{M,{M,{M,{M,_,C13,_},C12,_},C11,_},{M,C11,_,_},_},
[[M|P1]|T],[P1|T]) :- % 4-2-1
Cont=<1,
C13 = {M, _,_,_},
C12 = {M,C13,_,_},
C11 = {M,C12,_,_} | true.
fill(2,Cont,{M,{M,_,_,C11},_,{M,C11,_,{M,C12,_,{M,C13,_,_}}}},
[[M|P1]|T],[P1|T]) :- % 2-1-4
Cont=<2,
C13 = {M,_,_, _},
C12 = {M,_,_,C13},
C11 = {M,_,_,C12} | true.
fill(3,Cont,{M,_,{M,_,{M,_,{M,_,_,C13},C12},C11},{M,_,C11,_}},
[[M|P1]|T],[P1|T]) :- % 1-4-2
Cont=<3,
C13 = {M,_, _,_},
C12 = {M,_,C13,_},
C11 = {M,_,C12,_} | true.
fill(4,Cont,{M,{M,_,C11,_},{M,C11,{M,C12,{M,C13,_,_},_},_},_},
[[M|P1]|T],[P1|T]) :- % 2-4-1
Cont=<4,
C13 = {M,_, _,_},
C12 = {M,_,C13,_},
C11 = {M,_,C12,_} | true.
fill(5,Cont,{M,{M,{M,{M,_,_,C13},_,C12},_,C11},_,{M,C11,_,_}},
[[M|P1]|T],[P1|T]) :- % 4-1-2
Cont=<5,
C13 = {M, _,_,_},
C12 = {M,C13,_,_},
C11 = {M,C12,_,_} | true.
fill(6,Cont,{M,_,{M,_,_,C11},{M,_,C11,{M,_,C12,{M,_,C13,_}}}},
[[M|P1]|T],[P1|T]) :- % 1-2-4
Cont=<6,
C13 = {M,_,_, _},
C12 = {M,_,_,C13},
C11 = {M,_,_,C12} | true.
% p2 = 3x1x1: 3 orientations
fill(7,Cont,{M,{M,{M,_,_,_},_,_},_,_},[P1,[M|P2]|T],[P1,P2|T]) :-
Cont=<7 | true.
fill(8,Cont,{M,_,{M,_,{M,_,_,_},_},_},[P1,[M|P2]|T],[P1,P2|T]) :-
Cont=<8 | true.
fill(9,Cont,{M,_,_,{M,_,_,{M,_,_,_}}},[P1,[M|P2]|T],[P1,P2|T]) :-
Cont=<9 | true.
% p3 = 2x2x1: 3 orientations
fill(10,Cont,{M,{M,_,C,_},{M,C,_,_},_},[P1,P2,[M|P3]|T],[P1,P2,P3|T]) :-
Cont=<10,
C = {M,_,_,_} | true.
fill(11,Cont,{M,{M,_,_,C},_,{M,C,_,_}},[P1,P2,[M|P3]|T],[P1,P2,P3|T]) :-
Cont=<11,
C = {M,_,_,_} | true.
fill(12,Cont,{M,_,{M,_,_,C},{M,_,C,_}},[P1,P2,[M|P3]|T],[P1,P2,P3|T]) :-
Cont=<12,
C = {M,_,_,_} | true.
% p4 = 2x2x2: 1 orientation
fill(last,Cont,{M,{M,_,C110,C101},{M,C110,_,{M,C111,_,_}},{M,C101,C011,_}},
[P1,P2,P3,[M|P4]|T],[P1,P2,P3,P4|T]) :-
Cont=<13,
C110 = {M, _, _,C111},
C101 = {M, _,C111, _},
C011 = {M,C111, _, _},
C111 = {M, _, _, _} | true.
fill(failed,Cont,Spot,P,P) :-
otherwise | true.
% Note: literally speaking, there is a need for 'otherwise' in every
% clause, to ensure sequential clause try.
procedure append_reverse([Any],[Any],[Any]).
append_reverse([X|Xs],Ys,[X|Zs]) :-
append_reverse(Xs?,Ys,Zs).
append_reverse([],Ys,Zs) :-
reverse(Ys?,[],Zs).
procedure reverse([Any],[Any],[Any]).
reverse([],Ys,Ys).
reverse([X|Xs],Ys,Zs) :-
reverse(Xs?,[X|Ys],Zs).
*** Seconds FCP program:
%------------------------------------------------------------------------------
% Benchmark Program - Puzzle (Quintus Prolog Version)
% Lisp vs. Prolog Study
%
% Copyright by Evan Tick
% Date: October 30 1985
%
% Adapted to Typed FCP by Ehud Shapiro, December 21st, 1987.
% Multiprocessor version, depth first search.
% Brute force method (freeze state in each choice point).
% To execute:
% run(BoardIndex,N,Board,Queries)
%------------------------------------------------------------------------------
-syntax(typed_fcp).
-language(typed_fcp).
-mode(trust).
-export([run/4]).
Board ::= board#Board.
BoardIndex ::= board#BoardIndex.
Id ::= board#Id.
Cell ::= board#Cell.
InitialBoard ::= board#InitialBoard.
FrozenBoard ::= String.
State ::= (FrozenBoard,Pieces,Continuation).
Pieces ::= [PiecesOfAKind|[PiecesOfAKind]].
PiecesOfAKind ::= [Id|[Id]].
Move ::= Integer ; last.
MoveAttempt ::= Move ; failed.
Path ::= [Move].
Trail ::= [Move].
Continuation ::= Integer.
Trial ::= Integer.
Processors ::= Integer.
ToQueue ::= [QueueRequest|[QueueRequest]].
EnQDeQ ::=
enqueue(QueueElement) ;
dequeue(QueueElement).
QueueRequest ::=
EnQDeQ ;
solution ;
trial ;
trial(Trial).
ToQueueMerger ::= [QueueMergerRequest].
QueueMergerRequest ::= QueueRequest ; merge(ToQueue).
QueueElement ::= State.
Queue ::= [EnQDeQ].
procedure run(BoardIndex,Processors,Board,Integer).
run(BoardIndex,Processors,Board,ToQueue1) :-
freeze#freeze(Board,FrozenBoard,_),
pieces(BoardIndex,Pieces),
processors(Processors,ToQueueMerger),
stream#merger([merge(ToQueue1)|ToQueueMerger],ToQueue),
QueueElement=(FrozenBoard,Pieces,0),
puzzle8#queue([enqueue(QueueElement)|ToQueue],[],0).
procedure pieces(BoardIndex,Pieces).
pieces(1,[[a],[m,n,o,p],[],[]]).
pieces(5,[[a,b,c,d,e,f,g,h,i,j,k,l,m],[n,o,p],[q],[r]]).
procedure processors(Processors,ToQueueMerger).
processors(0,[]).
processors(N,[merge(ToQueue)|ToQueue1]) :-
N>0 |
processor(ToQueue), % @here
N1:=N-1,
processors(N1?,ToQueue1). % @next
procedure processor(ToQueue).
processor([dequeue((FrozenBoard,Pieces,Cont))|ToQ]) :-
freeze#melt(FrozenBoard,Board,_),
Board? = [Spot|Rest],
fill(Move,Cont?,Spot?,Pieces,NewPieces),
continue(Move?,Rest,NewPieces,FrozenBoard,Pieces,ToQ).
procedure continue(MoveAttempt,Board,Pieces,FrozenBoard,Pieces,ToQueue).
continue(failed,Rest,NewPieces,FrozenBoard,Pieces,ToQ) :-
processor(ToQ).
continue(last,Rest,NewPieces,FrozenBoard,Pieces,ToQ) :-
explore(Rest,NewPieces,ToQ).
continue(Move,Rest,NewPieces,FrozenBoard,Pieces,
[enqueue((FrozenBoard?,Pieces,Cont?))|ToQ]
) :-
Move =\= failed, Move =\= last |
Cont := Move+1,
explore(Rest,NewPieces?,ToQ).
procedure explore(Board,Pieces,ToQueue).
explore([],_,[solution|ToQ]). % That's it for me.
explore([{V,_,_,_}|Rest],Pieces,ToQ) :-
% spot already filled
known(V) |
explore(Rest?,Pieces,ToQ).
explore(Board,Pieces,[trial|ToQ]) :-
% spot empty - try to fill
Board = [{V,X,Y,Z}|Rest],
unknown(V) |
freeze#freeze(Board,FrozenBoard,_),
wait_then_continue(FrozenBoard?,Board,Pieces,ToQ).
wait_then_continue(FrozenBoard,[{V,X,Y,Z}|Rest],Pieces,ToQ) :-
known(FrozenBoard) |
fill(Move,0,{V,X,Y,Z},Pieces,NewPieces),
continue(Move?,Rest,NewPieces?,FrozenBoard,Pieces,ToQ).
procedure fill(MoveAttempt,Continuation,Cell,Pieces,Pieces).
% (same is in puzzle8)
*** Utility program:
%------------------------------------------------------------------------------
% Benchmark Program - Puzzle (Quintus Prolog Version)
% Lisp vs. Prolog Study
%
% Copyright by Evan Tick
% Date: October 30 1985
%
% Adapted to Typed FCP by Ehud Shapiro, December 21st, 1987.
%
% To execute:
% make_board(BoardIndex,Board) :- to compute Board, BoardIndex ::= 1 ; 5.
%------------------------------------------------------------------------------
-module(board).
-syntax(typed_fcp).
-language(typed_fcp).
-export([make_board/2]).
Cell ::= {Id,CellPointer,CellPointer,CellPointer}.
Id ::= String.
CellPointer ::= Cell ; z.
Board ::= [Cell].
InitialBoard ::= [Cell|Board]. % nonempty.
BoardIndex ::= 1 ; 5.
procedure make_board(Integer,Board).
make_board(1,Level0) :-
make_level4x5(Level0-[],[ z,z,z,z,z,
z,z,z,z,z,
z,z,z,z,z,
z,z,z,z,z]-[]).
procedure make_board(BoardIndex,Board).
make_board(5,Level0) :-
make_level(Level0-Level1,Level1-_),
make_level(Level1-Level2,Level2-_),
make_level(Level2-Level3,Level3-_),
make_level(Level3-Level4,Level4-_),
make_level(Level4-[],[ z,z,z,z,z,
z,z,z,z,z,
z,z,z,z,z,
z,z,z,z,z,
z,z,z,z,z]-[]).
make_board(1,Level0) :-
make_level4x5(Level0-[],[ z,z,z,z,z,
z,z,z,z,z,
z,z,z,z,z,
z,z,z,z,z]-[]).
procedure make_level(Board-[CellPointer],[CellPointer]-[CellPointer]).
make_level(C-Link,Z-L) :-
C= [C00,C10,C20,C30,C40,
C01,C11,C21,C31,C41,
C02,C12,C22,C32,C42,
C03,C13,C23,C33,C43,
C04,C14,C24,C34,C44|Link],
Z= [Z00,Z10,Z20,Z30,Z40,
Z01,Z11,Z21,Z31,Z41,
Z02,Z12,Z22,Z32,Z42,
Z03,Z13,Z23,Z33,Z43,
Z04,Z14,Z24,Z34,Z44|L],
C00 = {_,C10,C01,Z00},
C10 = {_,C20,C11,Z10},
C20 = {_,C30,C21,Z20},
C30 = {_,C40,C31,Z30},
C40 = {_, z,C41,Z40},
C01 = {_,C11,C02,Z01},
C11 = {_,C21,C12,Z11},
C21 = {_,C31,C22,Z21},
C31 = {_,C41,C32,Z31},
C41 = {_, z,C42,Z41},
C02 = {_,C12,C03,Z02},
C12 = {_,C22,C13,Z12},
C22 = {_,C32,C23,Z22},
C32 = {_,C42,C33,Z32},
C42 = {_, z,C43,Z42},
C03 = {_,C13,C04,Z03},
C13 = {_,C23,C14,Z13},
C23 = {_,C33,C24,Z23},
C33 = {_,C43,C34,Z33},
C43 = {_, z,C44,Z43},
C04 = {_,C14, z,Z04},
C14 = {_,C24, z,Z14},
C24 = {_,C34, z,Z24},
C34 = {_,C44, z,Z34},
C44 = {_, z, z,Z44}.
procedure make_level4x5(Board-[CellPointer],[CellPointer]-[CellPointer]).
make_level4x5(C-Link,Z-L) :-
C= [C01,C11,C21,C31,C41,
C02,C12,C22,C32,C42,
C03,C13,C23,C33,C43,
C04,C14,C24,C34,C44|Link],
Z= [Z01,Z11,Z21,Z31,Z41,
Z02,Z12,Z22,Z32,Z42,
Z03,Z13,Z23,Z33,Z43,
Z04,Z14,Z24,Z34,Z44|L],
C01 = {_,C11,C02,Z01},
C11 = {_,C21,C12,Z11},
C21 = {_,C31,C22,Z21},
C31 = {_,C41,C32,Z31},
C41 = {_, z,C42,Z41},
C02 = {_,C12,C03,Z02},
C12 = {_,C22,C13,Z12},
C22 = {_,C32,C23,Z22},
C32 = {_,C42,C33,Z32},
C42 = {_, z,C43,Z42},
C03 = {_,C13,C04,Z03},
C13 = {_,C23,C14,Z13},
C23 = {_,C33,C24,Z23},
C33 = {_,C43,C34,Z33},
C43 = {_, z,C44,Z43},
C04 = {_,C14, z,Z04},
C14 = {_,C24, z,Z14},
C24 = {_,C34, z,Z24},
C34 = {_,C44, z,Z34},
C44 = {_, z, z,Z44}.
------------------------------
End of PROLOG Digest
********************