ex 2.7 & 2.8
区間算術演算…難しめ。後回し。
(define (make-interval a b) (cons a b))
(define (upper-bound x) (max (car x) (cdr x)))
(define (lower-bound x) (min (car x) (cdr x)))
(define (add-interval x y)
(make-interval (+ (lower-bound x) (lower-bound y))
(+ (upper-bound x) (upper-bound y))))
(define (sub-interval x y)
(make-interval (- (lower-bound x) (lower-bound y))
(- (upper-bound x) (upper-bound y))))
(define (mul-interval x y)
(let ((p1 (* (lower-bound x) (lower-bound y)))
(p2 (* (lower-bound x) (upper-bound y)))
(p3 (* (upper-bound x) (lower-bound y)))
(p4 (* (upper-bound x) (upper-bound y))))
(make-interval (min p1 p2 p3 p4)
(max p1 p2 p3 p4))))
(define (div-interval x y)
(mul-interval x
(make-interval (/ 1.0 (upper-bound y))
(/ 1.0 (lower-bound y)))))ex 2.17
listの最後の要素を返す。ただし空ではないlistが与えられる。
(define (last-pair ls)
(if (null? (cdr ls))
(car ls)
(last-pair (cdr ls))))ex 2.18
listの要素を逆順にする。
(define (myreverse ls)
(define (iter list result)
(if (null? list)
result
(iter (cdr list) (cons (car list) result))))
(iter ls '()))ex 2.21
listの各要素を2乗したlistを返す。別々の方法で2つ定義する。
(define (square-list ls)
(if (null? ls)
'()
(cons (* (car ls) (car ls)) (square-list (cdr ls)))))(define (square-list ls)
(map (lambda (x) (* x x)) ls))gosh> (square-list '(1 2 3))
(1 4 9)ex 2.23
for-eachを自分で実装する。 for-eachは手続きとlistを受け取り、格要素に手続きを適用後、 その要素を返す。(listは返さない)
(define (for-each proc ls)
(if (null? ls)
#t
(begin (display (proc (car ls)))
(newline)
(for-each proc (cdr ls)))))gosh> (for-each (lambda (x) (+ x x)) '(1 2 3))
2
4
6
#tex 2.25
listから7を取り出す。car cdrは省略形が用意されてるけど4つまで。
gosh> (car (cdaddr '(1 3 (5 7) 9)))
7
gosh> (caar '((7)))
7
gosh> (cadadr (cadadr (cadadr '(1 (2 (3 (4 (5 (6 7)))))))))
7ex 2.26
append cons list の違いについて。
gosh> (define x '(1 2 3))
x
gosh> (define y '(4 5 6))
y
gosh> (append x y)
(1 2 3 4 5 6)
gosh> (cons x y)
((1 2 3) 4 5 6)
gosh> (list x y)
((1 2 3) (4 5 6))ex 2.27
ex 2.17の応用版。ネストのあるlistでも、要素を逆順にする。
(define (deep-reverse ls)
(define (iter list result)
(cond ((null? list) result)
((not (pair? (car list)))
(iter (cdr list) (cons (car list) result))) ;残りのlistがpairではない
(else
(iter (cdr list) (cons (iter (car list) '()) result))))) ;残りのlistがまだpair
(iter ls '()))gosh> (deep-reverse '((1 2 ) (4 5)))
((5 4) (2 1))ex 2.28
引数に木(list)をとり、左の葉を順に並べたlistを返す。
(define (fringe ls)
(define (iter lst result)
(cond ((null? lst) result)
((not (pair? (car lst))) (iter (cdr lst) (append result (list (car lst)))))
(else (iter (cdr lst) (iter (car lst) result)))))
(iter ls '()))gosh> (define x (list (list 1 2) (list 3 4)))
x
gosh> (fringe x)
(1 2 3 4)ex 2.29
2進モービル。難しいから放棄した。
left right structure は数値かlist,lengthは数値
(define (make-mobile left right) (list left right))
(define (make-branch length structure) (list length structure))
;a
(define (left-branch mobile) (car mobile))
(define (right-branch mobile) (cadr mobile))
(define (branch-length brnc) (car brnc))
(define (branch-structure brnc) (cadr brnc))ex 2.30
ex2.21の応用版。treeの葉に対して、それぞれ2乗し、演算後の木を返す。
(define (square x) (* x x))
(define (square-tree ls)
(map (lambda (sub-ls)
(if (pair? sub-ls)
(square-tree sub-ls)
(square sub-ls))) ls))gosh> (square-tree '(1 2 3 (4 5)))
(1 4 9 (16 25))ex 2.31
ex2.30の解答を抽象化する。(tree-map square tree)とすれば、square-treeと同じ機能を果たすようにする。
(define (square x) (* x x))
(define (square-tree tree)
(tree-map square tree))
(define (tree-map proc tree)
(let loop ((src tree) (dst '()))
(cond ((null? src) (reverse dst))
((pair? (car src))
(loop (cdr src) (cons (tree-map proc (car src)) dst)))
(else
(loop (cdr src) (cons (proc (car src)) dst))))))ex 2.33
公認インタフェースの穴埋め問題。
(define (accumulate op initial sequence)
(if (null? sequence)
initial
(op (car sequence)
(accumulate op initial (cdr sequence)))))
(define (map p sequence)
(accumulate (lambda (x y) (cons (p x) y)) '() sequence))
(define (append seq1 seq2)
(accumulate cons seq2 seq1))
(define (length sequence)
(accumulate (lambda (x y) (+ 1 y)) 0 sequence))gosh> (map (lambda (x) (* x x)) '(1 2 3))
(1 4 9)
gosh> (append '(1 2 3) '(4 (5) 6))
(1 2 3 4 (5) 6)
gosh> (length '(1 2 3))
3ex 2.34
Hornerの方法。
(define (accumulate op initial sequence)
(if (null? sequence)
initial
(op (car sequence)
(accumulate op initial (cdr sequence)))))
(define (horner-eval x coefficient-sequence)
(accumulate (lambda (this-coeff higher-terms)
(+ this-coeff (* x higher-terms)))
0
coefficient-sequence))
のとき、
の値を求めてみると、
gosh> (horner-eval 2 (list 1 3 0 5 0 1))
79ex 2.35
2.2.2節のcount-leavesの公認インタフェース版
(define (accumulate op initial sequence)
(if (null? sequence)
initial
(op (car sequence)
(accumulate op initial (cdr sequence)))))
(define (count-leaves t)
(accumulate + 0 (map (lambda (x)
(cond ((null? x) 0)
((not (pair? x)) 1)
(else (count-leaves x)))) t)))
(define (map p sequence)
(accumulate (lambda (x y) (cons (p x) y)) '() sequence))ex 2.36
(define (accumulate op initial sequence)
(if (null? sequence)
initial
(op (car sequence)
(accumulate op initial (cdr sequence)))))
(define (accumulate-n op init seqs)
(if (null? (car seqs))
'()
(cons (accumulate op init (map car seqs))
(accumulate-n op init (map cdr seqs)))))
(define (map p sequence)
(accumulate (lambda (x y) (cons (p x) y)) '() sequence))gosh> (accumulate-n + 0 '((1 2 3) (4 5 6) (7 8 9) (10 11 12)))
(22 26 30)ex 2.37
行列計算。accumulate-nの便利さ。要確認
(define (accumulate op initial sequence)
(if (null? sequence)
initial
(op (car sequence)
(accumulate op initial (cdr sequence)))))
(define (accumulate-n op init seqs)
(if (null? (car seqs))
'()
(cons (accumulate op init (map car seqs))
(accumulate-n op init (map cdr seqs)))))
(define (dot-product v w)
(accumulate + 0 (map * v w)))
(define (matrix-*-vector m v)
(map (lambda (x) (dot-product x v)) m))
(define (transpose mat)
(accumulate-n cons '() mat))
(define (matrix-*-matrix m n)
(let ((cols (transpose n)))
(map (lambda (x) (matrix-*-vector cols x)) m)))写像の入れ子
gosh> (map (lambda (i) (enumerate-interval 1 (- i 1))) (enumerate-interval 1 6))
(() (1) (1 2) (1 2 3) (1 2 3 4) (1 2 3 4 5))より、
gosh> (accumulate append
'()
(map (lambda (i)
(map (lambda (j) (list i j))
(enumerate-interval 1 (- i 1))))
(enumerate-interval 1 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))素数判定は、
(define (prime? n)
(define (smallest-divisor n)
(find-divisor n 2))
(define (square x) (* x x))
(define (find-divisor n test-divisor)
(cond ((> (square test-divisor) n) n)
((divides? test-divisor n) test-divisor)
(else (find-divisor n (+ test-divisor 1)))))
(define (divides? a b)
(= (remainder b a) 0))
(= n (smallest-divisor n)))したがって、
(define (filter predicate sequence)
(cond ((null? sequence) '())
((predicate (car sequence))
(cons (car sequence)
(filter predicate (cdr sequence))))
(else (filter predicate (cdr sequence)))))
(define (flatmap proc seq)
(accumulate append '() (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
(filter prime-sum?
(flatmap
(lambda (i)
(map (lambda (j) (list i j))
(enumerate-interval 1 (- i 1))))
(enumerate-interval 1 n)))))信号処理のような流れが大切。この写像の入り子を利用することで、多重ループで演算するような計算ができる。
ex 2.44
(define (right-split painter n)
(if (= n 0)
painter
(let ((smaller (right-split painter (- n 1))))
(beside painter (below smaller smaller)))))では、元の画像を半分に縮めたものを上下にして横にならべられる。
(beside painter (below smaller smaller))
という処理を行っているためであるから、ここを "元の画像を半分に縮めたものを左右にして上にならべる"とすればよい。
(define (left-split painter n)
(if (= n 0)
painter
(let ((smaller (left-split painter (- n 1))))
(below painter (beside smaller smaller)))))ex 2.56
微分演算。
;The variables are symbols. They are identified by the primitive predicate symbol?:
(define (variable? x) (symbol? x))
;Two variables are the same if the symbols representing them are eq?:
(define (same-variable? v1 v2)
(and (variable? v1) (variable? v2) (eq? v1 v2)))
;Sums and products are constructed as lists:
(define (make-sum a1 a2)
(cond ((=number? a1 0) a2)
((=number? a2 0) a1)
((and (number? a1) (number? a2)) (+ a1 a2))
(else (list '+ a1 a2))))
;This uses the procedure =number?, which checks whether an expression is equal to a given number:
(define (=number? exp num)
(and (number? exp) (= exp num)))
(define (make-product m1 m2)
(cond ((or (=number? m1 0) (=number? m2 0)) 0)
((=number? m1 1) m2)
((=number? m2 1) m1)
((and (number? m1) (number? m2)) (* m1 m2))
(else (list '* m1 m2))))
;A sum is a list whose first element is the symbol +:
(define (sum? x)
(and (pair? x) (eq? (car x) '+)))
;The addend is the second item of the sum list:
(define (addend s) (cadr s))
;The augend is the third item of the sum list:
(define (augend s) (caddr s))
;A product is a list whose first element is the symbol *:
(define (product? x)
(and (pair? x) (eq? (car x) '*)))
;The multiplier is the second item of the product list:
(define (multiplier p) (cadr p))
;The multiplicand is the third item of the product list:
(define (multiplicand p) (caddr p))
;;改良版
(define (deriv exp var)
(cond ((number? exp) 0)
((variable? exp)
(if (same-variable? exp var) 1 0))
((sum? exp)
(make-sum (deriv (addend exp) var)
(deriv (augend exp) var)))
((product? exp)
(make-sum
(make-product (multiplier exp)
(deriv (multiplicand exp) var))
(make-product (deriv (multiplier exp) var)
(multiplicand exp))))
((exponentiation? exp)
(let ((n (exponent exp)))
(cond ((= n 0) 1)
((= n 1) n)
(else
(make-product n
(make-exponentiation (base exp) (- n 1)))))))
(else
(error "unknown expression type -- DERIV" exp))))ex 2.59
(define true #t)
(define false #f)
(define (element-of-set? x set)
(cond ((null? set) false)
((equal? x (car set)) true)
(else (element-of-set? x (cdr set)))))
(define (adjoin-set x set)
(if (element-of-set? x set)
set
(cons x set)))
(define (intersection-set set1 set2)
(cond ((or (null? set1) (null? set2)) '())
((element-of-set? (car set1) set2)
(cons (car set1)
(intersection-set (cdr set1) set2)))
(else (intersection-set (cdr set1) set2))))
(define (union-set set1 set2)
(let loop ((ans '())
(src (append set1 set2)))
(cond ((null? src) (reverse ans))
((element-of-set? (car src) ans)
(loop ans (cdr src)))
(else
(loop (cons (car src) ans) (cdr src))))))
gosh> (union-set '(1 2 3) '(2 4 5))
(1 2 3 4 5)ex 2.61
(define (adjoin-set x set)
(cond ((null? set) (cons x '()))
((= x (car set)) ;;重複ok
(cons x set))
((< x (car set))
(cons x set))
(else
(cons (car set) (adjoin-set x (cdr set))))))