Archive for R

Le Monde puzzle [#1133]

Posted in Books, Kids, R with tags , , , , , , on March 28, 2020 by xi'an

A weekly Monde current mathematical puzzle that reminded me of an earlier one (but was too lazy to check):

If ADULE-ELUDE=POINT, was is the largest possible value of POINT? With the convention that all letters correspond to different digits and no digit can start with 0. Same question when ADULE+ELUDE=POINT.

The run of a brute force R search return 65934 as the solution (codegolf welcomed!)

dify<-function(aluda,point) 
  (sum(aluda*10^(4:0))-sum(rev(aluda)*10^(4:0)))
num2dig<-function(dif) (dif%/%10^(0:4))%%10
sl=NULL
for (t in 1:1e6){
  adule=sample(0:9,5)
  while((dify(aluda)<=0)||(!prod(adule[c(1,5)])))
     adule=sample(0:9,5)
point=rev(num2dig(dify(adule)))
if ((!sum(duplicated(point)))&(prod(point%in%(0:9)[-adule-1])))
  sl=rbind(sl,c(adule,point))}
sl=as.matrix(distinct(as.data.frame(sl),.keep_all = TRUE))

where distinct is a dplyr R function.

> 94581-18549
[1] 76032

The code can be easily turned into solving the second question

> 31782+28713
[1] 60495

Le Monde puzzle [#1134]

Posted in Books, R with tags , , , , , , on March 24, 2020 by xi'an

A Monde mathematical puzzle on gcd’s and scm’s:

If one replaces a pair (a,b) of integers with the pair (g,s) of their greatest common denominator and smallest common multiple, how long at most before the sequence ends. Same question when considering a collection of five integers where two are selected by the pair (g,s) of their greatest common denominator and smallest common multiple.

The first question is straightforward as s is a multiple of s. So the sequence ends at most after one run. For five, run of a brute force R search return 9 as “the” solution (even though the true maximum is 10, as illustrated by the quintuplet (16,24,36,54,81):

ogcd <- function(x,y){r<-x%%y
  return(ifelse(r,ogcd(y,r),y))}

oscm<-function(x,y) x*y/ogcd(x,y)

divemul<-function(a,b) return(c(oscm(a,b),ogcd(a,b)))

for (t in 1:1e5){
ini=sample(1:1e2,5)
i=0;per=ker=sample(ini,2)
nez=divemul(per[1],per[2])
while(!max(nez%in%per)){
 ini=c(ini[!ini%in%per],nez)
 per=sample(ini,2)
 ker=rbind(ker,per)
 nez=divemul(per[1],per[2])
 i=i+1}
 sol=max(sol,i)}

one or two?

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

A superposition of two random walks from The Riddler:

Starting from zero, a random walk is produced by choosing moves between ±1 and ±2 at each step. If the choice between both is made towards maximising the probability of ending up positive after 100 steps, what is this probability?

Although the optimal path is not necessarily made of moves that optimise the probability of ending up positive after the remaining steps, I chose to follow a dynamic programming approach by picking between ±1 and ±2 at each step based on that probability:

bs=matrix(0,405,101) #best stategy with value i-203 at time j-1
bs[204:405,101]=1
for (t in 100:1){
  tt=2*t
  bs[203+(-tt:tt),t]=.5*apply(cbind(
     bs[204+(-tt:tt),t+1]+bs[202+(-tt:tt),t+1],
     bs[201+(-tt:tt),t+1]+bs[205+(-tt:tt),t+1]),1,max)}

resulting in the probability

> bs[203,1]
[1] 0.6403174

Just checking that a simple strategy of picking ±1 above zero and ±2 below leads to the same value

ga=rep(0,T)
for(v in 1:100) ga=ga+(1+(ga<1))*sample(c(-1,1),T,rep=TRUE)

or sort of

> mean(ga>0)
[1] 0.6403494

With highly similar probabilities when switching at ga<2

> mean(ga>0)
[1] 0.6403183

or ga<0

> mean(ga>0)
[1] 0.6403008

and too little difference to spot a significant improvement between the three boundaries.

chain of lynx and drove of hares

Posted in Books, Kids, pictures, R, Statistics with tags , , , , , , , , , on February 27, 2020 by xi'an

A paper (and an introduction to the paper) in Nature this week seems to have made progress on the existence of indefinite predator-prey cyles. As in the lynx/hare dataset available on R. The paper is focusing on another pair, an invertebrate and its prey, an algae. For which the authors managed a 50 cycle sequence. What I do not get about this experiment is how the cycle can be tested via a rigorous statistical experiment.

“…the predator–prey system showed a strong tendency to return to the dominant dynamical regime with a defined phase relationship. A mathematical model suggests that stochasticity is probably responsible for the reversible shift from coherent to non-coherent oscillations, a notion that was supported by experiments with external forcing by pulsed nutrient supply.”

As I had not renewed my subscription to Nature in time, I could not check the additional material for details, but the modelling seems to involve a wavelet decomposition of the bivariate time series, with correlations between the two series…

multiplying the bars

Posted in Kids, R with tags , , , , , , , on February 25, 2020 by xi'an

The latest Riddler makes the remark that the expression

|-1|-2|-3|

has no unique meaning (and hence value) since it could be

| -1x|-2|-3 | = 5   or   |-1| – 2x|-3| = -5

depending on the position of the multiplication sign and asks for all the possible values of

|-1|-2|…|-9|

which can be explored by a recursive R function for computing |-i|-(i+1)|…|-(i+2j)|

vol<-function(i,j){x=i
  if(j){x=c(i-(i+1)*vol(i+2,j-1),abs(i*vol(i+1,j-1)+i+2*j))
  if(j>1){for(k in 1:(j-2))
        x=c(x,vol(i,k)-(i+2*k+1)*vol(i+2*k+2,j-k-1))}}
  return(x)}

producing 40 different values for the ill-defined expression. However, this is incorrect as the product(s) hidden in the expression only involve a single term in vol(i,j)… I had another try with the decomposition of the expression vol(i,j) into a first part and a second part

prod<-function(a,b) a*b[,1]+b[,2]

val<-function(i,j){
  x=matrix(c(i,0),ncol=2)
  if(j){x=rbind(cbind(i,prod(-(i+1),val(i+2,j-1))),
          cbind(abs(prod(-i,val(i+1,j-1))-i-2*j),0))
    if(j-1){for(k in 2:(j-1)){
      pon=val(i,k-1)
      for(m in 1:dim(pon)[1])
          x=rbind(x,cbind(pon[m,1],pon[m,2]+prod(-(i+2*k-1),val(i+2*k,j-k))))}}}
  return(x)}

but it still fails to produce the right version.

Le Monde puzzle [#1132]

Posted in Kids, R, Statistics with tags , , , , , on February 24, 2020 by xi'an

A vaguely arithmetic challenge as Le weekly Monde current mathematical puzzle:

Given two boxes containing x and 2N+1-x balls respectively. If one proceeds by repeatedly transferring half the balls from the even box to the odd box, what is the largest value of N for which the resulting sequence in one of the boxes covers all integers from 1 to 2N?

The run of a brute force R search return 2 as the solution

lm<-function(N)
fils=rep(0,2*N)
bol=c(1,2*N)
while(max(fils)<2){
    fils[bol[1]]=fils[bol[1]]+1
    bol=bol+ifelse(rep(!bol[1]%%2,2),-bol[1],bol[2])*c(1,-1)/2}
return(min(fils))}

with obvious arguments that once the sequence starts cycling all possible numbers have been visited:

> lm(2)
[1] 1
> lm(3)
[1] 0

While I cannot guess the pattern, there seems to be much larger cases when lm(N) is equal to one, as for instance 173, 174, 173, 473, 774 (and plenty in-between).

Le Monde puzzle [#1129]

Posted in Kids, R with tags , , , , , , on February 10, 2020 by xi'an

A number challenge as Le weekly Monde current mathematical puzzle:

When the three consecutive numbers 110, 111 and 112, they all are multiples of the sum of their digits. Are there 4 consecutive numbers with three digits like this? A contrario, does there exist 17 consecutive numbers with three digits such that they cannot be divided by the sum of their digits? 18?

The run of a brute force R search return 510,511,512,513 as the solution to the first question

library(gtools)
bez=!(100:999)%%apply(baseOf(100:999),1,sum)
> (100:897)[bez[-(1:3)]*bez[-c(1:2,900)]*bez[-c(1,899:900)]*bez[-(898:900)]==1]
[1] 510

And to the second one:

> max(diff((1:899)[!!diff(bez)]))
[1] 17