/*
Max activity problem in Picat.
From
Need help for defining appropriate constraints
http://stackoverflow.com/questions/25806906/need-help-for-defining-appropriate-constraints
"""
I'm very new to constraint programming and try to find some real situations to
test it. I found one i think may be solved with CP.
Here it is : I have a group of kids that i have to assign to some activities.
These kids fill a form where they specify 3 choices in order of preference. Activities
have a max number of participant so, the idea is to find a solution where the choices
are respected for the best without exceedind max.
So, in first approach, i defined vars for kids with [1,2,3] for domain (the link
between the number of choice, activity and children being known somewhere else).
But then, i don't really know how to define relevant constraints so I have all the
permutation (very long) and then, i have to give a note to each (adding the numbers of
choices to get the min) and eliminate results with to big groups.
I think there must be a good way to do this using CP but i can't figure it out.
Does someone can help me ?
"""
This Picat model was created by Hakan Kjellerstrand, hakank@gmail.com
See also my Picat page: http://www.hakank.org/picat/
*/
import cp.
% import sat.
main => go.
go =>
prefs(1,Prefs),
activity_size(1,ActivitySize),
max_activity(Prefs,ActivitySize, X, Scores,TotalScore),
println(x=X),
println(scores=Scores),
println(totalScore=TotalScore),
nl.
% find all solutions for second activity size
go2 =>
prefs(1,Prefs),
activity_size(2,ActivitySize),
max_activity(Prefs,ActivitySize, X, Scores,TotalScore),
println(x=X),
println(scores=Scores),
println(totalScore=TotalScore),
println("All optimal solutions:"),
All = findall([x=X2,scores=Scores2], max_activity(Prefs,ActivitySize, X2, Scores2,TotalScore)),
foreach(Row in All)
println(Row)
end,
nl.
%
% Here the preferred activities are not enough for the kids
% so we have to give someone a non-preferred activitiy.
% There are 180 optimal solutions (total_score = 7)
% for prefs 2 and activity_size 3, all with two 0 scores.
% Here is a sample output (truncated):
% x=[2,2,3,4,1,1]
% scores=[1,1,2,3,0,0]
% totalScore=7
% All optimal solutions:
% [x=[2,2,3,4,1,1],scores=[1,1,2,3,0,0]]
% [x=[2,2,4,3,1,1],scores=[1,1,3,2,0,0]]
% [x=[2,3,2,4,1,1],scores=[1,2,1,3,0,0]]
% ...
%
go3 ?=>
prefs(2,Prefs),
activity_size(3,ActivitySize),
max_activity(Prefs,ActivitySize, X, Scores,TotalScore),
println(x=X),
println(scores=Scores),
println(totalScore=TotalScore),
println("All optimal solutions:"),
All = findall([x=X2,scores=Scores2], max_activity(Prefs,ActivitySize, X2, Scores2,TotalScore)),
foreach(Row in All)
println(Row)
end,
println(numSolutions=All.length),
nl.
%
% larger random instances
%
go4 =>
NumKids = 100,
NumActivities = 20,
NumPrefs = 3,
Prefs = [select_unique(NumPrefs,NumActivities) : _ in 1..NumKids],
println(prefs=Prefs),
ActivitySize = generate_activities(NumActivities,NumKids),
println(activity_size=ActivitySize),
max_activity(Prefs,ActivitySize, X,Scores,TotalScore),
println(x=X),
println(scores=Scores),
println(totalScore=TotalScore),
if member(0,Scores) then
println("0 scores for these kids:"),
println([Kid : Kid in 1..NumKids, Scores[Kid] == 0])
end,
nl.
select_unique(N,Max) = Selected =>
Selected1 = [],
while (length(Selected1) < N)
Selected1 := (Selected1 ++ [1 + random2() mod Max]).remove_dups()
end,
Selected = Selected1.
generate_activities(NumActivities,NumKids) = ActivitySize =>
Mod = NumKids div 2,
ActivitySize = [2 + random2() mod Mod : _ in 1..NumActivities],
while (sum(ActivitySize) < NumKids)
ActivitySize := [2 + random2() mod Mod : _ in 1..NumActivities]
end.
max_activity(Prefs,ActivitySize, X, Scores,TotalScore) =>
NumKids = Prefs.length,
NumActivities = ActivitySize.length,
NumPrefs = Prefs[1].length, % number of stated preferences
% decision variables
X = new_list(NumKids),
X :: 1..NumActivities,
Scores = new_list(NumKids),
Scores :: 0..3,
% TotalScore :: 0..NumKids * NumPrefs,
TotalScore #= sum(Scores),
foreach(K in 1..NumKids)
% select one of the prefered activities
%
% Note: we cannot use
% #\/ Scores[K] #= 0
% here since element/3 is not allowed in reifications,
% so we just use a "plain logical" or (;).
% It works but is not recommended...
(
P :: 1..3,
% X[K] #= Prefs[K,P],
element(P,Prefs[K],X[K]),
Scores[K] #= NumPrefs-P+1 % score for the selected activity
;
println("zero score"),
Scores[K] #= 0
)
end,
% ensure size of the activities
foreach(A in 1..NumActivities)
sum([X[K] #= A : K in 1..NumKids]) #<= ActivitySize[A]
end,
println(totalScore=TotalScore),
Vars = Scores ++ X,
if var(TotalScore) then
solve($[max(TotalScore),down,report(printf("TotalScore: %d Score: %w\n", TotalScore, Scores))], Vars)
else
solve(Vars)
end.
% Activity preferences for each kid
prefs(1,Prefs) =>
Prefs =
[
[1,2,3],
[4,2,1],
[2,1,4],
[4,2,1],
[3,2,4],
[4,1,3]
].
prefs(2,Prefs) =>
Prefs =
[
[4,3,2],
[4,3,2],
[4,3,2],
[4,3,2],
[4,3,2],
[4,3,2]
].
% max size of activity
activity_size(1,ActivitySize) =>
ActivitySize = [2,2,2,3].
% smaller size of activity #4
activity_size(2,ActivitySize) =>
ActivitySize = [2,2,2,2].
% still smaller activities to yield 0 score
activity_size(3,ActivitySize) =>
ActivitySize = [2,2,1,1].