Le Monde puzzle [#783]

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 i_j 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 i₂<2, i₃<3, i₄<4, i₅<5, and i_j<6, for j>5. Hence, i₂+i₃+i₄+i₅+…+i_n≤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….