SICP読書会 2012-10-31

2012-10-31.scm

; 2.28
(define x (list (list 1 2) (list 3 4)))
(fringe x) ; (1 2 3 4)
(fringe (list x x)) ; (1 2 3 4 1 2 3 4)

(define (fringe t)
  (cond ((null? t) '())
	((not (pair? t)) (list t))
	(else (append (fringe (car t)) (fringe (cdr t))))))
(define (append list1 list2)
  (if (null? list1)
      list2
      (cons (car list1) (append (cdr list1) list2))))

; 2.29
(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 branch) (car branch))
(define (branch-structure branch) (cadr branch))

(define m (make-mobile
		(make-branch 10 20)
		(make-branch 30 40)))
(branch-length (left-branch m)) ; 10
(branch-structure (left-branch m)) ; 20
(branch-length (right-branch m)) ; 30
(branch-structure (right-branch m)) ; 40

;; b.
(define (simple-weight? mobile) (not (pair? mobile)))
(define (left-structure mobile) (branch-structure (left-branch mobile)))
(define (right-structure mobile) (branch-structure (right-branch mobile)))

(define (total-weight mobile)
  (if (simple-weight? mobile)
      mobile
      (+ (total-weight (left-structure mobile))
	 (total-weight (right-structure mobile)))))
(total-weight m) ; 60 = 20 + 40

;; c.
(define (baranced? mobile)
  (define (torque branch)
    (* (branch-length branch) (total-weight (branch-structure branch))))
  (if (simple-weight? mobile)
      #t
      (and
       (= (torque (left-branch mobile)) (torque (right-branch mobile)))
       (baranced? (left-structure mobile))
       (baranced? (right-structure mobile)))))

(baranced? m) ; #f

(define baranced-mobile (make-mobile
			 (make-branch 100 10)
			 (make-branch 20
				      (make-mobile
				       (make-branch 30 20)
				       (make-branch 20 30)))))
(baranced? baranced-mobile) ; #t

(define oshii-baranced-mobile (make-mobile
			 (make-branch 100 10)
			 (make-branch 20
				      (make-mobile
				       (make-branch 30 25)
				       (make-branch 20 25)))))
(baranced? oshii-baranced-mobile) ; #f

;; d.
(define (make-mobile left right)
  (cons left right))
(define (make-branch length structure)
  (cons length structure))

(baranced? baranced-mobile) ; error => #t
(baranced? oshii-baranced-mobile) ; error => #f

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

; 木の写像
(define nil '())
(define (scale-tree tree factor)
  (cond ((null? tree) nil)
	((not (pair? tree)) (* tree factor))
	(else (cons (scale-tree (car tree) factor)
		    (scale-tree (cdr tree) factor)))))
(scale-tree (list 1 (list 2 (list 3 4) 5) (list 6 7))
	    10)

(define (scale-tree tree factor)
  (map (lambda (sub-tree)
	 (if (pair? sub-tree)
	     (scale-tree sub-tree factor)
	     (* sub-tree factor)))
  tree))
(scale-tree (list 1 (list 2 (list 3 4) 5) (list 6 7))
	    10)

; 2.30
;; 直接的に定義
(define nil '())
(define (square-tree tree)
  (cond ((null? tree) nil)
	((not (pair? tree)) (* tree tree))
	(else (cons (square-tree (car tree))
		    (square-tree (cdr tree))))))
(square-tree (list 1 (list 2 (list 3 4) 5) (list 6 7)))

;; mapを再帰を使った定義
(define (square-tree tree)
  (map (lambda (sub-tree)
	 (if (pair? sub-tree)
	     (square-tree sub-tree)
	     (* sub-tree sub-tree)))
  tree))
(square-tree (list 1 (list 2 (list 3 4) 5) (list 6 7)))

; 2.31
(define (square x) (* x x))
(define (square-tree tree) (tree-map square tree))

;; step-by-step
(define (square-tree tree)
  (map (lambda (sub-tree)
	 (if (pair? sub-tree)
	     (square-tree sub-tree)
	     (square sub-tree)))
  tree))
(square-tree (list 1 (list 2 (list 3 4) 5) (list 6 7)))

;;;
(define (square-tree tree)
  (define (foo tree)
    (map (lambda (sub-tree)
	   (if (pair? sub-tree)
	       (square-tree sub-tree)
	       (square sub-tree)))
	 tree))
  (foo tree))
(square-tree (list 1 (list 2 (list 3 4) 5) (list 6 7)))

;;;
(define (square-tree tree)
  (define (foo tree)
    (map (lambda (sub-tree)
	   (if (pair? sub-tree)
	       (foo sub-tree)
	       (square sub-tree)))
	 tree))
  (foo tree))
(square-tree (list 1 (list 2 (list 3 4) 5) (list 6 7)))

;;;
(define (square-tree tree)
  (define (foo func tree)
    (map (lambda (sub-tree)
	   (if (pair? sub-tree)
	       (foo func sub-tree)
	       (func sub-tree)))
	 tree))
  (foo square tree))
(square-tree (list 1 (list 2 (list 3 4) 5) (list 6 7)))

;;;
(define (square-tree tree)
  (define (tree-map func tree)
    (map (lambda (sub-tree)
	   (if (pair? sub-tree)
	       (tree-map func sub-tree)
	       (func sub-tree)))
	 tree))
  (tree-map square tree))
(square-tree (list 1 (list 2 (list 3 4) 5) (list 6 7)))

;;;
(define (tree-map func tree)
  (map (lambda (sub-tree)
	 (if (pair? sub-tree)
	     (tree-map func sub-tree)
	     (func sub-tree)))
       tree))
(define (square-tree tree) (tree-map square tree))
(square-tree (list 1 (list 2 (list 3 4) 5) (list 6 7)))

;;; おまけ
(define (scale-tree tree factor) (tree-map (lambda (x) (* x factor)) tree))
(scale-tree (list 1 (list 2 (list 3 4) 5) (list 6 7))
	    10)


; 2.32
(define s1 (list 1 2 3))
(define nil '())
(define (append list1 list2)
  (if (null? list1)
      list2
      (cons (car list1) (append (cdr list1) list2))))
(define (subsets s)
  (if (null? s)
      (list nil)
      (let ((rest (subsets (cdr s))))
	(append rest (map (lambda (x) (cons (car s) x)) rest)))))
(subsets s1)

(map (lambda (x) (* x x)) s1)
(cons 0 s1)
(car s1)
(cons (car s1) s1)
(define s2 (cdr s1))
(cons (car s1) s2)
(define ss1 (list nil (list 3)))
(print ss1)
(define foo (map (lambda (x) (cons 2 x)) ss1))
(print foo)
(list? foo)
(append ss1 foo)
(define bar (append (list nil (list 1 2)) (list (list 3 4))))
(append bar bar)
(append nil nil)
(append ss1 (list nil))
(append (list nil) ss1)
(append (list nil (list 3)) (list (list 2) (list 2 3)))
(list (list 2) (list 2 3))
(map (lambda (x) (cons 2 x)) (list nil (list 3)))

(append ss1
	(map (lambda (x)
	       x)
	       ;(cons (car s2) x))
	     ss1
;	     (list nil (list 3))
	     ))
(print s2)
; (☝ ՞ਊ ՞)☝

公認インタフェース節は次の人にお譲りする方向で

(☝ ՞ਊ ՞)☝

(◞‸◟)