## Le Monde puzzle [#929]

Posted in Books, Kids, R with tags , on September 29, 2015 by xi'an

A combinatorics Le Monde mathematical puzzle:

In the set {1,…,12}, numbers adjacent to i are called friends of i. How many distinct subsets of size 5 can be chosen under the constraint that each number in the subset has at least a friend with him?

In a brute force approach, I tried a quintuple loop to check all possible cases:

case=0
for (a in 1:(12-4))
for (b in (a+1):(12-3))
for (c in (b+1):(12-2))
for (d in (c+1):(12-1))
for (e in (d+1):12)
case=case+((b-a<2)&(min(c-b,d-c)<2)
&(min(d-c,e-d)<2)&(e-d<2))


which returns 64 possible cases. Note that the second and last loop are useless since b=a+1 and e=d+1, necessarily. And c is either (b+1) or (d-1), which means 2 choices for c, except when e=a+4. This all adds up to

$8 + 2\sum_{a=1}^7\sum_{e=a+5}^{12} = 8+2.7.8-2.7.8/2=8.8=64$

A related R question: is there a generic way of programming a sequence of embedded loops like the one above without listing all of the loops one by one?

## Le Monde puzzle [#907]

Posted in Books, Kids, Statistics, University life with tags , , , on September 18, 2015 by xi'an

A combinatorics (?) Le Monde mathematical puzzle:

Each day of 2014, more than half of the 365 Paris métro drivers are at work. What is the minimal number of drivers one should consider to be sure to include at least a driver for each day of the year?

I may be missing an item of information from the puzzle: since at least 183 drivers are at work every day, if I select 183 drivers at random, there remain 182 further drivers. Even in the most extreme case where the 182 further drivers are at work every day of the year, there will be at least one of the 183 selected drivers at work every day. Conversely, if I select 182 or less drivers, one configuration is that the 183 or more remaining drivers are the ones always at work…

## Le Monde puzzle [#928]

Posted in Books, Kids, R with tags , , , on September 10, 2015 by xi'an

A combinatorics Le Monde mathematical puzzle:

How many distinct integers between 0 and 16 can one pick so that all positive differences are distinct?

If k is the number of distinct integers, the number of positive differences is

1+2+…+(k-1) = k(k-1)/2,

which cannot exceed 16, because it is a subset of {1,2,…,16}, meaning k cannot exceed 6 if all differences are distinct. From there, picking k integers at random makes it easy to check for the condition:

k=6
N=16
x=sort(sample(0:N,k-1))
y=outer(x[-1],x[-k],"-")
while (max(duplicated(y[!upper.tri(y)]))==1){
x=sort(sample(0:N,k-1))
y=outer(x[-1],x[-k],"-")}


which quickly returns for k=5

> x
[1] 0 1 7 12 15


as a solution. And is still running for k=6, meaning there is apparently no solution for k=6. (An exhaustive search shows there is indeed no solution for k=6 and N=16, while there are several for k=6 and N=17.) Now, reading the puzzle solution of Le Monde today, on September 09, I discovered that the authors proposed a sequence of length 7, (0,1,2,4,5,7,11,16), which does not work since 1-0=2-1… and proved that 8 is an impossible value by quite a convoluted argument. Did I misread again?!

In the earlier version of the R code posted today, I used

...y[lower.tri]...

which does not include the diagonal, instead of the proper

...y[!upper.tri(y)]..

a mistake that led to a wrong solution for k=6, as pointed out by Stephan.

## Egyptian fractions [Le Monde puzzle #922]

Posted in Books, Kids, R with tags , , , , , , , on July 28, 2015 by xi'an

For its summer edition, Le Monde mathematical puzzle switched to a lighter version with immediate solution. This #922 considers Egyptian fractions which only have distinct denominators (meaning the numerator is always 1) and can be summed. This means 3/4 is represented as ½+¼. Each denominator only appears once. As I discovered when looking on line, a lot of people are fascinated with this representation and have devised different algorithms to achieve decompositions with various properties. Including Fibonacci who devised a specific algorithm called the greedy algorithm in 1202 in the Liber Abaci. In the current Le Monde edition, the questions were somewhat modest and dealt with the smallest decompositions of 2/5, 5/12, and 50/77 under some additional constraint.

Since the issue was covered in so many places, I just spent one hour or so constructing a basic solution à la Fibonacci and then tried to improve it against a length criterion. Here are my R codes (using the numbers library):

