SICP包含n-queens解决方案的部分完整示例,方法是遍历最后一行中每个可能的女王位置的树,在下一行中生成更多可能的位置以合并到目前为止的结果,过滤可能性以仅保留最新女王安全的可能性,并递归重复。
在使用最大递归错误的about n=11之后,这个策略失败了。
我已经实现了另一种策略,它从第一列开始执行更智能的树遍历,从未使用的行列表中生成可能的位置,将每个位置列表合并到尚未使用的行的更新列表中。过滤那些被认为是安全的对,并在这些对上递归映射以用于下一列。到目前为止,这不会崩溃,但n=12需要一分钟,而n=13需要大约10分钟来解决。
(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 并不是真的在寻找代码,而是对一两种策略的简单解释,这种策略不那么天真,而且在函数式方法中很好地点击。
发布于 2013-06-12 16:25:53
我可以简化你的代码,所以它可能运行得更快一点。我们首先重命名一些变量以提高可读性(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))))发布于 2015-12-10 18:57:05
这是我第二次想出来的。不过,我不确定它会快得多。不过要漂亮得多。
(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。解决方案是反向产生的(可能会通过在r和k上变成n->1而不是1->n来修复),但反向集合与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))https://stackoverflow.com/questions/17010561
复制相似问题