Re: [R] [R-pkgs] sudoku

From: Henrik Bengtsson <hb_at_maths.lth.se>
Date: Tue 10 Jan 2006 - 03:52:00 EST

I "replied all" to the original message, but since that was to "r-packages@stat.math.ethz.ch" it might not have gone out there, did it?

    If not, below is my reply again. [You have restrict the randomization so that you permute within and between block rows/columns.]

/Henrik

Brahm, David wrote:
> Any doubts about R's big-league status should be put to rest, now that
> we have a
> Sudoku Puzzle Solver. Take that, SAS! See package "sudoku" on CRAN.
>
> The package could really use a puzzle generator -- contributors are
> welcome!

Last summer I put a quick generator together after discussing with some friends how these games a generate (and enumerated). I don't know if it is a correct/complete generator, but consider an empty game with 3x3 grids each with 3x3 cells. Create the initial board by adding 1:9 in the first row, the c(2:9,1), in the second and so on, to make sure you have one correct board. From this you can now generate all(?) other possible boards by permuting rows and columns. You can for instance use a random seed enumerate all such boards. Finally, you want to remove some of cells, which you also can by sampling using known random seeds.

See attached code. Example:

  > source("Sudoku.R")
  > Sudoku$generate()

        [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9]

   [1,]    1   NA    3    4   NA   NA   NA    8   NA
   [2,]    4   NA   NA   NA    8   NA   NA   NA   NA
   [3,]   NA    8   NA    1   NA    3    4    5    6
   [4,]    2   NA   NA   NA   NA   NA   NA   NA    1
   [5,]   NA    6    7   NA   NA   NA    2   NA    4
   [6,]    8   NA   NA   NA   NA   NA   NA    6   NA
   [7,]   NA   NA    5   NA   NA    8    9   NA   NA
   [8,]    6   NA    8    9    1   NA    3   NA   NA
   [9,]   NA    1   NA    3   NA   NA   NA    7    8
  > Sudoku$generate(1)
        [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9]
   [1,]    3   NA    2    5   NA   NA   NA    9   NA
   [2,]    9   NA   NA   NA    3   NA   NA   NA   NA
   [3,]   NA    4   NA    8   NA    7    2    3    1
   [4,]    2   NA   NA   NA   NA   NA   NA   NA    6
   [5,]   NA    3    4   NA   NA   NA    1   NA    9
   [6,]    8   NA   NA   NA   NA   NA   NA    5   NA
   [7,]   NA   NA    9   NA   NA    2    6   NA   NA
   [8,] 7 NA 6 9 1 NA 3 NA NA    [9,] NA 2 NA 6 NA NA NA 1 8   > Sudoku$generate(2)

        [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9]

   [1,]    7   NA    6    1   NA   NA   NA    2   NA
   [2,]    1   NA   NA   NA    3   NA   NA   NA   NA
   [3,]   NA    2   NA    7   NA    5    9    8    1
   [4,]    8   NA   NA   NA   NA   NA   NA   NA    5
   [5,]   NA    9    1   NA   NA   NA    7   NA    8
   [6,]    5   NA   NA   NA   NA   NA   NA    9   NA
   [7,]   NA   NA    5   NA   NA    7    2   NA   NA
   [8,]    9   NA    8    3    2   NA    5   NA   NA
   [9,]   NA    1   NA    6   NA   NA   NA    7    9

/Henrik

> -- David Brahm (brahm@alum.mit.edu)
>
>
> [[alternative HTML version deleted]]
>
> _______________________________________________
> R-packages mailing list
> R-packages@stat.math.ethz.ch
> https://stat.ethz.ch/mailman/listinfo/r-packages
>
> ______________________________________________
> R-help@stat.math.ethz.ch mailing list
> https://stat.ethz.ch/mailman/listinfo/r-help
> PLEASE do read the posting guide!
http://www.R-project.org/posting-guide.html
>
>

roger bos wrote:

