Scheme, N-queens SICP Optimization Strategies Chapter 2

Question

SICP contains a partially complete example of n-queens solutions, strolling through the tree of all possible queen placements on the last line, creating more possible positions on the next line to combine the results so far, filtering only those where the new queen is safe and repeats recursively.

This strategy explodes after n = 11 with a maximum recursion error.

I implemented an alternative strategy that makes a more reasonable tree-like walk from the first column, generating possible positions from the list of unused rows, each of which occupies a list of positions in the updated list of unused rows. Filtering these pairs is considered safe and recursively displays these pairs for the next column. This does not explode (yet), 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 are less naive and go well with a functional approach.

Answer 1

I can offer you a simplification of your code, so it can work a little faster. Let's start by renaming some variables to improve 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 gd) == flatmap (\x->let y=gx in [y|fy]) d (using the Haskell syntax bit), that is, we can merge map and 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? kp) (list (cons pd)) ()))) domain)) 

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

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

therefore simplified code

 (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)))) 

Answer 2

This is what I came up with for the second time. Not sure if this is much faster. A little more beautiful.

 (define (n-queens n) (let loop ((k 1) (r 1) (dangers (starting-dangers n)) (res '()) (solutions '())) (cond ((> kn) (cons res solutions)) ((> rn) solutions) ((safe? rk dangers) (let ((this (loop (+ k 1) 1 (update-dangers rk dangers) (cons (cons rk) res) solutions))) (loop k (+ r 1) dangers res this))) (else (loop k (+ r 1) dangers res solutions))))) 

The big thing is to use the let statement to serialize the recursion, limiting the depth to n. The solutions go back (maybe you can fix it by going n-> 1 instead of 1-> n to r and k), but the back set is the same set as the set frowards.

 (define (starting-dangers n) (list (list) (list (- n)) (list (+ (* 2 n) 1)))) ;;instead of terminating in null list, terminate in term that cant threaten 

a slight improvement, the danger can come from a row, diagonal or diagonal up, follow each as the board develops.

 (define (safe? rk dangers) (and (let loop ((rdangers (rdang dangers))) (cond ((null? rdangers) #t) ((= r (car rdangers)) #f) (else (loop (cdr rdangers))))) (let ((ddiag (- kr))) (let loop ((ddangers (ddang dangers))) (if (<= (car ddangers) ddiag) (if (= (car ddangers) ddiag) #f #t) (loop (cdr ddangers))))) (let ((udiag (+ kr))) (let loop ((udangers (udang dangers))) (if (>= (car udangers) udiag) (if (= (car udangers) udiag) #f #t) (loop (cdr udangers))))))) 

average improvement in format change, you only need to make one comparison to check against the previous two. Don’t think that ordered diagonals sorted me, it cost me nothing, but I don’t think it saves time either.

 (define (update-dangers rk dangers) (list (cons r (rdang dangers)) (insert (- kr) (ddang dangers) >) (insert (+ kr) (udang dangers) <))) (define (insert x sL pred) (let loop ((L sL)) (cond ((null? L) (list x)) ((pred x (car L)) (cons x L)) (else (cons (car L) (loop (cdr L))))))) (define (rdang dangers) (car dangers)) (define (ddang dangers) (cadr dangers)) (define (udang dangers) (caddr dangers))