Archive for R

an attempt at code golf

Posted in Kids, R with tags , , , , , , , , , on May 15, 2019 by xi'an

Having discovered codegolf on Stack Exchange a few weeks ago, I spotted a few interesting puzzles since then but only got the opportunity at a try over a quiet and rainy weekend (and Robin being on vacation)! The challenge was to write an R code for deciding whether or not a given integer n is congruent or not, when congruent means that it is the surface of a rectangle triangle with all three sides rational. The question included a pointer to the Birch and Swinnerton-Dyer conjecture as a mean to check congruence although the real solution was provided by Tunnell’s Theorem, which states that n is congruent if and only if the number of integer solutions to 2x²+y²+8z²=n is twice as much as the number of integer solutions to 2x²+y²+32z²=n if n is odd and  the number of integer solutions to 8x²+y²+16z²=n is twice as much as the number of integer solutions to 8x²+y²+64z²=n if n is even. Although this is only true for squared-free integers. (I actually spent more time on figuring out the exact wording of the theorem than on optimising the R code!)

My original solution

p=function(n){
 for (i in(n:2)^2)if(n%%i<1)n=n/i
 if(n%%2){d=8;f=2;g=16}else{d=2;f=1;g=8}
 A=0;b=(-n:n)^2
 for(x in d*b)for(y in x+f*b)for(z in g*b)
  A=A+(y+z==n)-2*(y+4*z==n)
 A==0}

was quite naïve, as shown by the subsequent improvements by senior players, like the final (?) version of Guiseppe:

function(n){b=(-n:n)^2
for(i in b[b>0])n=n/i^(!n%%i)
P=2^(n%%2)
o=outer
!sum(!o(y<-o(8/P*b,2*b,"+")/P-n,z<-16/P*b,"+"),-2*!o(y,4*z,"+"))}

exhibiting a load of code golf tricks, from using an anonymous function to renaming functions with a single letter, to switching from integers to booleans and back with the exclamation mark.

chance call for book reviewers

Posted in Statistics with tags , , , , , , , , on May 14, 2019 by xi'an

Since I have been unable to find local reviewers for my CHANCE review column of the above recent CRC Press books, namely

I am calling for volunteers among ‘Og’s readers. Please contact me if interested.

a perfectly normally distributed sample

Posted in R, Statistics with tags , , , , , , , , on May 9, 2019 by xi'an

When I saw this title on R-bloggers, I was wondering how “more perfect” a Normal sample could be when compared with the outcome of rnorm(n). Hence went checking the original blog on bayestestR in search of more information. Which was stating nothing more than how to generate a sample is perfectly normal by using the rnorm_perfect function. Still unsure of the meaning, I contacted one of the contributors who replied very quickly

…that’s actually a good question. I would say an empirical sample having characteristics as close as possible to a cannonic gaussian distribution.
and again leaving me hungering for more details. I thus downloaded the package bayestestR and opened the rnorm_perfect function. Which is simply the sequence of n-quantiles
stats::qnorm(seq(1/n, 1 – 1/n, length.out = n), mean, sd)
which I would definitely not call a sample as it has nothing random. And perfect?! Not really, unless one associates randomness and imperfection.

Le Monde puzzle [#1099]

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

A simple 2×2 Le Monde mathematical puzzle:

Arielle and Brandwein play a game out of two distinct even integers between 1500 and 2500,  and y. Providing one another with either the pair (x/2,y+x/2) or the pair (x+y/2,y/2) until they run out of even possibilities or exceed 6 rounds. When x=2304, what is the value of y that makes Brandwein win?

Which I solved by a recursive function (under the constraint of a maximum of 11 levels of recursion):

nezt=function(x,y,i=1){
  if ((i>11)||((is.odd(x)&is.odd(y)))){ return(-1)
  }else{
    z=-1
    if (is.even(x)) z=-nezt(x/2,y+x/2,i+1)
    if (is.even(y)) z=max(z,-nezt(y/2,x+y/2,i+1))
    return(z)}}

and checking all values of y between 1500 and 2500 when x=2304, which produces y=1792 as the only value when Arielle loses. The reason behind (?) is that both 2304 and 1792 are divisible by 2⁸, which means no strategy avoids reaching stalemate after 8 steps, when it is Arielle’s turn to play.

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