osiris=function(a,b){
#can the fraction a/b be simplified
diva=primeFactors(a)
divb=primeFactors(b)
divc=c(unique(diva),unique(divb))
while (sum(duplicated(divc))>0){
n=divc[duplicated(divc)]
for (i in n){a=div(a,i);b=div(b,i)}
diva=primeFactors(a)
divb=primeFactors(b)
divc=c(unique(diva),unique(divb))
}
return(list(a=a,b=b))
}


presumably superfluous for simplifying fractions

horus=function(a,b,teth=NULL){
#simplification
anubis=osiris(a,b)
a=anubis$a;b=anubis$b
#decomposition by removing 1/b
isis=NULL
if (!(b %in% teth)){
a=a-1
isis=c(isis,b)
teth=c(teth,b)}
if (a>0){
#simplification
anubis=osiris(a,b)
bet=b;a=anubis$a;b=anubis$b
if (bet>b){ isis=c(isis,horus(a,b,teth))}else{
# find largest integer
k=ceiling(b/a)
while (k %in% teth) k=k+1
a=k*a-b
b=k*b
isis=c(isis,k,horus(a,b,teth=c(teth,k)))
}}
return(isis)}


which produces a Fibonacci solution (with the additional inclusion of the original denominator) and

nut=20
seth=function(a,b,isis=NULL){
#simplification
anubis=osiris(a,b)
a=anubis$a;b=anubis$b
if ((a==1)&(!(b %in% isis))){isis=c(isis,b)}else{
ra=hapy=ceiling(b/a)
if (max(a,b)<1e5) hapy=horus(a,b,teth=isis)
k=unique(c(hapy,ceiling(ra/runif(nut,min=.1,max=1))))
propa=propb=propc=propd=rep(NaN,le=length((k %in% isis)))
bastet=1
for (i in k[!(k %in% isis)]){
propa[bastet]=i*a-b
propb[bastet]=i*b
propc[bastet]=i
propd[bastet]=length(horus(i*a-b,i*b,teth=c(isis,i)))
bastet=bastet+1
}
k=propc[order(propd)[1]]
isis=seth(k*a-b,k*b,isis=c(isis,k))
}
return(isis)}


which compares solutions against their lengths. When calling those functions for the three fractions above the solutions are

> seth(2,5)
[1] 15 3
> seth(5,12)
[1] 12  3
> seth(50,77)
[1]   2 154   7


with no pretension whatsoever to return anything optimal (and with some like crashes when the magnitude of the entries grows, try for instance 5/121). For this latest counter-example, the alternative horus works quite superbly:

> horus(5,121)
[1] 121 31 3751 1876 7036876


## Le Monde puzzle [#920]

Posted in Books, Kids, R, Statistics, University life with tags , on July 23, 2015 by xi'an

A puzzling Le Monde mathematical puzzle (or blame the heat wave):

