Archive for R

Le Monde puzzle [#1094]

Posted in Books, Kids, R with tags , , , , , , on April 23, 2019 by xi'an

A rather blah number Le Monde mathematical puzzle:

Find all integer multiples of 11111 with exactly one occurrence of each decimal digit..

Which I solved by brute force, by looking at the possible range of multiples (and  borrowing stringr:str_count from Robin!)

> combien=0
> for (i in 90001:900008){
  j=i*11111
  combien=combien+(min(stringr::str_count(j,paste(0:9)))==1)}
> combien
[1] 3456

And a bonus one:

Find all integers y that can write both as x³ and (10z)³+a with 1≤a≤999.

which does not offer much in terms of solutions since x³-v³=(x-v)(x²+xv+v²)=a shows that x² is less than 2a/3, meaning x is at most 25. Among such numbers only x=11,12 lead to a solution as x³=1331,1728.

Le Monde puzzle [#1092]

Posted in Statistics with tags , , , , , , , on April 18, 2019 by xi'an

A Latin square Le Monde mathematical puzzle that I found rather dreary:

A hidden 3×3 board contains all numbers from 1 to 9. Anselm wants to guess the board and makes two proposals. Berenicke tells him how many entries are in the right rows and colums for each proposal, along with the information that no entry is at the right location. Anselm deduces the right board.

Which I solved by brute force and not even simulated annealing, first defining a target

ordoku1=ordoku2=matrix(1,9,2)
ordoku1[,1]=c(1,1,1,2,2,2,3,3,3)
ordoku1[,2]=rep(1:3,3)
ordoku2[,1]=c(3,2,3,1,2,3,2,1,1)
ordoku2[,2]=c(2,2,3,2,3,1,1,3,1)
fitz=function(ordo){
  (sum(ordo[c(1,4,7),2]==1)==1)+(sum(ordo[c(2,5,8),2]==2)==1)+
  (sum(ordo[c(3,6,9),2]==3)==0)+(sum(ordo[c(1,2,3),1]==1)==1)+
  (sum(ordo[c(4,5,6),1]==2)==1)+(sum(ordo[c(7,8,9),1]==3)==2)+
  (sum(ordo[c(6,7,9),2]==1)==2)+(sum(ordo[c(1,2,4),2]==2)==1)+
  (sum(ordo[c(3,5,8),2]==3)==2)+(sum(ordo[c(4,8,9),1]==1)==1)+
  (sum(ordo[c(7,2,5),1]==2)==1)+(sum(ordo[c(1,3,6),1]==3)==0)+
  (!(0%in%apply((ordo-ordoku1)^2,1,sum)))+(!(0%in%apply((ordo-ordoku2)^2,1,sum)))
}

on a 9×9 board entry reproducing all items of information given by Berenicke. If all constraints are met, the function returns 14. And then searched for a solution at random:

temp=1
randw=function(ordo){
  for (t in 1:1e6){
    chlg=sample(1:9,2)
    temp=ordo[chlg[1],]
    ordo[chlg[1],]=ordo[chlg[2],]
    ordo[chlg[2],]=temp
    if (fitz(ordo)==14){
      print(ordo);break()}}}

which produces the correct board

4 3 5
6 7 1
9 2 8

no country for old liars

Posted in Kids, R with tags , , , , , on March 30, 2019 by xi'an

A puzzle from the Riddler about a group of five persons, A,..,E, where all and only people strictly older than L are liars, all making statements about others’ ages:

  1. A: B>20 and D>16
  2. B: C>18 and E<20
  3. C: D<22 and A=19
  4. D: E≠20 and B=20
  5. E: A>21 and C<18

The Riddler is asking for the (integer value of L and the ranges or values of A,…,E. After thinking about this puzzle over a swimming session, I coded the (honest) constraints and their (liar) complements as many binary matrices, limiting the number of values of L to 8 from 0 (15) to 7 (22) and A,…,E to 7 from 1 (16) to 7 (22):

CA=CB=CC=CD=CE=A=B=C=D=E=matrix(1,5,7)
#constraints
A[2,1:(20-15)]=A[4,1]=0 #A honest
CA[2,(21-15):7]=CA[4,2:7]=0 #A lying
B[3,1:(18-15)]=B[5,(20-15):7]=0
CB[3,(19-15):7]=CB[5,1:(19-15)]=0
C[1,-(19-15)]=C[4,7]=0 #C honest
CC[1,(19-15)]=CC[4,-7]=0 #C lying
D[5,(17-15)]=D[2,-(20-15)]=0
CD[5,-(17-15)]=CD[2,(20-15)]=0
E[1,1:(21-15)]=E[3,(18-15):7]=0
CE[1,7]=CE[3,1:(17-15)]=0

since the term-wise product of these five matrices expresses all the constraints on the years, as e.g.

ABCDE=A*CB*CC*D*CE

if A,D≤L and B,C,E>L, and I then looked by uniform draws [with a slight Gibbs flavour] for values of the integers that suited the constraints or their complement, the stopping rule being that the collection of A,…,E,L is producing an ABCDE binary matrix that agrees with all statements modulo the lying statuum of their authors:

yar=1:5
for (i in 1:5) yar[i]=sample(1:7,1)
L=sample(0:7,1)
ABCDE=((yar[1]>L)*CA+(yar[1]<=L)*A)* 
   ((yar[2]>L)*CB+(yar[2]<=L)*B)* 
   ((yar[3]>L)*CC+(yar[3]<=L)*C)* 
   ((yar[4]>L)*CD+(yar[4]<=L)*D)* 
   ((yar[5]>L)*CE+(yar[5]<=L)*E) 
while (min(diag(ABCDE[,yar]))==0){ 
   L=sample(0:7,1);idx=sample(1:5,1) 
   if (max(ABCDE[idx,])==1) yar[idx]=sample(which(ABCDE[idx,]>0),1)
   ABCDE=((yar[1]>L)*CA+(yar[1]<=L)*A)* 
   ((yar[2]>L)*CB+(yar[2]<=L)*B)* 
   ((yar[3]>L)*CC+(yar[3]<=L)*C)*
   ((yar[4]>L)*CD+(yar[4]<=L)*D)* 
   ((yar[5]>L)*CE+(yar[5]<=L)*E) 
    }

which always produces L=18,A=19,B=20,C=18,D=16 and E>19 as the unique solution (also reported by The Riddler).

> ABCDE
     [,1] [,2] [,3] [,4] [,5] [,6] [,7]
[1,]    0    0    0    1    0    0    0
[2,]    0    0    0    0    1    0    0
[3,]    0    0    1    0    0    0    0
[4,]    1    0    0    0    0    0    0
[5,]    0    0    0    0    1    1    1

(x=scan())%in%(2*4^(n=0:x)-2^n-1)

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

One challenge on code golf is to find the shortest possible code to identify whether or not an integer belongs to the binary cyclops numbers which binary expansion is 0, 101, 11011, 1110111, 111101111, &tc. The n-th such number being

a(n) = 2^{2n + 1} - 2^n - 1 = 2\,4^n - 2^n - 1 = (2^n - 1)(2\,2^n + 1)

this leads to the above solution in R (26 bits). The same length as the C solution [which I do not get]

f(n){n=~n==(n^=-~n)*~n/2;}

And with shorter versions in many esoteric languages I had never heard of, like the 8 bits Brachylog code

ḃD↔Dḍ×ᵐ≠

or the 7 bits Jelly

B¬ŒḂ⁼SƊ

As a side remark, since this was not the purpose of the game, the R code is most inefficient in creating a set of size (x+1), with most terms being Inf.

Le Monde puzzle [#1087]

Posted in Books, Kids, R, Statistics with tags , , , , , on February 25, 2019 by xi'an

A board-like Le Monde mathematical puzzle in the digit category:

Given a (k,m) binary matrix, what is the maximum number S of entries with only one neighbour equal to one? Solve for k=m=2,…,13, and k=6,m=8.

For instance, for k=m=2, the matrix

\begin{matrix} 0 &0\\ 1 &1\\ \end{matrix}

is producing the maximal number 4. I first attempted a brute force random filling of these matrices with only a few steps of explorations and got the numbers 4,8,16,34,44,57,… for the first cases. Since I was convinced that the square k² of a number k previously exhibited to reach its maximum as S=k² was again perfect in this regard, I then tried another approach based on Gibbs sampling and annealing (what else?):

gibzit=function(k,m,A=1e2,N=1e2){
  temp=1 #temperature
  board=sole=matrix(sample(c(0,1),(k+2)*(m+2),rep=TRUE),k+2,m+2)
  board[1,]=board[k+2,]=board[,1]=board[,m+2]=0 #boundaries
  maxol=counter(board,k,m) #how many one-neighbours?
  for (t in 1:A){#annealing
    for (r in 1:N){#basic gibbs steps
      for (i in 2:(k+1))
        for (j in 2:(m+1)){
          prop=board
          prop[i,j]=1-board[i,j]
          u=runif(1)
          if (log(u/(1-u))<temp*(counter(prop,k,m)-val)){ 
             board=prop;val=counter(prop,k,m) 
             if (val>maxol){
               maxol=val;sole=board}}
      }}
    temp=temp*2}
  return(sole[-c(1,k+2),-c(1,m+2)])}

which leads systematically to the optimal solution, namely a perfect square k² when k is even and a perfect but one k²-1 when k is odd. When k=6, m=8, all entries can afford one neighbour exactly,

> gibzbbgiz(6,8)
[1] 48
     [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8]
[1,]    1    0    0    1    1    0    0    1
[2,]    1    0    0    0    0    0    0    1
[3,]    0    0    1    0    0    1    0    0
[4,]    0    0    1    0    0    1    0    0
[5,]    1    0    0    0    0    0    0    1
[6,]    1    0    0    1    1    0    0    1

but this does not seem feasible when k=6, m=7, which only achieves 40 entries with one single neighbour.

call for sessions and labs at Bay2sC0mp²⁰

Posted in pictures, R, Statistics, Travel, University life with tags , , , , , , , , , , , , , , , , , on February 22, 2019 by xi'an

A call to all potential participants to the incoming BayesComp 2020 conference at the University of Florida in Gainesville, Florida, 7-10 January 2020, to submit proposals [to me] for contributed sessions on everything computational or training labs [to David Rossell] on a specific language or software. The deadline is April 1 and the sessions will be selected by the scientific committee, other proposals being offered the possibility to present the associated research during a poster session [which always is a lively component of the conference]. (Conversely, we reserve the possibility of a “last call” session made from particularly exciting posters on new topics.) Plenary speakers for this conference are

and the first invited sessions are already posted on the webpage of the conference. We dearly hope to attract a wide area of research interests into a as diverse as possible program, so please accept this invitation!!!

Le Monde puzzle [#1085]

Posted in Books, Kids, R with tags , , , , , on February 18, 2019 by xi'an

A new Le Monde mathematical puzzle in the digit category:

Given 13 arbitrary relative integers chosen by Bo, Abigail can select any subset of them to be drifted by plus or minus one by Bo, repeatedly until Abigail reaches the largest possible number N of multiples of 5. What is the minimal possible value of N under the assumption that Bo tries to minimise it?

I got stuck on that one, as building a recursive functiion led me nowhere: the potential for infinite loop (add one, subtract one, add one, …) rather than memory issues forced me into a finite horizon for the R function, which then did not return anything substantial in a manageable time. Over the week and the swimming sessions, I thought of simplifying the steps, like (a) work modulo 5, (b) bias moves towards 1 or 4, away from 2 and 3, by keeping only one entry in 2 and 3, and all but one at 1 and 4, but could only produce five 0’s upon a sequence of attempts… With the intuition that only 3 entries should remain in the end, which was comforted by Le Monde solution the week after.