Prolog STRIPS planner never completes - prolog

Following examples by Ivan Bratko on Artificial Intelligence in Prolog through his book:
"Prolog Programming for Artificial Intelligence - 3rd Edition" (ISBN-13: 978-0201403756) (1st edition 1986 by Addison-Wesley, ISBN 0-201-14224-4)
I've noticed that a lot of the examples do not run to completion but instead seem to get stuck. I have tried several different implementations following it to the letter, but with no luck. Would anyone be willing to take a gander at the code to see if they can spot where there is faulty logic or if I made a mistake?
This is the complete program of a STRIPS style planner for a blocks world as illustrated in the book:
% This planner searches in iterative-deepening style.
% A means-ends planner with goal regression
% plan( State, Goals, Plan)
plan( State, Goals, []) :-
satisfied( State, Goals). % Goals true in State
plan( State, Goals, Plan) :-
append( PrePlan, [Action], Plan), % Divide plan achieving breadth-first effect
select( State, Goals, Goal), % Select a goal
achieves( Action, Goal),
can( Action, Condition), % Ensure Action contains no variables
preserves( Action, Goals), % Protect Goals
regress( Goals, Action, RegressedGoals), % Regress Goals through Action
plan( State, RegressedGoals, PrePlan).
satisfied( State, Goals) :-
delete_all( Goals, State, []). % All Goals in State
select( State, Goals, Goal) :- % Select Goal from Goals
member( Goal, Goals). % A simple selection principle
achieves( Action, Goal) :-
adds( Action, Goals),
member( Goal, Goals).
preserves( Action, Goals) :- % Action does not destroy Goals
deletes( Action, Relations),
not((member( Goal, Relations),
member( Goal, Goals))).
regress( Goals, Action, RegressedGoals) :- % Regress Goals through Action
adds( Action, NewRelations),
delete_all( Goals, NewRelations, RestGoals),
can( Action, Condition),
addnew( Condition, RestGoals, RegressedGoals). % Add precond., check imposs.
% addnew( NewGoals, OldGoals, AllGoals):
% OldGoals is the union of NewGoals and OldGoals
% NewGoals and OldGoals must be compatible
addnew( [], L, L).
addnew( [Goal | _], Goals, _) :-
impossible( Goal, Goals), % Goal incompatible with Goals
!,
fail. % Cannot be added
addnew( [X | L1], L2, L3) :-
member( X, L2), !, % Ignore duplicate
addnew( L1, L2, L3).
addnew( [X | L1], L2, [X | L3]) :-
addnew( L1, L2, L3).
% delete_all( L1, L2, Diff): Diff is set-difference of lists L1 and L2
delete_all( [], _, []).
delete_all( [X | L1], L2, Diff) :-
member( X, L2), !,
delete_all( L1, L2, Diff).
delete_all( [X | L1], L2, [X | Diff]) :-
delete_all( L1, L2, Diff).
can( move( Block, From, To), [clear(Block), clear(To), on(Block,From)]) :-
block(Block),
object(To),
To \== Block,
object( From),
From \== To,
Block \== From.
adds( move(X,From,To),[on(X,To),clear(From)]).
deletes( move(X,From,To),[on(X,From), clear(To)]).
object(X) :-
place(X)
;
block(X).
impossible( on(X,X), _).
impossible( on( X,Y), Goals) :-
member( clear(Y), Goals)
;
member( on(X,Y1), Goals), Y1 \== Y % Block cannot be in two places
;
member( on( X1, Y), Goals), X1 \== X. % Two blocks cannot be in same place
impossible( clear( X), Goals) :-
member( on(_,X), Goals).
block(a).
block(b).
block(c).
block(d).
block(e).
block(f).
block(g).
place(1).
place(2).
place(3).
place(4).
I added 7 blocks and 4 locations and tested it with a representation where all the blocks are alphabetically stacked from a through g on position 1, and the goal is to stack them in the same order on position 2.
To run the program call plan(StartState,GoalState, Sol).
plan([on(a,1), on(b,a), on(c,b), on(d,c), on(e,d), on(f,e), on(g,f),
clear(g), clear(2), clear(3)],
[clear(1), on(a,2), on(b,a), on(c,b), on(d,c), on(e,d), on(f,e),
on(g,f), clear(g), clear(3)],
P).
~ ~
g g
f f
e e
d ---> d
c c
b b
a ~ ~ ~ ~ a ~ ~
_ _ _ _ _ _ _ _
1 2 3 4 1 2 3 4
References:
Definition of move: http://media.pearsoncmg.com/intl/ema/ema_uk_he_bratko_prolog_3/prolog/ch17/fig17_2.txt
End means planner with goal regression: http://media.pearsoncmg.com/intl/ema/ema_uk_he_bratko_prolog_3/prolog/ch17/fig17_8.txt
Any advice would be greatly appreciated.

