123 Sudoku Solver in R

First edit the Sudoku grid below in order to solve your own puzzle. Note `0' means missing value. Please edit carefully - you need to keep the commas here!

Then press Go! (once only) Be patient, a new screen appears with `R' at the top and WAIT until it says `Program Output' (you need to wait several seconds or longer).

then scroll to the end of the page to see three plots: the puzzle, the number of possibilities for each cell, and the solution. This program is written in R and makes use of the Rcgi web interface . The software is free.

Details of the backtracking algorithm are given below (after the code).

input<-c(###################R-Sudoku ################################# ############# when running... be patient and WAIT!!!################## # First edit the Sudoku grid below. Note `0' means missing value. # Please edit carefully - you need to keep the commas here! # Then press Go! (once only) Be patient, a new screen appears with `R' # at the top and WAIT until it says `Program Output' # (you need to wait several seconds or longer) # Then scroll down to see the solution. ############################## 4, 3, 0, 0, 1, 0, 0, 8, 9, 6, 0, 0, 9, 0, 8, 0, 0, 1, 0, 0, 1, 0, 0, 0, 2, 0, 0, ############################## 0, 4, 0, 3, 0, 7, 0, 9, 0, 8, 0, 0, 0, 2, 0, 0, 0, 3, 0, 5, 0, 1, 0, 9, 0, 4, 0, ############################## 0, 0, 8, 0, 0, 0, 6, 0, 0, 5, 0, 0, 8, 0, 4, 0, 0, 7, 2, 7, 0, 0, 3, 0, 0, 1, 8, ############################## ## This particular puzzle is from the Guardian 11/10/05 (Easy) 0) ########### This program is written in R - see cran.r-project.org ########### GPL 2 Licence - comes with absolutely no warranty! ########### Beta version - not fully tested ########### No attempt has been made to speed this up ########### requires input files with Sudoku grids as integers ########### with 0 representing a missing value. ########### Attempts to solve a Sudoku puzzle, but ########### It doesn't check ########### for more than one solution. ########### www.123sudoku.com ########### preliminary functions check<-function(xw,i,j,c){ out<-TRUE if (sum(xw[i,]==c)>0) out<-FALSE if (sum(xw[,j]==c)>0) out<-FALSE r1<-neighr(i,j) r2<-neighc(i,j) if (sum(xw[r1,r2]==c)>0) out<-FALSE out } checktrue<-function(xw,i,j){ out<-TRUE c<-xw[i,j] if (sum(xw[i,]==c)>1) out<-FALSE if (sum(xw[,j]==c)>1) out<-FALSE r1<-neighr(i,j) r2<-neighc(i,j) if (sum(xw[r1,r2]==c)>1) out<-FALSE out } neighr<-function(i,j){ if (i < 4) neighr<-c(1,2,3) if ((i>3)&(i<7)) neighr<-c(4,5,6) if (i>6) neighr<-c(7,8,9) neighr } neighc<-function(i,j){ if (j < 4) neighc<-c(1,2,3) if ((j>3)&(j<7)) neighc<-c(4,5,6) if (j>6) neighc<-c(7,8,9) neighc } numcheck<-function(xw,i,j){ avail<-rep(0,times=9) sum<-0 if (xw[i,j]==0){ for (k in 1:9){ if (check(xw,i,j,k)==TRUE) { sum<-sum+1 avail[sum]<-k } } } out<-list(n=0,avail=0) out$n<-sum out$avail<-avail out } nposs<-function(xw){ ir<-1 ic<-1 z<-array(0,c(9,9,9)) count<-matrix(0,9,9) for (i in 1:9){ for (j in 1:9){ a<-numcheck(xw,i,j) z[i,j,]<-a$avail count[i,j]<-a$n } } out<-list(count=0,z=0) out$count<-count out$z <- z out } sweep<-function(x){ xw<-x ww<-nposs(xw) low<-ww$z[,,1] for (i in 1:9){ for (j in 1:9){ if (ww$count[i,j]==1) {xw[i,j]<-low[i,j] ww<-nposs(xw) low<-ww$z[,,1] } } } xw } ########################################## ############plot a sudoku grid############################## plotsudoku <- function(x){ x<-t(x) par(pty="s") plot(c(0,0),xlim=c(0,10),ylim=c(0,10),axes=FALSE,type="n",xlab=" ",ylab=" ") for (i in 1:9){ for (j in 1:9){ if (x[i,j]!=0){ text(i,10-j,as.character(x[i,j]),cex=2) } lines(c(i-0.5,i+0.5,i+0.5,i-0.5,i-0.5),c(10-j-0.5,10-j-0.5,10-j+0.5,10-j+0.5,10-j-0.5),col="grey") } } for (i in 1:3){ for (j in 1:3){ lines(c(3*i-2.5,3*i+0.5,3*i+0.5,3*i-2.5,3*i-2.5),c(10-3*j-0.5,10-3*j-0.5,10-3*j+2.5,10-3*j+2.5,10-3*j-0.5),col=1,lwd=2) } } } ###### function to eliminate all values where there is just ###### one possible value ###### this will usually solve it for an easy grid elim<-function(x){ sum<-0 flag<-FALSE xw<-x oldn<-sum(xw==0) while (flag==FALSE){ sum<-sum+1 cat(c("iteration",sum,"\n")) xw<-sweep(xw) numbertodo<-sum(xw==0) if (oldn==numbertodo) flag<-TRUE oldn<-numbertodo cat(c("number to do",numbertodo,"\n")) if (numbertodo==0) flag<-TRUE } xw } initialcheck<-function(x){ ans<-TRUE test<-TRUE for (i in 1:9){ for (j in 1:9){ if (x[i,j]!=0) test<-checktrue(x,i,j) if (test==FALSE) ans<-FALSE } } ans } ####################function to carry out a backtracking ####################algorithm sudokusolver<-function(x){ xw<-x ncand<-sum(xw==0) xc<-rep(0,times=ncand) yc<-xc maxtry<-xc sum<-0 a<-nposs(x) print("No of possibilities for each space") print(a$count) for (i in 1:9){ for (j in 1:9){ if (xw[i,j]==0){ sum<-sum+1 xc[sum]<-i yc[sum]<-j maxtry[sum]<-a$count[i,j] } } } try<-rep(1,times=ncand) STOP<-FALSE cn<-1 while (STOP==FALSE){ ans<-check(xw,xc[cn],yc[cn],a$z[xc[cn],yc[cn],try[cn]]) if (ans==TRUE){ xw[xc[cn],yc[cn]]<-a$z[xc[cn],yc[cn],try[cn]] cn<-cn+1 } else { try[cn]<-try[cn]+1 if (try[cn]>maxtry[cn]){ xw[xc[cn],yc[cn]]<-0 cn <- cn-1 try[cn+1]<-1 if (cn==1) print(c("back to square 1",try[1])) } } if (sum(xw==0)==0) { print("DONE IT!") STOP<-TRUE } if (cn==0){ print("No solution") STOP<-TRUE } } xw } sudodistance<-function(x1,x2){ sum(x1==x2) } ############################################################################ ###################### main part of program ################################################################## x<-input[1:81] x<-t(matrix(x,9,9)) plotsolve<-function(x){ par(mfrow=c(2,2)) plotsudoku(x) title("Puzzle") if (initialcheck(x)==FALSE){ print("Not a Sudoku grid!!") } if (initialcheck(x)==TRUE){ #fill in any obvious missing values with one just candidate #y2<-elim(x) #if (sum(y2==0)!=0){ #use a backtracking algorithm if not solved yet #y1<-sudokusolver(y2) #y2<-y1 #} a<-nposs(x)$count plotsudoku(a) title("Number of possibilties per square") y2<-sudokusolver(x) #print out the solution plotsudoku(y2) title("Solution") #NB you'll probably need to resize the graphics ## window (make it bigger!!) y2 } } y<-plotsolve(x) print("The Sudoku grid - nb 0 = missing") print(x) print("The solution") print(y) plot(c(0,0),c(1,1),xlim=c(0,10),ylim=c(0,10),xlab=" ",ylab=" ",type="n",axes=FALSE) text(5,5," Your puzzle, help + solution") ############################################################

Details of the program

It is reasonably easy to write a program to solve Sudoku using a backtracking algorithm.

What is the back-tracking algorithm?

1. First of all check each square in turn for the number of possible numbers that could be in that position, by eliminating the other numbers that are given in the same row, column and 3x3 grid.

2. Then starting at the first unknown square we'll try with the lowest available number that is allowed.

3.Move on to the next square then we'll try with the lowest available number...and keep doing this.

4. If you hit a problem and there are no available numbers then move back a square [i.e. you must `back-track'], and increase that digit to be the next lowest available number. Go to step 3.

5. Eventually you should pass through all the squares in the grid - and `voila' you have the solution!

Note you may end up having to back-track all the way back to the beginning several times! However, a computer can do this easily and reasonably quickly.

We wrote this program in R fairly quickly and it seems to do the job. Making it work faster is more of a challenge - that's left for another day. Also, working out how many solutions a Sudoku grid has is not so straightforward - again on the back burner for now.

If you're interested in using this more than a few times then you ought to download R (see cran.r-project.org ) and install it on your machine (it's free!), then source in this R code . There is absolutely no warranty and the Licence is GPL2. We should warn you that you probably need to be familiar with R to do this - or at least be a bit of a boffin. There's another challenge for you!

One nice by-product is that the program gives you the number of possibilities at the outset for each square, which can be a helpful way to start a difficult puzzle if you're stuck.

All puzzles on this site have been checked using this program.