🚀 go-pugleaf

RetroBBS NetNews Server

Inspired by RockSolid Light RIP Retro Guy

Article View: comp.lang.prolog
Article #667

A little block stacking program

#667
From: Ken Johnson
Date: Thu, 20 Aug 1992 17:50
129 lines
4142 bytes

% A little block stacking program.
% Ken Johnson 20 August 1992
% You may use and distribute this code freely but if you sell copies of it
% at a profit, I want a share. 
% 
% The state of the game is represented in a canonical form; it is
% important that your start and goal states are stated in canonical form. 
% There is no check that the problem is correctly stated and feasible, so
% don't say I didn't warn you.
%
% The canonical form is a term state/1 whose argument is list of lists of
% atoms.  Each sublist is a pile, each atom is a brick name, leftmost on
% top.  The empty pile does not exist.  Lists are ordered by their first
% atom using sort/2.  So both
% 
%   A                    A
%   B   C       and  C   B
%   -----            -----
% 
% are represented as state([[a,b],[c]]) because a precedes c
% 
% The method uses iterative deepening and depth first search; this
% combination is guaranteed to find first the path with the fewest moves. 
% The part is a list of states.

% Run example_1/0 and example_2/0 to get the idea

% Example 1 starts from
%                              C
%   A                          B
%   B  C      and moves to     A

example_1 :-
	Start = state([[a,b],[c]]),
	Goal  = state([[c,b,a]]),
	search(Start,Goal,Path),
	write('Start '), write(Start), nl,
	write('Goal '), write(Goal), nl,
	write('Path '), write(Path), nl.

% Example 2
%                           B
%   A                       C
%   B   D                   D
%   C   E               E   A

example_2 :-
	Start = state([[a,b,c],[d,e]]),
	Goal  = state([[b,c,d,a],[e]]),		% Canonical order!
	search(Start,Goal,Path),
	write('Start '), write(Start), nl,
	write('Goal '), write(Goal), nl,
	write('Path '), write(Path), nl.

% To search for a state

search(A,B,P) :-
	search_w_lim(0,A,B,R),			% Iterative limit init 0
	reverse(R,P).				% Reverse path as it is
                                                % saved in reverse order
search_w_lim(N,A,B,R) :-
	search(N,A,B,R).

search_w_lim(N,A,B,R) :-
	N1 is N + 1,
	search_w_lim(N1,A,B,R).

search(N,A,B,R) :-				% Real work starts here
	search_1(N,[A],B,R).

search_1(_,[G|As],G,[G|As]).			% Found goal, succeed

search_1(N,[A|As],G,R) :-			% Not there yet
	N > 0,					% Can make more moves?
	move(A,B),				% Find applicable move
	\+ member(B,[A|As]),			% Check new state not used
	N1 is N - 1,				% Decr move limit
	search_1(N1,[B,A|As],G,R).		% Keep going

% What the moves are:
% (a) Pick up a block of a pile of two or more blocks and put it
%     on the table

move(state(Piles),state(Canonical)) :-
	member([Block,Block_1|Pile],Piles,Piles_1),
	sort([[Block],[Block_1|Pile]|Piles_1],Canonical).

% (b) Pick a block up off the table and put it onto a pile of one
%     or more

move(state(Piles),state(Canonical)) :-
	member([Block],Piles,Piles_1),
	member(Pile,Piles_1,Piles_left),
	sort([[Block|Pile]|Piles_left],Canonical).

% (c) Pick a block up off one pile of two or more and put it onto
%     another pile of one or more.

move(state(Piles),state(Canonical)) :-
	member([Block,B1|Bm],Piles,Piles_1),
	member([A1|Am],Piles_1,Piles_2),
	sort([[B1|Bm],[Block,A1|Am]|Piles_2],Canonical).

% Utilities

member(X,[X|_]).
member(X,[_|T]) :-
	member(X,T).

member(X,[X|R],R).
member(X,[H|T],[H|R]) :-
	member(X,T,R).
	

reverse(A,B) :-
	reverse(A,[],B).

reverse([],X,X).

reverse([H|T],Acc,Rev) :-
	reverse(T,[H|Acc],Rev).

-- 
////  Advice to dieters:          ////  Ken Johnson, A I Applications Institute
////    Never eat more than       ////       80 South Bridge, EDINBURGH EH1 1HN
////    you can carry.            ////                 E-mail ken@aiai.ed.ac.uk
////               -- Miss Piggy  ////     phone 031-650 2756  fax 031-650 6513
Technical Details
Message-ID: <7254@skye.ed.ac.uk>
Path: arc1-ca.pugleaf.net!sparky!uunet!mcsun!uknet!edcastle!aiai!ken

Show Full Headers
Complete Article Headers
Path: arc1-ca.pugleaf.net!sparky!uunet!mcsun!uknet!edcastle!aiai!ken
From: ken@aiai.ed.ac.uk (Ken Johnson)
Newsgroups: comp.lang.prolog
Subject: A little block stacking program
Message-ID: <7254@skye.ed.ac.uk>
Date: 20 Aug 92 17:50:09 GMT
Followup-To: comp.lang.prolog
Organization: Bugs-R-Us
Lines: 129