Схема, стратегии оптимизации N-ферзей, глава 2 SICP

Я могу предложить вам упрощение вашего кода, чтобы он работал немного быстрее. Начнем с переименования некоторых переменных для улучшения читаемости (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

Теперь filter f (map g d) == flatmap (\x->let {y=g x} in [y | f y]) d (используя там немного синтаксиса Haskell), т.е. мы можем объединить map и filter в один 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)) 

затем flatmap h (flatmap g d) == flatmap (h <=< g) d (где <=< - оператор композиции Клейсли с направлением справа налево, но кого это волнует), чтобы мы могли объединить два flatmap в один, с

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

поэтому упрощенный код

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

Вот что я придумал во второй раз. Хотя не уверен, что это намного быстрее. Хотя немного красивее.

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

Важным моментом является использование оператора let для сериализации рекурсии с ограничением глубины до n. Решения приходят в обратном направлении (возможно, можно исправить, перейдя n-> 1 вместо 1-> n для r и k), но набор в обратном направлении - это тот же набор, что и набор 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

Небольшое улучшение, опасность может исходить от ряда, по диагонали вниз или вверх по диагонали, следите за каждым из них по мере развития доски.

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

среднее улучшение в изменении формата, требуется только одно сравнение для проверки по сравнению с предыдущими двумя. Не думаю, что сортировка диагоналей мне чего-нибудь стоит, но и не думаю, что это экономит время.

(define (update-dangers r k dangers)
  (list
     (cons r (rdang dangers))
     (insert (- k r) (ddang dangers) >)
     (insert (+ k r) (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))