home *** CD-ROM | disk | FTP | other *** search
/ NetNews Usenet Archive 1992 #18 / NN_1992_18.iso / spool / comp / lang / prolog / 1571 < prev    next >
Encoding:
Internet Message Format  |  1992-08-20  |  3.8 KB
  1. Path: sparky!uunet!mcsun!uknet!edcastle!aiai!ken
  2. From: ken@aiai.ed.ac.uk (Ken Johnson)
  3. Newsgroups: comp.lang.prolog
  4. Subject: Re: A little block stacking program
  5. Message-ID: <7255@skye.ed.ac.uk>
  6. Date: 20 Aug 92 21:47:31 GMT
  7. References: <7254@skye.ed.ac.uk>
  8. Followup-To: comp.lang.prolog
  9. Organization: Bugs-R-Us
  10. Lines: 109
  11.  
  12.  
  13. In article <7254@skye.ed.ac.uk> I wrote
  14.  
  15. %   # A little block stacking program.
  16.  
  17. Here is a little checker that the problem is correctly stated before you
  18. start to search.  This is meant to be useful, as I felt the canonical
  19. form was a bit much to expect people to get right before first checking. 
  20. The predicate feasible(S,G) checks that S and G are valid block world
  21. states which contain the same bricks and are written in the canonical
  22. form. 
  23.  
  24. % -------------------------------- 8< --------------------------------
  25. % Checker that problem is feasible by the block stacking problem
  26. % Ken Johnson 20 August 1992
  27. % You may use and distribute this code freely but if you sell copies of it
  28. % at a profit, I want a share. 
  29.  
  30. % Example call
  31. %    ?- feasible(state([[a],[b],[c]]),state([[a,b,c]])).
  32.  
  33. feasible(S,G) :-        % S and G are states, which define the problem
  34.     check(right_format(S,Bs-[]),S,'Wrong format '),
  35.     check(right_format(G,Bg-[]),G,'Wrong format '),
  36.     check(canonical(S),S,'Not canonical form '),
  37.     check(canonical(G),G,'Not canonical form '),
  38.     check(same_bricks_in(Bs,Bg),G,'Blocks appear or vanish ').
  39.  
  40. % ------------------------------------------------------------------------
  41.  
  42. check(T,_,_) :-        % Try the test
  43.     T,        % Success?
  44.     !.        % OK, succeed, stop here
  45.  
  46. check(_,S,M) :-        % Test failed
  47.     write(M),    % Write message
  48.     write(S),     % Write bad argument
  49.     fail.        % Fail main routine
  50.  
  51. % ------------------------------------------------------------------------
  52.  
  53. right_format(State,Bricks) :-    % Check format, return list of brick names used
  54.     nonvar(State),
  55.     State = state(List),    % Must have state/1 functor
  56.     right_list_format(List,Bricks).    % Check format of arg
  57.  
  58.  
  59. right_list_format(List,Bricks) :-        % Start off
  60.     right_list_format(List,X-X,Bricks).
  61.  
  62. right_list_format([],Bricks,Bricks).        % Done
  63.  
  64. right_list_format([Pile|Ps],Acc_1,Bricks) :-    % Take pile
  65.     right_pile_format(Pile,Acc_1,Acc_2),    % Check pile
  66.     right_list_format(Ps,Acc_2,Bricks).    % Other piles
  67.  
  68. right_pile_format([X],A-B,A-C) :-        % Pile of one brick
  69.     atomic(X),                % Name must be atomic
  70.     \+ diff_member(X,A-B),            % Not seen name before
  71.     B = [X|C].                % Note name
  72.  
  73. right_pile_format([X,Y|More],A-B,Acc) :-    % Pile of 2 or more bricks
  74.     atomic(X),                % Same as above
  75.     \+ diff_member(X,A-B),
  76.     B = [X|C],
  77.     right_pile_format([Y|More],A-C,Acc).
  78.  
  79. % ------------------------------------------------------------------------
  80.  
  81. canonical(S) :-                % List in canonical form?
  82.     nonvar(S),
  83.     S = state(List),
  84.     canonical_list(List).
  85.  
  86. canonical_list([]).            % [] is OK, but trivial, state
  87.  
  88. canonical_list([[A|_]|More]) :-        % Else take first pile
  89.     canonical_list(A,More).
  90.  
  91. canonical_list(_,[]).            % All done
  92.  
  93. canonical_list(A,[[B|_]|More]) :-    % Compare head of this pile with
  94.     A @< B,                % head of last
  95.     canonical_list(B,More).
  96.  
  97. % ------------------------------------------------------------------------
  98.  
  99. same_bricks_in([],_).            % Check two lists have same
  100.                     % members in any order
  101. same_bricks_in([H|T],List_2) :-
  102.     member(H,List_2,Res),
  103.     same_bricks_in(T,Res).
  104.  
  105. % ------------------------------------------------------------------------
  106.  
  107. diff_member(X,A-B) :-            % Standard utility
  108.     A \== B,
  109.     A = [X|_].
  110.  
  111. diff_member(X,A-B) :-
  112.     A \== B,
  113.     A = [_|T],
  114.     diff_member(X,T-B).
  115.  
  116. -- 
  117. ////  Advice to dieters:          ////  Ken Johnson, A I Applications Institute
  118. ////    Never eat more than       ////       80 South Bridge, EDINBURGH EH1 1HN
  119. ////    you can carry.            ////                 E-mail ken@aiai.ed.ac.uk
  120. ////               -- Miss Piggy  ////     phone 031-650 2756  fax 031-650 6513
  121.