In the end, the code is correct but the combinatorial explosion kills it.
Data:
3 places, 3 blocks succeeds with 5 moves after 9'755 calls to plan/3.
4 places, 3 blocks succeeds with 5 moves after 98'304 calls to plan/3.
3 places, 4 blocks succeeds with 7 moves after 915'703 calls to plan/3.
3 places, 5 blocks succeeds with 9 moves after 97'288'255 calls to plan/3.
There is no sense trying with more, especially not with 4 places, 7 blocks. It is clear that heuristics, exploitation of symmetry, etc. are needed to go further. All of those need larger amounts of memory. Here, memory used remains small in all cases: only one path down the iteratively deepened (and stored on stack) search tree is live at any time. We don't remember any states visited or anything, it's a very simple search.
Below the updated code (LONG, 337 lines)
Changes (important ones marked with 'FIX' in the code)
library(list) predicates have been used where possible, getting rid of some code.
Debugging output generation using format/2 added.
Assertions (see here) using assertion/1 added to check that what happens is what I think happens.
Predicates and variables renamed to better reflect their intended meaning.
run/0 predicate added which initializes the State and Goal, calls plan/3 and prettyprints the Plan.
can/2 confusingly combined two separate aspects: instantiating an Action and determining its Preconditions. Separated into two predicates instantiate_action/1 and preconditions/2.
select_goal/2 looked like it depended on State, but really didn't. Cleaned up.
Note the trick for making this an "iterative deepening" search. It is very clever but on second thoughts, it is too clever by half as it is based on the predicate run/3 behaving differently when being called with Plan an unbound variable than with Plan being a bound variable. The first case occurs only at the very top node of the implied search tree. This may be further explained in the textbook, which I don't have, and it took some time to realize what is actually happening in this code.
If the pruning expression ((nonvar(Plan), Plan == []) -> fail ; true ) that I put at the start of the search branch of plan/3 irritates, then so should the iterative deepening trick. IMHO, better use tree depth counters and return the Plan via an accumulator. Especially if someone will be tasked to maintain such code in a production system (that is, a "system in production", not a "forward-chaining rule-based system").
% Based on
%
% Exercise 17.5 on page 429 of "Prolog Programming for Artificial Intelligence"
% by Ivan Bratko, 3rd edition
%
% The text says:
%
% "This planner searches through the state space in iterative-deepening style."
%
% See also:
%
% https://en.wikipedia.org/wiki/Iterative_deepening_depth-first_search
% https://en.wikipedia.org/wiki/Blocks_world
%
% The "iterative deepening" trick is all in the "Plan" list structure.
% If you remove it, the search becomes depth-first and no longer terminates!
% ----------
% Encapsulator to be called by user from the toplevel
% ----------
run :-
% Setting up
start_state(State),
final_state(Goals),
% TODO: Build predicates that verify that State and Goal are actually validly constructed
% Or choose better representations
nb_setval(glob_plancalls,0), % global variable for counting calls (non-backtrackable)
b_setval(glob_depth,0), % global variable for counting depth (backtrable)
% plan/3 is backtrackable and generates different/successively longer plans on backtrack
% it may however generate the same plan several times
plan(State, Goals, Plan),
dump_plan(Plan,1).
% ----------
% Writing out a solution found
% ----------
dump_plan([P|R],N) :-
% TODO: Verify that the plan indeed works!
format('Plan step ~w: ~w~n',[N,P]),
NN is N+1,
dump_plan(R,NN).
dump_plan([],_).
% The representation of the blocks world (see below) is a bit unfortunate as places and blocks
% have to be declared separately and relationships between places and blocks, as well
% as among blocks themselves have to declared explicitely and consistently.
% Additionally we have to specify which elements have a view of the sky (i.e. are clear/1)
% On the other hand, the final state and end state need not be specified fully, which is
% interesting (not sure what that means exactly regarding solution finding)
% The atoms used in describing places and blocks must be distinct due to program construction!
start_state([on(a,1), on(b,a), on(c,b), clear(c), clear(2), clear(3), clear(4)]).
final_state([on(a,2), on(b,a), on(c,b), clear(c), clear(1), clear(3), clear(4)]).
% ----------
% Representation of the blocks world
% ----------
% We have BLOCKs identified by atoms a,b,c, ...
% Each of those is identified by block/1 attribute.
% A block/1 is clear/1 if there is nothing on top of it.
% A block/1 is on(Block, Object) where Object is a block/1 or place/1.
block(a).
block(b).
block(c).
% We have PLACEs (i.e. columns of blocks) onto which to stack blocks.
% Each of these is identified by place/1 attribute.
% A place/1 can be clear/1 if there is nothing on top of it.
% (In fact these are like special immutable blocks and should be modeled as such)
place(1).
place(2).
place(3).
place(4).
% OBJECTs are place/1 or block/1.
object(X) :- place(X) ; block(X).
% ACTIONs are terms "move( Block, From, To)".
% "Block" must be block/1.
% "From" must be object/1 (i.e. block/1 or place/1).
% "To" must be object/1 (i.e. block/1 or place/1).
% Evidently constraints exist for a move/3 to be possible from or to any given state.
% STATEs are sets (implemented by lists) of "goal" terms.
% A goal term is "on( X, Y)" or "clear(Y)" where Y is object/1 and X is block/1.
% ----------
% plan( +State, +Goals, -Plan)
% Build a "Plan" get from "State" to "Goals".
% "State" and "Goals" are sets (implemented as lists) of goal terms.
% "Plan" is a list of action terms.
% The implementation works "backwards" from the "Goals" goal term list towards the "State" goal term list.
% ----------
% ___ Satisfaction branch ____
% This can only succeed if we are at the "end" of a Plan (the Plan must match '[]') and State matches Goal.
plan( State, Goals, []) :-
% Debugging output
nb_getval(glob_plancalls,P),
b_getval(glob_depth,D),
NP is P+1,
ND is D+1,
nb_setval(glob_plancalls,NP),
b_setval(glob_depth,ND),
statistics(stack,STACK),
format('plan/3 call ~w at depth ~d (stack ~d)~n',[NP,ND,STACK]),
% If the Goals statisfy State, print and succeed, otherwise print and fail
( satisfied( State, Goals) ->
(sort(Goals,Goals_s),
sort(State,State_s),
format(' Goals: ~w~n', [Goals_s]),
format(' State: ~w~n', [State_s]),
format(' *** SATISFIED ***~n'))
;
format(' --- NOT SATISFIED ---~n'),
fail).
% ____ Search branch ____
%
% Magic which generates the breath-first iterative deepening search:
%
% In the top node of the call tree (the node directly underneath "run"), "Plan" is unbound.
%
% At point "XXX" "Plan" is set to a list of as-yet-unbound actions of a given length.
% At each backtrack that reaches up to "XXX", "Plan" is bound to list longer by 1.
%
% In any other node of the call tree than the top node, "Plan" is bound to a list of fixed length
% becoming shorter by 1 on each recursive call.
%
% The length of that list determines how deep the search through the state space *must* go because
% satisfaction can only be happen if the "Plan" list is equal to [] and State matches Goal.
%
% So:
% On first activation of the top, build plans of length 0 (only possible if Goals passes satisfied/2 directly)
% On second activation of the top, build plans of length 1 (and backtrack over all possibilities of length 1)
% ...
% On Nth activation of the top, build plans of length N-1 (and backtrack over all possibilities of length N-1)
%
% A slight improvement is to fail the search branch immediately if Plan is a nonvar and is equal to []
% because append( PrePlan, [Action], Plan) will fail...
plan( State, Goals, Plan) :-
% The line below can be commented out w/o ill effects, it is just there to fail early
((nonvar(Plan), Plan == []) -> fail ; true ),
% Debugging output
nb_getval(glob_plancalls,P),
b_getval(glob_depth,D),
NP is P+1,
ND is D+1,
nb_setval(glob_plancalls,NP),
b_setval(glob_depth,ND),
statistics(stack,STACK),
format('plan/3 call ~w at depth ~d (stack ~d)~n',[NP,ND,STACK]),
format(' goals ~w~n',[Goals]),
% Even more debugging output
( var(Plan) -> format(' Top node of plan/3 call~n') ; true ),
( nonvar(Plan) -> (length(Plan,LP), format(' Low node of plan/3 call, plan length to complete: ~w~n',[LP])) ; true ),
% prevent runaway behaviour
% assertion(NP < 1000000),
% XXX
% append/3 is backtrackable.
% For the top node, it will generate longer completely uninstantiated PrePlans on backtracking:
% PrePlan = [], Plan = [Action] ;
% PrePlan = [_G981], Plan = [_G981, Action] ;
% PrePlan = [_G981, _G987], Plan = [_G981, _G987, Action] ;
% PrePlan = [_G981, _G987, _G993], Plan = [_G981, _G987, _G993, Action] ;
% For lower nodes, Plan is instantiated to a list of length N already, and PrePlan will therefore necessarily
% be the prefix list of length N-1
% XXX
append( PrePlan, [Action], Plan),
% Backtrackably select some concrete Goal from Goals
select_goal( Goals, Goal), % FIX: In the original this seems to depend on State, but it really doesn't
assert_goal(Goal),
format( ' Depth ~d, selected Goal: ~w~n',[ND,Goal]),
% Check whether Action achieves the Goal.
% As Action is free, what we actually do is instantiate Action backtrackably with something that achieves Goal
achieves( Action, Goal),
format( ' Depth ~d, selected Action: ~w~n', [ND,Action]),
% Fully instantiate Action backtrackably
% FIX: Passed "conditions", the precondition for a move, which is unused at this point: broken up into two calls
instantiate_action( Action),
format( ' Depth ~d, action instantiated to: ~w~n', [ND,Action]),
assertion(ground(Action)),
% Check that the Action does not clobber any of the Goals
preserves( Action, Goals),
% We now have a ground Action that "achieves" some goals in Goals while "preserving" all of them
% Work backwards from Goals to a "prior goals". regress/3 may fail to build a consistent GoalsPrior!
regress( Goals, Action, GoalsPrior),
plan( State, GoalsPrior, PrePlan).
% ----------
% Check
% ----------
assert_goal(X) :-
assertion(ground(X)),
assertion((X = on(A,B), block(A), object(B) ; X = clear(C), object(C))).
% ----------
% A State (a list) is satisfied by Goals (a list) if all the terms in Goals can also be found in State
% ----------
satisfied( State, Goals) :-
subtract( Goals, State, []). % Set difference yields empty list: [] = Goals - State
% ----------
% Backtrackably select a single Goal term from a set of Goals
% ----------
select_goal( Goals, Goal) :-
member( Goal, Goals).
% ----------
% When does an Action (move/2) achieve a Goal (clear/1, on/2)?
% This is called with instantiated Goal and free Action, so this actually instantiates Action
% with something (partially specified) that achieves Goal.
% ----------
achieves( Action, Goal) :-
assertion(var(Action)),
assertion(ground(Goal)),
would_add( Action, GoalsAdded),
member( Goal, GoalsAdded).
% ----------
% Given a ground Action and ground Goals, will Action from a State leading to Goals preserve Goals?
% ----------
preserves( Action, Goals) :-
assertion(ground(Action)),
assertion(ground(Goals)),
would_del( Action, GoalsDeleted),
intersection( Goals, GoalsDeleted, []). % "would delete none of the Goals"
% ----------
% Given existing Goals and an (instantiated) Action, compute the previous Goals
% that, when Action is applied, yield Goals. This may actually fail if no
% consistent GoalsPrior can be built!
% ** It is actually not at all self-evident that this is right and that we get a valid
% "GoalsPrior" via this method! ** (prove it!)
% FIX: "Condition" replaced by "Preconditions" which is what this is about.
% ----------
regress( Goals, Action, GoalsPrior) :-
assertion(ground(Action)),
assertion(ground(Goals)),
would_add( Action, GoalsAdded),
subtract( Goals, GoalsAdded, GoalsPriorPass), % from the "lists" library
preconditions( Action, Preconditions),
% All the Preconds must be fulfilled in Goals2, so try adding them
% Adding them may not succeed if inconsistencies appear in the resulting set of goals, in which case we fail
add_preconditions( Preconditions, GoalsPriorPass, GoalsPrior).
% ----------
% Adding preconditions to existing set of goals and checking for inconsistencies as we go
% Previously named addnew/3
% New we use union/3 from the "lists" library and the modified "consistent"
% ----------
add_preconditions( Preconditions, GoalsPriorIn, GoalsPriorOut) :-
add_preconditions_recur( Preconditions, GoalsPriorIn, GoalsPriorIn, GoalsPriorOut).
add_preconditions_recur( [], _, GoalsPrior, GoalsPrior).
add_preconditions_recur( [G|R], Goals, GoalsPriorAcc, GoalsPriorOut) :-
consistent( G, Goals),
union( [G], GoalsPriorAcc, GoalsPriorAccNext),
add_preconditions_recur( R, Goals, GoalsPriorAccNext, GoalsPriorOut).
% ----------
% Check whether a given Goal is consistent with the set of Goals to which it will be added
% Previously named "impossible/2".
% Now named "consistent/2" and we use negation as failure
% ----------
consistent( on(X,Y), Goals ) :-
\+ on(X,Y) = on(A,A), % this cannot ever happen, actually
\+ member( clear(Y), Goals ), % if X is on Y then Y cannot be clear
\+ ( member( on(X,Y1), Goals ), Y1 \== Y ), % Block cannot be in two places
\+ ( member( on(X1,Y), Goals), X1 \== X ). % Two blocks cannot be in same place
consistent( clear(X), Goals ) :-
\+ member( on(_,X), Goals). % if something is on X, X cannot be clear
% ----------
% Backtrackably instantiate a partially instantiated Action
% Previously named "can/2" and it also instantiated the "Condition", creating confusion
% ----------
instantiate_action(Action) :-
assertion(Action = move( Block, From, To)),
Action = move( Block, From, To),
block(Block), % will unify "Block" with a concrete block
object(To), % will unify "To" with a concrete object (block or place)
To \== Block, % equivalent to \+ == (but = would do here); this demands that blocks and places have disjoint sets of atoms
object(From), % will unify "From" with a concrete object (block or place)
From \== To,
Block \== From.
% ----------
% Find preconditions (a list of Goals) of a fully instantiated Action
% ----------
preconditions(Action, Preconditions) :-
assertion(ground(Action)),
Action = move( Block, From, To),
Preconditions = [clear(Block), clear(To), on(Block, From)].
% ----------
% would_del( Move, DelGoals )
% would_add( Move, AddGoals )
% If we run Move (assuming it is possible), what goals do we have to add/remove from an existing Goals
% ----------
would_del( move( Block, From, To), [on(Block,From), clear(To)] ).
would_add( move( Block, From, To), [on(Block,To), clear(From)] ).
Running the above produces lots of output and eventually:
plan/3 call 57063 at depth 6 (stack 98304)
Goals: [clear(2),clear(3),clear(4),clear(c),on(a,1),on(b,a),on(c,b)]
State: [clear(2),clear(3),clear(4),clear(c),on(a,1),on(b,a),on(c,b)]
*** SATISFIED ***
Plan step 1: move(c,b,3)
Plan step 2: move(b,a,4)
Plan step 3: move(a,1,2)
Plan step 4: move(b,4,a)
Plan step 5: move(c,3,b)
See also
STRIPS automatic planner
Iterative deepening depth-first search
Blocks World

