## Le Monde puzzle [#1053]

Posted in Books, Kids, R with tags , , , , , , , on June 21, 2018 by xi'an

An easy arithmetic Le Monde mathematical puzzle again:

1. If coins come in units of 1, x, and y, what is the optimal value of (x,y) that minimises the number of coins representing an arbitrary price between 1 and 149?
2.  If the number of units is now four, what is the optimal choice?

The first question is fairly easy to code

```coinz <- function(x,y){
z=(1:149)
if (y<x){xx=x;x=y;y=xx}
ny=z%/%y
nx=(z%%y)%/%x
no=z-ny*y-nx*x
return(max(no+nx+ny))
}```

and returns M=12 as the maximal number of coins, corresponding to x=4 and y=22. And a price tag of 129.  For the second question, one unit is necessarily 1 (!) and there is just an extra loop to the above, which returns M=8, with other units taking several possible values:

```[1] 40 11  3
[1] 41 11  3
[1] 55 15  4
[1] 56 15  4
```

A quick search revealed that this problem (or a variant) is solved in many places, from stackexchange (for an average—why average?, as it does not make sense when looking at real prices—number of coins, rather than maximal), to a paper by Shalit calling for the 18¢ coin, to Freakonomics, to Wikipedia, although this is about finding the minimum number of coins summing up to a given value, using fixed currency denominations (a knapsack problem). This Wikipedia page made me realise that my solution is not necessarily optimal, as I use the remainders from the larger denominations in my code, while there may be more efficient divisions. For instance, running the following dynamic programming code

```coz=function(x,y){
minco=1:149
if (x<y){ xx=x;x=y;y=xx}
for (i in 2:149){
if (i%%x==0)
minco[i]=i%/%x
if (i%%y==0)
minco[i]=min(minco[i],i%/%y)
for (j in 1:max(1,trunc((i+1)/2)))
minco[i]=min(minco[i],minco[j]+minco[i-j])
}
return(max(minco))}
```

returns the lower value of M=11 (with x=7,y=23) in the first case and M=7 in the second one.

## a chain of collapses

Posted in Books, Kids, R with tags , , , on June 20, 2018 by xi'an

A quick riddler resolution during a committee meeting (!) of a short riddle: 36 houses stand in a row and collapse at times t=1,2,..,36. In addition, once a house collapses, the neighbours if still standing collapse at the next time unit. What are the shortest and longest lifespans of this row?

Since a house with index i would collapse on its own by time i, the longest lifespan is 36, which can be achieved with the extra rule when the collapsing times are perfectly ordered. For the shortest lifespan, I ran a short R code implementing the rules and monitoring its minimum. Which found 7 as the minimal number for 10⁵ draws. However, with an optimal ordering, one house plus one or two neighbours of the most recently collapsed, leading to a maximal number of collapsed houses after k time units being

1+2(k-1)+1+2(k-2)+….=k+k(k-1)=k²

which happens to be equal to 36 for k=6. (Which was also obtained in 10⁶ draws!) This also gives the solution for any value of k.

## Le Monde puzzle [#1051]

Posted in Books, Kids, R with tags , , , , , , on May 18, 2018 by xi'an

A combinatoric Le Monde mathematical puzzle of limited size:
When the only allowed move is to switch two balls from adjacent boxes, what is the minimal number of moves to return all balls in the above picture to their respective boxes? Same question with six boxes and 12 balls.

The question is rather interesting to code as I decided to use recursion (as usual!) but wanted to gain time by storing the number of steps needed by any configuration to reach its ordered recombination. Meaning I had to update an external vector within the recursive function for each new configuration I met. With help from Julien Stoehr, who presented me with the following code, a simplification of a common R function

```v.assign <- function (i,value,...) {
temp <- get(i, pos = 1)
temp[...] <- value
assign(i, temp, pos = 1)}
```

which assigns one or several entries to the external vector i. I thus used this trick in the following R code, where cosz is a vector of size 5¹⁰, much larger than the less than 10! values I need but easier to code. While n≤5.

```n=5;tn=2*n
baz=n^(0:(tn-1))
cosz=rep(-1,n^tn)
swee <- function(balz){
indz <- sum((balz-1)*baz)
if (cosz[indz]==-1){
if (min(diff(balz))==0){ #ordered
v.assign("cosz",indz,value=1)}else{
val <- n^tn
for (i in 2:n)
for (j in (2*i-1):(2*i))
for (k in (2*i-3):(2*i-2)){
calz <- balz
calz[k] <- balz[j];calz[j] 0)
val <- min(val,1+swee(calz))}
v.assign("cosz",indz,value=val)
}}
return(cosz[indz])}
```

which returns 2 for n=2, 6 for n=3, 11 for n=4, 15 for n=5. In the case n=6, I need a much better coding of the permutations of interest. Which is akin to ranking all words within a dictionary with letters (1,1,…,6,6). After some thinking (!) and searching, I came up with a new version, defining

