Le Monde puzzle [#783]
Want to share your content on R-bloggers? click here if you have a blog, or here if you don't.
In a political party, there are as many cells as there are members and each member belongs to at least one cell. Each cell has five members and an arbitrary pair of cells only shares one member. How many members are there in this political party?
Back to the mathematical puzzles of Le Monde (science leaflet of the weekend edition)! In addition to a tribune by Cédric Villani celebrating the 100th anniversary of the death of Henri Poincaré, this issue [now of last week] offers this interesting challenge. So much interesting that I could only solve it for three (instead of five) members and could not see the mathematical notion behind the puzzle…
Let us denote by n the number of both the cells and the number of members. Then, when picking an arbitrary order on the sets, if ij denotes the number of members in set j already seen in sets with lower indices, we have the following equality on the total number of members
and the constraints are that i2<2, i3<3, i4<4, i5<5, and ij<6, for j>5. Hence, i2+i3+i4+i5+…+in≤5n-15, which implies n≥15.
Now, in terms of analytics, I could not go much further and thus turned to an R code to see if I could find a solution by brute force. Here is my code (where the argument a is the number of elements in each set):
lemond=function(a){ obj=1:a set=matrix(obj,1,a) newset=c(1,(a+1):(2*a-1)) obj=sort(unique(c(obj,newset))) set=rbind(set,as.vector(newset)) stob=FALSE while (!stob){ newset=sample(set[1,],1) prohib=set[1,] # ensuring intersections of one and one only for (i in 2:nrow(set)){ chk=length(intersect(newset,set[i,])) if (chk>1){ #impossibile newset=1:(10*a)}else{ if (chk==0){ #no common point yet but #can't increase the intersection size with previous sets locprob=setdiff(set[i,],prohib) if ((length(locprob)==0)){newset=1:(10*a)}else{newset= c(newset,sample(c(locprob,locprob),1))} }} #else do nothing, restriction already satisfied prohib=unique(as.vector(set[1:i,])) } if (length(newset)a)||(max(obj)>9*a)||(max(obj)==nrow(set))) } list(set=set,sol=((length(newset)==a)&&(max(obj)==nrow(set)))) }
I build the sets and the collection of members by considering the constraints and stopping when (a) it is impossible to satisfy all constraints, (b) the current number of sets is the current number of members, or (c) there are too many members. (The R programming is very crude, witness the selection of possible values in the inside loop…)
Running the code for a=2 and a=3 led to the results
$set [,1] [,2] [1,] 1 2 [2,] 1 3 [3,] 2 3
and
$set [,1] [,2] [,3] [1,] 1 2 3 [2,] 1 4 5 [3,] 3 5 6 [4,] 2 4 6 [5,] 2 5 7 [6,] 3 4 7 [7,] 1 6 7
and
$set [,1] [,2] [,3] [,4] [1,] 1 2 3 4 [2,] 1 5 6 7 [3,] 3 5 8 9 [4,] 2 6 8 10 [5,] 4 7 8 11 [6,] 1 9 10 11 [7,] 4 5 10 12 [8,] 1 8 12 13 [9,] 3 7 10 13 [10,] 3 6 11 12 [11,] 4 6 9 13 [12,] 2 5 11 13 [13,] 2 7 9 12
which are indeed correct (note that the solution for a=3 is n=7 which allows for a symmetric allocation, rather than n=6 which is the simple upper bound). However, the code does not return a solution for a=5, which makes me wonder if the solution can be reached by brute force….
Filed under: R, Travel, University life Tagged: combinatorics, integer set, Le Monde, mathematical puzzle
R-bloggers.com offers daily e-mail updates about R news and tutorials about learning R and many other topics. Click here if you're looking to post or find an R/data-science job.
Want to share your content on R-bloggers? click here if you have a blog, or here if you don't.