Le Monde puzzle [#783]

[This article was first published on Xi'an's Og » R, and kindly contributed to R-bloggers]. (You can report issue about the content on this page here)
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

n = 5n -i_2-\cdots-i_n

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

To leave a comment for the author, please follow the link and comment on their blog: Xi'an's Og » R.

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.

Never miss an update!
Subscribe to R-bloggers to receive
e-mails with the latest R posts.
(You will not see this message again.)

Click here to close (This popup will not appear again)