During my holiday I decided to implement a solver for those puzzles my girlfriend likes to do. They are called [Takuzu][1], but "binero" in Dutch. The puzzle gives you a grid in which you have to fill in either a 1 or a 0. The constraints are the following: 1. No 3 adjacentvalues may be the same in a row or column 2. No two rows may be equal 3. No two columns may be equal My first attempt to solve this was using a brute force approach. Yesterday, inspired by Peter Norvig's Sudoku solver I tried it in a more smart way. I have a function that takes a grid, which is represented as a list of lists, and tries to fill in all the values that are 100% to be a 1 or a 0. This can be determines by finding all pairs of 0's or 1's. E.g., the example below allows us to fill in a 1 at position `a1` and `d1` because we would otherwise create a sequence of 3 or 4 0's. This function is then applied in a fixpoint fashion until the input is the same as the output. At which point, it seemed, that all bineros are solved. I have a test batch of 590 inputs from around the web along with their solution. a b c d 1. x 0 0 x 2. x x x x 3. x x x x #The solver: #lang racket (provide solve) ;; Defines the variable we us as empty. (define x 'x) ;; Check if a given value is an unknown. (define (unknown? x) (equal? x 'x)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;; INDEXING ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Returns the value on the given position, false if the position is invalid. (define (get binero coords) (let ((dim (length binero)) (x (car coords)) (y (cdr coords))) (if (or (> 0 x) (> 0 y) (<= dim x) (<= dim y)) #f (list-ref (list-ref binero (cdr coords)) (car coords))))) ;; Updates the value at the given position (non-destructive). ;; Does not update if position is invalid. (define (binero-set! binero coords value) (define (list-replace lst nth value) (cond ((null? lst) lst) ((eq? 0 nth) (cons value (cdr lst))) (else (cons (car lst) (list-replace (cdr lst) (- nth 1) value))))) (let ((x (car coords)) (y (cdr coords))) (cond ((null? binero) binero) ((eq? 0 y) (cons (list-replace (car binero) (car coords) value) (cdr binero))) (else (cons (car binero) (binero-set! (cdr binero) (cons (car coords) (- (cdr coords) 1)) value)))))) ;;; (0,0) is top left corner. (define (left-of coord) (cons (- (car coord) 1) (cdr coord))) (define (right-of coord) (cons (+ (car coord) 1) (cdr coord))) (define (top-of coord) (cons (car coord) (- (cdr coord) 1))) (define (below-of coord) (cons (car coord) (+ (cdr coord) 1))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;; HELPERS ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Prints a binero with each row on a new line. (define (display-binero binero) (if (not (or (equal? #f binero) (null? binero))) (begin (display (car binero)) (newline) (display-binero (cdr binero))) '())) (define (certain-value binero coord) (let* ((curr (get binero coord)) (left (get binero (left-of coord))) (lleft (get binero (left-of (left-of coord)))) (right (get binero (right-of coord))) (rright (get binero (right-of (right-of coord)))) (above (get binero (top-of coord))) (aabove (get binero (top-of (top-of coord)))) (below (get binero (below-of coord))) (bbelow (get binero (below-of (below-of coord))))) (cond ;; Already filled in. ((not (unknown? curr)) curr) ;; Two left values are the same. ((and (eq? lleft left) (member left '(1 0))) (abs (- left 1))) ;; Two right values are the same. ((and (eq? rright right) (member right '(1 0))) (abs (- right 1))) ;; Two top values are the same. ((and (eq? above aabove) (member above '(1 0))) (abs (- above 1))) ;; Two bottom values are the same. ((and (eq? below bbelow) (member below '(1 0))) (abs (- below 1))) ;; Bottom and top are the same. ((and (eq? below above) (member below '(1 0))) (abs (- below 1))) ;; Left and right are the same. ((and (eq? left right) (member left '(1 0))) (abs (- left 1))) (else curr)))) (define (solve-certainties binero) (let ((dim (length binero))) (let row-loop ((y 0) (b binero)) (if (< y dim) (let col-loop ((x 0) (bb b)) (if (< x dim) (let* ((coords (cons x y)) (new-value (certain-value bb coords)) (new-binero (binero-set! bb coords new-value))) (col-loop (+ x 1) new-binero)) (row-loop (+ y 1) bb))) b)))) (define (solve binero) (let ((pass (solve-certainties binero))) (if (equal? pass binero) pass (solve pass)))) # Specific questions Do you think it would be faster to represent the grid in any other way? I had tried to make the `certain-value` cleaner by inputting the binero and then transposing it. This way I only had to check row-wise combinations eac time and it halves the conditional. Can you give me pointers on how to make this program a bit more dense yet readable? In general I would like some feedback on the quality of the code, and perhaps how I can make it faster. [1]: https://en.wikipedia.org/wiki/Takuzu