Archive for recursive function

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-…

Le Monde puzzle [#1044]

Posted in Books, Kids with tags , , , , , , on March 12, 2018 by xi'an

A dynamic programming Le Monde mathematical puzzle:

Bob and Alice are playing a game where Alice fills a one-litre bottle from a water fountain, and empties it between four buckets. Bob then empties two of the four buckets. Alice then fills again her bottle and empties it again in the buckets. Alice wins if she manages to fill one bucket after a finite number of steps. What is the maximum capacity of a bucket for Alice to find a winning strategy?

The question sounded too complex to solve by an R code so I somewhat simplified it by deciding that Alice could not allocate any portion of the litre to a bucket but instead only 0,¼,⅓,½,⅔,¾,1. And then looked at a finite horizon to see how much she could fill a bucket when Bob was trying to minimise this amount: a crude R code just took too long for an horizon of 6 steps and hence I tried to reduce the number of calls to my recursive function

solfrak=c(0,.25,.333,.5,.667,.75,1)
petifil=function(buck=rep(0,4),hor=3){
#eliminate duplicates
 albukz=NULL
 for (a in solfrak)
 for (b in solfrak[!(solfrak+a>1)])
 for (c in solfrak[!(solfrak+a+b>1)]){
   if (a+b+c<=1){ albukz=rbind(albukz,
      c(a,b,c,1-a-b-c))}} 
   albukz=t(apply(buck+albukz,1,sort)) 
   albukz=albukz[!duplicated(albukz),] 
   if (is.matrix(albukz)){ 
    bezt=max(apply(albukz,1,petimpty,hor=hor-1)) 
    }else{ 
      bezt=petimpty(albukz,hor-1)} 
    return(bezt)} 

petimpty=function(buck,hor){ 
  if (hor>1){
    albukz=NULL
     for (i in 1:3)
     for (j in (i+1):4)
      albukz=rbind(albukz,c(buck[-c(i,j)],0,0))
     albukz=t(apply(albukz,1,sort))
     albukz=albukz[!duplicated(albukz),]
     if (is.matrix(albukz)){
       bezt=min(apply(albukz,1,petifil,hor))}else{
        bezt=petifil(albukz,hor)}
     }else{
      bezt=sort(buck)[2]+1}
   return(bezt)}

which led to a most surprising outcome:

> petifil(hor=2)
[1] 1.333
> petifil(hor=3)
[1] 1.5
> petifil(hor=4)
[1] 1.5
> petifil(hor=5)
[1] 1.5

that is no feasible strategy to beat the value 1.5 liters. Which actually stands way below two liters, the maximum content of the bucket produced in the solution!

Le Monde puzzle [#1019]

Posted in Books, Kids with tags , , , , , , on September 7, 2017 by xi'an

A gamey (and verbose) Le Monde mathematical puzzle:

A two-player game involves n+2 cards in a row, blue on one side and red on the other. Each player can pick any blue card among the n first ones and flip it plus both following ones. The game stops when no blue card is left to turn. The gain for the last player turning cards is 20-t, where t is the number of times cards were flipped, with gain t for its opponent. Both players aim at maximising their gain.

1. When n=4 and all cards are blue, can the first player win? If not, what is the best score for this player?

2. Among all 16 configurations at start, how many lead to the first player to win?

3. When n=10 and all cards are blue, how many cards are flipped an odd number of times for the winning configuration?

The first two questions can easily be processed by an R code like the following recursive function:

liplop <- function(x,n,i){
  if (max(x[1:n])==0){
    return(i)
  }else{
    sol=NULL
    for (j in (1:n)[x[1:n]==1]){
      y=x;y[j:(j+2)]=1-y[j:(j+2)]
      sol=c(sol,20-liplop(y,n,i+1))}
    return(max(sol))}}

Returning

> liplop(rep(1,6),4,0)
[1] 6

Meaning the first player cannot win, by running at most six rounds. Calling the same function for all 4⁴=16 possible configurations leads to 8 winning ones:

[1] 0 0 0 1
[1] 0 0 1 1
[1] 0 1 0 1
[1] 0 1 1 1
[1] 1 0 0 0
[1] 1 0 1 0
[1] 1 1 0 0
[1] 1 1 1 0

Solving the same problem with n=10 is not feasible with this function. (Even n=6 seems out of reach!)

Le Monde puzzle [#965]

Posted in Kids, R with tags , , , on June 14, 2016 by xi'an

A game-related Le Monde mathematical puzzle:

Starting with a pile of 10⁴ tokens, Bob plays the following game: at each round, he picks one of the existing piles with at least 3 tokens, takes away one of the tokens in this pile, and separates the remaining ones into two non-empty piles of arbitrary size. Bob stops when all piles have identical size. What is this size and what is the maximal number of piles?

First, Bob can easily reach a decomposition that prevents all piles to be of the same size: for instance, he can start with a pile of 1 and another pile of 2. Looking at the general perspective, an odd number of tokens, n=2k+1, can be partitioned into (1,1,2k-1). Which means that the decomposition (1,1,…,1) involving k+1 ones can always be achieved. For an even number, n=2k, this is not feasible. If the number 2k can be partitioned into equal numbers u, this means that the sequence 2k-(u+1),2k-2(u+1),… ends up with u, hence that there exist m such that 2k-m(u+1)=u or that 2k+1 is a multiple of (u+1). Therefore, the smallest value is made of the smallest factor of 2k+1. Minus one. For 2k=10⁴, this value is equal to 72, while it is 7 for 10³. The decomposition is impossible for 2k=100, since 101 is prime. Here are the R functions used to check this analysis (with small integers, if not 10⁴):

solvant <- function(piles){
 if ((length(piles)>1)&((max(piles)==2)||(min(piles)==max(piles)))){
  return(piles)}else{
   i=sample(rep(1:length(piles),2),1,prob=rep(piles-min(piles)+.1,2))
   while (piles[i]<3)
    i=sample(rep(1:length(piles),2),1,prob=rep(piles-min(piles)+.1,2))
   split=sample(rep(2:(piles[i]-1),2),1,
        prob=rep(abs(2:(piles[i]-1)-piles[i]/2)+.1,2))
   piles=c(piles[-i],split-1,piles[i]-split)
   solvant(piles)}}

disolvant <- function(piles){
 sol=solvant(piles)
 while (min(sol)<max(sol))
 sol=solvant(piles)
 return(sol)}

resolvant <- function(piles){
 sol=disolvant(piles)
 lasol=sol;maxle=length(sol)
 for (t in 1:piles){
 sol=disolvant(piles)
 if (length(sol)>maxle){
 lasol=sol;maxle=length(sol)}}
 return(lasol)}

another riddle

Posted in Books, Kids, R with tags , , , , , , on March 29, 2016 by xi'an

A very nice puzzle on The Riddler last week that kept me busy on train and plane rides, runs and even in between over the weekend. The core of the puzzle is about finding the optimal procedure to select k guesses about the value of a uniformly random integer x in {a,a+1,…,b}, given that each guess y produces the position of x respective to y (less, equal, or more). If y=x at one stage, the player wins x. Optimal being defined as maximising the expected gain. After some (and more) experimentation, I found that, when b-a is large enough [depending on k], the optimal guess at stage i is b-f(i) with f(k)=0 and f(i-1)=2f(i)+1. For the values given on The Riddler, a=1,b=1000,k=9, my solution is to first guess at y=1000-f(9)=255 and this produces a gain of 380.31 with a probability of winning of 0.510, which seems amazingly large, but not so much when considering that 2⁹ is close to 500. Continue reading

Le Monde puzzle [#954]

Posted in Kids, R with tags , , , , , , on March 25, 2016 by xi'an

A square Le Monde mathematical puzzle:

Given a triplet (a,b,c) of integers, with a<b<c, it satisfies the S property when a+b, a+c, b+c, a+b+c are perfect squares such that a+c, b+c, and a+b+c are consecutive squares. For a given a, is it always possible to find a pair (b,c) such (a,b,c) satisfies S? Can you find the triplet (a,b,c) that produces the sum a+b+c closest to 1000?

This is a rather interesting challenge and a brute force resolution does not produce interesting results. For instance, using the function is.whole from the package Rmpfr, the R functions

ess <- function(a,b,k){
#assumes a<b<k
 ess=is.whole(sqrt(a+b))&
 is.whole(sqrt(b+k))&
 is.whole(sqrt(a+k))&
 is.whole(sqrt(a+b+k))
 mezo=is.whole(sqrt(c((a+k+1):(b+k-1),(b+k+1):(a+b+k-1))))
 return(ess&(sum(mezo==0)))
 }

and

quest1<-function(a){
 b=a+1
 while (b<1000*a){
  if (is.whole(sqrt(a+b))){
   k=b+1
   while (k<100*b){
    if (is.whole(sqrt(a+k))&is.whole(b+k))
     if (ess(a,b,k)) break()
    k=k+1}}
   b=b+1}
 return(c(a,b,k))
 }

do not return any solution when a=1,2,3,4,5

Looking at the property that a+b,a+c,b+c, and a+b+c are perfect squares α²,β²,γ², and δ². This implies that

a=(δ+γ)(δ-γ), b=(δ+β)(δ-β), and c=(δ+α)(δ-α)

with 1<α<β<γ<δ. If we assume β²,γ², and δ² consecutive squares, this means β=γ-1 and δ=γ+1, hence

a=2γ+1, b=4γ, and c=(γ+1+α)(γ+1-α)

which leads to only two terms to examine. Hence writing another R function

abc=function(al,ga){
 a=2*ga+1
 b=4*ga
 k=(ga+al+1)*(ga-al+1)
 return(c(a,b,k))}

and running a check for the smallest values of α and γ leads to the few solutions available:

> for (ga in 3:1e4)
for(al in 1:(ga-2))
if (ess(abc(al,ga))) print(abc(al,ga))
[1] 41 80 41 320
[1] 57 112 672
[1] 97 192 2112
[1] 121 240 3360
[1] 177 352 7392
[1] 209 416 10400
[1] 281 560 19040
[1] 321 640 24960
[1] 409 816 40800
[1] 457 912 51072

Le Monde puzzle [#950]

Posted in Books, Kids, pictures, Statistics, Travel, University life with tags , , , , on March 10, 2016 by xi'an

A Le Monde mathematical puzzle with Alice and Bob:

Alice and Bob play a game with 100 tokens set in ten piles of 1, 9 piles of 2, 8 piles of 3, 7 piles of 4, and 4 piles of 5. They each take a token in turn, either to remove it from the game, or to create a new pile of one, provided this token is taken from a pile with at least two remaining tokens. The winner is the one left with the last token. If Alice starts, who is the winner?

I just wrote a most rudimentary recursive R function

reward=function(tokens){
 gain=0
 if (max(tokens)>0){
 #takes one token off
 for (i in (1:5)[tokens>0]){
 gain=max(gain,1-reward(tokens-((1:5)==i)))
 if (gain==1) break()}
 #create another singleton
 if (max(tokens[-1])>1){
 for (i in (2:5)[tokens[-1]>1]){
 gain=max(gain,1-reward(c(tokens[1]+1,tokens[-1]-((2:5)==i))))
 if (gain==1) break()}}}
 return(gain)}

where token represents the number of remaining sets with 1, 2, 3, 4, and 5 tolkiens. With the suggested values, (10,18,24,28,20), the R code takes too long on my machine! Or even overnight on our server. So as usual I thought a bit more about it and started cutting at unnecessary bits, reaching the faster recursive function

reward=function(tokens){
  #clean up piles with single token
  tokens[1]=tokens[1]+sum((tokens[-1]==1))
  tokens[-1][tokens[-1]==1]=0
  if (max(tokens[-1])==0){
    #end: no choice left
    gain=1*(tokens[1]%%2==1)
  }else{
    gain=0
    #all piles have to disappear, order should not matter
    i=min((2:5)[tokens[-1]>1])
    #set one token appart
    gain=max(gain,1-reward(tokens-((1:5)==i)))
    #create another singleton
    gain=max(gain,1-reward(c(tokens[1]+1,tokens[-1]-((2:5)==i))))}
  return(gain)}

as all sets have to vanish at one point or another so order should not matter. However, with the starting values provided in the puzzle, two weeks of computation on our local cluster did produce nothing, as there are too many cases to examine! (The exact solution is that Alice cannot win the game if Bob plays in an optimal manner.)