4

How to Design Programs の拡張演習 28.2 で行き詰まっています。リストを使用する代わりに、真または偽の値のベクトルを使用してボードを表現しました。これは私が持っているもので、動作しません:

#lang Scheme

(define-struct posn (i j))

;takes in a position in i, j form and a board and 
;  returns a natural number that represents the position in index form
;example for board xxx
;                  xxx
;                  xxx
;(0, 1) -> 1
;(2, 1) -> 7
(define (board-ref a-posn a-board)
  (+ (* (sqrt (vector-length a-board)) (posn-i a-posn))
     (posn-j a-posn)))

;reverse of the above function
;1 -> (0, 1)
;7 -> (2, 1)
(define (get-posn n a-board)
  (local ((define board-length (sqrt (vector-length a-board))))
    (make-posn (floor (/ n board-length)) 
               (remainder n board-length))))

;determines if posn1 threatens posn2
;true if they are on the same row/column/diagonal
(define (threatened? posn1 posn2)
  (cond
    ((= (posn-i posn1) (posn-i posn2)) #t)
    ((= (posn-j posn1) (posn-j posn2)) #t)
    ((= (abs (- (posn-i posn1)
                (posn-i posn2)))
        (abs (- (posn-j posn1)
                (posn-j posn2)))) #t)
    (else #f)))

;returns a list of positions that are not threatened or occupied by queens
;basically any position with the value true
(define (get-available-posn a-board)
  (local ((define (get-ava index)
            (cond
              ((= index (vector-length a-board)) '())
              ((vector-ref a-board index)
               (cons index (get-ava (add1 index))))
              (else (get-ava (add1 index))))))
    (get-ava 0)))

;consume a position in the form of a natural number and a board
;returns a board after placing a queen on the position of the board
(define (place n a-board)
  (local ((define (foo x)
            (cond
              ((not (board-ref (get-posn x a-board) a-board)) #f)
              ((threatened? (get-posn x a-board) (get-posn n a-board)) #f)
              (else #t))))
    (build-vector (vector-length a-board) foo)))

;consume a list of positions in the form of natural numbers, and a board
;returns a list of boards after placing queens on each of the positions
;                                                            on the board
(define (place/list alop a-board)
  (cond
    ((empty? alop) '())
    (else (cons (place (first alop) a-board)
                (place/list (rest alop) a-board)))))

;returns a possible board after placing n queens on a-board
;returns false if impossible
(define (placement n a-board)
  (cond
    ((zero? n) a-board)
    (else (local ((define available-posn (get-available-posn a-board)))
            (cond
              ((empty? available-posn) #f)
              (else (or (placement (sub1 n) 
                          (place (first available-posn) a-board))
                        (placement/list (sub1 n) 
                          (place/list (rest available-posn) a-board)))))))))

;returns a possible board after placing n queens on a list of boards
;returns false if all the boards are not valid
(define (placement/list n boards)
  (cond
    ((empty? boards) #f)
    ((zero? n) (first boards))
    ((not (boolean? (placement n (first boards)))) (first boards))
    (else (placement/list n (rest boards)))))
4

4 に答える 4

2

これは可能な限り最速のスキーム実装ではありませんが、かなり簡潔です。私はそれを独自に思いついたのですが、それがユニークだとは思えません。これはPLTスキームに含まれているため、R6RSで実行するには、一部の関数名を変更する必要があります。ソリューションのリストと各ソリューションは短所を使用して作成されているため、逆になっています。最後に反転とマップを行うと、すべてが並べ替えられ、ソリューションに行が追加されてきれいな出力が得られます。ほとんどの言語にはフォールドタイプの関数があります。http:
//en.wikipedia.org/wiki/Fold_%28higher-order_function%29を参照してください。

#lang scheme/base
(define (N-Queens N)  

  (define (attacks? delta-row column solution)
    (and (not (null? solution))
         (or (= delta-row (abs (- column (car solution))))
             (attacks? (add1 delta-row) column (cdr solution)))))  

  (define (next-queen safe-columns solution solutions)
    (if (null? safe-columns)
        (cons solution solutions)
        (let move-queen ((columns safe-columns) (new-solutions solutions))
          (if (null? columns) new-solutions
              (move-queen
                (cdr columns)
                (if (attacks? 1 (car columns) solution) new-solutions
                    (next-queen (remq (car columns) safe-columns)  
                                (cons (car columns) solution)  
                                new-solutions)))))))

  (unless (exact-positive-integer? N)
    (raise-type-error 'N-Queens "exact-positive-integer" N))
  (let ((rows (build-list N (λ (row) (add1 row)))))
    (reverse (map (λ (columns) (map cons rows (reverse columns)))
                  (next-queen (build-list N (λ (i) (add1 i))) null null)))))

問題について考えると、リストは実際にはこの問題の自然なデータ構造です。各行に配置できるクイーンは1つだけなので、実行する必要があるのは、安全な列または未使用の列のリストを次の行のイテレーターに渡すことだけです。これは、next-queenへのバックトラッキング呼び出しを行うcond句のremqへの呼び出しで行われます。

foldl関数は、名前付きletとして書き直すことができます。

(define (next-queen safe-columns solution solutions)
  (if (null? safe-columns)
      (cons solution solutions)
      (let move-queen ((columns safe-columns) (new-solutions solutions))
        (if (null? columns) new-solutions
            (move-queen

これは、foldlに組み込まれている引数チェックのオーバーヘッドを回避するため、かなり高速です。PLTスキームのN-Queensベンチマークを見ているときに、暗黙の行を使用するというアイデアに出くわしました。1のデルタ行から始めて、解がチェックされるときにそれをインクリメントするのはかなりスムーズです。何らかの理由で、PLTスキームではabsが高価なので、攻撃のより速い形式がありますか?

PLTスキームでは、最速の実装のために可変リストタイプを使用する必要があります。ソリューションを返さずにカウントするベンチマークは、最初の列リスト以外の短所セルを作成せずに作成できます。これにより、プログラムが95,815,104のソリューションを見つけるのに1時間51分を費やしている間に、gcで618ミリ秒が費やされたN = 17まで、ガベージの収集が回避されます。

于 2010-05-24T20:25:52.510 に答える
1

また私です。私はここ数日、質問について考え、苦しみ、ついに答えを得ました。

誰も質問に答えていないので。役に立つと思う人のために、ここに投稿します。

興味のある方のために、私はDrSchemeを使用しています。

以下はコードです。

#langスキーム

;線の間のコードはグラフの問題です
;後でn-queens問題に適応されます

; ------------------------------------------------- -------------------------------------------------- ----------------------

(定義(隣接ノードグラフ)
  (条件
    ((空の?グラフ)'())
    ((symbol =?(最初の(最初のグラフ))ノード)
     (最初(残り(最初のグラフ))))
    (else(隣接ノード(レストグラフ)))))

;; find-route:ノードノードグラフ->(ノードのリスト)またはfalse
;; Gで出発地から目的地までのパスを作成する
;; パスがない場合、関数はfalseを生成します
(定義(ルート検索の発信先G)
  (条件
    [(symbol =?発信先)(リスト宛先)]
    [else(local((definepossible-route
            (find-route / list(neighbors origination G)destination G)))
        (条件
          [(ブール値?可能ルート)false]
          [else(cons originationpossible-route)]))])))

;; find-route / list:(listof node)ノードグラフ->(listof node)またはfalse
;; lo-OsのあるノードからDへのパスを作成します
;; パスがない場合、関数はfalseを生成します
(定義(find-route / list lo-Os DG)
  (条件
    [(空?lo-Os)false]
    [else(local((definepossible-route(find-route(first lo-Os)DG)))
        (条件
          [(boolean?possible-route)(find-route / list(rest lo-Os)DG)]
          [それ以外の場合-ルート]))]))

  (グラフを定義する
    '((A(BE))
      (B(EF))
      (CD))
      (D())
      (E(CF))
      (F(DG))
      (G())))

;テスト
(find-route'A' Gグラフ)

; ------------------------------------------------- -------------------------------------------------- ----------------------


; チェス盤は#t /#f /'q値のベクトル(別名配列)で表されます
; #tは、女王に占領も脅迫もされていないポジションを表します
; #fは、女王に脅かされているポジションを表します
; 'qは、女王が占める位置を表します
; nxnの空のチェス盤は、(build-vector(* nn)(lambda(x)#t))によって作成できます。

; ボードのボード長を返します
; 例えば。ボードが8x8ボードの場合、8を返します
(定義(ボードの長さのボード)
  (sqrt(vector-length a-board)))

; ボード上のインデックスの行を返します
(定義(get-row a-board index)
  (floor(/ index(board-length a-board))))

; ボード上のインデックスの列を返します
(define(get-column a-board index)
  (残りのインデックス(ボードの長さa-ボード)))

; インデックスn1によって参照される位置が、インデックスn2によって参照される位置を脅かす場合、およびその逆の場合、trueを返します。
; n1がn2と同じ行/列/対角線上にある場合はtrue
(定義(脅迫?a-board n1 n2)
  (条件
    ((=(get-row a-board n1)(get-row a-board n2))#t)
    ((=(get-column a-board n1)(get-column a-board n2))#t)
    ((=(abs(-(get-row a-board n1)(get-row a-board n2)))
        (abs(-(get-column a-board n1)(get-column a-board n2))))#t)
    (else #f)))

;ボード上のインデックスnにクイーンを配置した後にボードを返します
(define(place-queen-on-n a-board n)
  (ローカル((define(foo x)
            (条件
              ((= nx)'q)
              ((eq?(vector-ref a-board x)'q)' q)
              ((eq?(vector-ref a-board x)#f)#f)
              ((脅迫?a-board nx)#f)
              (else #t))))
    (build-vector(vector-length a-board)foo)))

; ボード上でまだ利用可能なポジションを返します
; 基本的に、値が#tの位置を返します
(定義(get-possible-posn a-board)
  (ローカル((define(get-ava index)
            (条件
              ((= index(vector-length a-board))'())
              ((eq?(vector-ref a-board index)#t)
               (cons index(get-ava(add1 index))))
              (else(get-ava(add1 index))))))
    (get-ava 0)))

; クイーンをボードに配置した後、ボードのリストを返します
; この関数は、上記のグラフの問題で隣接する関数のように機能します
(define(place-a-queen a-board)
  (ローカル((define(place-queen lop)
            (条件
              ((空?lop)'())
              (else(cons(place-queen-on-n a-board(first lop))
                          (place-queen(rest lop)))))))
    (place-queen(get-possible-posn a-board))))

; 主な機能
; この関数は、上のグラフの問題の関数find-routeのように機能します
(定義(place-n-queens発信先a-board)
  (条件
    ((=発信先)a-board)
    (else(local((definepossible-steps
                    (place-n-queens / list(add1 origination)
                                         行き先
                                         (place-a-queen a-board))))
            (条件
              ((ブール値?可能-ステップ)#f)
              (他の可能性-ステップ)))))))

; この関数は、上記のグラフの問題の関数find-route/listのように機能します
(定義(place-n-queens / list発信先ボード)
  (条件
    ((空の?ボード)#f)
    (else(local((definepossible-steps
                    (place-n-queensオリジネーション
                                    行き先
                                    (最初のボード))))          
            (条件
              ((ブール値?可能-ステップ)
               (place-n-queens / list origination
                                    行き先
                                    (レストボード)))
              (他の可能性-ステップ)))))))

;テスト
;8x8ボードに8つのクイーンを配置します
(place-n-queens 0 8(build-vector(* 8 8)(lambda(x)#t)))


于 2010-04-11T08:13:21.010 に答える
1

これは約 11 年前に関数型プログラミングのクラスを受講したときのもので、MIT スキームまたは mzScheme のいずれかを使用していたと思います。ほとんどの場合、使用した Springer/Friedman のテキストを修正しただけで、8 つのクイーンが解決されました。演習は、このコードが行う N 個のクイーンに対して一般化することでした。

;_____________________________________________________
;This function tests to see if the next attempted move (try)
;is legal, given the list that has been constructed thus far
;(if any) - legal-pl (LEGAL PLacement list)
;N.B. - this function is an EXACT copy of the one from
;Springer and Friedman
(define legal?
  (lambda (try legal-pl)
    (letrec
        ((good?
          (lambda (new-pl up down)
            (cond
              ((null? new-pl) #t)
              (else (let ((next-pos (car new-pl)))
                      (and
                       (not (= next-pos try))
                       (not (= next-pos up))
                       (not (= next-pos down))
                       (good? (cdr new-pl)
                              (add1 up)
                              (sub1 down)))))))))
      (good? legal-pl (add1 try) (sub1 try)))))
;_____________________________________________________
;This function tests the length of the solution to
;see if we need to continue "cons"ing on more terms
;or not given to the specified board size.
;
;I modified this function so that it could test the
;validity of any solution for a given boardsize.
(define solution?
    (lambda (legal-pl boardsize)
      (= (length legal-pl) boardsize)))
;_____________________________________________________
;I had to modify this function so that it was passed
;the boardsize in its call, but other than that (and
;simply replacing "fresh-start" with boardsize), just
;about no changes were made.  This function simply
;generates a solution.
(define build-solution
  (lambda (legal-pl boardsize)
    (cond
      ((solution? legal-pl boardsize) legal-pl)
      (else (forward boardsize legal-pl boardsize)))))
;_____________________________________________________
;This function dictates how the next solution will be
;chosen, as it is only called when the last solution
;was proven to be legal, and we are ready to try a new
;placement.
;
;I had to modify this function to include the boardsize
;as well, since it invokes "build-solution".
(define forward
  (lambda (try legal-pl boardsize)
    (cond
      ((zero? try) (backtrack legal-pl boardsize))
      ((legal? try legal-pl) (build-solution (cons try legal-pl) boardsize))
      (else (forward (sub1 try) legal-pl boardsize)))))
;_____________________________________________________
;This function is used when the last move is found to
;be unhelpful (although valid) - instead it tries another
;one until it finds a new solution.
;
;Again, I had to modify this function to include boardsize
;since it calls "forward", which has boardsize as a
;parameter due to the "build-solution" call within it
(define backtrack
  (lambda (legal-pl boardsize)
    (cond
      ((null? legal-pl) '())
      (else (forward (sub1 (car legal-pl)) (cdr legal-pl) boardsize)))))
;_____________________________________________________
;This is pretty much the same function as the one in the book
;with just my minor "boardsize" tweaks, since build-solution
;is called.
(define build-all-solutions
  (lambda (boardsize)
    (letrec
        ((loop (lambda (sol)
                 (cond
                   ((null? sol) '())
                   (else (cons sol (loop (backtrack sol boardsize))))))))
      (loop (build-solution '() boardsize)))))
;_____________________________________________________
;This function I made up entirely myself, and I only
;made it really to satisfy the syntactical limitations
;of the laboratory instructions.  This makes it so that
;the input of "(queens 4)" will return a list of the
;two possible configurations that are valid solutions,
;even though my modifiend functions would return the same
;value by simply inputting "(build-all-solutions 4)".
(define queens
  (lambda (n)
    (build-all-solutions n)))
于 2010-04-11T08:40:29.927 に答える
0

マスター (Hal Ableson) の演奏をご覧ください。

http://www.youtube.com/watch?v=skd-nyVyzBQ

于 2011-04-22T21:59:53.573 に答える