Le Monde puzzle [52]

The last puzzle of the year in Le Monde reads as follows (as far as I understand its wording!):

Iter(n,x,y) is the function

Iter=function(n,x,y){

 if (n==1){
 output=trunc(y/10)+x*(y%%10)
 }else{
 output=Iter(n-1,x,Iter(1,x,y))}

 return output
 }

Find the seven-digit number z such that
Iter(6,1,z)=12, Iter(6,2,z)=19, Iter(6,3,z)=29,
and Iter(6,-1,z)=Iter(6,-2,z)=Iter(6,-3,z)=0.

Obviously, the brute-force solution of listing all 90 million seven digit numbers until the six constraints are met is feasible (especially around New Year since the mainframe computer is completely at rest!). However, this sounds like the last resort solution and I thus tried first a simulated annealing approach already tested for the sudoku problem a few years ago… (This puzzle is actually of the same nature as the sudoku problem,  in particular because we do know when we find the solution, except that checking for the six conditions to hold is apparently not so straightforward. For us if not for the computer.)

I thus wrote the following R code:

chick=function(sol){

 y=sum(sol*10^(6:0))

 abs(Iter(6,1,y)-12)+abs(Iter(6,2,y)-19)+abs(Iter(6,3,y)-29)+
 abs(Iter(6,-1,y))+abs(Iter(6,-2,y))+abs(Iter(6,-3,y))
 }

Zearch=function(Niter=10^4,initemp=1){

 temp=initemp/log(1+(1:Niter))^2

 sol=topsol=sample(0:9,7,rep=TRUE)
 val=topval=chick(sol)

 for (t in 1:Niter){

 propind=sample(1:7,1)
 propsol=matrix(sol,byrow=TRUE,nrow=10,ncol=7)
 propsol[,propind]=0:9
 propval=apply(propsol,1,chick)

 if (min(propval)

 topsol=propsol[order(propval)[1],];topval=min(propval)
 }

 movind=sample(1:10,1,prob=exp((val-propval)/temp[t]))
 sol=propsol[movind,];val=propval[movind]

 print(c(sol,val))

 if (val==0) break()
 }

 list(time=t,vale=topval,arg=topsol)
 }

where the second argument in Zearch is the scale for the starting temperature… Note that this is not a blind simulated annealing scheme in that we compare all possible moves once a digit has been randomly chosen. As the temperature decreases we are thus more and more likely to pick the most interesting digit (in terms of the criterion). Running the code for 100,000 iterations and a starting scale of 1000 produced a “solution” 9,552,774 that only differed from the targeted value by 1, since Iter(6,2,9552774)=20. And again for 106 iterations with another “solution”, 6,097,917. Obviously, just as for the sudoku problem, this “close solution” has a priori no connection with the exact solution! Running six parallel copies of the program on the main frame eventually produced (twice) the exact solution, y=3945711, over 106 iterations.

It is also interesting to compare the simulated annealing solution with a deterministic search, which always gets stuck in local minima:

Dearch=function(Niter=10^2){

 sol=topsol=sample(0:9,7,rep=TRUE)
 val=topval=chick(sol)

 for (t in 1:Niter){

 perm=sample(1:7)

 for (j in 1:7){

 propind=perm[j]
 propsol=matrix(sol,byrow=TRUE,nrow=10,ncol=7)
 propsol[,propind]=0:9
 propval=apply(propsol,1,chick)

 if (min(propval)<topval){

 topsol=propsol[order(propval)[1],];topval=min(propval)
 }

 sol=propsol[order(propval)[1],];val=min(propval)
 }

 print(c(t,sol,val))

 if (val==0) break()
 }

 list(time=t,vale=topval,arg=topsol)
 }

3 Responses to “Le Monde puzzle [52]”

  1. [...] I have now received the first issue of Le Monde magazine, including the solution to puzzle #52 I solved just in time by simulated annealing! The trick is in using the following theorem: [...]

  2. Berend Hasselman Says:

    This puzzle can be solved quite quickly.
    The function Iter exhibits tail recursion which can be removed.
    There is no need to compute all required Iter() calls before checking the required conditions.
    The calls Iter(6,1,z), Iter(6,2,z) and Iter(6,3,z) can be vectorized. Same for the other 3 conditions.

    So I did this:

    mIteru <- function(n,y) {
    z <- rep(y,3)
    s <- c(1,2,3)
    for(k in 1:n) {
    z <- trunc(z/10) + (z%%10)*s
    }
    return(z)
    }

    mIterv <- function(n,y) {
    z <- rep(y,3)
    s <- c(1,2,3)
    for(k in 1:n) {
    z <- trunc(z/10) – (z%%10)*s
    }
    return(z)
    }

    tb <- proc.time()

    # for recording all numbers that satisfy the first 3 conditions of the puzzle
    zsuc <- numeric(10000000)
    p <- 0
    for(z in 1000000:9999999) {
    if( all(mIteru(6,z) == c(12,19,29)) ) {p <- p+1; zsuc[p] <- z}
    }
    print(p)
    zsuc[1:p]

    # the second set of conditions only needs to be checked for numbers that passes the first test
    zfin <- numeric(p)
    q <- 0
    for(k in 1:p) {
    if( all(mIterv(6,zsuc[k]) == c(0,0,0)) ) {q <- q+1; zfin[q] <- zsuc[k]}
    }
    print(q)
    zfin[1:q]

    proc.time()-tb

    On my MacBookPro 13" 2010 (C2D 2.4Ghz) using R 2.12.1 (64-bit) on Mac OS X 10.6.5 this took 242.6 seconds.
    The answer is 3945711.

    I wouldn't be surprised if this can be speeded up more.

    Berend

    • Thanks for your solution and code, Berend! I am quite aware my proposal is brute-force resolution and I am looking forward the solution provided in Le Monde as it will not involve any computing. In addition, your R code showed me how to bypass multiple testing, through the all() function, something I had been looking for for a long long while…

Leave a Reply

Fill in your details below or click an icon to log in:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out / Change )

Twitter picture

You are commenting using your Twitter account. Log Out / Change )

Facebook photo

You are commenting using your Facebook account. Log Out / Change )

Google+ photo

You are commenting using your Google+ account. Log Out / Change )

Connecting to %s

Follow

Get every new post delivered to your Inbox.

Join 598 other followers