**Xi'an's Og » R**, and kindly contributed to R-bloggers)

*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?*

**B**ack 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…

**L**et 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}<2, *i*_{3}<3, *i*_{4}<4, *i*_{5}<5, and *i*_{j}<6, for j>5. Hence, *i*_{2}+*i*_{3}+*i*_{4}+*i*_{5}+…+*i*_{n}≤5n-15, which implies *n≥15*.

**N**ow, 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…)

**R**unning 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

**leave a comment**for the author, please follow the link and comment on his blog:

**Xi'an's Og » R**.

R-bloggers.com offers

**daily e-mail updates**about R news and tutorials on topics such as: visualization (ggplot2, Boxplots, maps, animation), programming (RStudio, Sweave, LaTeX, SQL, Eclipse, git, hadoop, Web Scraping) statistics (regression, PCA, time series, trading) and more...