Home > Archive > Prolog > March 2005 > Golf Problem
You are viewing an archived Text-only version of the thread.
To view this thread in it's original format and/or if you want to reply to
this thread please [click here]
|
|
| Nameless 2004-12-28, 3:59 pm |
| Prologers might find this problem, originating in the sci.math
newsgroup, both appropriate and challenging:
You do not need to be a golfer to help with my problem.
I am arranging a competition for 12 players (say A through L)
over 5 days. Each day 3 groups of 4 will play. Day one could
be A+B v C+D, E+F v G+H and I+J v K+L (Easy so far!). The
problem is that I cannot make the 15 groups (3x5) such that:
Every player plays in a group with ever other player during
the 5 days at least once and ideally not more than twice.
No player partners any other player more than once. eg If A+B
v C+D is a group then another group of A+B v E+K is not
acceptable but A+E v B+K is.
Each player tees off in the first group at least once but no
more than twice over the 5 days.
After hours of looking for patterns and juggling with letters
I have not found a solution but have been so near that I am
convinced that it is mathematically possible.
A real mathematician might find this easy but I am a chemist!
No useful replies were forthcoming in the sci.math newsgroup!
--
Mail sent to this email address is automatically deleted
(unread) on the server. Send replies to the newsgroup.
| |
| Markus Triska 2004-12-28, 3:59 pm |
| Nameless wrote:
>
> Every player plays in a group with ever other player during
> the 5 days at least once and ideally not more than twice.
>
I'm not sure that even this requirement can be fulfilled. I quick
translation to Prolog up to here:
group(G) :-
G = gr(pair(P1,P2),pair(P3,P4)).
groups([]).
groups([G|Gs]) :-
group(G),
groups(Gs).
day(D) :-
D = day(Gr1,Gr2,Gr3),
groups([Gr1,Gr2,Gr3]).
days([]).
days([D|Ds]) :-
day(D),
days(Ds).
choosetwo([X|Xs],(X,Y)) :-
member(Y,Xs).
choosetwo([_,X|Xs],Two) :-
choosetwo([X|Xs],Two).
group_day(Gr1,day(Gr1,_,_)).
group_day(Gr2,day(_,Gr2,_)).
group_day(Gr3,day(_,_,Gr3)).
twoinanygroup((T1,T2),Day) :-
group_day(Group,Day),
Group = gr(pair(P1,P2),pair(P3,P4)),
Players = [P1,P2,P3,P4],
member(T1,Players),
member(T2,Players).
twosplayingroup([],_).
twosplayingroup([Two|Twos],Ds) :-
member(Day,Ds),
twoinanygroup(Two,Day),
twosplayingroup(Twos,Ds).
tournament(Ds) :-
Ds = [D1,D2,D3,D4,D5],
days(Ds),
Players = [1,2,3,4,5,6,7,8,9,10,11,12],
findall(Two,choosetwo(Players,Two),Twos)
,
twosplayingroup(Twos,Ds).
I'm unable to find any solution for tournament(Ds) even after waiting
for several minutes. Maybe someone can recommend a different search
strategy or prove that this requirement can or cannot be fulfilled?
Best regards,
Markus.
| |
| Bart Demoen 2004-12-28, 3:59 pm |
| Nameless wrote:
> Prologers might find this problem, originating in the sci.math
> newsgroup, both appropriate and challenging:
>
> You do not need to be a golfer to help with my problem.
>
> I am arranging a competition for 12 players (say A through L)
> over 5 days. Each day 3 groups of 4 will play. Day one could
> be A+B v C+D, E+F v G+H and I+J v K+L (Easy so far!). The
> problem is that I cannot make the 15 groups (3x5) such that:
>
> Every player plays in a group with ever other player during
> the 5 days at least once and ideally not more than twice.
>
> No player partners any other player more than once. eg If A+B
> v C+D is a group then another group of A+B v E+K is not
> acceptable but A+E v B+K is.
>
> Each player tees off in the first group at least once but no
> more than twice over the 5 days.
>
> After hours of looking for patterns and juggling with letters
> I have not found a solution but have been so near that I am
> convinced that it is mathematically possible.
> A real mathematician might find this easy but I am a chemist!
>
> No useful replies were forthcoming in the sci.math newsgroup!
>
Aha, Daniel is back :-)
The above (at least superficially) looks like the social golfer problem.
Here are some related references:
www.recherche.enac.fr/opti/papers/articles/golf.ps.gz
http://www.icparc.ic.ac.uk/eclipse/appl/index.html (there is a paper
about scheduling tournaments - I didn't pursue it)
http://www.icparc.ic.ac.uk/eclipse/...es/golf.ecl.txt
Maybe the last one is what people interested in the problem should have
a look at.
ECLiPSe used to have a webpage with the "solved" golfer problems - this
is maybe just vague memory - I can't find it anymore - maybe someone
from ECLiPSe can comment ?
Cheers
Bart Demoen
| |
| Nameless 2004-12-28, 8:58 pm |
| "Bart Demoen" <bmd@cs.kuleuven.ac.be> wrote in message
news:1104262941.464412@seven.kulnet.kuleuven.ac.be...
> Nameless wrote:
>
> Aha, Daniel is back :-)
Wrong--again! Maybe you should limit yourself to three
guesses, with just one more remaining. :)
--
Mail sent to this email address is automatically deleted
(unread) on the server. Send replies to the newsgroup.
| |
| Bart Demoen 2004-12-28, 8:58 pm |
| Nameless wrote:
> "Bart Demoen" <bmd@cs.kuleuven.ac.be> wrote in message
> news:1104262941.464412@seven.kulnet.kuleuven.ac.be...
>
>
>
> Wrong--again! Maybe you should limit yourself to three
> guesses, with just one more remaining. :)
>
I am no guessing: in this newsgroup, the failure to prove that you are
someone else than Daniel, is common cause for assuming that you are.
| |
| Nameless 2004-12-29, 3:58 am |
| "Bart Demoen" <bmd@cs.kuleuven.ac.be> wrote in message
news:1104272966.434764@seven.kulnet.kuleuven.ac.be...
> Nameless wrote:
>
> I am no guessing: in this newsgroup, the failure to prove that
> you are someone else than Daniel, is common cause for assuming
> that you are.
Yer, in your fantasy! Dream on... any burden of proof must
necessarily fall on you, I choose to keep my anonymity.
Besides, as the newsgroup administrator, you should know
that this is off-topic. :(
--
Mail sent to this email address is automatically deleted
(unread) on the server. Send replies to the newsgroup.
| |
| Bart Demoen 2004-12-29, 8:57 am |
| Nameless wrote:
> Besides, as the newsgroup administrator, you should know
> that this is off-topic. :(
After all these years in comp.lang.prolog, you should know that
there is no newsgroup administrator here !
| |
| Nameless 2004-12-30, 8:57 am |
| "Bart Demoen" <bmd@cs.kuleuven.ac.be> wrote in message
news:1104307207.572610@seven.kulnet.kuleuven.ac.be...
> Nameless wrote:
>
> After all these years in comp.lang.prolog, you should know
> that there is no newsgroup administrator here !
Well, since you've relegated the conversation to off-topic
status anyway, two of Aesop's Fables come to mind...
Once upon a time a Wolf was lapping at a spring on a
hillside, when, looking up, what should he see but a Lamb
just beginning to drink a little lower down. 'There's my
supper,' thought he, 'if only I can find some excuse to
seize it.' Then he called out to the Lamb, 'How dare you
muddle the water from which I am drinking?'
Nay, master, nay,' said Lambikin; 'if the water be
muddy up there, I cannot be the cause of it, for it runs
down from you to me.'
'Well, then,' said the Wolf, 'why did you call me bad
names this time last year?'
'That cannot be,' said the Lamb; 'I am only six months
old.'
'I don't care,' snarled the Wolf; 'if it was not you it
was your father;' and with that he rushed upon the poor
little Lamb and WARRA WARRA WARRA WARRA WARRA ate her all
up. But before she died she gasped out 'Any excuse will
serve a tyrant.'
- The Wolf and the Lamb
One fine day two Crabs came out from their home to take
a stroll on the sand. 'Child,' said the mother, 'you are
walking very ungracefully. You should accustom yourself, to
walking straight forward without twisting from side to side.'
'Pray, mother,' said the young one, 'do but set the
example yourself, and I will follow you.'
Example is the best precept.
- The Two Crabs
--
Mail sent to this email address is automatically deleted
(unread) on the server. Send replies to the newsgroup.
| |
|
| In addition to the links that Bart provided, check out:
http://www.csplib.org/
Problem #10 is the Social Golfer problem, which is similar to this one.
Problems of this kind lend themselves very naturally to a constraint
programming formulation. Using the SICStus library(clpfd), the
following schedule was found in a few milliseconds:
SCHEDULE: Pairs of players play in the same group at most 5 times.
Day 1
0+3 vs 6+9
1+4 vs 7+10
2+5 vs 8+11
Day 2
1+2 vs 6+7
0+4 vs 8+9
3+5 vs 10+11
Day 3
2+4 vs 8+10
0+5 vs 6+11
1+3 vs 7+9
Day 4
1+5 vs 7+11
0+2 vs 9+10
3+4 vs 6+8
Day 5
4+5 vs 9+11
0+1 vs 7+8
2+3 vs 6+10
A couple of observations:
- It seems that the partners form a bipartite graph i.e.
{0,1,2,3,4,5} never partners {6,7,8,9,10,11}.
I found no solution where this is not the case.
- In all solution found, some two players x and y play in the same
group every day. After restricting all (x,y) pairs to play in the
same
group at most four times, no solution was found after 1 hour.
Conjecture: these observations hold in all valid schedules.
Challenge to everyone: prove the conjecture.
Season's greetings, --Mats
| |
| Markus Triska 2004-12-30, 3:58 pm |
| Mats wrote:
> Problems of this kind lend themselves very naturally to a constraint
> programming formulation. Using the SICStus library(clpfd), the
> following schedule was found in a few milliseconds:
Could you please provide details of your implementation? I also tried a
constraint formulation, for example:
twoinanygroup((T1,T2),Day) :-
group_day(Group,Day),
Group = gr(pair(P1,P2),pair(P3,P4)),
( P1 #= T1 #\/ P2 #= T1 #\/ P3 #= T1 #\/ P4 #= T1 ),
( P1 #= T2 #\/ P2 #= T2 #\/ P3 #= T2 #\/ P4 #= T2 ).
but it does not improve running time considerably. I'm therefore curious
about how you went about formulating for example the "each player with
every other in some group"-constraint.
Best regards,
Markus.
| |
|
| > I'm therefore curious
> about how you went about formulating for example the "each player
> [plays] with every other in some group"-constraint.
The general idea is to form the multiset of all pairs of players that
occur in the groups, and to constrain that multiset to contain every
feasible pair of players.
I prefer to wait a few days before posting the source code, to
encourage others to have a try.
--Mats
| |
| Markus Triska 2005-02-08, 3:59 am |
| Dear Mats!
Mats wrote:
> I prefer to wait a few days before posting the source code, to
> encourage others to have a try.
By now I've had a few tries and I'm glad to say that it has improved my
understanding of the problem at least to the point that I can laugh
about the approach I previously posted.
I tried to come up with better initial labelings by "fitting"
constraints to groups that look appropriate, for example, a group
already containing player pair (1,2) would seem a natural candidate to
also satisfy the (1,4) and (1,3) constraints, since they have a player
(namely 1) in common. I also tried to eliminate already satisfied
constraints earlier. I ended up with 13 free variables (range from 4 to
12) and about 30 constraints left (as opposed to the 66 initial
constraints).
Here is the current version (still only trying to solve the "each player
plays with every other in some group"-constraint):
:- use_module(library('clp/bounds')).
gs_vars([]) -->
[].
gs_vars([G|Gs]) -->
{ G = gr(pair(A,B),pair(C,D)) },
[A,B,C,D],
gs_vars(Gs).
t_vars([]) -->
[].
t_vars([D|Ds]) -->
{ D = day(Gs) },
gs_vars(Gs),
t_vars(Ds).
group(G) :-
G = gr(pair(A,B),pair(C,D)),
Players = [A,B,C,D],
all_different(Players).
groups([]).
groups([G|Gs]) :-
group(G),
groups(Gs).
day(D,NumGr) :-
length(Grs,NumGr),
D = day(Grs),
groups(Grs).
days([],[]).
days([D|Ds],[N|Ns]) :-
day(D,N),
days(Ds,Ns).
choosetwo([X|Xs],(X,Y)) :-
member(Y,Xs).
choosetwo([_,X|Xs],Two) :-
choosetwo([X|Xs],Two).
group_day(Gr1,day(Grs)) :-
member(Gr1,Grs).
twoinanygroup((T1,T2),Day) :-
group_day(Group,Day),
Group = gr(pair(P1,P2),pair(P3,P4)),
(P1 = T1 ; P2 = T1 ; P3 = T1 ; P4 = T1),
(P1 = T2 ; P2 = T2 ; P3 = T2 ; P4 = T2).
twosplayingroup([],_).
twosplayingroup([Two|Twos],Ds) :-
member(Day,Ds),
twoinanygroup(Two,Day),
twosplayingroup(Twos,Ds).
% each group can at handle 2 constraints easily, for example:
% (1,2) and (2,3), but not necessarily 3, e.g.: (1,2), (2,3), (4,5)
% (at most: 4 choose 2 = 6)
% Initially, there are (12 choose 2) = 66 constraints and 15 groups.
% It turns out that the following restricts us too much:
%init_constraints([P1,P2,P3,P4|Xs], [(P1,P2),(P1,P3),(P1,P4)|Rs], Rest,
Vars) :-
% init_constraints(Xs, Rs, Rest, Vars).
%init_constraints([P1,P2,P3,P4|Xs], [(P1,P2),(P1,P3),(P5,P6)|Rs], Rest,
[P4|Vars]) :-
% P1 \= P5,
% init_constraints(Xs, [(P5,P6)|Rs], Rest, Vars).
% So we leave 1 degree of freedom (variable) in most cases, which leaves
us with
% 66 - 30 = 36 constraints and 13 variables to label between 4 and 12.
% Number of constraints can be reduced to 27 by deleting those that are
% automatically satisfied.
%init_constraints([], Rest, Rest, []).
%init_constraints([P1,P2,P3,P4|Xs], [(P1,P2),(P1,P3)|Rs], Rest,
[P4|Vars]) :-
% delete(Rs,(P2,P3),Rs1),
% init_constraints(Xs, Rs1, Rest, Vars).
%init_constraints([P1,P2,P3,P4|Xs], [(P1,P2),(P3,P4) | Rs], Rest, Vars) :-
% P1 \= P2, P1 \= P3, P1 \= P4, P2 \= P3, P2 \= P4, P3 \= P4,
% delete(Rs,(P2,P3),Rs1),
% delete(Rs1,(P1,P4),Rs2),
% delete(Rs2,(P2,P4),Rs3),
% init_constraints(Xs, Rs3, Rest, Vars).
% Here is a different strategy:
init_constraints([], Rest, Rest).
init_constraints([P1,P2,_X3,_X4 | Xs], [(P1,P2)|Rs], Rest) :-
init_constraints(Xs, Rs, Rest).
fit_constraint([P1,_P2,P3,_X4 | _Xs], (P1, P3)).
fit_constraint([_P1,P2,P3,_X4 | _Xs], (P2, P3)).
fit_constraint([P1,_P2,P3,_X4 | _Xs], (P3, P1)).
fit_constraint([_P1,P2,P3,_X4 | _Xs], (P3, P2)).
fit_constraint([X1,X2,_,_ | Xs], (P1,P2)) :-
P1 \= X1, P1 \= X2,
P2 \= X1, P2 \= X2,
fit_constraint(Xs, (P1,P2)).
fit_constraints(_Vars, [], []).
fit_constraints(Vars, [C | Cs], Rest) :-
fit_constraint(Vars, C),
fit_constraints(Vars, Cs, Rest).
fit_constraints(Vars, [C | Cs], [C | Rest]) :-
\+ fit_constraint(Vars, C),
fit_constraints(Vars, Cs, Rest).
% second pass, focus is on P4 now
fit_constraint2([X1,X2,X3,X4 | _Xs], (P1, P2)) :-
nonvar(X3),
member(P1,[X1,X2,X3]),
X4 = P2.
fit_constraint2([X1,X2,X3,X4 | _Xs], (P1,P2)) :-
nonvar(X3),
member(P2,[X1,X2,X3]),
X4 = P1.
fit_constraint2([_X1,_X2,X3,_X4 | Xs], C) :-
var(X3),
fit_constraint2(Xs, C).
fit_constraint2([X1,X2,X3,_X4 | Xs], (P1,P2)) :-
nonvar(X3),
\+ member(P1, [X1,X2,X3]),
\+ member(P2, [X1,X2,X3]),
fit_constraint2(Xs,(P1,P2)).
fit_constraints2(_Vars, [], []).
fit_constraints2(Vars, [C | Cs], Rest) :-
fit_constraint2(Vars, C),
fit_constraints2(Vars, Cs, Rest).
fit_constraints2(Vars, [C | Cs], [C | Rest]) :-
\+ fit_constraint2(Vars, C),
fit_constraints2(Vars, Cs, Rest).
deleteset(Cs0,(P1,P2),Cs) :-
delete(Cs0,(P1,P2),Cs1),
delete(Cs1,(P2,P1),Cs).
eliminate_constraints([],Cs,Cs).
eliminate_constraints([P1,P2,P3,P4 | Ps], Cs0, Cs) :-
deleteset(Cs0,(P1,P2),Cs1),
(nonvar(P3) ->
deleteset(Cs1,(P2,P3),Cs2),
deleteset(Cs2,(P1,P3),Cs3),
(nonvar(P4) ->
deleteset(Cs3,(P1,P4),Cs4),
deleteset(Cs4,(P2,P4),Cs5),
deleteset(Cs5,(P3,P4),Cs7)
;
Cs7 = Cs3
)
;
Cs7 = Cs1
),
eliminate_constraints(Ps, Cs7, Cs).
allpairs(Pairs) :-
Players = [1,2,3,4,5,6,7,8,9,10,11,12],
findall(Two,choosetwo(Players,Two),Pairs
).
t(Ds) :-
days(Ds,[3,3,3,3,3]),
allpairs(Pairs),
phrase(t_vars(Ds),Vars),
init_constraints(Vars, Pairs, Rest),
fit_constraints(Vars, Rest, Rest1),
fit_constraints2(Vars,Rest1,Rest2),
eliminate_constraints(Vars, Rest2, Rest3),
sublist(var,Vars,FVs),
in(FVs, 2..12),
label(FVs),
twosplayingroup(Rest3, Ds).
However, it still takes too long (especially compared to the running
time of the solution you reported), and I might already have missed
solutions due to unfortunate initial labeling decisions (in fact, this
is almost certainly the case, since the initial constraints are of the
form (1,2), (1,3) etc, which means that the first few groups all contain
player 1).
Best regards,
Markus.
| |
|
| Here is my solution. --Mats
/*
* SICSTUS CLPFD DEMONSTRATION PROGRAM
* Purpose : Social Golfer Problem
* Author : Mats Carlsson
*
* We have 32 golfers, individual play.
* We will golf for W w s.
* Set up the foursomes so that each person only golfs with the same
* person once.
*
* Requires sicstus4. Global constraints:
*
* table(+Tuples, +Extension)
*
* Extension - a list of tuples of integers, each of length N.
* Tuples - a list of tuples of dvars, each of length N.
*
* Meaning: each tuple of Tuples is in the relation
* generated by Extension.
*
* +Expr1 #< +Expr2
*
* +Expr1 #= +Expr2
*
* all_different(+Dvars, +Options)
*
*/
% | ?- golf(+NbGroups, +GroupSize, +NbWs, +LabelOption, +VarOrder).
% Best luck so far:
% | ?- golf(8,4,9,[min],bycolall).
:- module(golf, [golf/5]).
:- use_module(library(lists), [
append/2,
transpose/2,
nth0/3
]).
:- use_module(library(clpfd)).
golf(G, S, W, Opt, VarOrder) :-
golfer(G, S, W, Schedule, Byrow, Bycol),
var_order(VarOrder, Byrow, Bycol, All),
statistics(runtime, [T1,_]),
( label_sets(All, Opt)
; statistics(runtime, [T2,_]),
format('[labeling failed in ~d msec]', [T2-T1]),
flush_output,
fail
),
display_rounds(Schedule, 0).
var_order(bycol, _, All, All).
var_order(byrow, All, _, All).
var_order(bycolall, _, Cols, [All]) :-
append(Cols, All).
var_order(byrowall, Rows, _, [All]) :-
append(Rows, All).
label_sets([], _).
label_sets([Set|Sets], Opt) :-
labeling(Opt, Set),
label_sets(Sets, Opt).
display_rounds([], _).
display_rounds([Round|Rounds], V) :-
W is V+1,
format('W ~d:\n', [W]),
display_round(Round),
display_rounds(Rounds, W).
display_round([]).
display_round([Four|Round]) :-
format(' ~d ~d ~d ~d\n', Four),
display_round(Round).
golfer(G, S, W, Schedule, PlayersByRow, PlayersByCol) :-
schedule(0, G, S, W, Schedule, PlayersByRow, PlayersByCol),
Schedule = [FirstS|RestS],
append(FirstS, Players),
labeling([enum], Players), !,
seed_rest(RestS, S),
ordered_players_by_w(PlayersByRow),
players_meet_disjoint(Schedule, G, S),
first_s_alldiff(0, S, RestS).
schedule(W, _, _, W, [], [], []) :- !.
schedule(I, G, S, W, [W|Schedule], [ByRow|ByRows], [ByCol|ByCols])
:-
w(0, G, S, W),
append(W, ByRow),
all_different(ByRow,[on(dom),consistency
(global)]),
transpose(W, WT),
append(WT, ByCol),
J is I+1,
schedule(J, G, S, W, Schedule, ByRows, ByCols).
w(G, G, _, []) :- !.
w(I, G, S, [Group|W]) :-
length(Group, S),
GS is G*S-1,
domain(Group, 0, GS),
J is I+1,
w(J, G, S, W).
players_meet_disjoint(Schedule, G, S) :-
append(Schedule, Groups),
groups_meets(Groups, Tuples, [], MeetVars, []),
GS is G*S,
ac_pair_vars(Tuples, GS),
all_distinct(MeetVars).
ac_pair_vars(Tuples, GS) :-
mult_table(0, 0, GS, Table),
table(Tuples, Table).
mult_table(_, N, N, []) :- !.
mult_table(I, I, N, Table) :- !,
J is I+1,
mult_table(0, J, N, Table).
mult_table(I, K, N, [[I,K,P]|Table]) :-
P is N*I + K,
J is I+1,
mult_table(J, K, N, Table).
groups_meets([], Tuples, Tuples) --> [].
groups_meets([Group|Groups], Tuples1, Tuples3) -->
group_meets(Group, Tuples1, Tuples2),
groups_meets(Groups, Tuples2, Tuples3).
group_meets([], Tuples, Tuples) --> [].
group_meets([P|Ps], Tuples1, Tuples3) -->
group_meets(Ps, P, Tuples1, Tuples2),
group_meets(Ps, Tuples2, Tuples3).
group_meets([], _, Tuples, Tuples) --> [].
group_meets([Q|Qs], P, [[P,Q,PQ]|Tuples1], Tuples2) --> [PQ],
group_meets(Qs, P, Tuples1, Tuples2).
seed_rest([], _).
seed_rest([W|Rest], S) :-
ascending_quotients(W, S),
seed_w(0, S, W),
seed_rest(Rest, S).
seed_w(S, S, W) :- !,
S1 is S-1,
seed_w(W, S1).
seed_w(I, S, [[I|_]|W]) :-
J is I+1,
seed_w(J, S, W).
seed_w([], _).
seed_w([[J|_]|W], I) :-
I #< J,
seed_w(W, J).
ascending_quotients([], _).
ascending_quotients([Group|Groups], S) :-
ascending_quotient(Group, S),
ascending_quotients(Groups, S).
ascending_quotient([P|Ps], S) :-
P/S #= Q,
ascending_quotient(Ps, Q, S).
ascending_quotient([], _, _).
ascending_quotient([P|Ps], Q0, S) :-
P/S #= Q,
Q0 #< Q,
ascending_quotient(Ps, Q, S).
ordered_players_by_w([W|Ws]) :-
ordered_players_by_w(Ws, W).
ordered_players_by_w([], _).
ordered_players_by_w([W|Ws], V) :-
W = [_,Y|_],
V = [_,X|_],
X #< Y,
ordered_players_by_w(Ws, W).
first_s_alldiff(S, S, _Schedule) :- !.
first_s_alldiff(I, S, Schedule) :-
concat_ith(Schedule, I, Conc, []),
all_different(Conc,[on(dom),consistency(
global)]),
J is I+1,
first_s_alldiff(J, S, Schedule).
concat_ith([], _) --> [].
concat_ith([W|S], I) -->
{nth0(I, W, [_|Ps])},
dlist(Ps),
concat_ith(S, I).
dlist([]) --> [].
dlist([X|Xs]) --> [X], dlist(Xs).
end_of_file.
| ?- golf(8,4,9,[min],bycolall), statistics(runtime,[_,T2]),
clpfd:fd_statistics.
W 1:
0 1 2 3
4 5 6 7
8 9 10 11
12 13 14 15
16 17 18 19
20 21 22 23
24 25 26 27
28 29 30 31
W 2:
0 8 16 24
1 9 17 25
2 10 18 26
3 11 19 27
4 12 20 28
5 13 21 29
6 14 22 30
7 15 23 31
W 3:
0 9 18 27
1 8 19 26
2 11 16 25
3 10 17 24
4 13 22 31
5 12 23 30
6 15 20 29
7 14 21 28
W 4:
0 10 20 30
1 11 21 31
2 8 22 28
3 9 23 29
4 14 16 26
5 15 17 27
6 12 18 24
7 13 19 25
W 5:
0 11 22 29
1 10 23 28
2 9 20 31
3 8 21 30
4 15 18 25
5 14 19 24
6 13 16 27
7 12 17 26
W 6:
0 12 19 31
1 13 18 30
2 14 17 29
3 15 16 28
4 8 23 27
5 9 22 26
6 10 21 25
7 11 20 24
W 7:
0 13 17 28
1 12 16 29
2 15 19 30
3 14 18 31
4 9 21 24
5 8 20 25
6 11 23 26
7 10 22 27
W 8:
0 14 23 25
1 15 22 24
2 12 21 27
3 13 20 26
4 10 19 29
5 11 18 28
6 8 17 31
7 9 16 30
W 9:
0 15 21 26
1 14 20 27
2 13 23 24
3 12 22 25
4 11 17 30
5 10 16 31
6 9 19 28
7 8 18 29
Resumptions: 26476
Entailments: 2114
Prunings: 20342
Backtracks: 22
Constraints created: 1896
T2 = 1530
| |
| Markus Triska 2005-02-11, 3:59 am |
| Dear Mats!
> Here is my solution. --Mats
Thank you very much for posting your code. Unfortunately, I don't have
access to SICStus 4, but unless I'm completely mistaken, this is not the
solution to the problem stated by the OP.
Meanwhile, I have sought to further improve my program by changing the
labeling order (alas, SWI currently does not allow to specify options
for label/1). I used this program to verify that the tournament you
initially posted indeed satisfies many requirements:
:- t([1,4,7,10,2,5,8,11,3,6,9,12,2,3,7,8,1,
5,9,10, 4, 6,11,12,3,5,
9,11,1,6,7,12,2,4,8,10,2,6,8,12,1,3,10,1
1,4,5, 7,9,5,6,10,12,1,2,8,
9,3,4,7, 11]).
Yes
(I had to comment out the "teelimit"-line, not sure how you encoded this.)
Maybe someone can recommend a way to speed this up?
:- use_module(library('clp/bounds')).
gs_vars([]) -->
[].
gs_vars([G|Gs]) -->
{ G = gr(pair(A,B),pair(C,D)) },
[A,B,C,D],
gs_vars(Gs).
t_vars([]) -->
[].
t_vars([D|Ds]) -->
{ D = day(Gs) },
gs_vars(Gs),
t_vars(Ds).
group(G) :-
G = gr(pair(A,B),pair(C,D)),
Players = [A,B,C,D],
all_different(Players).
groups([]).
groups([G|Gs]) :-
group(G),
groups(Gs).
day(D,NumGr) :-
length(Grs,NumGr),
D = day(Grs),
groups(Grs).
days([],[]).
days([D|Ds],[N|Ns]) :-
day(D,N),
days(Ds,Ns).
choosetwo([X|Xs],(X,Y)) :-
member(Y,Xs).
choosetwo([_,X|Xs],Two) :-
choosetwo([X|Xs],Two).
allpairs(Pairs) :-
Players = [1,2,3,4,5,6,7,8,9,10,11,12],
findall(Two,choosetwo(Players,Two),Pairs
).
all_greqone([]).
all_greqone([A|As]) :-
A #>= 1,
all_greqone(As).
pn(X,Y,(P1,P2),N) :-
X #= P1 #/\ Y #= P2 #<=> N1,
X #= P2 #/\ Y #= P1 #<=> N2,
N #= N1 + N2.
pair_reify([], _Pair, 0).
pair_reify([X1,X2,X3,X4|Xs],Pair, V) :-
pn(X1,X2,Pair,N1),
pn(X1,X3,Pair,N2),
pn(X1,X4,Pair,N3),
pn(X2,X3,Pair,N4),
pn(X2,X4,Pair,N5),
pn(X3,X4,Pair,N6),
N1 + N2 + N3 + N4 + N5 + N6 + N #= V,
pair_reify(Xs,Pair,N).
all_pairreify(_V, [], []).
all_pairreify(Vars, [Pair|Pairs], [R|Rs]) :-
pair_reify(Vars, Pair, R),
all_pairreify(Vars, Pairs, Rs).
nomore_of(_Pair,[]).
nomore_of((X1,X2),[A,B|Rs]) :-
X1 #= A #/\ X2 #= B #<=> 0,
X1 #= B #/\ X2 #= A #<=> 0,
nomore_of((X1,X2),Rs).
notwopartners([]).
notwopartners([X1,X2|Rest]) :-
nomore_of((X1,X2),Rest),
notwopartners(Rest).
pnumtees(_P, [], 0).
pnumtees(P,[X1,_X2,_X3,_X4|Xs],N) :-
P #= X1 #<=> N1,
N #= N1 + N2,
pnumtees(P,Xs,N2).
teelimit([],_Vars).
teelimit([P|Ps], Vars) :-
pnumtees(P, Vars, N),
in(N,1..2),
teelimit(Ps,Vars).
% reorder variables for labeling (ff in SICStus)
% cannot use it in SWI (or can I?) - therefore
% work in progress - could yield considerable
% speedup - for the moment, speed up for teelimit/2
vars_reorder([],Rest) -->
Rest.
vars_reorder([X1,X2,X3,X4|Xs],Rs) -->
[X1],
vars_reorder(Xs,[X2,X3,X4|Rs]).
t(Vars) :-
days(Ds,[3,3,3,3,3]),
allpairs(Allpairs),
length(Allpairs,LAllpairs),
length(Apconstr,LAllpairs),
all_greqone(Apconstr),
phrase(t_vars(Ds),Vars),
in(Vars, 1..12),
teelimit([1,2,3,4,5,6,7,8,9,10,11,12], Vars),
notwopartners(Vars),
all_pairreify(Vars, Allpairs, Apconstr),
phrase(vars_reorder(Vars,[]),RVars),
label(RVars).
Best regards,
Markus.
| |
| Tom Schrijvers 2005-02-11, 8:58 am |
| Markus Triska wrote:
> Dear Mats!
>
>
>
> Thank you very much for posting your code. Unfortunately, I don't have
> access to SICStus 4, but unless I'm completely mistaken, this is not the
> solution to the problem stated by the OP.
>
> Meanwhile, I have sought to further improve my program by changing the
> labeling order (alas, SWI currently does not allow to specify options
> for label/1).
Dear Markus,
Indeed, but you do have access to the source code of clp/bounds.pl. By
looking at the implementation of label/1 it should be a small effort to
implement a different labeling order. If you send me the code, I'll see
to it that it gets included in SWI-Prolog and many other people may
benefit from it.
Cheers,
Tom
| |
| Markus Triska 2005-02-11, 4:00 pm |
| Dear Tom!
Tom Schrijvers wrote:
> Indeed, but you do have access to the source code of clp/bounds.pl. By
> looking at the implementation of label/1 it should be a small effort to
> implement a different labeling order. If you send me the code, I'll see
> to it that it gets included in SWI-Prolog and many other people may
> benefit from it.
A patch that implements the labeling orders leftmost (default), min, max
and ff is attached. The new predicate is label/2 - first argument is a
list of options. Unknown options are ignored, leftmost known option
counts (I don't know if you want this behaviour - I thought it made
sense to people porting code from implementations with more labeling
options, but maybe it's better to fail or print a warning in case of an
unknown option).
Best regards,
Markus.
| |
| Markus Triska 2005-03-07, 4:04 pm |
| Nameless wrote:
> Prologers might find this problem, originating in the sci.math
> newsgroup, both appropriate and challenging:
By now I have found what appears to me to be a much more suitable model
for this problem (compared to what I had tried previously): I am using a
Boolean matrix consisting of 15 rows (groups) and 12 columns (players).
A value of 1 an position (i,j) means that player j plays in group i.
Since group and player permutations do not matter, I impose
lexicographic ordering an both rows and columns to break symmetry
(lex_chain/1 is currently available in SWI Prolog CVS).
My question was previously how to make sure that each player plays with
every other at least once in some group. With the new model, this is
very easy to express. Concentrating exclusively on this requirement,
there are (12 choose 2) = 66 constraints to satisfy. I was not able to
satisfy them all within one hour, but I could satisfy 60 of them in less
than 4 seconds on a 2.4 GHz P4:
?- time(t(G,60,N)).
% 8,997,888 inferences, 3.68 CPU in 3.78 seconds (97% CPU, 2445078 Lips)
G = [[0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 1, 1], [0, 0, 0, 0, 1, 1, 1, 1, 0,
0, 0, 0], [0, 0, 0, 1, 0, 0, 0, 0, 0, 1, 1, 1], [0, 0, 0, 1, 0, 0, 0, 1,
1, 0, 0, 1], [0, 0, 0, 1, 0, 0, 0, 1, 1, 0, 1, 0], [0, 0, 0, 1, 0, 1, 1,
0, 0, 1, 0, 0], [0, 0, 1, 0, 0, 0, 1, 0, 1, 1, 0, 0], [0, 0, 1, 0, 0, 0,
1, 1, 0, 0, 0, 1], [0, 0, 1, 0, 0, 1, 0, 1, 0, 0, 1, 0], [0, 0, 1, 0, 1,
1, 0, 0, 0, 0, 0, 1], [0, 1, 0, 0, 1, 0, 0, 1, 0, 1, 0, 0], [0, 1, 0, 0,
1, 0, 1, 0, 0, 0, 1, 0], [1, 0, 1, 1, 1, 0, 0, 0, 0, 0, 0, 0], [1, 1, 0,
0, 0, 0, 1, 0, 0, 0, 0, 1], [1, 1, 0, 0, 0, 1, 0, 0, 1, 0, 0, 0]]
N = 60
I am appending the source in case anyone is interested. The lines I
marked with "try this:" are attempts to satisfy more constraints by
hand-tweaking the solution or imposing additional constraints that I
figured would not hurt too much and seemed a good idea. Bear in mind
that they could cause loss of valid solutions.
Best regards,
Markus.
:- use_module(library('clp/bounds')).
choosetwo([X|Xs],(X,Y)) :-
member(Y,Xs).
choosetwo([_,X|Xs],Two) :-
choosetwo([X|Xs],Two).
allpairs(List,Pairs) :-
setof(Two,choosetwo(List,Two),Pairs).
%%%%%% transpose
allfirsts([],[]) -->
[].
allfirsts([[First|Rest]|Fs], [Rest|Rs]) -->
[First],
allfirsts(Fs,Rs).
nil([]).
transpose(Lss,[]) :-
maplist(nil,Lss).
transpose(Lss,[Ts|Tss]) :-
phrase(allfirsts(Lss,Rest),Ts),
transpose(Rest,Tss).
%%%%%%
multsum([], [], 0).
multsum([A1|A1s],[A2|A2s], Sum) :-
Sum #= Sum1 + (A1*A2),
multsum(A1s, A2s, Sum1).
notwopartners(_Gss, [], []).
notwopartners(Gss, [(P1,P2)|Pairs], [B|Bs]) :-
maplist(nth1(P1),Gss,As1),
maplist(nth1(P2),Gss,As2),
multsum(As1, As2, Sum),
Sum #=< 2, % try this: prohibit these two from playing too often in
the same group
Sum #>= 1 #<=> B,
notwopartners(Gss, Pairs, Bs).
nosamegroup(_Gss,[]).
nosamegroup(Gss,[(P1,P2)|Ps]) :-
nth1(P1,Gss,G1),
nth1(P2,Gss,G2),
multsum(G1,G2,Sum),
Sum #< 4,
nosamegroup(Gss,Ps).
length12(L) :-
length(L,12).
sum_n(N,Op,L) :-
sum(L,Op,N).
t(Gss,Numsatisfied,N) :-
length(Gss, 15),
maplist(length12, Gss),
Gss = [_FirstG,SecondG|_],
nth1(12,SecondG,0), % try this: make the second group rather different
transpose(Gss,Tss),
flatten(Gss, Zs),
Zs in 0..1,
lex_chain(Tss),
lex_chain(Gss),
maplist(sum_n(6,#=< ),Tss), % try this: each player plays at most 6 times
maplist(sum_n(4,#=),Gss), % group = 4 players
allpairs([1,2,3,4,5,6,7,8,9,10,11,12],Al
lPlayerPairs),
notwopartners(Gss, AllPlayerPairs, Bs),
sum(Bs,#>=,Numsatisfied),
allpairs([1,2,3,4,5,6,7,8,9,10,11,12,13,
14,15],AllGroupPairs),
nosamegroup(Gss,AllGroupPairs), % try this: no group occurs twice
label(Zs),
sum(Bs,#=,N).
|
|
|
|
|