🚀 go-pugleaf

RetroBBS NetNews Server

Inspired by RockSolid Light RIP Retro Guy

Article View: comp.lang.prolog
Article #669

Re: A little block stacking program

#669
From: Ken Johnson
Date: Thu, 20 Aug 1992 21:47
109 lines
3972 bytes
In article <7254@skye.ed.ac.uk> I wrote

%   # A little block stacking program.

Here is a little checker that the problem is correctly stated before you
start to search.  This is meant to be useful, as I felt the canonical
form was a bit much to expect people to get right before first checking. 
The predicate feasible(S,G) checks that S and G are valid block world
states which contain the same bricks and are written in the canonical
form. 

% -------------------------------- 8< --------------------------------
% Checker that problem is feasible by the block stacking problem
% 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. 

% Example call
%    ?- feasible(state([[a],[b],[c]]),state([[a,b,c]])).

feasible(S,G) :-		% S and G are states, which define the problem
	check(right_format(S,Bs-[]),S,'Wrong format '),
	check(right_format(G,Bg-[]),G,'Wrong format '),
	check(canonical(S),S,'Not canonical form '),
	check(canonical(G),G,'Not canonical form '),
	check(same_bricks_in(Bs,Bg),G,'Blocks appear or vanish ').

% ------------------------------------------------------------------------

check(T,_,_) :-		% Try the test
	T,		% Success?
	!.		% OK, succeed, stop here

check(_,S,M) :-		% Test failed
	write(M),	% Write message
	write(S), 	% Write bad argument
	fail.		% Fail main routine

% ------------------------------------------------------------------------

right_format(State,Bricks) :-	% Check format, return list of brick names used
	nonvar(State),
	State = state(List),	% Must have state/1 functor
	right_list_format(List,Bricks).	% Check format of arg


right_list_format(List,Bricks) :-		% Start off
	right_list_format(List,X-X,Bricks).

right_list_format([],Bricks,Bricks).		% Done

right_list_format([Pile|Ps],Acc_1,Bricks) :-	% Take pile
	right_pile_format(Pile,Acc_1,Acc_2),	% Check pile
	right_list_format(Ps,Acc_2,Bricks).	% Other piles

right_pile_format([X],A-B,A-C) :-		% Pile of one brick
	atomic(X),				% Name must be atomic
	\+ diff_member(X,A-B),			% Not seen name before
	B = [X|C].				% Note name

right_pile_format([X,Y|More],A-B,Acc) :-	% Pile of 2 or more bricks
	atomic(X),				% Same as above
	\+ diff_member(X,A-B),
	B = [X|C],
	right_pile_format([Y|More],A-C,Acc).

% ------------------------------------------------------------------------

canonical(S) :-				% List in canonical form?
	nonvar(S),
	S = state(List),
	canonical_list(List).

canonical_list([]).			% [] is OK, but trivial, state

canonical_list([[A|_]|More]) :-		% Else take first pile
	canonical_list(A,More).

canonical_list(_,[]).			% All done

canonical_list(A,[[B|_]|More]) :-	% Compare head of this pile with
	A @< B,				% head of last
	canonical_list(B,More).

% ------------------------------------------------------------------------

same_bricks_in([],_).			% Check two lists have same
					% members in any order
same_bricks_in([H|T],List_2) :-
	member(H,List_2,Res),
	same_bricks_in(T,Res).

% ------------------------------------------------------------------------

diff_member(X,A-B) :-			% Standard utility
	A \== B,
	A = [X|_].

diff_member(X,A-B) :-
	A \== B,
	A = [_|T],
	diff_member(X,T-B).

-- 
////  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: <7255@skye.ed.ac.uk>
Path: arc1-ca.pugleaf.net!sparky!uunet!mcsun!uknet!edcastle!aiai!ken
References: <7254@skye.ed.ac.uk>

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: Re: A little block stacking program
Message-ID: <7255@skye.ed.ac.uk>
Date: 20 Aug 92 21:47:31 GMT
References: <7254@skye.ed.ac.uk>
Followup-To: comp.lang.prolog
Organization: Bugs-R-Us
Lines: 109