Skip to content

Instantly share code, notes, and snippets.

@iyahoo
Last active December 18, 2017 03:48
Show Gist options
  • Select an option

  • Save iyahoo/b2d572d1b913f8b8ee10c05c75c362f6 to your computer and use it in GitHub Desktop.

Select an option

Save iyahoo/b2d572d1b913f8b8ee10c05c75c362f6 to your computer and use it in GitHub Desktop.
;; ex 2.42
(define (enumerate-interval low high)
(if (> low high)
nil
(cons low (enumerate-interval (+ low 1) high))))
(define (flatmap proc seq)
(accumulate append nil (map proc seq)))
(define empty-board '())
(define (adjoin-position new-row k rest-of-queens)
(append rest-of-queens (list (cons new-row k))))
(define (same-row? a b)
(= (car a) (car b)))
(define (same-col? a b)
(= (cdr a) (cdr b)))
(define (same-diagonal? a b)
(= (+ (car a) (cdr a)) (+ (car b) (cdr b))))
(define (same-anti-diagonal? a b)
(= (- (car a) (cdr a)) (- (car b) (cdr b))))
(define (hit? a b)
(or (same-row? a b) (same-col? a b) (same-diagonal? a b) (same-anti-diagonal? a b)))
(define (safe? k positions)
(let ([kth-queen (ref positions (- k 1))]
[rest-queen (cdr (reverse positions))])
(not (reduce (^[a b] (or a b)) #f
(map (^[a-queen] (hit? kth-queen a-queen)) rest-queen)))))
(define (queens board-size)
(define (queen-cols k)
(if (= k 0)
(list empty-board)
(filter (^[positions] (safe? k positions))
(flatmap (^[rest-of-queens]
(map (^[new-row]
(adjoin-position new-row k rest-of-queens))
(enumerate-interval 1 board-size)))
(queen-cols (- k 1))))))
(queen-cols board-size))
(test-section "ex ex 2.42")
(test* "adjoin-position" '((1 . 1) (3 . 2) (2 . 3)) (adjoin-position 2 3 '((1 . 1) (3 . 2))))
(test* "same-row?" #t (same-row? '(1 . 1) '(1 . 2)))
(test* "same-row?" #f (same-row? '(2 . 1) '(1 . 2)))
(test* "same-col?" #t (same-col? '(1 . 1) '(2 . 1)))
(test* "same-diagonal?" #t (same-diagonal? '(2 . 2) '(3 . 1)))
(test* "same-anti-diagonal?" #t (same-anti-diagonal? '(2 . 2) '(3 . 3)))
(test* "safe?" #t (safe? 0 '((1 . 1))))
(test* "safe?" #t (safe? 3 '((2 . 1) (4 . 2) (1 . 3) (3 . 4))))
;; P134 の例 (row(行), col(列))
(define sample-ans-queen '((3 . 1) (7 . 2) (2 . 3) (8 . 4) (5 . 5) (1 . 6) (4 . 7) (6 . 8)))
(test* "queens" #t (not (null? (member sample-ans-queen (queens 8)))))
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment