.packageName <- "sudoku"
fetchSudokuUK <- function(day){
  if(missing(day)){
    th <- url('http://www.sudoku.org.uk/DailySudoku.asp')
  } else {
    th <- url(paste('http://www.sudoku.org.uk/DailySudoku.asp?day=',day,sep=''))
  }

  
  tmp <- readLines(th)

  close(th)

  tmp2 <- grep('InnerTDone',tmp,value=TRUE,fixed=TRUE)

  if(length(tmp2) < 81){
    stop('Unable to download full puzzle, did you specify a correct date?\n')
  }

  tmp3 <- regexpr('.</td>$', tmp2)

  vals <- substr(tmp2,tmp3,tmp3)
  vals <- as.numeric( sub('[^1-9]','0',vals) )

  matrix(vals,9,9,byrow=T)
}
generateSudoku <- function(Nblank=50, print.it=FALSE) {
  z <- c(1:9,4:9,1:3,7:9,1:6,2:9,1,5:9,1:4,8:9,1:7,3:9,1:2,6:9,1:5,9,1:8)
  z <- matrix(sample(9)[z], 9,9)
  for (i in 1:5) z <- z[replicate(3, sample(3)) + 3*rep(sample(0:2), each=3),
                        replicate(3, sample(3)) + 3*rep(sample(0:2), each=3)]
  for (bi in seq(0,6,3)) for (bj in seq(0,6,3)) {
    idx <- data.matrix(expand.grid(bi + 1:3, bj + 1:3))
    z[idx[sample(1:9, Nblank%/%9), ]] <- 0
  }
  ## Depopulate (if we had a test for uniqueness, we'd put it here):
  while (sum(!z) < Nblank) z[matrix(sample(9,2), 1)] <- 0
  if (print.it) printSudoku(z)
  z
}
hintSudoku <- function(z, i,j) {
  tmp <- setdiff(1:9, z[i, ])
  if (length(tmp)) {tmp2 <- 1:9; tmp2[-tmp] <- " "} else tmp2 <- " "
  line1 <- paste("row:", paste(tmp2,collapse=" "))
  tmp <- setdiff(1:9, z[ ,j])
  if (length(tmp)) {tmp2 <- 1:9; tmp2[-tmp] <- " "} else tmp2 <- " "
  line2 <- paste("col:", paste(tmp2,collapse=" "))
  if (j < 4) {
    if (i < 4)      tmp <- setdiff(1:9, z[ 1:3, 1:3 ])
    else if (i < 7) tmp <- setdiff(1:9, z[ 4:6, 1:3 ])
    else            tmp <- setdiff(1:9, z[ 7:9, 1:3 ])
  } else if (j < 7) {
    if(i < 4)       tmp <- setdiff(1:9, z[ 1:3, 4:6 ])
    else if (i < 7) tmp <- setdiff(1:9, z[ 4:6, 4:6 ])
    else            tmp <- setdiff(1:9, z[ 7:9, 4:6 ])
  } else {
    if (i < 4)      tmp <- setdiff(1:9, z[ 1:3, 7:9 ])
    else if (i < 7) tmp <- setdiff(1:9, z[ 4:6, 7:9 ])
    else            tmp <- setdiff(1:9, z[ 7:9, 7:9 ])
  }
  if (length(tmp)) {tmp2 <- 1:9; tmp2[-tmp] <- " "} else tmp2 <- " "
  line3 <- paste("grp:", paste(tmp2,collapse=" "))
  paste(line1, line2, line3, "\n", sep="\n")
}
## Original by Greg Snow <Greg.Snow@intermountainmail.org>

