Search code examples
lispschemesicpmit-schemen-queens

Scheme, N-queens optimization strategies SICP chapter 2


SICP contains an partially complete example of the n-queens solutions, by walking a tree of every possible queen placement in the last row, generating more possible positions in the next row to combine the results so far, filtering the possibilities to keep only ones where the newest queen is safe, and repeating recursively.

This strategy blows up after about n=11 with a maximum recursion error.

I've implemented an alternate strategy that does a smarter tree-walk from the first column, generating possible positions from a list of unused rows, consing each position-list onto an updated list of yet-unused rows. Filtering those pairs considered safe, and recursively mapping over these pairs for the next column. This doesn't blow up (so far) but n=12 takes a minute and n=13 takes about 10 minutes to solve.

(define (queens board-size)
 (let loop ((k 1) (pp-pair (cons '() (enumerate-interval 1 board-size))))
   (let ((position (car pp-pair))
         (potential-rows (cdr pp-pair)))
    (if (> k board-size) 
        (list position)
        (flatmap (lambda (pp-pair) (loop (++ k) pp-pair)) 
         (filter (lambda (pp-pair) (safe? k (car pp-pair))) ;keep only safe
          (map (lambda (new-row) 
                (cons (adjoin-position new-row k position) 
                      (remove-row new-row potential-rows))) ;make pp-pair
           potential-rows))))))) 
;auxiliary functions not listed 

Not really looking for code, but a simple explanation of a strategy or two that's less naive and that clicks well with a functional approach.


Solution

  • I can offer you a simplification of your code, so it may run a little bit faster. We start by renaming some variables for improved readability (YMMV),

    (define (queens board-size)
     (let loop ((k 1) 
                (pd (cons '() (enumerate-interval 1 board-size))))
       (let ((position (car pd))
             (domain   (cdr pd)))
        (if (> k board-size) 
            (list position)
            (flatmap (lambda (pd) (loop (1+ k) pd)) 
             (filter (lambda (pd) (safe? k (car pd))) ;keep only safe NewPositions
              (map (lambda (row) 
                    (cons (adjoin-position row k position)  ;NewPosition
                          (remove-row row domain))) ;make new PD for each Row in D
                   domain)))))))                            ; D
    

    Now, filter f (map g d) == flatmap (\x->let {y=g x} in [y | f y]) d (using a bit of Haskell syntax there), i.e. we can fuse the map and the filter into one flatmap:

            (flatmap (lambda (pd) (loop (1+ k) pd)) 
             (flatmap (lambda (row)                   ;keep only safe NewPositions
                   (let ( (p (adjoin-position row k position))
                          (d (remove-row row domain)))
                     (if (safe? k p) 
                         (list (cons p d)) 
                         '())))
                domain)) 
    

    then, flatmap h (flatmap g d) == flatmap (h <=< g) d (where <=< is right-to-left Kleisli composition operator, but who cares), so we can fuse the two flatmaps into just one, with

            (flatmap 
                (lambda (row)                         ;keep only safe NewPositions
                    (let ((p (adjoin-position row k position)))
                      (if (safe? k p)
                        (loop (1+ k) (cons p (remove-row row domain)))
                        '())))
                domain)
    

    so the simplified code is

    (define (queens board-size)
     (let loop ((k        1) 
                (position '())
                (domain   (enumerate-interval 1 board-size)))
        (if (> k board-size) 
            (list position)
            (flatmap 
                (lambda (row)                         ;use only the safe picks
                  (if (safe_row? row k position)      ;better to test before consing
                    (loop (1+ k) (adjoin-position row k position)
                                 (remove-row row domain))
                    '()))
                domain))))