Optimizing clp(FD) labeling - prolog

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]).

Related

Prolog STRIPS planner never completes

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

Prolog: Exam schedule generator - How to avoid permutations in solutions

I'm building an exam scheduler in Prolog.
The scheduler is based on this example:
https://metacpan.org/source/DOUGW/AI-Prolog-0.741/examples/schedule.pl
How can I make sure there are no permutations in my solution?
For example solution
-> ((exam1, teacher1, time1, room1), (exam2, teacher2, time2, room2))
Later solution:
-> ((exam2, teacher2, time2, room2),(exam1, teacher1, time1, room1))
How can I avoid this?
Thanks!

1) The closest/easiest from what you've got is to check that the course you've chosen is strictly bigger in order than the previous one.
For example by adding an extra predicate which also includes the previous course in the combination.
%%makeListPrev(PreviousTakenCourse, ResultCombinationOfCourses, NrOfCoursesToAdd)
makeListPrev(_,[], 0).
makeListPrev(course(Tprev,Ttime,Troom),[course(Teacher,Time,Room)|Rest], N) :-
N > 0,
teacher(Teacher),
classtime(Time),
classroom(Room),
course(Tprev,Ttime,Troom) #< course(Teacher,Time,Room), %% enforce unique combinations
is(M,minus(N,1)),
makeListPrev(course(Teacher,Time,Room),Rest,M).
In this way you eliminate all duplicate permutations of the same combination by always taking the lexographically smallest.
E.g if you have 4 courses:
(a,b,c,d)
(a,b,d,c) % d can't be before c
(a,c,b,d) % c can't be before b
...
2) Another way to solve this quite easily is to first create a list of all possible courses. And then take out all possible combinations of N sequentially.
scheduler(L) :-
%% Find all possible courses
findall(course(Teacher,Time,Room),(teacher(Teacher),classtime(Time),classroom(Room)),Courses),
makeList(Courses,4,L),
different(L).
makeList([],0,[]) :- !. %% list completed
makeList([H|T],N,[H|Res]) :- %% list including H
M is N-1,
makeList(T,M,Res).
makeList([_|T], N, Res) :- makeList(T, N, Res). %% list without H

Trouble displaying constraint values - SICStus clpfd

I am trying to solve a problem for a class that consists of this:
Fill the white cells on the each barrels side with different digits from 1 to 6. Digits cannot
repeat in every horizontal and vertical directions. Each number on the barrels top must
be equal to the sum or product of the four different digits in the barrel. All top numbers
are different and less than 91.
I can achieve the results fine, but I need to display the barrel's results and when I run my base case it shows this:
[_24087,18,60,17,_24343,72,_24471,_24535,14]
[1,2,3,4,5,6,3,4,5,6,1,2,2,5,1,3,6,4,4,6,2,5,3,1,5,1,6,2,4,3,6,3,4,1,2,5]
Result achieved in 0.015 sec.
Resumptions: 6197
Entailments: 1306
Prunings: 3520
Backtracks: 62
Constraints created: 107
The 1st list is the barrels and the 2nd list the Matrix calculated with labeling.
In order to calculate the barrels I use this on a rule:
getlist(Matrix,CounterX,CounterY,InnerSize,Value), % gets the barrel sublist
all_distinct(Value),
sum(Value, #=, SSet), % sum
prod(Value, VSet), % product
Set #= SSet #\/ Set #= VSet, % chooses one
Set #=< MaxValue,
insertinto(Set, List, NewList), % inserts into the barrel list
Since SICStus doesn't have a product calculation rule, I created this one:
prod([H|T], R) :-
prod(T, H, R).
prod([], R, R).
prod([H|T], V, R) :-
NV #= H * V,
prod(T, NV, R).
I don't understand where the problem actually lies.
In my prod rule -> It seems to unify correctly but seems not to when 1 is in the sublist.
How I unify the sum or prod -> Maybe that barrel can be a sum or prod and can't unify with Set correctly.

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).

Calculating variance in prolog

i have made a function in Prolog:-
mean(L, M) :-
sum(L, S),
length(L, N),
M is S/N.
sum([],0).
sum([H|T],Y):-
sum(T,X),
Y is X + H.
variance([],0).
variance([H|T], M, VO):-
variance(T,M,Y),
VO is( Y + ((H-M)*(H-M))).
statsList(L, M, V1) :-
sum(L, S),
length(L, N),
M is S/N,
variance(L, M, VO),
V1 is V0/N.
for some reason when I try to calculate the variance it always replies "false"
as so: variance([1,2,3],2,VO) or statsList([1,2,3],M,VO)
However if I use this just to test it works:
variance([],0).
variance([H|T], VO):-
variance(T,Y),
VO is( Y + ((H-2)*(H-2))).
Can someone tell me where I am going wrong?

variance([],0).
variance([H|T], M, VO):-
variance(T,M,Y),
VO is( Y + ((H-M)*(H-M))).
The first clause defines a predicate variance/2 (two arguments) while the second defines variance/3. The latter predicate then calls itself recursively until it hits the empty list, which it cannot handle.
You should define a proper base case for variance/3. In Prolog, clauses with the same predicate name but different arity (number of arguments) define different predicates.
The error does not show up in your test code since there you define variance/2 with a base case and a recursive case.

In your first code you have defined two predicates variance/2 and variance/3 (one with 2 arguments and the other with 3 arguments).
You have probably misspelled the first predicate. It should read
variance([], _, 0).

Resources