Related

Optimizing clp(FD) labeling

I have been crunching through a scheduling problem following this article which references this program and trying to generalize it past the seven shifts. I am getting hung up on the labelling strategy employed because I am not sure how it could be optimized to report results in a reasonable time frame.
The gist is, a map is generated of all the combinations of staff (s), shifts to fill (f), and tasks (t) to be performed on each shift, which results in sft variables which then are either labeled 1 or 0 to represent assigned or not assigned.
The example uses 3 staff, with 11 shifts with several tasks per shift and runs really fast to generate a possible solution.
But labelling takes an unreasonable amount of time when even considering as few as 20 shifts with 1 task per shift with 6 staff.
Is this normal in the sense I should expect this performance loss with this increased complexity?
Is there a more elegant strategy I could look at to employ?
Dec 19 edit:
Looking into this more, I think the problem is that labelling in this context is inefficient since I don't know how to create a ranking mechanism to assist the default labelling strategy since the map is dealing with reified (with a domain of 0..1) variables.
I think my options are:
a) add some variable to assist the labeling strategy to make it so it behaves better than a bruteforce strategy.
b) create a custom labeling strategy. (any resources on this would be appreciated)
-- The code:
:- use_module(library(lists)).
:- use_module(library(apply)).
:- use_module(library(clpfd)).
:- dynamic employee/1.
:- dynamic employee_max_shifts/2.
:- dynamic employee_skill/2.
:- dynamic task_skills/2.
:- dynamic employee_unavailable/2.
:- dynamic task/2.
:- dynamic employee_assigned/2.
employee(micah).
employee(jonathan).
employee(blake).
employee(barry).
employee(jerry).
employee(larry).
employee(gary).
employee_max_shifts(micah, 14).
employee_max_shifts(jonathan, 14).
employee_max_shifts(blake, 14).
employee_max_shifts(barry, 14).
employee_max_shifts(jerry, 14).
employee_max_shifts(larry, 14).
employee_max_shifts(gary, 14).
employee_skill(micah, programming).
employee_skill(barry, programming).
employee_skill(jerry, programming).
employee_skill(larry, programming).
employee_skill(gary, programming).
employee_skill(jonathan,programming).
employee_skill(blake, programming).
task_skills(web_design,[programming]).
shifts([
shift(1,1),shift(1,2),
shift(2,1),shift(2,2),
shift(3,1),shift(3,2),
shift(4,1),shift(4,2),
shift(5,1),shift(5,2),
shift(6,1),shift(6,2),
shift(7,1),shift(7,2),
shift(8,1),shift(8,2),
shift(9,1),shift(9,2),
shift(10,1),shift(10,2),
shift(11,1),shift(11,2),
shift(12,1),shift(12,2),
shift(13,1),shift(13,2),
shift(14,1),shift(14,2),
shift(15,1),shift(15,2),
shift(16,1),shift(16,2),
shift(17,1),shift(17,2),
shift(18,1),shift(18,2),
shift(19,1),shift(19,2),
shift(20,1),shift(20,2),
shift(21,1),shift(21,2),
shift(22,1),shift(22,2),
shift(23,1),shift(23,2),
shift(24,1),shift(24,2),
shift(25,1),shift(25,2),
shift(26,1),shift(26,2),
shift(27,1),shift(27,2),
shift(28,1),shift(28,2)]).
task(web_design,shift('1',1)).
task(web_design,shift('1',2)).
task(web_design,shift('2',1)).
task(web_design,shift('2',2)).
task(web_design,shift('3',1)).
task(web_design,shift('3',2)).
task(web_design,shift('4',1)).
task(web_design,shift('4',2)).
task(web_design,shift('6',1)).
task(web_design,shift('6',2)).
task(web_design,shift('7',1)).
task(web_design,shift('7',2)).
task(web_design,shift('8',1)).
task(web_design,shift('8',2)).
task(web_design,shift('9',1)).
task(web_design,shift('9',2)).
task(web_design,shift('10',1)).
task(web_design,shift('10',2)).
task(web_design,shift('11',1)).
task(web_design,shift('11',2)).
task(web_design,shift('12',1)).
task(web_design,shift('12',2)).
task(web_design,shift('13',1)).
task(web_design,shift('13',2)).
task(web_design,shift('14',1)).
task(web_design,shift('14',2)).
task(web_design,shift('15',1)).
task(web_design,shift('15',2)).
task(web_design,shift('16',1)).
task(web_design,shift('16',2)).
task(web_design,shift('17',1)).
task(web_design,shift('17',2)).
task(web_design,shift('18',1)).
task(web_design,shift('18',2)).
task(web_design,shift('19',1)).
task(web_design,shift('19',2)).
task(web_design,shift('20',1)).
task(web_design,shift('20',2)).
task(web_design,shift('21',1)).
task(web_design,shift('21',2)).
task(web_design,shift('22',1)).
task(web_design,shift('22',2)).
task(web_design,shift('23',1)).
task(web_design,shift('23',2)).
task(web_design,shift('24',1)).
task(web_design,shift('24',2)).
task(web_design,shift('25',1)).
task(web_design,shift('25',2)).
task(web_design,shift('26',1)).
task(web_design,shift('26',2)).
task(web_design,shift('27',1)).
task(web_design,shift('27',2)).
task(web_design,shift('28',1)).
task(web_design,shift('28',2)).
% get_employees(-Employees)
get_employees(Employees) :-
findall(employee(E),employee(E),Employees).
% get_tasks(-Tasks)
get_tasks(Tasks) :-
findall(task(TName,TShift),task(TName,TShift),Tasks).
% create_assoc_list(+Employees,+Tasks,-Assoc)
% Find all combinations of pairs and assign each a variable to track
create_assoc_list(Es,Ts,Assoc) :-
empty_assoc(EmptyAssoc),
findall(assign(E,T),(member(E,Es),member(T,Ts)),AssignmentPairs),
build_assoc_list(EmptyAssoc,AssignmentPairs,Assoc).
% build_assoc_list(+AssocAcc,+Pairs,-Assoc)
build_assoc_list(Assoc,[],Assoc).
build_assoc_list(AssocAcc,[Pair|Pairs],Assoc) :-
put_assoc(Pair,AssocAcc,_Var,AssocAcc2),
build_assoc_list(AssocAcc2,Pairs,Assoc).
% assoc_keys_vars(+Assoc,+Keys,-Vars)
%
% Retrieves all Vars from Assoc corresponding to Keys.
% (Note: At first it seems we could use a fancy findall in place of this, but findall
% will replace the Vars with new variable references, which ruins our map.)
assoc_keys_vars(Assoc, Keys, Vars) :-
maplist(assoc_key_var(Assoc), Keys, Vars).
assoc_key_var(Assoc, Key, Var) :- get_assoc(Key, Assoc, Var).
% list_or(+Exprs,-Disjunction)
list_or([L|Ls], Or) :- foldl(disjunction_, Ls, L, Or).
disjunction_(A, B, B#\/A).
get_assoc_values_in_employee_order(Es, Ts, Assoc, Values) :-
findall(assign(E,T),(member(E,Es), member(T,Ts)),AssignmentPairs),
assoc_keys_vars(Assoc, AssignmentPairs,Values).
% schedule(-Schedule)
%
% Uses clp(fd) to generate a schedule of assignments, as a list of assign(Employee,Task)
% elements. Adheres to the following rules:
% (1) Every task must have at least one employee assigned to it.
% (2) No employee may be assigned to multiple tasks in the same shift.
% (3) No employee may be assigned to more than their maximum number of shifts.
% (4) No employee may be assigned to a task during a shift in which they are unavailable.
% (5) No employee may be assigned to a task for which they lack necessary skills.
% (6) Any pre-existing assignments (employee_assigned) must still hold.
schedule(Schedule) :-
writeln('Building constraints'),
get_employees(Es),
get_tasks(Ts),
create_assoc_list(Es,Ts,Assoc),
assoc_to_keys(Assoc,AssocKeys),
assoc_to_values(Assoc,AssocValues),
constraints(Assoc,Es,Ts),
label(AssocValues),
findall(AssocKey,(member(AssocKey,AssocKeys),get_assoc(AssocKey,Assoc,1)),Assignments),
Schedule = Assignments.
% constraints(+Assoc,+Employees,+Tasks)
constraints(Assoc,Es,Ts) :-
core_constraints(Assoc,Es,Ts),
simul_constraints(Assoc,Es,Ts),
max_shifts_constraints(Assoc,Es,Ts),
unavailable_constraints(Assoc,Es,Ts),
skills_constraints(Assoc,Es,Ts),
assigned_constraints(Assoc).
% core_constraints(+Assoc,+Employees,+Tasks)
%
% Builds the main conjunctive sequence of the form:
% (A_e(0),t(0) \/ A_e(1),t(0) \/ ...) /\ (A_e(0),t(1) \/ A_e(1),t(1) \/ ...) /\ ...
core_constraints(Assoc,Es,Ts) :-
maplist(core_constraints_disj(Assoc,Es),Ts).
% core_constraints_disj(+Assoc,+Employees,+Task)
% Helper for core_constraints, builds a disjunction of sub-expressions, such that
% at least one employee must be assigned to Task
core_constraints_disj(Assoc,Es,T) :-
findall(assign(E,T),member(E,Es),Keys),
assoc_keys_vars(Assoc,Keys,Vars),
list_or(Vars,Disj),
Disj.
% simul_constraints(+Assoc,+Employees,+Tasks)
%
% Builds a constraint expression to prevent one person from being assigned to multiple
% tasks at the same time. Of the form:
% (A_e(0),t(n1) + A_e(0),t(n2) + ... #=< 1) /\ (A_e(1),t(n1) + A_e(1),t(n2) + ... #=< 1)
% where n1,n2,etc. are indices of tasks that occur at the same time.
simul_constraints(Assoc,Es,Ts) :-
shifts(Shifts),
findall(employee_shift(E,Shift),(member(E,Es),member(Shift,Shifts)),EmployeeShifts),
maplist(simul_constraints_subexpr(Assoc,Ts),EmployeeShifts).
simul_constraints_subexpr(Assoc,Ts,employee_shift(E,Shift)) :-
findall(task(TName,Shift),member(task(TName,Shift),Ts),ShiftTs),
findall(assign(E,T),member(T,ShiftTs),Keys),
assoc_keys_vars(Assoc,Keys,Vars),
sum(Vars,#=<,1).
% max_shifts_constraints(+Assoc,+Employees,+Tasks)
%
% Builds a constraint expression that prevents employees from being assigned too many
% shifts. Of the form:
% (A_e(0),t(0) + A_e(0),t(1) + ... #=< M_e(0)) /\ (A_e(1),t(0) + A_e(1),t(1) + ... #=< M_e(1)) /\ ...
% where M_e(n) is the max number of shifts for employee n.
max_shifts_constraints(Assoc,Es,Ts) :-
maplist(max_shifts_subexpr(Assoc,Ts),Es).
max_shifts_subexpr(Assoc,Ts,E) :-
E = employee(EName),
employee_max_shifts(EName,MaxShifts),
findall(assign(E,T),member(T,Ts),Keys),
assoc_keys_vars(Assoc,Keys,Vars),
sum(Vars,#=,MaxShifts).
% unavailable_constraints(+Assoc,+Employees,+Tasks)
%
% For every shift for which an employee e(n) is unavailable, add a constraint of the form
% A_e(n),t(x) = 0 for every t(x) that occurs during that shift. Note that 0 is equivalent
% to False in clp(fd).
unavailable_constraints(Assoc,Es,Ts) :-
findall(assign(E,T),(
member(E,Es),
E = employee(EName),
employee_unavailable(EName,Shift),
member(T,Ts),
T = task(_TName,Shift)
),Keys),
assoc_keys_vars(Assoc,Keys,Vars),
maplist(#=(0),Vars).
% skills_constraints(+Assoc,+Employees,+Tasks)
%
% For every task t(m) for which an employee e(n) lacks sufficient skills, add a
% constraint of the form A_e(n),t(m) = 0.
skills_constraints(Assoc,Es,Ts) :-
findall(assign(E,T),(
member(T,Ts),
T = task(TName,_TShift),
task_skills(TName,TSkills),
member(E,Es),
\+employee_has_skills(E,TSkills)
),Keys),
assoc_keys_vars(Assoc,Keys,Vars),
maplist(#=(0),Vars).
% employee_has_skills(+Employee,+Skills)
%
% Fails if Employee does not possess all Skills.
employee_has_skills(employee(EName),Skills) :-
findall(ESkill,employee_skill(EName,ESkill),ESkills),
subset(Skills,ESkills).
% assigned_constraints(+Assoc)
%
% For every task t(m) to which an employee e(n) is already assigned, add a constraint
% of the form A_e(n),t(m) = 1 to force the assignment into the schedule. Note that
% we execute this constraint inline here instead of collecting it into a Constraint list.
assigned_constraints(Assoc) :-
findall(assign(E,T),(
employee_assigned(EName,T),
E = employee(EName)
),Keys),
assoc_keys_vars(Assoc,Keys,Vars),
maplist(#=(1),Vars).
task_skills(web_design,[programming]).

Having a "out of global stack" in prolog

Hey guys I have a fairly simple question about Prolog.
%on(Block,Object).
% clear(Object).
block(b1).
block(b2).
block(b3).
place(p1).
place(p2).
place(p3).
place(p4).
state1([clear(p2),clear(p4),clear(b2),clear(b3),on(b1,p1),on(b2,p3),on(b3,b1)]).
% visual state1
% b3
% b1 b2
% = = = =
% 1 2 3 4 <----Positions
% can(Action,Condition).
% adds(Action,AddRelationship).
% deletes(Action,DeleteRelationship).
% move(Block,From,To).
can( move( Block, From, To), [ clear( Block), clear( To), on( Block, From)]) :-
block( Block), % Block to be moved
object( To), % "To" is a block or a place
To \== Block, % Block cannot bå moved to itself
object( From), % "From" is a block or a place
From \== To, % Move to new position
Block \== From. % Block not moved from itself
adds(move(X,From,To),[on(X,To),clear(From)]).
deletes(move(X,From,To),[on(X,From),clear(To)]).
object(X):-
place(X)
;
block(X).
% plan(State,Goals,Plan,FinalState).
plan(State,Goals,[],State):-
satisfied(State,Goals).
plan(State,Goals,Plan,FinalState) :-
append(PrePlan,[Action|PostPlan],Plan),
select(State,Goals,Goal),
achieves(Action,Goal),
can(Action,Condition),
plan(State,Condition,PrePlan,MidState1),
apply(MidState1,Action,MidState2),
plan(MidState2,Goals,PostPlan,FinalState).
% satisfied(State,[]).
satisfied(State,[Goal|Goals]):-
member(Goal,State),
satisfied(State,Goals).
select(State,Goals,Goal):-
member(Goal,Goals),
not(member(Goal,State)).
achieves(Action,Goal):-
adds(Action,Goals),
member(Goal,Goals).
apply(State,Action,NewState):-
deletes(Action,DelList),
delete_all(State,DelList,State1),!,
adds(action,AddList),
append(AddList,State1,NewState).
delete_all([],_,[]).
delete_all([X|L1],L2,Diff):-
member(X,L2),!,
delete_all(L1,L2,Diff).
delete_all([X|L1],L2,[X|Diff]):-
delete_all(L1,L2,Diff).
After running this in the compiler it says it has no problems but when i try to execute the command
plan(state1,on(b1,b2),Plan,FinalState).
it just says out of global stack. Can someone help me to fix this
You only need to look at this:
plan(State,Goals,[],State):- false,
satisfied(State,Goals).
plan(State,Goals,Plan,FinalState) :-
append(PrePlan,[Action|PostPlan],Plan), false,
select(State,Goals,Goal),
achieves(Action,Goal),
can(Action,Condition),
plan(State,Condition,PrePlan,MidState1),
apply(MidState1,Action,MidState2),
plan(MidState2,Goals,PostPlan,FinalState).
?- plan(state1,on(b1,b2),Plan,FinalState).
Since this program already loops, the very same program will loop with the additional false goals removed. You need to address this problem first. See failure-slice for more.

Prolog program to return atoms in a proposition formula

I am a newbie to prolog and am trying to write a program which returns the atoms in a well formed propositional formula. For instance the query ats(and(q, imp(or(p, q), neg(p))), As). should return [p,q] for As. Below is my code which returns the formula as As. I dont know what to do to split the single F in ats in the F1 and F2 in wff so wff/2 never gets called. Please I need help to proceed from here. Thanks.
CODE
logical_atom( A ) :-
atom( A ),
atom_codes( A, [AH|_] ),
AH >= 97,
AH =< 122.
wff(A):- ground(A),
logical_atom(A).
wff(neg(A)) :- ground(A),wff(A).
wff(or(F1,F2)) :-
wff(F1),
wff(F2).
wff(and(F1,F2)) :-
wff(F1),
wff(F2).
wff(imp(F1,F2)) :-
wff(F1),
wff(F2).
ats(F, As):- wff(F), setof(F, logical_atom(F), As).
First, consider using a cleaner representation: Currently, you cannot distinguish atoms by a common functor. So, wrap them for example in a(Atom).
Second, use a DCG to describe the relation between a well-formed formula and the list of its atoms, like in:
wff_atoms(a(A)) --> [A].
wff_atoms(neg(F)) --> wff_atoms(F).
wff_atoms(or(F1,F2)) --> wff_atoms(F1), wff_atoms(F2).
wff_atoms(and(F1,F2)) --> wff_atoms(F1), wff_atoms(F2).
wff_atoms(imp(F1,F2)) --> wff_atoms(F1), wff_atoms(F2).
Example query and its result:
?- phrase(wff_atoms(and(a(q), imp(or(a(p), a(q)), neg(a(p))))), As).
As = [q, p, q, p].
This should do what you want. It extracts the unique set of atoms found in any arbitrary prolog term.
I'll leave it up to you, though, to determine what constitutes a "well formed propositional formula", as you put it in your problem statement (You might want to take a look at DCG's for parsing and validation).
The bulk of the work is done by this "worker predicate". It simply extracts, one at a time via backtracking, any atoms found in the parse tree and discards anything else:
expression_atom( [T|_] , T ) :- % Case #1: head of list is an ordinary atom
atom(T) , % - verify that the head of the list is an atom.
T \= [] % - and not an empty list
. %
expression_atom( [T|_] , A ) :- % Case #2: head of listl is a compound term
compound(T) , % - verify that the head of the list is a compound term
T =.. [_|Ts] , % - decompose it, discarding the functor and keeping the arguments
expression_atom(Ts,A) % - recurse down on the term's arguments
. %
expression_atom( [_|Ts] , A ) :- % Finally, on backtracking,
expression_atom(Ts,A) % - we simply discard the head and recurse down on the tail
. %
Then, at the top level, we have this simple predicate that accepts any [compound] prolog term and extracts the unique set of atoms found within by the worker predicate via setof/3:
expression_atoms( T , As ) :- % To get the set of unique atoms in an arbitrary term,
compound(T) , % - ensure that's its a compound term,
T =.. [_|Ts] , % - decompose it, discarding the functor and keeping the arguments
setof(A,expression_atom(Ts,A),As) % - invoke the worker predicate via setof/3
. % Easy!
I'd approach this problem using the "univ" operator =../2 and explicit recursion. Note that this solution will not generate and is not "logically correct" in that it will not process a structure with holes generously, so it will produce different results if conditions are reordered. Please see #mat's comments below.
I'm using cuts instead of if statements for personal aesthetics; you would certainly find better performance with a large explicit conditional tree. I'm not sure you'd want a predicate such as this to generate in the first place.
Univ is handy because it lets you treat Prolog terms similarly to how you would treat a complex s-expression in Lisp: it converts terms to lists of atoms. This lets you traverse Prolog terms as lists, which is handy if you aren't sure exactly what you'll be processing. It saves me from having to look for your boolean operators explicitly.
atoms_of_prop(Prop, Atoms) :-
% discard the head of the term ('and', 'imp', etc.)
Prop =.. [_|PropItems],
collect_atoms(PropItems, AtomsUnsorted),
% sorting makes the list unique in Prolog
sort(AtomsUnsorted, Atoms).
The helper predicate collect_atoms/2 processes lists of terms (univ only dismantles the outermost layer) and is mutually recursive with atoms_of_prop/2 when it finds terms. If it finds atoms, it just adds them to the result.
% base case
collect_atoms([], []).
% handle atoms
collect_atoms([A|Ps], [A|Rest]) :-
% you could replace the next test with logical_atom/1
atom(A), !,
collect_atoms(Ps, Rest).
% handle terms
collect_atoms([P|Ps], Rest) :-
compound(P), !, % compound/1 tests for terms
atoms_of_prop(P, PAtoms),
collect_atoms(Ps, PsAtoms),
append(PAtoms, PsAtoms, Rest).
% ignore everything else
collect_atoms([_|Ps], Rest) :- atoms_of_prop(Ps, Rest).
This works for your example as-is:
?- atoms_of_prop(ats(and(q, imp(or(p, q), neg(p))), As), Atoms).
Atoms = [p, q].

What are the optimal green cuts for successor arithmetics sum?

To grok green cuts in Prolog I am trying to add them to the standard definition of sum in successor arithmetics (see predicate plus in What's the SLD tree for this query?). The idea is to "clean up" the output as much as possible by eliminating all useless backtracks (i.e., no ... ; false) while keeping identical behavior under all possible combinations of argument instantiations - all instantiated, one/two/three completely uninstantiated, and all variations including partially instantiated args.
This is what I was able to do while trying to come as close as possible to this ideal (I acknowledge false's answer to how to insert green cuts into append/3 as a source):
natural_number(0).
natural_number(s(X)) :- natural_number(X).
plus(X, Y, X) :- (Y == 0 -> ! ; Y = 0), (X == 0 -> ! ; true), natural_number(X).
plus(X, s(Y), s(Z)) :- plus(X, Y, Z).
Under SWI this seems to work fine for all queries but those with shape ?- plus(+X, -Y, +Z)., as for SWI's notation of predicate description. For instance, ?- plus(s(s(0)), Y, s(s(s(0)))). yields Y = s(0) ; false.. My questions are:
How do we prove that the above cuts are (or are not) green?
Can we do better than the above program and eliminate also the last backtrack by adding some other green cuts?
If yes, how?
First a minor issue: the common definition of plus/3 has the first and second argument exchanged which allows to exploit first-argument indexing. See Program 3.3 of the Art of Prolog. That should also be changed in your previous post. I will call your exchanged definition plusp/3 and your optimized definition pluspo/3. Thus, given
plusp(X, 0, X) :- natural_number(X).
plusp(X, s(Y), s(Z)) :- plusp(X, Y, Z).
Detecting red cuts (question one)
How to prove or disprove red/green cuts? First of all, watch for "write"-unifications in the guard. That is, for any such unifications prior to the cut. In your optimized program:
pluspo(X, Y, X) :- (Y == 0 -> ! ; Y = 0), (X == 0 -> ! ; true), ...
I spot the following:
pluspo(X, Y, X) :- (...... -> ! ; ... ), ...
So, let us construct a counterexample: To make this cut cut in a red manner, the "write unification" must make its actual guard Y == 0 true. Which means that the goal to construct must contain the constant 0 somehow. There are only two possibilities to consider. The first or third argument. A zero in the last argument means that we have at most one solution, thus no possibility to cut away further solutions. So, the 0 has to be in the first argument! (The second argument must not be 0 right from the beginning, or the "write unification would not have a detrimental effect.). Here is one such counterexample:
?- pluspo(0, Y, Y).
which gives one correct solution Y = 0, but hides all the other ones! So here we have such an evil red cut!
And contrast it to the unoptimized program which gave infinitely many solutions:
Y = 0
; Y = s(0)
; Y = s(s(0))
; Y = s(s(s(0)))
; ... .
So, your program is incomplete, and any questions about further optimizing it are thus not relevant. But we can do better, let me restate the actual definition we want to optimize:
plus(0, X, X) :- natural_number(X).
plus(s(X), Y, s(Z)) :- plus(X, Y, Z).
In practically all Prolog systems, there is first-argument indexing, which makes the following query determinate:
?- plus(s(0),0,X).
X = s(0).
But many systems do not support (full) third argument indexing. Thus we get in SWI, YAP, SICStus:
?- plus(X, Y, 0).
X = Y, Y = 0
; false.
What you probably wanted to write is:
pluso(X, Y, Z) :-
% Part one: green cuts
( X == 0 -> ! % first-argument indexing
; Z == 0 -> ! % 3rd-argument indexing, e.g. Jekejeke, ECLiPSe
; true
),
% Part two: the original unifications
X = 0,
Y = Z,
natural_number(Z).
pluso(s(X), Y, s(Z)) :- pluso(X, Y, Z).
Note the differences to pluspo/3: There are now only tests prior to the cut! All unifications are thereafter.
?- pluso(X, Y, 0).
X = Y, Y = 0.
The optimizations so far relied only on investigating the heads of the two clauses. They did not take into account the recursive rule. As such, they can be incorporated into a Prolog compiler without any global analysis. In O'Keefe's terminology, these green cuts might be considered blue cuts. To cite The Craft of Prolog, 3.12:
Blue cuts are there to alert the Prolog system to a determinacy it should have noticed but wouldn't. Blue cuts do not change the visible behavior of the program: all they do is make it feasible.
Green cuts are there to prune away attempted proofs that would succeed or be irrelevant, or would be bound to fail, but you would not expect the Prolog system to be able to tell that.
However, the very point is that these cuts do need some guards to work properly.
Now, you considered another query:
?- pluso(X, s(s(0)), s(s(s(0)))).
X = s(0)
; false.
or to put a simpler case:
?- pluso(X, s(0), s(0)).
X = 0
; false.
Here, both heads apply, thus the system is not able to determine determinism. However, we know that there is no solution to a goal plus(X, s^n, s^m) with n > m. So by considering the model of plus/3 we can further avoid choicepoints. I'll be right back after this break:
Better use call_semidet/1!
It gets more and more complex and chances are that optimizations might easily introduce new errors in a program. Also optimized programs are a nightmare to maintain. For practical programming purposes use rather call_semidet/1. It is safe, and will produce a clean error should your assumptions turn out to be false.
Back to business: Here is a further optimization. If Y and Z are identical, the second clause cannot apply:
pluso2(X, Y, Z) :-
% Part one: green cuts
( X == 0 -> ! % first-argument indexing
; Z == 0 -> ! % 3rd-argument indexing, e.g. Jekejeke, ECLiPSe
; Y == Z, ground(Z) -> !
; true
),
% Part two: the original unifications
X = 0,
Y = Z,
natural_number(Z).
pluso2(s(X), Y, s(Z)) :- pluso2(X, Y, Z).
I (currently) believe that pluso2/3 is the optimal usage of green/blue cuts w.r.t. leftover choicepoints. You asked for a proof. Well, I think that is well beyond an SO answer...
The goal ground(Z) is necessary to ensure the non-termination properties. The goal plus(s(_), Z, Z) does not terminate, that property is preserved by ground(Z). Maybe you think it is a good idea to remove infinite failure branches too? In my experience, this is rather problematic. In particular, if those branches are removed automatically. While at first sight it seems to be a good idea, it makes program development much more brittle: An otherwise benign program change might now disable the optimization and thus "cause" non-termination. But anyway, here we go:
Beyond simple green cuts
pluso3(X, Y, Z) :-
% Part one: green cuts
( X == 0 -> ! % first-argument indexing
; Z == 0 -> ! % 3rd-argument indexing, e.g. Jekejeke, ECLiPSe
; Y == Z -> !
; var(Z), nonvar(Y), \+ unify_with_occurs_check(Z, Y) -> !, fail
; var(Z), nonvar(X), \+ unify_with_occurs_check(Z, X) -> !, fail
; true
),
% Part two: the original unifications
X = 0,
Y = Z,
natural_number(Z).
pluso3(s(X), Y, s(Z)) :- pluso3(X, Y, Z).
Can you find a case where pluso3/3 does not terminate while there are finitely many answers?

Convert peano number s(N) to integer in Prolog

I came across this natural number evaluation of logical numbers in a tutorial and it's been giving me some headache:
natural_number(0).
natural_number(s(N)) :- natural_number(N).
The rule roughly states that: if N is 0 it's natural, if not we try to send the contents of s/1 back recursively to the rule until the content is 0, then it's a natural number if not then it's not.
So I tested the above logic implementation, thought to myself, well this works if I want to represent s(0) as 1 and s(s(0)) as 2, but I´d like to be able to convert s(0) to 1 instead.
I´ve thought of the base rule:
sToInt(0,0). %sToInt(X,Y) Where X=s(N) and Y=integer of X
So here is my question: How can I convert s(0) to 1 and s(s(0)) to 2?
Has been answered
Edit: I modified the base rule in the implementation which the answer I accepted pointed me towards:
decode(0,0). %was orignally decode(z,0).
decode(s(N),D):- decode(N,E), D is E +1.
encode(0,0). %was orignally encode(0,z).
encode(D,s(N)):- D > 0, E is D-1, encode(E,N).
So I can now use it like I wanted to, thanks everyone!
Here is another solution that works "both ways" using library(clpfd) of SWI, YAP, or SICStus
:- use_module(library(clpfd)).
natsx_int(0, 0).
natsx_int(s(N), I1) :-
I1 #> 0,
I2 #= I1 - 1,
natsx_int(N, I2).
No problemo with meta-predicate nest_right/4 in tandem with
Prolog lambdas!
:- use_module(library(lambda)).
:- use_module(library(clpfd)).
:- meta_predicate nest_right(2,?,?,?).
nest_right(P_2,N,X0,X) :-
zcompare(Op,N,0),
ord_nest_right_(Op,P_2,N,X0,X).
:- meta_predicate ord_nest_right_(?,2,?,?,?).
ord_nest_right_(=,_,_,X,X).
ord_nest_right_(>,P_2,N,X0,X2) :-
N0 #= N-1,
call(P_2,X1,X2),
nest_right(P_2,N0,X0,X1).
Sample queries:
?- nest_right(\X^s(X)^true,3,0,N).
N = s(s(s(0))). % succeeds deterministically
?- nest_right(\X^s(X)^true,N,0,s(s(0))).
N = 2 ; % succeeds, but leaves behind choicepoint
false. % terminates universally
Here is mine:
Peano numbers that are actually better adapted to Prolog, in the form of lists.
Why lists?
There is an isomorphism between
a list of length N containing only s and terminating in the empty list
a recursive linear structure of depth N with function symbols s
terminating in the symbol zero
... so these are the same things (at least in this context).
There is no particular reason to hang onto what 19th century mathematicians
(i.e Giuseppe Peano )
considered "good structure structure to reason with" (born from function
application I imagine).
It's been done before: Does anyone actually use Gödelization to encode
strings? No! People use arrays of characters. Fancy that.
Let's get going, and in the middle there is a little riddle I don't know how to
solve (use annotated variables, maybe?)
% ===
% Something to replace (frankly badly named and ugly) "var(X)" and "nonvar(X)"
% ===
ff(X) :- var(X). % is X a variable referencing a fresh/unbound/uninstantiated term? (is X a "freshvar"?)
bb(X) :- nonvar(X). % is X a variable referencing an nonfresh/bound/instantiated term? (is X a "boundvar"?)
% ===
% This works if:
% Xn is boundvar and Xp is freshvar:
% Map Xn from the domain of integers >=0 to Xp from the domain of lists-of-only-s.
% Xp is boundvar and Xn is freshvar:
% Map from the domain of lists-of-only-s to the domain of integers >=0
% Xp is boundvar and Xp is boundvar:
% Make sure the two representations are isomorphic to each other (map either
% way and fail if the mapping gives something else than passed)
% Xp is freshvar and Xp is freshvar:
% WE DON'T HANDLE THAT!
% If you have a freshvar in one domain and the other (these cannot be the same!)
% you need to set up a constraint between the freshvars (via coroutining?) so that
% if any of the variables is bound with a value from its respective domain, the
% other is bound auotmatically with the corresponding value from ITS domain. How to
% do that? I did it awkwardly using a lookup structure that is passed as 3rd/4th
% argument, but that's not a solution I would like to see.
% ===
peanoify(Xn,Xp) :-
(bb(Xn) -> integer(Xn),Xn>=0 ; true), % make sure Xn is a good value if bound
(bb(Xp) -> is_list(Xp),maplist(==(s),Xp) ; true), % make sure Xp is a good value if bound
((ff(Xn),ff(Xp)) -> throw("Not implemented!") ; true), % TODO
length(Xp,Xn),maplist(=(s),Xp).
% ===
% Testing is rewarding!
% Run with: ?- rt(_).
% ===
:- begin_tests(peano).
test(left0,true(Xp=[])) :- peanoify(0,Xp).
test(right0,true(Xn=0)) :- peanoify(Xn,[]).
test(left1,true(Xp=[s])) :- peanoify(1,Xp).
test(right1,true(Xn=1)) :- peanoify(Xn,[s]).
test(left2,true(Xp=[s,s])) :- peanoify(2,Xp).
test(right2,true(Xn=2)) :- peanoify(Xn,[s,s]).
test(left3,true(Xp=[s,s,s])) :- peanoify(3,Xp).
test(right3,true(Xn=3)) :- peanoify(Xn,[s,s,s]).
test(f1,fail) :- peanoify(-1,_).
test(f2,fail) :- peanoify(_,[k]).
test(f3,fail) :- peanoify(a,_).
test(f4,fail) :- peanoify(_,a).
test(f5,fail) :- peanoify([s],_).
test(f6,fail) :- peanoify(_,1).
test(bi0) :- peanoify(0,[]).
test(bi1) :- peanoify(1,[s]).
test(bi2) :- peanoify(2,[s,s]).
:- end_tests(peano).
rt(peano) :- run_tests(peano).

Resources