SICPゼミ第7回

練習問題2.24

練習問題2.25

(car (cdr (car (cdr (cdr (list 1 3 (list 5 7) 9))))))
(car (car (list (list 7))))
(car (cdr (car (cdr (car (cdr (car (cdr (car (cdr (car (cdr (list 1 (list 2 (list 3 (list 4 (list 5 (list 6 7))))))))))))))))))

by pine

(define x (list 1 3 (cons 5 7) 9))
(cdaddr x)

(define x (list (list 7)))
(caar x)

(define x (cons 1 (cons 2 (cons 3 (cons 4 (cons 5 (cons 6 7)))))))
(cddr (cddddr x))

by tube

どうもcaaaarとか調子乗ると死ぬっぽい

(cadr (caddr (list 1 3 (list 5 7) 9)))

は動くけど，

(cadaddr (list 1 3 (list 5 7) 9))

は死ぬ

練習問題2.26

gosh> (1 2 3 4 5 6)
gosh> ((1 2 3) 4 5 6)
gosh> ((1 2 3) (4 5 6))

練習問題2.27

(define (deep-reverse ls)
  (if (= (length ls) 1)
      (if (= (count-leaves ls) 1)
          (list (car ls))
          (list (deep-reverse (car ls))))
      (append (deep-reverse (cdr ls)) (deep-reverse (list (car ls))))))

by pine

(define (deep-reverse l)
	(define (iterate-func f n)
		(cond
			((= n 1) f)
			(else (lambda(x) (f (map (iterate-func f (- n 1)) x))))
			)
		)
	(define (count-depth l)
		(cond
			((not (pair? l)) 0)
			(else (max (+ 1 (count-depth (car l))) (count-depth (cdr l))))
			)
		)
	((iterate-func reverse (count-depth l)) l)
	)

どうしてもmapが使いたかった。 by どりきゃす

練習問題2.28

(define (fringe ls)
  (if (= (count-leaves ls) (length ls))
      ls
      (append (fringe (car ls)) (fringe (cdr ls)))))

by pine

練習問題2.29

mobileの例

(define b40 (make-branch 4 2))
(define b41 (make-branch 3 1))
(define m4 (make-mobile b40 b41))
(define b30 (make-branch 1 10))
(define b31 (make-branch 7 m4))
(define m3 (make-mobile b30 b31))
(define b20 (make-branch 3 9))
(define b21 (make-branch 2 m3))
(define m2 (make-mobile b20 b21))
(define b10 (make-branch 2 5))
(define b11 (make-branch 1 4))
(define m1 (make-mobile b10 b11))
(define b00 (make-branch 10 m1))
(define b01 (make-branch 4 m2))
(define m0 (make-mobile b00 b01))

つりあうmobile

(define dol0 (make-mobile (make-branch 2 1) (make-branch 1 2)))
(define dorl0 (make-mobile (make-branch 1 2) (make-branch 1 2)))
(define dorr0 (make-mobile (make-branch 2 3) (make-branch 3 2)))
(define dor1 (make-mobile (make-branch 5 dorl0) (make-branch 4 dorr0)))
(define dolicas-mobile (make-mobile (make-branch 3 dol0) (make-branch 1 dor1)))

（どりきゃす）

(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)))

(define (total-weight m)
	(define left (branch-structure (left-branch m)))
	(define right (branch-structure (right-branch m)))
	(define (iter-total-weight s)
		(cond
			((not (pair? s)) s)
			(else (total-weight s))
			)
		)
	(+ (iter-total-weight left) (iter-total-weight right))
	)

(define (balance? m)
	(define left (left-branch m))
	(define right (right-branch m))
	(define left_s (branch-structure left))
	(define right_s (branch-structure right))
	(define left_l (branch-length left))
	(define right_l (branch-length right))
	(define (toggle-balance? left_w left_l right_w right_l)
		(= (* left_w left_l) (* right_w right_l))
		)
	(define (as-daughter-balance? s)
		(cond
			((not (pair? s)) #t)
			(else (balance? s))
			)
		)
	(define (iter-total-weight s)
		(cond
			((not (pair? s)) s)
			(else (total-weight s))
			)
		)
	(and (as-daughter-balance? left_s)
		(as-daughter-balance? right_s)
		(toggle-balance? (iter-total-weight left_s) left_l (iter-total-weight right_s) right_l))
	)

byどりきゃす

(define (total-weight m)
  (if (pair? m)
        (+ (total-weight (branch-structure (right-branch m)))
           (total-weight (branch-structure (left-branch m))))
      m))

(define (balanced? m)
  (if (not (pair? m))
      #t
      (and (= (* (branch-length (left-branch m))
                  (total-weight (branch-structure (left-branch m))))
               (* (branch-length (right-branch m))
                  (total-weight (branch-structure (right-branch m)))))
            (balanced? (branch-structure (left-branch m)))
            (balanced? (branch-structure (right-branch m))))))

by tube

(define (total-weight mobile)
  (if 
    (list? mobile)
    (+ (total-weight (branch-structure (left-branch mobile) )) (total-weight (branch-structure (right-branch mobile) )) )
    mobile
    )
  )

by ば

(define (get-weight branch)
  (if (= (count-leaves branch) 2)
      (branch-structure branch)
      (total-weight (branch-structure branch))))

(define (total-weight mobile)
	(+ (get-weight (left-branch mobile)) (get-weight (right-branch mobile))))

(define (balanced mobile)
  (if (= (* (get-weight (left-branch mobile)) (branch-length (left-branch mobile)))
         (* (get-weight (right-branch mobile)) (branch-length (right-branch mobile))))
      (and (if (pair? (left-branch mobile))
               #t
               (balanced (left-branch mobile)))
           (if (pair? (right-branch mobile))
               #t
               (balanced (right-branch mobile))))
      #f))

by pine

(d)

(define right-branch cdr)
(define branch-structure cdr)

そんなに変更しなくていい！オブジェクト指向は神。
by どりきゃす

練習問題2.30

(define (square-tree tree)
  (map (lambda (sub-tree)
         (if (pair? sub-tree)
             (square-tree sub-tree)
             (* sub-tree sub-tree)))
       tree))

by pine

練習問題2.31

(define (tree-map method tree)
  (map (lambda (sub-tree)
         (if (pair? sub-tree)
             (tree-map method sub-tree)
             (method sub-tree)))
      tree))

コピペした

練習問題2.32

(define (subsets s)
  (if (null? s)
      (list '())
      (let ((rest (subsets (cdr s))))
        (append rest (map (lambda (l) (cons (car s) l)) rest)))))

「sの中ではじめの要素を除いたもの」の部分集合を考えれば、それに「sのはじめの要素を付け加えたもの」と「それ自身」とを合わせれば「sの部分集合」になる。
appendでこの二つを足しておしまい♪

by tube