Le Monde puzzle [52]

[This article was first published on Xi'an's Og » R, and kindly contributed to R-bloggers]. (You can report issue about the content on this page here)
Want to share your content on R-bloggers? click here if you have a blog, or here if you don't.

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!

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)
 }

Filed under: R, Statistics Tagged: simulated annealing, sudoku

To leave a comment for the author, please follow the link and comment on their blog: Xi'an's Og » R.

R-bloggers.com offers daily e-mail updates about R news and tutorials about learning R and many other topics. Click here if you're looking to post or find an R/data-science job.
Want to share your content on R-bloggers? click here if you have a blog, or here if you don't.

Never miss an update!
Subscribe to R-bloggers to receive
e-mails with the latest R posts.
(You will not see this message again.)

Click here to close (This popup will not appear again)