Want to share your content on R-bloggers? click here if you have a blog, or here if you don't.
So I reprogrammed an R code following (as much as possible) their scheme. However, I do not get a better behaviour than with my earlier code, and certainly no solution within seconds, if any. For instance, the temperature decrease in 100(.99)t seems too steep to manage 105 steps. So, either I am missing a crucial element in the code, or my R code is very poor and clever Fortran programming does the trick! Here is my code
target=function(s){ tar=sum(apply(s,1,duplicated)+apply(s,2,duplicated)) for (r in 1:9){ bloa=(1:3)+3*(r-1)%%3 blob=(1:3)+3*trunc((r-1)/3) tar=tar+sum(duplicated(as.vector(s[bloa,blob]))) } return(tar) } cost=function(i,j,s){ #constraint violations in cell (i,j) cos=sum(s[,j]==s[i,j])+sum(s[i,]==s[i,j]) boxa=3*trunc((i-1)/3)+1; boxb=3*trunc((j-1)/3)+1; cos+sum(s[boxa:(boxa+2),boxb:(boxb+2)]==s[i,j]) } entry=function(){ s=con pop=NULL for (i in 1:9) pop=c(pop,rep(i,9-sum(con==i))) s[s==0]=sample(pop) return(s) } move=function(tau,s,con){ pen=(1:81) for (i in pen[con==0]){ a=((i-1)%%9)+1 b=trunc((i-1)/9) pen[i]=cost(((i-1)%%9)+1,trunc((i-1)/9),s) } wi=sample((1:81)[con==0],2,prob=exp(pen[(1:81)[con==0]])) prop=s prop[wi[1]]=s[wi[2]] prop[wi[2]]=s[wi[1]] if (runif(1)<exp((target(s)-target(prop)))/tau) s=prop return(s) } #Example: s=matrix(0,ncol=9,nrow=9) s[1,c(1,6,7)]=c(8,1,2) s[2,c(2:3)]=c(7,5) s[3,c(5,8,9)]=c(5,6,4) s[4,c(3,9)]=c(7,6) s[5,c(1,4)]=c(9,7) s[6,c(1,2,6,8,9)]=c(5,2,9,4,7) s[7,c(1:3)]=c(2,3,1) s[8,c(3,5,7,9)]=c(6,2,1,9) con=s tau=100 s=entry() for (t in 1:10^4){ for (v in 1:100) s=move(tau,s,con) tau=tau*.99 if (target(s)==0) break() }
Filed under: Books, pictures, R, Statistics, University life Tagged: C, Colosseo, Fortran 95, R, Roma, simulated annealing, sudoku, temperature
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.