; a. (define outliner (segments->painter (list (make-segment (make-vect 0 0) (make-vect 1 0)) (make-segment (make-vect 1 0) (make-vect 0 1)) (make-segment (make-vect 0 0) (make-vect 0 1)) (make-segment (make-vect 0 1) (make-vect 1 0))))) ;…

(define (make-segment o v) (list o v)) (define (start-segment s) (car s)) (define (end-segment s) (add-vect (car s) (cadr s)))

リストによる実装に対するセレクター: (define (origin-frame f) (car f)) (define (edge1-frame f) (cadr f)) (define (edge2-frame f) (caddr f)) cons による実装に対するセレクター: (define (origin-frame f) (car f)) (define (edge1-frame f) (cadr f…

(define (make-vect x y) (list x y)) (define (xcor-vect v) (car v)) (define (ycor-vect v) (cadr v)) (define (add-vect a b) (make-vect (+ (xcor-vect a) (xcor-vect b)) (+ (ycor-vect a) (ycor-vect b)))) (define (sub-vect a b) (make-vect (- (xc…

(define (split f g) (lambda (p n) (if (= n 0) p (let ((smaller ((split f g) p (- n 1)))) (f p (g smaller smaller)))))) (二引数の手続きを返せる、ということに気づくまでに時間がかかった。)

(define (up-split painter n) (if (= n 0) painter (let ((smaller (up-split painter (- n 1)))) (below painter (beside smaller smaller)))))

再帰的に呼び出す (queen-cols (- k 1)) が (enumerate-interval 1 board-size) のループの内側にあるため、 board-size の階乗のオーダーで増えていくことが問題。 最終的に呼び出される (queen-cols 0) の回数で処理時間が決定されると考えると (board-siz…

(define empty-board nil) (define (adjoin-position new-row k rest-of-queens) (cons new-row rest-of-queens)) (define (safe? k ps) (define (next triple) (list (- (car triple) 1) (cadr triple) (+ (caddr triple) 1))) (define (check triple ps) (…

(define (triples n) (let ((1..n (enumerate-interval 1 n))) (flatmap (lambda (i) (flatmap (lambda (j) (map (lambda (k) (list i j k) (filter (lambda (x) (and (not (= i x)) (not (= j x)))) 1..n)) (filter (lambda (x) (not (= i x))) 1..n)) 1..n…

(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 n) (map make-pair-sum (filter prime-sum? (unique-pairs n)))) flatmap 手続きは H…

(define (reverse xs) (fold-right (lambda (x y) (append y (list x))) nil xs)) (define (reverse xs) (fold-left (lambda (x y) (cons y x)) nil xs))

(fold-right / 1 (list 1 2 3)) ;Value: 3/2 <== (1 / (2 / (3 / 1))) (fold-left / 1 (list 1 2 3)) ;Value: 1/6 <== (((1 / 3) / 2) / 1) (fold-right cons nil (list 1 2 3)) ;Value: (1 2 3) <== (cons 1 (cons 2 (cons 3 nil))) (fold-left cons nil (l…

(define (matrix-*-vector m v) (map (lambda (x) (dot-product x v) m)) (define (transpose mat) (accumulate-n cons nil mat)) (define (matrix-*-matrix m n) (let ((cols (transpose n))) (map (lambda (x) (map (lambda (y) (dot-product x y)) cols))…

(define (accumulate-n op init xs) (if (null? (car xs)) nil (cons (accumulate op init (accumulate (lambda (x xs) (cons (car x) xs)) nil xs)) (accumulate-n op init (accumulate (lambda (x xs) (cons (cdr x) xs)) nil xs)))))

(define (count-leaves t) (accumulate + 0 (map (lambda (x) (if (pair? x) (count-leaves x) 1)) t))) accumulate で実装するというので、まず浮かんだのは fringe を使って木をリストにたたんでから長さを計るというものだったのだけれど、 accumulate の…

(define (horner-eval x coefs) (accumulate (lambda (coef higher) (+ coef (* x higher))) 0 coefs))

ここからは accumulate が定義された環境が前提になる、のか。 (define (map f xs) (accumulate (lambda (x y) (cons (f x) y)) nil xs)) (define (append xs ys) (accumulate cons ys xs)) (define (length xs) (accumulate (lambda (x y) (+ 1 y)) 0 xs) a…

これは以前悩んだことがあるから楽勝 (コードを書くのは)。 (define (subsets s) (if (null? s) (list s) (let ((rest (subsets (cdr s)))) (append rest (map (lambda (x) (cons (car s) x)) rest))))) なぜこれでよいか、に対する明快な説明...ってのは難…

(define (tree-map f t) (map (lambda (x) (if (pair? x) (tree-map f x) (f x))) t))

map 使用: (define (square-tree t) (map (lambda (x) (if (pair? x) (square-tree x) (square x))) t)) map 不使用: (define (square-tree t) (cond (null? t) t) ((not (pair? t)) (square t)) (else (cons (square-tree (car t)) (square-tree (cdr t))))…

かなり悩んでいる。とりあえず経過を。a. (define (left-branch m) (car m)) (define (right-branch m) (car (cdr m))) (define (branch-length b) (car b)) (define (branch-structure b) (car (cdr b))) b. (define (total-weight m) (define (weight b) (…

(define (fringe xs) (cond ((null? xs) xs) ((not (pair? (car xs))) (cons (car xs) (fringe (cdr xs)))) (else (append (fringe (car xs)) (fringe (cdr xs)))))) という解答を作ったのだが、テキストを読み進めるとわかるとおり以下で足りるらしい: (def…

(define (deep-reverse xs) (if (or (null? xs) (not (pair? xs))) xs (append (deep-reverse (cdr xs)) (list (deep-reverse (car xs))))))

答えは順に (1 2 3 4 5 6) ((1 2 3) 4 5 6) ((1 2 3) (4 5 6))

これは、いやがらせ問題、だろうか？答えは順に、 (car (cdr (car (cdr (cdr <>))))) (car (car <>)) (car (cdr (car (cdr (car (cdr (car (cdr (car (cdr (car (cdr <>))))))))))))

解釈系が表示するのは (1 (2 (3 4)))。うーん、アスキーアートで絵を描くのはつらいなあ…とりあえず略。今日はここまでとしよう。 - で翌日なわけだが描いてみる。 (1 (2 (3 4))) -> ((2 (3 4))) -> nil | | 1 (2 (3 4)) -> ((3 4)) -> nil | | 2 (3 4) -> (…

map そのものじゃ、ダメなのかな？ (map (lambda (x) (newline) (display x)) (list 1 2 3)) 1 2 3 ; value 22: (#!unspecific #!unspecific #!unspecific) ってんで題意を満たしている、気がする。一方、 (define (for-each f xs) (if (null? xs) true ((f …

説明せよ系の問題は苦手だな…。最初の定義だと空リストに、順次リストの際左端の要素から cons していくために逆順になってしまう。 (list 1 2 3 ...) というのから (... (cons 3 (cons 2 (cons 1 (nil)))) ) と作り上げてしまう。他方の定義では、リスト構…

あ、これは簡単... (define (square-list items) (if (null? items) '() (cons (square (car items)) (square-list (cdr items))))) そして (define (square-list items) (map square items)) だ。

ううーん、おもったより時間がかかってしまった。 (define (same-parity x . xs) (define (filtered xs) (cond ((null? xs) xs) ((= (modulo x 2) (modulo (car xs) 2)) (cons (car xs) (filtered (cdr xs)))) (cons x (filtered xs))) (filtered xs) を計算…