Download
/*
* SICSTUS CLPFD DEMONSTRATION PROGRAM
* Purpose : Progressive Party Problem
* Author : Mats Carlsson
*
* A set of guest boat crews are supposed to visit a set of host boats in
* six shifts. The host boats have finite capacity. A guest crew can't
* visit a host twice. Two guest crews can't meet twice.
*
* See Smith, B.,Brailsford, S., Hubbard, P., and Williams, H.
* The progressive party problem: integer linear programming and
* constraint programming compared. Constraints 1:119-138, 1996.
*
* Constants:
*
* spare(I) : the spare capacity of host I
* crew(I) : the crew size of guest I
*
*
* Variables:
*
* h(I,T) in 1..13 : the host boat that guest boat I visits at time T
* m(I,J,T) #<=> h(I,T) #= h(J,T)
*
*
* Problem constraints:
*
* all_different([h(I,1),...,h(I,6)]) % guest I can't visit a host twice
* cumulatives([task(1,1,2,2,h(1,1)), ..., task(6,1,7,2,h(1,6)),
* ...
* task(1,1,2,4,h(13,1)), ..., task(6,1,7,4,h(13,6))],
* [machine(1,10),...,machine(13,4)],
* [bound(upper)])
* sum([m(I,J,1)...,m(I,J,6)], #=<, 1) % crews I,J can't meet twice
*
* Redundant constraints (do not seem to help):
*
* count(H, [h(1,T),...,h(29,T)], #>=, 1)
*
* Asymmetry constraints:
*
* h(1,1) #< ... #< h(1,6)
* I<J & crew(I) #= crew(J) #=>
* (h(I,1) #=< h(J,1) #/\ (h(I,1) #< h(J,1) #\/ h(I,2) #< h(J,2)))
*
* | ?- party.
*/
:- module(party, [party/0]).
:- use_module(library(lists)).
:- use_module(library(clpfd)).
party :-
party_variables(6, Vars),
party_constraints(6, Vars),
guest_vars(0, 29, Vars, All, []),
labeling([ff], All),
format('Guest~t~10|Hosts\n', []),
pp_party(13, 42, Vars).
guest_vars(G, G, _) --> !.
guest_vars(G0, G, Vars) -->
{G1 is G0+1},
{aget(h(G1), Vars, Row)},
(foreach(X,Row) do [X]),
guest_vars(G1, G, Vars).
pp_party(G, G, _) :- !.
pp_party(I, G, Vars) :-
J is I+1,
(guest(J1, _, J) -> true),
aget(h(J1), Vars, Row),
( foreach(H,Row),
foreach(H1,Row1)
do host(H, _, H1)
),
format('~w~t~10|~w\n', [J,Row1]),
pp_party(J, G, Vars).
party_variables(T, Vars) :-
Vars = vars(H,M),
sizes(Hosts, Guests),
functor(H, h, Guests),
functor(M, m, Guests),
h_array(Guests, T, Hosts, H),
m_array(Guests, T, Vars, M).
party_constraints(Times, Vars) :-
sizes(Hosts, Guests),
( for(G1,1,Guests),
param([Vars,domain])
do aget(h(G1), Vars, L1),
all_distinct(L1)
),
host_capacities(Hosts, Guests, Times, Vars),
( for(G2,1,Guests),
param(Vars)
do ( for(H,1,G2-1),
param([G2,Vars])
do aget(m(G2,H), Vars, L2),
sum(L2, #=<, 1)
)
),
first_guest_order(Vars),
% redundant(Hosts, Guests, Times, Vars), % does not help
asym_crews(Vars).
% host_capacities(13, 29, 6, Vars)
host_capacities(Hosts, Guests, Times, Vars) :-
host_cap_tasks(0, Guests, Times, Vars, Tasks, []),
host_cap_machines(0, Hosts, Mach, []),
cumulatives(Tasks, Mach, [bound(upper)]).
host_cap_tasks(G, G, _, _) --> !.
host_cap_tasks(G0, G, Times, Vars) -->
{G1 is G0+1},
guest_cap_tasks(0, Times, G1, Vars),
host_cap_tasks(G1, G, Times, Vars).
guest_cap_tasks(T, T, _, _) --> !.
guest_cap_tasks(T0, T, G1, Vars) --> [task(T0,1,T1,CrewSize,Host)],
{T1 is T0+1},
{guest(G1, CrewSize, _)},
{aget(h(G1,T1), Vars, Host)},
guest_cap_tasks(T1, T, G1, Vars).
host_cap_machines(H, H) --> !.
host_cap_machines(H0, H) --> [machine(H1,Spare)],
{H1 is H0+1},
{host(H1, Spare, _)},
host_cap_machines(H1, H).
first_guest_order(Vars) :-
aget(h(1), Vars, [H1|Hosts]),
first_guest_order(Hosts, H1).
first_guest_order([], _).
first_guest_order([H2|Hs], H1) :-
H1 #< H2,
first_guest_order(Hs, H2).
% redundant(Hosts, Guests, Times, Vars)
redundant(_, _, 0, _) :- !.
redundant(H, G, T, Vars) :-
redundant2(G, T, Vars, L),
redundant(H, L),
( for(I,1,H),
param(L)
do count(I, L, #>=, 1)
),
T1 is T-1,
redundant(H, G, T1, Vars).
redundant2(0, _, _, []) :- !.
redundant2(G, T, Vars, [V|Vs]) :-
aget(h(G,T), Vars, V),
G1 is G-1,
redundant2(G1, T, Vars, Vs).
asym_crews(Vars) :-
findall(Crew-Guest, guest(Guest,Crew,_), Pairs),
keysort(Pairs, Keysorted),
keyclumped(Keysorted, Keymerged),
( foreach(_-Class,Keymerged),
param(Vars)
do asym_crews1(Class, Vars)
).
asym_crews1([_], _) :- !.
asym_crews1([G1,G2|Gs], Vars) :-
aget(h(G1,1), Vars, H11),
aget(h(G1,2), Vars, H12),
aget(h(G2,1), Vars, H21),
aget(h(G2,2), Vars, H22),
H11 #=< H21,
H11 #< H21 #\/ H12 #< H22,
asym_crews1([G2|Gs], Vars).
h_array(0, _, _, _) :- !.
h_array(I, T, Hosts, H) :-
arg(I, H, Row),
length(L, T),
domain(L, 1, Hosts),
Row =.. [h|L],
J is I-1,
h_array(J, T, Hosts, H).
v_array(0, _, _, _, _) :- !.
v_array(I, Hosts, T, Vars, V) :-
arg(I, V, Row),
functor(Row, v, Hosts),
v_array1(I, Hosts, T, Vars, Row),
I1 is I-1,
v_array(I1, Hosts, T, Vars, V).
v_array1(_, 0, _, _, _) :- !.
v_array1(I, J, T, Vars, V) :-
arg(J, V, Row),
functor(Row, v, T),
v_array2(I, J, T, Row, Vars),
J1 is J-1,
v_array1(I, J1, T, Vars, V).
v_array2(_, _, 0, _, _) :- !.
v_array2(I, J, T, Row, Vars) :-
arg(T, Row, X),
aget(h(I,T), Vars, Y),
Y #= J #<=> X,
T1 is T-1,
v_array2(I, J, T1, Row, Vars).
m_array(0, _, _, _) :- !.
m_array(I, T, Vars, M) :-
I1 is I-1,
arg(I, M, Row),
functor(Row, m, I1),
m_array1(I, I1, T, Vars, Row),
m_array(I1, T, Vars, M).
m_array1(_, 0, _, _, _) :- !.
m_array1(I, J, T, Vars, M) :-
arg(J, M, Row),
functor(Row, m, T),
m_array2(I, J, T, Row, Vars),
J1 is J-1,
m_array1(I, J1, T, Vars, M).
m_array2(_, _, 0, _, _) :- !.
m_array2(I, J, T, Row, Vars) :-
arg(T, Row, X),
aget(h(I,T), Vars, Y),
aget(h(J,T), Vars, Z),
Y #= Z #<=> X,
T1 is T-1,
m_array2(I, J, T1, Row, Vars).
aget(h(I), vars(H,_), L) :-
arg(I, H, X0),
X0 =.. [h|L].
aget(h(I,T), vars(H,_), X) :-
arg(I, H, X0),
arg(T, X0, X).
aget(m(I,J), vars(_,M), L) :-
arg(I, M, X0),
arg(J, X0, X1),
X1 =.. [m|L].
aget(m(I,J,T), vars(_,M), X) :-
arg(I, M, X0),
arg(J, X0, X1),
arg(T, X1, X).
% First 13 are hosts, remaining 29 are guests.
% boat(BoatNo, Capacity, CrewSize)
boat( 1, 6, 2).
boat( 2, 8, 2).
boat( 3, 12, 2).
boat( 4, 12, 2).
boat( 5, 12, 4).
boat( 6, 12, 4).
boat( 7, 12, 4).
boat( 8, 10, 1).
boat( 9, 10, 2).
boat(10, 10, 2).
boat(11, 10, 2).
boat(12, 10, 3).
boat(13, 8, 4).
boat(14, 8, 2).
boat(15, 8, 3).
boat(16, 12, 6).
boat(17, 8, 2).
boat(18, 8, 2).
boat(19, 8, 4).
boat(20, 8, 2).
boat(21, 8, 4).
boat(22, 8, 5).
boat(23, 7, 4).
boat(24, 7, 4).
boat(25, 7, 2).
boat(26, 7, 2).
boat(27, 7, 4).
boat(28, 7, 5).
boat(29, 6, 2).
boat(30, 6, 4).
boat(31, 6, 2).
boat(32, 6, 2).
boat(33, 6, 2).
boat(34, 6, 2).
boat(35, 6, 2).
boat(36, 6, 2).
boat(37, 6, 4).
boat(38, 6, 5).
boat(39, 9, 7).
boat(40, 0, 2).
boat(41, 0, 3).
boat(42, 0, 4).
% derived facts
% host(Id, SpareCap, BoatNo)
% Total spare cap = 98, guest crews = 94
host( 1, 10, 3).
host( 2, 10, 4).
host( 3, 9, 8).
host( 4, 8, 5).
host( 5, 8, 6).
host( 6, 8, 7).
host( 7, 8, 9).
host( 8, 8, 10).
host( 9, 8, 11).
host(10, 7, 12).
host(11, 6, 2).
host(12, 4, 1).
host(13, 4, 13).
% guest(Id, CrewSize, BoatNo)
guest( 1, 7, 39).
guest( 2, 6, 16).
guest( 3, 5, 22).
guest( 4, 5, 28).
guest( 5, 5, 38).
guest( 6, 4, 19).
guest( 7, 4, 21).
guest( 8, 4, 23).
guest( 9, 4, 24).
guest(10, 4, 27).
guest(11, 4, 30).
guest(12, 4, 37).
guest(13, 4, 42).
guest(14, 3, 15).
guest(15, 3, 41).
guest(16, 2, 14).
guest(17, 2, 17).
guest(18, 2, 18).
guest(19, 2, 20).
guest(20, 2, 25).
guest(21, 2, 26).
guest(22, 2, 29).
guest(23, 2, 31).
guest(24, 2, 32).
guest(25, 2, 33).
guest(26, 2, 34).
guest(27, 2, 35).
guest(28, 2, 36).
guest(29, 2, 40).
% sizes(Hosts, Guests)
sizes(13, 29).
This work is licensed under a Creative Commons Attribution 4.0 International License.