```parclass=rep(2,n)
rankum=function(confg){
n=length(confg);permdex=1
for (i in 1:(n-1)){
x=confg[i]
if (x>1){
for (j in 1:(x-1)){
if(parclass[j]>0){
parclass[j]=parclass[j]-1
permdex=permdex+ritpermz(n-i,parclass)
parclass[j]=parclass[j]+1}}}
parclass[x]=parclass[x]-1}
return(permdex)}

ritpermz=function(n,parclass){
return(factorial(n)/prod(factorial(parclass)))}
```

for finding the index of a given permutation, between 1 and (2n)!/2!..2!, and then calling the initial swee(p) with this modified allocation. The R code was still running when I posted this entry… and six days later, it returned the answer of 23.

## Le Monde puzzle [#1045]

Posted in Books, Kids with tags , , , , , , on May 13, 2018 by xi'an

An minor arithmetic Le Monde mathematical puzzle:

Take a sequence of 16  integers with 4 digits each, separated by 2,  such that it contains a perfect square and its sum is a perfect cube. What are the possible squares and cubes?

The question is dead easy to code in R

```for (x in as.integer(1e3:(1e4-16))){
if (max(round(sqrt(x+2*(0:15)))^2==x+2*(0:15))==1) {
b=sqrt((x+2*(0:15))[round(sqrt(x+2*(0:15)))^2==x+2*(0:15)])
if ((round((2*x+30)^(1/3)))^3==(2*x+30))
print(c(x,b,(16*(x+15))^(1/3)))}}
```

and return the following solutions:

```[1] 1357   37   28
[1] 5309   73   44
```

Nothing that exciting…!

## the riddle of the stands

Posted in Books, Kids, R with tags , , , , , on May 11, 2018 by xi'an

The simple riddle of last week on The Riddler, about the minimum number of urinals needed for n men to pee if the occupation rule is to stay as far as possible from anyone there and never to stand next to another man,  is quickly solved by an R code:

```ocupee=function(M){
ok=rep(0,M)
ok[1]=ok[M]=1
ok[trunc((1+M/2))]=1
while (max(diff((1:M)[ok!=0])>2)){
i=order(-diff((1:M)[ok!=0]))[1]
ok[(1:M)[ok!=0][i]+trunc((diff((1:M)[ok!=0])[i]/2))]=1
}
return(sum(ok>0))
}
```

with maximal occupation illustrated by the graph below:

Meaning that the efficiency of the positioning scheme is not optimal when following the sequential positioning, requiring $N+2^{\lceil log_2(N-1) \rceil}$ urinals. Rather than one out of two, requiring 2N-1 urinals. What is most funny in this simple exercise is the connection exposed in the Riddler with an Xkcd blag written a few years go about the topic.

## Le Monde puzzle [#1049]

Posted in Books, Kids, R with tags , , , on April 18, 2018 by xi'an

An algorithmic Le Monde mathematical puzzle with a direct

Alice and Bob play a game by picking alternatively one of the remaining digits between 1 and 10 and putting it in either one of two available stacks, 1 or 2. Their respective gains are the products of the piles (1 for Alice and 2 for Bob).

The problem is manageable by a recursive function

```facten=factorial(10)
pick=function(play=1,remz=matrix(0,2,5)){
if ((min(remz[1,])>0)||(min(remz[2,])>0)){#finale
remz[remz==0]=(1:10)[!(1:10)%in%remz]
return(prod(remz[play,]))
}else{
gainz=0
for (i in (1:10)[!(1:10)%in%remz]){
propz=rbind(c(remz[1,remz[1,]>0],i,
rep(0,sum(remz[1,]==0)-1)),remz[2,])
gainz=max(gainz,facten/pick(3-play,remz=propz))}
for (i in (1:10)[!(1:10)%in%remz]){
propz=rbind(remz[1,],c(remz[2,remz[2,]>0],i,
rep(0,sum(remz[2,]==0)-1)))
gainz=max(gainz,facten/pick(3-play,remz=propz))}
return(gainz)}}
```

that shows the optimal gain for Alice is 3360=2x5x6x7x 8, versus Bob getting 1080=1x3x4x9x10. The moves ensuring the gain are 2-10-…

## a [Gregorian] calendar riddle

Posted in R with tags , , , , , on April 17, 2018 by xi'an

A simple riddle express this week on The Riddler, about finding the years between 2001 and 2099 with the most cases when day x month = year [all entries with two digits]. For instance, this works for 1 January, 2001 since 01=01 x 01. The only difficulty in writing an R code for this question is to figure out the number of days in a given month of a given year (in order to include leap years).

The solution was however quickly found on Stack Overflow and the resulting code is

```#safer beta quantile
numOD <- function(date) {
m <- format(date, format="%m")
while (format(date, format="%m") == m) date <- date + 1
return(as.integer(format(date - 1, format="%d")))
}
dayz=matrix(31,12,99)
for (i in 2001:2099)
for (j in 2:11)
dayz[j,i-2000]=numOD(as.Date(
paste(i,"-",j,"-1",sep=""),"%Y-%m-%d"))

monz=rep(0,99)
for (i in 1:99){
for (j in 1:12)
if ((i==(i%/%j)*j)&((i%/%j)<=dayz[j,i]))
monz[i]=monz[i]+1}
```

The best year in this respect being 2024, with 7 occurrences of the year being the product of a month and a day…