A pocket calculator with ten keys (0,1,…,9) starts with a random digit n between 0 and 9. A number on the screen can then be modified into another number by two rules:
1. pressing k changes the k-th digit v whenever it exists into (v+1)(v+2) where addition is modulo 10;
2. pressing 0k deletes the (k-1)th and (k+1)th digits if they both exist and are identical (otherwise nothing happens.
Which 9-digit numbers can always be produced whatever the initial digit?

I did not find an easy entry to this puzzle, in particular because it did not state what to do once 9 digits had been reached: would the extra digits disappear? But then, those to the left or to the right? The description also fails to explain how to handle n=000 000 004 versus n=4.

Instead, I tried to look at the numbers with less than 7 digits that could appear, using some extra rules of my own like preventing numbers with more than 9 digits. Rules which resulted in a sure stopping rule when applying both rules above at random:

leplein=rep(0,1e6)
for (v in 1:1e6){
x=as.vector(sample(1:9,1))
for (t in 1:1e5){
k=length(x) #as sequence of digits
if (k<3){

i=sample(rep(1:k,2),1)
x[i]=(x[i]+1)%%10
y=c(x[1:i],(x[i]+1)%%10)
if (i<k){ x=c(y,x[(i+1):k])}else{ x=y}
}else{

prop1=prop2=NULL
difs=(2:(k-1))[abs(x[-(1:2)]-x[-((k-1):k)])==0]
if (length(difs)>0) prop1=sample(rep(difs,2),1)
if (k<9) prop2=sample(rep(1:k,2),1)

if (length(c(prop1,prop2))>1){
if (runif(1)<.5){

x[prop2]=(x[prop2]+1)%%10
y=c(x[1:prop2],(x[prop2]+1)%%10)
if (prop2<k){ x=c(y,x[(prop2+1):k])}else{ x=y}
}else{
x=x[-c(prop1-1,prop1+1)]}
while ((length(x)>1)&(x[1]==0)) x=x[-1]}

if (length(c(prop1,prop2))==1){
if (is.null(prop2)){ x=x[-c(prop1-1,prop1+1)]
}else{
x[prop2]=(x[prop2]+1)%%10
y=c(x[1:prop2],(x[prop2]+1)%%10)
if (prop2<k){ x=c(y,x[(prop2+1):k])
}else{ x=y}
x=c(x[1:(prop2-1)],
(x[prop2]+1)%%10,
(x[prop2]+2)%%10,x[(prop2+1):k])}
while ((length(x)>1)&(x[1]==0)) x=x[-1]}

if (length(c(prop1,prop2))==0) break()
}

k=length(x)
if (k<7) leplein[sum(x*10^((k-1):0))]=
leplein[sum(x*10^((k-1):0))]+1
}}


code that fills an occupancy table for the numbers less than a million over 10⁶ iterations. The solution as shown below (with the number of zero entries over each column) is rather surprising in that it shows an occupancy that is quite regular over a grid. While it does not answer the original question…

## Le Monde puzzle [#919]

Posted in Books, Kids, Statistics, University life with tags , , , , on July 19, 2015 by xi'an

A rather straightforward Le Monde mathematical puzzle:

Find 3 digit integers x such that the integer created by collating x with (x+1) gives a 6 digit integer that is a perfect square.

Easy once you rewrite the constraint as 1000x+x+1 being a perfect square a², which means that x is equal to (a-1)(a+1)/1001, hence that 1001=7x11x13 divides either a+1 or a=1.

sol=NULL
vals=as.vector(outer(c(7,11,13),1:999,"*"))
vals=c(vals-1,vals+1)
for (a in vals){
x=round((a-1)*(a+1)/1001)
if ((1000*x+x+1==a^2)&(x<999)&(x>99)) sol=c(sol,x)}


which returns four solutions:

> unique(sol)
[1] 183 328 528 715


An addendum to the puzzle is

Find 4 digit integers x such that the integer created by collating x with (x+1) gives an 8 digit integrer that is a perfect square.

Similarly easy once you rewrite the constraint as 10,000x+x+1 being a perfect square a², which means that x is equal to (a-1)(a+1)/10,001, hence that 10,001=73×137 divides either a+1 or a=1.

sol=NULL
vals=as.vector(outer(c(73,137),(1:9999),"*"))
vals=c(vals-1,vals+1)
for (a in vals){
x=round((a-1)*(a+1)/10001)
if ((10000*x+x+1==a^2)&(x<9999)&(x>999)) sol=c(sol,x)}


leading to the conclusion there is a single solution:

> unique(sol)
[1] 6099


## Le Monde puzzle [#913]

Posted in Books, Kids, Statistics, University life with tags , , , , , , , on June 12, 2015 by xi'an

An arithmetics Le Monde mathematical puzzle:

Find all bi-twin integers, namely positive integers such that adding 2 to any of their dividers returns a prime number.

An easy puzzle, once the R libraries on prime number decomposition can be found!, since it is straightforward to check for solutions. Unfortunately, I could not install the recent numbers package. So I used instead the schoolmath R package. Despite its possible bugs. But it seems to do the job for this problem:

lem=NULL
for (t in 1:1e4)
if (prod(is.prim(prime.factor(t)+2)==1))
lem=c(lem,t)digin=function(n){


which returned all solutions, albeit in a lengthy fashion:

> lem
[1] 1 3 5 9 11 15 17 25 27 29 33 41 45 51 55
[16] 59 71 75 81 85 87 99 101 107 121 123 125 135 137 145
[31] 149 153 165 177 179 187 191 197 205 213 225 227 239 243 255
[46] 261 269 275 281 289 295 297 303 311 319 321 347 355 363 369
[61] 375 405 411 419 425 431 435 447 451 459 461 493 495 505 521
[76] 531 535 537 561 569 573 591 599 605 615 617 625 639 641 649
[91] 659 675 681 685 697 717 725 729 745 765 781 783 807 809 821
[106] 825 827 841 843 857 867 881 885 891 895 909 933 935 955 957
[121] 963 985 1003 1019 1025 1031 ...