playSudoku <- function(z=NULL, hist.len=100, solve=TRUE,
                        display=c("guess","windows","tk"),
                        hscale=1.25, vscale=1.25, ...) {

  dsp <- substring(match.arg(display), 1,1)
  if (dsp=="g") dsp <- switch(getOption("device"), windows="w", "t")
  if (dsp=="t" && !require(tkrplot)) stop("'tkrplot' package needed\n")
  
  if (identical(z,0)) {z <- matrix(0, 9,9); solve <- FALSE}
  if (is.null(z))      z <- generateSudoku(...)
  if (length(z)==1)    z <- readSudoku(z)
  if (solve) {cat("Solving..."); zz <- solveSudoku(z, p=FALSE); cat("done!\n")}
  cols <- ifelse(z, "blue","black")

  hst <- list(z)                   # Keep a history of z's to length "hist.len"
  ah <- function(newz) {hst <<- c(hst, list(newz))
                        if (length(hst) > hist.len) hst <<- hst[-1]}
    
  cusr <- cplt <- rep(0+NA, 4)
  replot <- function() {
    par(mar=c(0,0,0,0), bg="white")
    plot(0.5:9.5, 0.5:9.5, type="n", axes=FALSE, xlab="", ylab="")
    cusr <<- par("usr"); cplt <<- par("plt")
    segments(0.5:9.5, rep(0.5,10), 0.5:9.5, rep(9.5,10), col="grey")
    segments(rep(0.5,10), 0.5:9.5, rep(9.5,10), 0.5:9.5, col="grey")
    segments(c(0,3,6,9)+0.5, rep(0.5,4), c(0,3,6,9)+0.5, rep(9.5,4), lwd=3)
    segments(rep(0.5,4), c(0,3,6,9)+0.5, rep(9.5,4), c(0,3,6,9)+0.5, lwd=3)
    for (i in 1:9) for (j in 1:9) if (z[i,j]) {
      if (cols[i,j]=="red") text(j, 10-i, "X", col="pink", cex=3)
      text(j, 10-i, z[i,j], col=cols[i,j], font=ifelse(cols[i,j]=="blue",2,1),
           cex=ifelse(cols[i,j]=="blue", 2.0, 1.8))
    }
  }

  if (dsp=="t") {
    tt <- tktoplevel()
    tkwm.title(tt,"Sudoku")
    img <- tkrplot(tt, replot, hscale=hscale, vscale=vscale)
    txt <- tktext(tt, bg="white", font="courier")
    scr <- tkscrollbar(tt, repeatinterval=5,
                       command=function(...)tkyview(txt,...))
    tkconfigure(txt, yscrollcommand=function(...)tkset(scr,...))
    tkpack(img, side='top')
    tkpack(txt, side="left", fill="both", expand=TRUE)
    tkpack(scr, side="right", fill="y")
    iw <- as.numeric(tcl('image','width', tkcget(img,'-image')))
    ih <- as.numeric(tcl('image','height',tkcget(img,'-image')))
  }

  showz <- function() switch(dsp, w=replot(), t=tkrreplot(img))
  showz()
  
  cc <- function(x, y) {           # Convert mouse position to cell coordinates
    if (dsp=="t") {x <- (as.real(x)-1)/iw;  y <- 1 - (as.real(y)-1)/ih}
    px <- (x-cplt[1])/(cplt[2]-cplt[1])
    py <- (y-cplt[3])/(cplt[4]-cplt[3])
    ux <- px*(cusr[2]-cusr[1])+cusr[1]
    uy <- py*(cusr[4]-cusr[3])+cusr[3]
    c(10-round(uy), round(ux))
  }
  
  help.txt <- paste(" ?     -- this help",
                    "1-9   -- insert digit",
                    "0,' ' -- clear cell",
                    "r     -- replot the puzzle",
                    "q     -- quit",
                    "h     -- hint/help",
                    "c     -- correct wrong entries (show in red)",
                    "u     -- undo last entry",
                    "s     -- show number in cell",
                    "a     -- show all (solve the puzzle)",
                    "\n", sep="\n")
  type <- function(s) switch(dsp, w=cat(s),
                                  t={tkinsert(txt,'end',s); tksee(txt,'end')})
  ij <- c(5,5)                                                # Initial "point"
  mm.w <- function(buttons, x, y) {ij <<- cc(x,y); return()}
  mm.t <- function(x, y)          {ij <<- cc(x,y); return()}

  kb <- function(A) {
    i <- ij[1];  j <- ij[2]
    z[cols=="red"] <<- 0;  cols[cols=="red"] <<- "black"
    key <- switch(A, " "="0", "/"="?", tolower(A))
    if (key=="q") switch(dsp, t=tkdestroy(tt), w=return(1))
    if (key %in% c(0:9,"h","s") && (i < 1 || i > 9 || j < 1 || j > 9))
      {type("Must be over puzzle cell\n"); return()}
    if (key %in% c("c","s","a") && !solve)
      {type("Solution not available\n"); return()}
    if (key %in% c(0:9,"c","s","a")) ah(z)
    if (key %in% 0:9) {z[i,j] <<- as.real(key);  cols[i,j] <<- "black"}
    if (key=="?") type(help.txt)
    if (key=="h") type(hintSudoku(z, i,j))
    if (key=="c") {cols[z != 0 & z != zz] <<- "red"
                   if (!any(cols=="red")) {type("All Correct\n"); return()}}
    if (key=="u") {h <- length(hst); z <<- hst[[h]]; if (h>1) hst <<- hst[-h]}
    if (key=="s") {z[i,j] <<- zz[i,j];  cols[i,j] <<- "green3"}
    if (key=="a") {cols[z != zz] <<- "green3";  z <<- zz}
    if (key %in% c(0:9,"r","c","u","s","a")) showz()
    if (solve && all(z==zz)) type("You got it!\n")
    return()
  }    

  kb("?")
  if (solve && is.null(zz)) {type("Puzzle not solvable.\n"); solve <- F}
  switch(dsp, w=getGraphicsEvent("Ready!", onMouseMove=mm.w, onKeybd=kb),
              t={tkbind(img,'<Motion>',mm.t); tkbind(tt,'<Key>',kb);
                 tkwait.window(tt)})
  return(invisible(z))
}
printSudoku <- function(z) {
  z[z==0] <- " "
  for (r in 0:9) {
    if (r > 0) cat("  |", z[r,1:3], "|", z[r,4:6], "|", z[r,7:9], "|\n")
    if (r %% 3 == 0) cat("  +-------+-------+-------+\n")
  }
}
readSudoku <- function(fn, map=c(1:9,letters)) {
  z <- scan(fn, "", quiet=TRUE)
  z <- do.call(rbind, strsplit(z, ""))
  matrix(match(z, map, 0), nrow(z))
}
solveSudoku <- function(z, verbose=FALSE, map=c(1:9,letters), level=0,
                        print.it=TRUE) {
  if (length(z)==1) z <- readSudoku(z, map)
  N <- nrow(z);  Ns <- sqrt(N)                              # Traditionally N=9
  oldngot <- sum(z > 0)
  if (verbose) cat("Known:", oldngot, ", level:", level, "\n")
  isok <- TRUE
  a <- array(NA, c(N,N,N))                       # T=this num, F=not this, NA=?
  fill <- function(i, j, k, txt="") {
    if (length(i)!=1 || length(j)!=1 || length(k)!=1) {isok<<-FALSE; return()}
    if (verbose && txt != "") cat(i, j, "=", k, txt, "\n")
    z[i,j] <<- k
    ain <- a
    a[ i, j,  ] <<- seq(1:N)==k
    a[ i,-j, k] <<- FALSE                         # No other k's in this row
    a[-i, j, k] <<- FALSE                         # No other k's in this column
    for (ii in Ns*((i-1) %/% Ns) + 1:Ns) for (jj in Ns*((j-1) %/% Ns) + 1:Ns)
      if (!(ii==i && jj==j)) a[ii,jj, k] <- FALSE # No other k's in this box
    if (any(a != ain, na.rm=TRUE)) isok <<- FALSE   # You turned a T into an F!
  }
  for (i in 1:N) for (j in 1:N) if (k <- z[i,j]) fill(i, j, k)

  repeat {
    for (i in 1:N) for (j in 1:N)      # Check each cell for only 1 possibility
      if (sum(!a[i,j, ], na.rm=TRUE)==N-1 & sum(a[i,j, ], na.rm=TRUE)==0)
        fill(i, j, which(is.na(a[i,j, ])), "by elimination")
    for (k in 1:N) {                # Now explore each digit (a[ , ,k]) in turn
      for (i in which(rowSums(!a[ , ,k],TRUE)==N-1 & !rowSums(a[ , ,k],TRUE)))
        fill(i, which(is.na(a[i, ,k])), k, "each row has a k")
      for (j in which(colSums(!a[ , ,k],TRUE)==N-1 & !colSums(a[ , ,k],TRUE)))
        fill(which(is.na(a[ ,j,k])), j, k, "each col has a k")
      for (bi in seq(0, N-Ns, Ns)) for (bj in seq(0, N-Ns, Ns)) {
        idx <- cbind(data.matrix(expand.grid(bi + 1:Ns, bj + 1:Ns)), k)
        if (sum(!a[idx], na.rm=TRUE)==N-1 && sum(a[idx], na.rm=TRUE)==0) {
          m <- which(is.na(a[idx]))
          fill(idx[m,1], idx[m,2], idx[m,3], "each box has a k")
        }
      }
    }

    if (!isok) {if (verbose) cat("Inconsistent level", level, "\n"); return()}
    ngot <- sum(z > 0)
    if (verbose) cat("Known:", ngot, ", level:", level, "\n\n")
    if (ngot==N^2) {
      if (print.it) print(matrix(map[z],N), quote=FALSE, right=TRUE)
      return(invisible(z))
    }
    if (ngot==oldngot) {                               # Failed.  Take a guess!
      poss <- rowSums(is.na(a), ,2)                # Number of possible guesses
      if (!any(poss)) {if (verbose) cat("No possibilities left\n"); return()}
      ij <- which(poss == min(setdiff(poss,0)), TRUE)[1, ]
      k <- which(is.na(a[ij[1], ij[2], ]))[1]              # 1st possible guess
      if (verbose) cat("Guessing:", ij[1], ij[2], "=", k, "\n")
      zg <- z
      zg[ij[1], ij[2]] <- k
      res <- Recall(zg, verbose, map, level+1, print.it)
      if (is.null(res)) a[ij[1], ij[2], k] <- FALSE else return(invisible(res))
    }
    oldngot <- ngot
  }
}
writeSudoku <- function(z, fn) {
  z[z==0] <- "-"
  cat(t(z), file=fn, sep=c(rep.int("", ncol(z)-1), "\n"))        # From "write"
}