> As far as generating a sudoku, it can't be too hard because I have a program
> on my cell phone that does it with a size less than 325K.  I don't know the
> best way to generate these, but one way I was thinking of was starting with
> a filled up one then randomize the columns and rows. Then make some of them
> blank.  The cell-phone version often generates puzzles that have non-unique
> solutions.  Though I admit this is sometimes annoying, it also can make the
> puzzle harder.
> 
> Thanks,
> 
> Roger
> 
> 
> 
> On 1/9/06, Martin Maechler <maechler@stat.math.ethz.ch> wrote:
> 
>>First, "thanks a lot!" to David Brahms for finally tackling this
>>important problem, and keeping the R language "major league" !
>>;-) :-)  {but the "thanks!" is meant seriously!}
>>
>>
>>>>>>>"Detlef" == Detlef Steuer <detlef.steuer@hsu-hamburg.de>
>>>>>>>    on Sun, 8 Jan 2006 12:21:52 +0100 writes:
>>
>>   Detlef> Hey, you spoiled my course!  :-)
>>
>>   Detlef> I planned using this as an excersise.  Alternative
>>   Detlef> ideas anyone ...
>>
>>Well, you could *add* to it:
>>
>>1) When I have been thinking about doing this myself (occasionally
>>in the past weeks), I had always thought that finding *ALL*
>>solutions was a very important property of the algorithm I would
>>want to design.
>>(since this is slightly more general and useful than proofing
>>uniqueness which the current algorithm does not yet do anyway).
>>
>>2) The current sudoku() prints the result itself and returns a
>>  matrix; improved, it should return an object of class "sudoku",
>>  with a print() and a plot() method;
>>3) The plot() method should of course also work for unfinished
>>  "sudoku" objects, and in fact, the *input* to sudoku() should
>>  also be allowed to be a (typically unfinished) "sudoku" object.
>>
>>4) Then you could have your students use "grid" and
>>  grid.locator() for GUI *input* of a sudoku; i.e. you'd have
>>  another function which returns a (typically unfinished)
>>  "sudoku" object.
>>
>>5) You could start looking at *solving* the more general sudokus
>>  where the blocks are not 3x3 squares anymore, but more
>>  general rectangular polygons of 9 squares each.
>>
>>6) Now you need to refine the GUI from "4)" because your users
>>  need to be able to *draw* the block shapes for the
>>  generalized sudokus.
>>
>>7) Given "1)" is solved, the problem of *generating* sudokus,
>>  that David already mentioned in his announcement, becomes
>>  more relevant: You want to be sure that the sudokus you
>>  generate have exactly one solution.  And your generating
>>  algorithm could start with a very full sudoku (that has
>>  exactly 1 solution) and "erases" squares as much as possible,
>>  always checking that no other solution becomes possible.
>>
>>You see, there's lot of interesting exercises left for your
>>course. (;-)
>>
>>Martin
>>
>>   Detlef> On Fri, 6 Jan 2006 11:43:44 -0500 "Brahm, David"
>>   Detlef> <David.Brahm@geodecapital.com> wrote:
>>
>>   >> Any doubts about R's big-league status should be put to
>>   >> rest, now that we have a Sudoku Puzzle Solver.  Take
>>   >> that, SAS!  See package "sudoku" on CRAN.
>>   >>
>>   >> The package could really use a puzzle generator --
>>   >> contributors are welcome!
>>   >>
>>   >> -- David Brahm (brahm@alum.mit.edu)
>>
>>______________________________________________
>>R-help@stat.math.ethz.ch mailing list
>>https://stat.ethz.ch/mailman/listinfo/r-help
>>PLEASE do read the posting guide!
>>http://www.R-project.org/posting-guide.html
>>
> 
> 
> 	[[alternative HTML version deleted]]
> 
> ______________________________________________
> R-help@stat.math.ethz.ch mailing list
> https://stat.ethz.ch/mailman/listinfo/r-help
> PLEASE do read the posting guide! http://www.R-project.org/posting-guide.html
> 
> 


library(R.oo)

setMethodS3("rotate", "default", function(x, steps, ...) {   n <- length(x);
  steps <- steps %% n;
  if (steps == 0)
    return(x);

  partA <- 1:steps;
  partB <- (steps+1):n;
  x[c(partB,partA)];
})

setMethodS3("rotateColumns", "matrix", function(x, steps, ...) {   idx <- rotate(1:ncol(x), steps=steps);   x[,idx];
})

setMethodS3("rotateRows", "matrix", function(x, steps, ...) {   idx <- rotate(1:nrow(x), steps=steps);   x[idx,];
})

setConstructorS3("Sudoku", function(...) {   extend(Object(), "Sudoku");
})

setMethodS3("generate", "Sudoku", function(static, squareId=0, hideId=0, ...) {   # Generate the root square
  X <- matrix(c(

    rotate(1:9,0),
    rotate(1:9,3),
    rotate(1:9,6)

  ), ncol=9, byrow=TRUE)
  X <- rbind(X, rotateColumns(X, 1), rotateColumns(X, 2))

  if (squareId != 0) {
    set.seed(squareId, kind="Mersenne-Twister");

    # Permute rows and columns
    rows <- sapply(1:3, FUN=function(x) sample(3)) + 3*rep(sample(0:2),each=3)     cols <- sapply(1:3, FUN=function(x) sample(3)) + 3*rep(sample(0:2),each=3)     X <- X[rows,cols];
  }   

  # Assert that everything is correct
  for (kk in 1:9) {

    if (any(duplicated(X[kk,])))
      throw("Duplicated elements in row #", kk);
    if (any(duplicated(X[,kk])))
      throw("Duplicated elements in column #", kk);
    if (any(rowSums(X) != 45))
      throw("Some rows does not sum to 45.");
    if (any(colSums(X) != 45))
      throw("Some columns does not sum to 45.");
  }   

  Xtrue <- X;   

  # Empty middle block
  X[4:6,4:6] <- NA;

  set.seed(hideId, kind="Mersenne-Twister");   

  # For the rest of the blocks, keep 3 or 4 elements   for (bb in 1:9) {
    rows <- 1:3 + 3*(bb-1) %/% 3;
    cols <- 1:3 + 3*(bb-1) %% 3;
    Xb <- X[rows,cols];
    Xb[sample(1:9,5)] <- NA;
    X[rows,cols] <- Xb;
  }

  X;
}, static=TRUE)

###########################################################################
# HISTORY:
# 2005-07-10

# o Created.
###########################################################################

______________________________________________

R-help@stat.math.ethz.ch mailing list
https://stat.ethz.ch/mailman/listinfo/r-help PLEASE do read the posting guide! http://www.R-project.org/posting-guide.html Received on Tue Jan 10 04:00:29 2006

This archive was generated by hypermail 2.1.8 : Tue 10 Jan 2006 - 06:24:12 EST