如何在方案(N-queens)中从此函数中删除可变性

How to remove mutability from this function in scheme (N-queens)

我正在努力解决 SICP 中的 N 皇后问题(这本书;我花了几天时间研究它 -- 最后一个问题:)。这是我的辅助函数:

#lang sicp

; the SICP language in Racket already defines this:
; (define nil '()

; boilerplate: filter function and range functions
(define (filter func lst)
  (cond 
    ((null? lst)
       nil)
    (else
      (if (func (car lst))
        (cons (car lst) (filter func (cdr lst)))
        (filter func (cdr lst))))))

(define (range a b)
  (if (> a b)
    nil
    (cons a (range (+ 1 a) b))))
; Selectors/handlers to avoid confusion on the (col, row) notation:
; representing it a position as (col, row), using 1-based indexing
(define (make-position col row) (cons col (list row)))
(define (col p) (car p))
(define (row p) (cadr p))

; adding a new position to a board
(define (add-new-position existing-positions p)
  (append existing-positions
     (list (make-position (col p) (row p)))))
; The 'safe' function
(define (any? l proc)
  (cond ((null? l) #f)
        ((proc (car l)) #t)
        (else (any? (cdr l) proc))))

(define (none? l proc) (not (any? l proc)))

(define (safe? existing-positions p)
  (let ((bool (lambda (x) x))  (r (row p))  (c (col p)))
   (and
    ; is the row safe? i.e., no other queen occupies that row?
    (none? (map (lambda (p) (= (row p) r))  existing-positions)
           bool)

    ; safe from the diagonal going up
    (none? (map (lambda (p) (= r (+ (row p) (- c (col p)))))
                existing-positions)
           bool)
    
    ; safe from the diagonal going down
    (none? (map (lambda (p) (= r (- (row p) (- c (col p)))))
                existing-positions)
           bool))))

现在,有了那个样板文件,actual/monstrous 我拥有的皇后问题的第一个工作版本:

(define (positions-for-col col size)
    (map (lambda (ri) (make-position col ri)) 
         (range 1 size)))

(define (queens board-size)
  
(define possible-positions '())
(define safe-positions '())
(define all-new-position-lists '())
(define all-positions-list '())

; existing-positions is a LIST of pairs
(define (queen-cols col existing-positions)
  (if (> col board-size)
    (begin
      (set! all-positions-list 
            (append all-positions-list (list existing-positions))))

    (begin
      ; for the column, generate all possible positions, 
      ;   for example (3 1) (3 2) (3 3) ...
      (set! possible-positions (positions-for-col col board-size))
      ; (display "Possible positions: ") (display possible-positions) (newline)

      ; filter out the positions that are not safe from existing queens
      (set! safe-positions 
            (filter (lambda (pos) (safe? existing-positions pos)) 
                    possible-positions))
      ; (display "Safe positions: ") (display safe-positions) (newline)

      (if (null? safe-positions)
        ; bail if we don't have any safe positions
        '()
        ; otherwise, build a list of positions for each safe possibility 
        ;     and recursively call the function for the next column
        (begin
          (set! all-new-position-lists 
                (map  (lambda (pos) 
                          (add-new-position existing-positions pos)) 
                      safe-positions))
          ; (display "All positions lists: ") (display all-new-position-lists) (newline)
          
          ; call itself for the next column
          (map (lambda (positions-list) (queen-cols (+ 1 col) 
                    positions-list))
               all-new-position-lists))))))

    (queen-cols 1 '())

    all-positions-list)
(queens 5)
(((1 1) (2 3) (3 5) (4 2) (5 4))
 ((1 1) (2 4) (3 2) (4 5) (5 3))
 ((1 2) (2 4) (3 1) (4 3) (5 5))
 ((1 2) (2 5) (3 3) (4 1) (5 4))
 ((1 3) (2 1) (3 4) (4 2) (5 5))

老实说,我想我做了所有 set!s 以便我可以更轻松地调试东西(这很常见吗?)我如何删除各种 set!s 来制作这个适当的功能程序?


作为更新,我能得到的最多 'terse' 如下,尽管它仍然附加到列表中以建立位置:

(define (queens board-size)
  (define all-positions-list '())
  (define (queen-cols col existing-positions)
    (if (> col board-size)
      (begin
        (set! all-positions-list 
              (append all-positions-list 
                      (list existing-positions))))
      (map (lambda (positions-list)
               (queen-cols (+ 1 col) positions-list))
           (map (lambda (pos) 
                    (add-new-position existing-positions pos))
                (filter (lambda (pos) 
                            (safe? existing-positions pos)) 
                        (positions-for-col col board-size))))))
  (queen-cols 1 nil)
  all-positions-list)

最后,我认为这是我能做的最好的,利用 'flatmap' 函数来帮助处理嵌套列表:

; flatmap to help with reduction
(define (reduce function sequence initializer)
  (let ((elem (if (null? sequence) nil (car sequence)))
        (rest (if (null? sequence) nil (cdr sequence))))
    (if (null? sequence)
        initializer
        (function elem 
                  (reduce function rest initializer)))))

(define (flatmap proc seq) 
   (reduce append  (map proc seq)  nil))
; actual
(define (queens board-size)
  (define (queen-cols col existing-positions)
    (if (> col board-size)
        (list existing-positions)
        (flatmap 
           (lambda (positions-list)  
              (queen-cols (+ 1 col) positions-list))
           (map 
              (lambda (pos) 
                 (add-new-position existing-positions 
                                   pos))
              (filter 
                 (lambda (pos) 
                    (safe? existing-positions pos))
                 (positions-for-col col board-size))))))
  (queen-cols 1 nil))

与使用 set! 的函数相比,此函数是否有任何优势,或者它更像是一个偏好问题(我找到了集合!一个更易于阅读和调试)。

大家在做SICP题的时候,如果能努力坚持题目的精神,那将是最有益的。您可以从上下文中确定精神:直到您阅读本书时所涵盖的主题、给出的任何帮助代码、使用的术语等。具体来说,避免使用尚未介绍的方案语言部分;重点不是能否解决问题,而是如何解决。如果您已经获得了帮助代码,请尽量使用它。

SICP 有一种构建复杂性的方法;它不会引入一个概念,除非它已经为它提供了足够的动机和理由。本书的基本主题是通过抽象进行简化,在这个特定的部分中,您将了解各种高阶过程——抽象,如在 [= 上运行的 accumulate、map、filter、flatmap 51=],使您的代码更加结构化、紧凑并最终更易于推理。

如本节开头所示,您可以很好地避免使用此类高级编程结构,并且仍然可以使用 运行 好的程序,但它们的(自由)使用会导致结构化、可读性更高, top-down 样式代码。它借鉴了信号处理系统的设计,并展示了我们如何从中汲取灵感来为我们的代码添加结构:使用 map、filter 等过程来划分我们的代码逻辑,不仅使它看起来更卫生,而且看得懂。

如果您过早地使用直到本书后面才出现的技术,您将错过作者在本节中为您准备的许多重要知识。你需要摆脱以命令式方式思考的冲动。使用套装!不是在方案中做事的好方法,直到它是。 SICP 迫使 你走 'difficult' 一条路,让你以功能的方式思考是有原因的——这是为了让你的思维(和代码)优雅并且 'clean'.

试想一下,推理生成树递归过程的代码会有多困难,其中每个(子)函数调用都会改变函数的参数。此外,正如我在评论中提到的,赋值通过使表达式的顺序对计算结果产生影响,给程序员(以及那些阅读他们的代码的人)带来了额外的负担,因此更难验证代码执行预期的操作。

编辑:我只是想补充几点我觉得会增加更多的见解:

  1. 您的代码正在使用集!没有错(甚至 非常 不雅),只是在这样做时,你非常明确地告诉你在做什么。除了自下而上之外,迭代还稍微降低了优雅度——自下而上通常更难思考。
  2. 我觉得教大家尽可能递归地做事是这本书的目标之一。你会发现递归是一项至关重要的技术,在整本书中都不可避免地会用到它。例如,在第 4 章中,您将编写求值器(解释器),作者在其中递归地求值表达式。更早的时候,在 2.3 节中,有符号微分问题,它也是表达式递归求值的练习。因此,即使您第一次解决了问题(使用 set!、begin)和自下而上的迭代,就问题陈述而言,这不是 正确的 方法。

说了这么多,这是我针对这个问题的代码(对于 FP 赋予的所有结构和可读性,注释仍然是必不可少的):

; the board is a list of lists - a physical n x n board, where 
; empty positions are 0 and filled positions are 1
(define (queens board-size)
  (let ((empty-board (empty-board-gen board-size)))   ; minor modification - making empty-board available to queen-cols
   (define (queen-cols k)
    (if (= k 0)
        (list empty-board)
        (filter (lambda (positions) (safe? k positions))
          ; the flatmap below generates a list of new positions 
          ; by 'adjoining position'- adding 'board-size' number 
          ; of new positions for each of the positions obtained 
          ; recursively from (queen-cols (- k 1)), which have 
          ; been found to be safe till column k-1. This new 
          ; set (list) of positions is then filtered using the
          ; safe? function to filter out unsafe positions
          (flatmap 
            (lambda (rest-of-queens) 
            ; the map below adds 'board-size' number of new 
            ; positions to 'rest-of-queens', which is an 
            ; element of (queen-cols (- k 1))
                      (map (lambda (new-row) 
                             (adjoin-position new-row k rest-of-queens)) 
                           (enumerate-interval 1 board-size)))
            (queen-cols (- k 1))))))
  (queen-cols board-size))   ; end of let block
 )

; add a column having a queen placed at position (new-row, col).
(define (adjoin-position new-row col rest-queens)    
 (let ((board-dim (length rest-queens)))  ;length of board
  ; first create a zero 'vector', put a queen in it at position  
  ; 'new-row', then put (replace) this new vector/column at the 
  ; 'col' position in rest-queens
  (replace-elem (replace-elem 1 new-row (gen-zero-vector board-dim)) col rest-queens)))  

(define (safe? k positions)   ; the safe function
 (let ((row-pos-k (non-zero-index (item-at-index k positions))))  ; get the row of the queen in column k
  (define (iter-check col rem)   ;iteratively check if column 'col' of the board is safe wrt the kth column
   (let ((rw-col (non-zero-index (car rem))))    ; get the row of 'col' in which a queen is placed
     (cond ((= k 1) #t); 1x1 board is always safe
           ((= col k) #t); if we reached the kth column, we are done
           ; some simple coordinate geometry
           ; checks if the row of the queen in col and kth 
           ; column is same, and also checks if the 'slope' of
           ; the line connecting the queens of the two columns 
           ; is 1 (i.e. if it's a diagonal), if either is true, 
           ; the kth queen is not safe
           ((or (= row-pos-k rw-col) (= (- k col) (abs (- row-pos-k rw-col)))) #f)
           (else (iter-check (+ col 1) (cdr rem))))))  ; check the next column

(iter-check 1 positions)))   ; start checking from the first column

; helper functions follow

(define (item-at-index n items)  ; given a list, return the nth element
  (define (iter idx rem)
   (if (= idx n)
      (car rem)
      (iter (+ idx 1) (cdr rem))))
      (iter 1 items))

(define (non-zero-index items)   
; gives the first non-zero element from items - used for
; determining the row at which a queen is placed
 (define (iter a rem)
  (if (> (car rem) 0)
      a
      (iter (+ a 1) (cdr rem))))
      (iter 1 items))

(define (empty-board-gen n)   ; the empty board is n lists, each list with n zeros
 (map (lambda (x) (map (lambda (y) 0) (enumerate-interval 1 n))) (enumerate-interval 1 n)))

(define (replace-elem new-elem pos items)   ; replace item at position pos in items by new-elem, ultimately used for replacing an empty column with a column which has a queen
 (define (iter i res rem)
  (if (= i pos)
      (append res (list new-elem) (cdr rem))
      (iter (+ i 1) (append res (list(car rem))) (cdr rem)))) (iter 1 '() items))

(define (gen-zero-vector n)    ; generate a list of length n with only zeros as elements
 (define (iter a res)
  (if (> a n)
      res
      (iter (+ a 1) (append res (list 0))))) (iter 1 '()))

(define (flatmap proc seq)
 (accumulate append '() (map proc seq)))

(define (length items)      ; not particularly efficient way for length of a list
  (accumulate + 0 (map (lambda (x) 1) items)))

(define (accumulate op null-value seq)
 (if (null? seq)
     null-value
     (op (car seq) (accumulate op null-value (cdr seq)))))

(define (enumerate-interval low high)     ; a list of integers from low to hi
 (define (iter a b res)
   (if (> a b)
       res
       (iter (+ a 1) b (append res (cons a '())))))
 (iter low high '()))

有很多方法可以解决这个问题。我将尝试使用特定于 Racket 的过程编写一个简短明了的解决方案,并解释其中的每个步骤。仅使用 SICP 中解释的 Scheme 过程的解决方案也是可能的,但它会更冗长,我认为更难以理解。

我的目标是编写函数式编程风格的解决方案,尽可能多地重用内置过程,并不惜一切代价避免变异 - 这是 SICP 鼓励您学习的风格。如果我认为我们可以通过重用现有的 Racket 过程获得更清晰的解决方案,我将偏离 SICP 中的模板解决方案(然后,必须使用 #lang racket 语言执行此代码),但我提供了另一个 完全符合本书中的练习 2.42,在标准 Scheme 中实现并与 #lang sicp.

兼容

要事第一。让我们就如何代表董事会达成一致——这是一个关键点,我们代表数据的方式将对实施我们的解决方案的难易程度产生重大影响。我将使用一个简单的表示,只包含最少的必要信息。

假设“板”是行索引列表。我的坐标原点是棋盘左上角的位置 (0, 0)。出于本练习的目的,我们只需要跟踪皇后所在的,该列由其在列表中的索引隐式表示,并且每列只能有一个皇后.使用我的表示,列表 '(2 0 3 1) 对以下板进行编码,请注意皇后的位置如何由其行号和索引唯一表示:

   0 1 2 3
0  . Q . .
1  . . . Q
2  Q . . .
3  . . Q .

接下来,让我们看看如何检查在棋盘末尾添加的新皇后相对于之前存在的皇后是否“安全”。为此,我们需要检查同一行是否还有其他皇后,或者从新皇后的位置开始的对角线上是否有皇后。我们不需要检查同一列中的皇后,我们正在尝试设置一个新皇后并且这一行中没有其他皇后。让我们将此任务拆分为多个过程。

; main procedure for checking if a queen in the given
; column is "safe" in the board; there are no more
; queens to the "right" or in the same column
(define (safe? col board)
  ; we're only interested in the queen's row for the given column
  (let ([row (list-ref board (sub1 col))])
    ; the queen must be safe on the row and on the diagonals
    (and (safe-row? row board)
         (safe-diagonals? row board))))

; check if there are any other queens in the same row,
; do this by counting how many times `row` appears in `board`
(define (safe-row? row board)
  ; only the queen we want to add can be in this row
  ; `curry` is a shorthand for writing a lambda that
  ; compares `row` to each element in `board`
  (= (count (curry equal? row) board) 1))

; check if there are any other queens in either the "upper"
; or the "lower" diagonals starting from the current queen's
; position and going to the "left" of it
(define (safe-diagonals? row board)
  ; we want to traverse the row list from right-to-left so we
  ; reverse it, and remove the current queen from it; upper and
  ; lower positions are calculated starting from the current queen
  (let loop ([lst   (rest (reverse board))]
             [upper (sub1 row)]
             [lower (add1 row)])
    ; the queen is safe after checking all the list
    (or (null? lst)
        ; the queen is not safe if we find another queen in
        ; the same row, either on the upper or lower diagonal
        (and (not (= (first lst) upper))
             (not (= (first lst) lower))
             ; check the next position, updating upper and lower
             (loop (rest lst) (sub1 upper) (add1 lower))))))

可以进行一些优化,例如,如果同一行中有多个皇后则提前停止,或者当对角线的行落在棋盘之外时停止,但它们会使代码更难理解,我将它们留作 reader.

的练习

在书中,他们建议我们使用一个 adjoin-position 过程来接收行和列参数;根据我的表示,我们只需要该行,所以我将其重命名为 add-queen,它只是在棋盘的末尾添加了一个新皇后:

; add a new queen's row to the end of the board
(define (add-queen queen-row board)
  (append board (list queen-row)))

现在是有趣的部分。准备好上述所有程序后,我们需要尝试不同的皇后组合,并过滤掉那些不安全的组合。我们将使用高阶过程和递归来实现这个回溯解决方案,只要我们的心态正确,根本不需要使用 set!

如果您从“由内而外”阅读,这将更容易理解,在进入外部之前尝试理解内部部分的作用,并始终记住我们正在递归展开我们的方式流程:第一种情况是当我们有一个空棋盘时,下一种情况是当我们的棋盘只有一个皇后在位时等等,直到我们最终有一个完整的棋盘。

; main procedure: returns a list of all safe boards of the given
; size using our previously defined board representation
(define (queens board-size)
  ; we need two values to perform our computation:
  ; `queen-col`: current row of the queen we're attempting to set
  ; `board-size`: the full size of the board we're trying to fill
  ; I implemented this with a named let instead of the book's
  ; `queen-cols` nested procedure
  (let loop ([queen-col board-size])
    ; if there are no more columns to try exit the recursion
    (if (zero? queen-col)
        ; base case: return a list with an empty list as its only
        ; element; remember that the output is a list of lists
        ; the book's `empty-board` is just the empty list '()
        (list '())
        ; we'll generate queen combinations below, but only the
        ; safe ones will survive for the next recursive call
        (filter (λ (board) (safe? queen-col board))
                ; append-map will flatten the results as we go, we want
                ; a list of lists, not a list of lists of lists of...
                ; this is equivalent to the book's flatmap implementation
                (append-map
                 (λ (previous-boards)
                   (map (λ (new-queen-row)
                          ; add a new queen row to each one of
                          ; the previous valid boards we found
                          (add-queen new-queen-row previous-boards))
                        ; generate all possible queen row values for this
                        ; board size, this is similar to the book's
                        ; `enumerate-interval` but starting from zero
                        (range board-size)))
                 ; advance the recursion, try a smaller column
                 ; position, as the recursion unwinds this will
                 ; return only previous valid boards
                 (loop (sub1 queen-col)))))))

仅此而已!我将提供一些不言自明的打印程序(对测试有用);他们采用我的紧凑板表示并以更易读的方式打印出来。皇后区由 'o 表示,空格由 'x:

表示
(define (print-board board)
  (for-each (λ (row) (printf "~a~n" row))
            (map (λ (row)
                   (map (λ (col) (if (= row col) 'o 'x))
                        board))
                 (range (length board)))))

(define (print-all-boards boards)
  (for-each (λ (board) (print-board board) (newline))
            boards))

我们可以验证一切正常,8 皇后问题的 solutions 数量符合预期:

(length (queens 8))
=> 92

(print-all-boards (queens 4))

(x x o x)
(o x x x)
(x x x o)
(x o x x)

(x o x x)
(x x x o)
(o x x x)
(x x o x)

作为奖励,这是另一个解决方案,它适用于 SICP 书中提供的 queens 精确 定义。我不会详细介绍,因为它使用相同的板表示(除了这里的索引开始于 1 而不是 0)和我之前的 safe? 实施 , queens 过程的解释基本相同。我做了一些小改动以支持标准 Scheme 程序,因此希望它更便携。

#lang racket

; redefine procedures already explained in the book with
; Racket equivalents, delete them and use your own
; implementation to be able to run this under #lang sicp

(define flatmap append-map)

(define (enumerate-interval start end)
  (range start (+ end 1)))

; new definitions required for this exercise

(define empty-board '())

(define (adjoin-position row col board)
  ; `col` is unused
  (append board (list row)))

; same `safe?` implementation as before

(define (safe? col board)
  (let ((row (list-ref board (- col 1))))
    (and (safe-row? row board)
         (safe-diagonals? row board))))

(define (safe-row? row board)
  ; reimplemented to use standard Scheme procedures
  (= (length (filter (lambda (r) (equal? r row)) board)) 1))

(define (safe-diagonals? row board)
  (let loop ((lst   (cdr (reverse board)))
             (upper (- row 1))
             (lower (+ row 1)))
    (or (null? lst)
        (and (not (= (car lst) upper))
             (not (= (car lst) lower))
             (loop (cdr lst) (- upper 1) (+ lower 1))))))

; exact same implementation of `queens` as in the book

(define (queens board-size)
  (define (queen-cols k)
    (if (= k 0)
        (list empty-board)
        (filter
         (lambda (positions) (safe? k positions))
         (flatmap
          (lambda (rest-of-queens)
            (map (lambda (new-row)
                   (adjoin-position new-row k rest-of-queens))
                 (enumerate-interval 1 board-size)))
          (queen-cols (- k 1))))))
  (queen-cols board-size))

; debugging

(define (print-board board)
  (for-each (lambda (row) (display row) (newline))
            (map (lambda (row)
                   (map (lambda (col) (if (= row col) 'o 'x))
                        board))
                 (enumerate-interval 1 (length board)))))

(define (print-all-boards boards)
  (for-each (lambda (board) (print-board board) (newline))
            boards))

上面的代码更符合原始练习的精神,它只要求你实现三个定义:empty-boardadjoin-positionsafe?,因此这更像是一个关于数据表示的问题。不出所料,结果是一样的:

(length (queens 8))
=> 92

(print-all-boards (queens 4))

(x x o x)
(o x x x)
(x x x o)
(x o x x)

(x o x x)
(x x x o)
(o x x x)
(x x o x)