オンラインSICP読書女子会 #23 (2.2.3 (3))
ex-2.40 .. ex-2.43
sec-2.2.3 (c) マップのネスト
この場合、
(list nil)というひとつの項目からなる列、つまり空集合を生成します。
For this, we generate(list nil), which is a sequence with one item, namely the set with no elements.
「この場合、 (list nil) というひとつの項目、すなわち空集合、からなる列を生成します。」かな？^^;
sec-2.2.3 (c) 実装
; [sec-2.2.3-c.scm]
;
(define (sec-2.2.3-c)
(print "(gen-pairs 6)")
(print ";==> " (gen-pairs 6))
(newline)
(print "(prime-sum-pairs 6)")
(print ";==> " (prime-sum-pairs 6))
(newline)
(print "(permutations (list 1 2 3))")
(print ";==> " (permutations (list 1 2 3)))
#t)
; {{{ 準備.
(define accumulate fold-right)
(define nil ())
(define (enumerate-interval low high)
(if
(> low high)
nil
(cons low (enumerate-interval (+ low 1) high))))
(define (prime? n)
(define (iter i n)
(cond
((> (* i i) n) #t)
((= (remainder n i) 0) #f)
(else (iter (+ i 1) n))))
(if
(< n 2)
#f
(iter 2 n)))
; }}} 準備.
(define (gen-pairs n)
(accumulate
append
nil
(map
(lambda (i)
(map
(lambda (j) (list i j))
(enumerate-interval 1 (- i 1))))
(enumerate-interval 1 n))))
(define (flatmap proc seq)
(accumulate append nil (map proc seq)))
(define (prime-sum? pair)
(prime? (+ (car pair) (cadr pair))))
(define (make-pair-sum pair)
(list (car pair) (cadr pair) (+ (car pair) (cadr pair))))
(define (prime-sum-pairs n)
(map
make-pair-sum ; (Int, Int) -> (Int, Int, Int)
(filter
prime-sum?
(flatmap ;==> [(i:Int, j:Int)] ; concatenated.
(lambda (i) ; i:Int -> [(i:Int, j:Int)]
(map
(lambda (j) (list i j)) ; j:Int -> (i:Int, j:Int)
(enumerate-interval 1 (- i 1)))) ; [j:Int]
(enumerate-interval 1 n))))) ; [Int]
(define (permutations s)
(if
(null? s) ; 集合は空か?
(list nil) ; 空の場合は空集合を持つ列が復帰値.
(flatmap
(lambda (x)
(map
(lambda (p) (cons x p))
(permutations (remove x s))))
s)))
(define (remove item sequence)
(filter
(lambda (x) (not (= x item)))
sequence))
sec-2.2.3 (c) 実行結果
gosh> (sec-2.2.3-c)
(gen-pairs 6)
;==> ((2 1) (3 1) (3 2) (4 1) (4 2) (4 3) (5 1) (5 2) (5 3) (5 4) (6 1) (6 2) (6 3) (6 4) (6 5))
(prime-sum-pairs 6)
;==> ((2 1 3) (3 2 5) (4 1 5) (4 3 7) (5 2 7) (6 1 7) (6 5 11))
(permutations (list 1 2 3))
;==> ((1 2 3) (1 3 2) (2 1 3) (2 3 1) (3 1 2) (3 2 1))
ex-2.40. unique-pairs
1 ≤ j < i ≤ n な (i, j) の組の列.
ex-2.40 実装
; [ex-2.40.scm]]
;
(define (ex-2.40)
(print "(unique-pairs 6)")
(print ";==> " (unique-pairs 6))
(newline)
(print "(prime-sum-pairs-2.40 6)")
(print ";==> " (prime-sum-pairs-2.40 6))
#t)
(load "./sec-2.2.3-c") ; flatmap, prime-sum?, enumerate-interval.
(define (unique-pairs n)
(flatmap
(lambda (i)
(map
(lambda (j)
(list i j))
(enumerate-interval 1 (- i 1))))
(enumerate-interval 1 n)))
(define (prime-sum-pairs-2.40 n)
(map
make-pair-sum
(filter prime-sum? (unique-pairs n))))
ex-2.40 実行結果
gosh> (ex-2.40)
(unique-pairs 6)
;==> ((2 1) (3 1) (3 2) (4 1) (4 2) (4 3) (5 1) (5 2) (5 3) (5 4) (6 1) (6 2) (6 3) (6 4) (6 5))
(prime-sum-pairs-2.40 6)
;==> ((2 1 3) (3 2 5) (4 1 5) (4 3 7) (5 2 7) (6 1 7) (6 5 11))
ex-2.41. 特定の合計数になる3つ組
「合計で s になる」の部分若干わすれてたっ（）
ex-2.41 実装
; [ex-2.41.scm]
;
(define (ex-2.41)
(print "(unique-triples 5)")
(print ";==> " (unique-triples 5))
(print "(const-sum-pairs 10)")
(print ";==> " (const-sum-pairs 10))
#t)
(load "./sec-2.2.3-c") ; accumulate, flatmap, prime-sum?, enumerate-interval.
(define (const-sum-pairs s)
(filter
(lambda (triple) ; (i,j,k) -> Bool
(let
(
(sum (+ (list-ref triple 0) (list-ref triple 1) (list-ref triple 2)))
)
(= sum s)))
(unique-triples s))) ; [(i,j,k)]
(define (unique-triples n)
(flatmap
(lambda (i)
(flatmap
(lambda (j)
(map
(lambda (k)
(list i j k))
(enumerate-interval 1 (- j 1))))
(enumerate-interval 1 (- i 1))))
(enumerate-interval 1 n)))
ex-2.41 実行結果
gosh> (ex-2.41)
(unique-triples 5)
;==> ((3 2 1) (4 2 1) (4 3 1) (4 3 2) (5 2 1) (5 3 1) (5 3 2) (5 4 1) (5 4 2) (5 4 3))
(const-sum-pairs 10)
;==> ((5 3 2) (5 4 1) (6 3 1) (7 2 1))
ex-2.42 8 Queens
ひとまず最低限動作に必要な部分を実装.
今はまだ全部が safe としておく.
つまり (queen n) を実行すると全部の組み合わせが解として返る.
(define empty-board nil)
(define (safe? k positions)
#t)
(define (adjoin-position new-row k rest-of-queens)
(cons new-row rest-of-queens))
queen の利き筋は斜めと縦横で, その線上にいる場合に unsafe になる.
逆に, 新しく置いた queen から見て, 斜め左上, 真上, 斜め右上のいずれかに既に queen がいる場合にのみ unsafe と判断できる.
この3方向の判定をそれぞれ safe-left?, safe-column?, safe-right? とおく.
(define (safe? k positions)
(and
(safe-left? k (car positions) (cdr positions))
(safe-column? k (car positions) (cdr positions))
(safe-right? (+ k 1) (car positions) (cdr positions))))
(define (safe-left? k positions)
#t)
(define (safe-column? k positions)
#t)
(define (safe-right? k positions)
#t)
(queens 1)
;==> ((1))
(queens 2)
;==> ((1 1) (2 1) (1 2) (2 2))
(queens 3)
;==> ((1 1 1) (2 1 1) (3 1 1) (1 2 1) (2 2 1) (3 2 1) (1 3 1) (2 3 1) (3 3 1)
(1 1 2) (2 1 2) (3 1 2) (1 2 2) (2 2 2) (3 2 2) (1 3 2) (2 3 2) (3 3 2)
(1 1 3) (2 1 3) (3 1 3) (1 2 3) (2 2 3) (3 2 3) (1 3 3) (2 3 3) (3 3 3))
safe-column? を実装する.
ぐぐっと safe が減少.
(define (safe-column? k p positions)
(cond
((null? positions) #t)
((= (car positions) p) #f)
(else (safe-column? k p (cdr positions)))))
(queens 1)
;==> ((1))
(queens 2)
;==> ((2 1) (1 2))
(queens 3)
;==> ((3 2 1) (2 3 1) (3 1 2) (1 3 2) (2 1 3) (1 2 3))
#t
safe-left? を実装.
一段上に遡るたびに queen さんがいるかの判定する場所も1つずれていく.
(define (safe-left? k p positions)
(cond
((null? positions) #t)
((= (car positions) (- p 1)) #f)
(else (safe-left? k (- p 1) (cdr positions)))))
(queens 1)
;==> ((1))
(queens 2)
;==> ((1 2))
(queens 3)
;==> ((2 3 1) (3 1 2) (1 2 3))
safe-right? も実装:
(define (safe-right? k p positions)
(cond
((null? positions) #t)
((= (car positions) (+ p 1)) #f)
(else (safe-right? k (+ p 1) (cdr positions)))))
(queens 1)
;==> ((1))
(queens 2)
;==> ()
(queens 3)
;==> ()
safe? のなかで k 使ってない＼(^o^)／
盤面を右とか左に突き抜けちゃうけど計算量以外は問題ないはず？^^;
1 から 10 の解の数:
(for-each (lambda (n) (print (list n (length (queens n))))) (enumerate-interval 1 10))
;==>
(1 1)
(2 0)
(3 0)
(4 2)
(5 10)
(6 4)
(7 40)
(8 92)
(9 352)
(10 724)
ex-2.42 実装
; [ex-2.42.scm]
;
(define (ex-2.42)
(print "(queens 1)")
(print ";==> " (queens 1))
(newline)
(print "(queens 2)")
(print ";==> " (queens 2))
(newline)
(print "(queens 3)")
(print ";==> " (queens 3))
#t)
(load "./sec-2.2.3-c")
(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))))))
(define empty-board nil)
(define (safe? k positions)
(and
(safe-left? k (car positions) (cdr positions))
(safe-column? k (car positions) (cdr positions))
(safe-right? (+ k 1) (car positions) (cdr positions))))
(define (safe-left? k p positions)
(cond
((null? positions) #t)
((= (car positions) (- p 1)) #f)
(else (safe-left? k (- p 1) (cdr positions)))))
(define (safe-column? k p positions)
(cond
((null? positions) #t)
((= (car positions) p) #f)
(else (safe-column? k p (cdr positions)))))
(define (safe-right? k p positions)
(cond
((null? positions) #t)
((= (car positions) (+ p 1)) #f)
(else (safe-right? k (+ p 1) (cdr positions)))))
(define (adjoin-position new-row k rest-of-queens)
(cons new-row rest-of-queens))
(queen-cols board-size))
ex-2.42 実行結果
gosh> (ex-2.42)
(queens 1)
;==> ((1))
(queens 2)
;==> ()
(queens 3)
;==> ()
ex-2.43
本来は board-size 回, 自分に必要な盤面を1回だけ呼べばよかったのが,
board-size 回, さらに board-size 回再計算してしまっているため.
O(n) が O(n^2) になっていることから,
T^2 の時間が必要になると見積もれる.