SICP読書女子会 2.3.2 (#26)

  • 0
    いいね
  • 0
    コメント

    ICP読書女子会 2.3.2 (#26)

    2.3.2

    (define (variable? x) (symbol? x)) ;; 変数かどうか
    (define (same-variable? v1 v2)
        (and (variable? v1) (variable? v2) (eq? v1 v2)))
    
    
    
    (define (make-sum a1 a2) (list '+ a1 a2))
    (define (make-product m1 m2) (list '* m1 m2))
    
    (print (make-sum 'a 'b))
    ;(+ a b)
    
    ;和は、最初の要素が記号 + であるリスト
    (define (sum? x) (and (pair? x) (eq? (car x) '+)))
    
    ;加数は、和のリストの二つ目の項
    (define (addend s) (cadr s))
    
    ;被加数は、和のリストの三つ目の項
    (define (augend s) (caddr s)) ;; augentっては初耳
    
    ;積は、最初の要素が記号 * であるリスト
    (define (product? x) (and (pair? x) (eq? (car x) '*)))
    
    ;乗数は、積のリストの二つ目の項
    (define (multiplier p) (cadr p))
    
    ;被乗数は、積のリストの三つ目の項
    (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))))
        (else (error "unknown expression type: DERIV" exp))))
    

    気になったけど普通被加数って a + b なら aのほうで、加数がbだよねえ。
    ここだと逆なようだ・・・。

    
    
    (print "===微分してみる===")
    ;;
    (print (deriv '(+ x 3) 'x))
    (print (deriv '(* x y) 'x))
    (print (deriv '(* (* x y) (+ x 3)) 'x))
    ;(+ 1 0)
    ;(+ (* x 0) (* 1 y))
    ;(+ (* (* x y) (+ 1 0)) (* (+ (* x 0) (* 1 y)) (+ x 3)))
    
    
    (print "===+0や *1をmerge===")
    (define (=number? exp num) 
        (and (number? exp) (= exp num)))
    
    (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))))
    
    (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))))
    
    (print (deriv '(+ x 3) 'x))
    (print (deriv '(* x y) 'x))
    (print (deriv '(* (* x y) (+ x 3)) 'x))
    ;1
    ;y
    ;(+ (* x y) (* y (+ x 3)))
    

    Ex 2.56

    (print "===Ex 2.56===")
    (define (base v) (cadr v))
    (define (exponent v) (caddr v))
    
    (define (make-exponentiation base exponent)
        (cond 
            ((=number? exponent 0) 1)
            ((=number? exponent 1) base)
            ((and (number? base) (number? exponent)) (expt base exponent))
            (else (list '** base exponent))))
    
    (define (exponentiation? v)
        (and (pair? v) (eq? '** (car v))))
    
    (print "make-exponentiation")
    (print (make-exponentiation 3 0));1
    (print (make-exponentiation 3 1));3
    (print (make-exponentiation 3 2));9
    (print (make-exponentiation 'x 2));(** x 2)
    
    (define (exponentiation? v)
        (and (pair? v) (eq? '** (car v))))
    
    (print "make-exponentiation")
    (print (make-exponentiation 3 0))
    (print (make-exponentiation 3 1))
    (print (make-exponentiation 3 2))
    ;1
    ;3
    ;(** 3 2)
    
    (print "===deriv===")
    (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)
                (make-product
                    (make-product 
                        (exponent exp) 
                        (make-exponentiation (base exp) (- (exponent exp) 1)))
                    (deriv (base exp) var)
                    ))
        (else (error "unknown expression type: DERIV" exp))))
    
    (print "(deriv '(** x 2) 'x)")
    (print (deriv '(** x 2) 'x))
    ;(* 2 x)
    

    (a * b)'((a * b') + (a' * b))って計算できるって知らなかったよ・・・。
    調べて知ったよ。常識? 数学の授業とかもう覚えてない;;

    memo

    (x ** 2)' = (x * x)' = x' * x + x * x' = 1 * x + x * 1 = 2x

    Ex 2.57

    
    (print "===Ex 2.57===")
    
    (print "cddrとかcaddrの復習")
    (define sum3 '(+ 1 2 3))
    (print (cddr sum3)) ;(2 3)
    (print (cdddr sum3)) ;(3)
    
    (print (car sum3)) ;+
    (print (cadr sum3)) ;1
    (print (caddr sum3)) ;2
    
    (define (augend s)
        (if (null? (cdddr s)) 
            (caddr s) ; 項が1つしか無い時
            (cons '+ (cddr s)))) ; 項が2つ以上のとき
    
    (define (multiplicand p)
      (if (null? (cdddr p))
          (caddr p) ; 項が1つしか無い時
          (cons '* (cddr p)))) ; 項が2つ以上のとき
    
    (define (augend-test)
        (print "(augend '(+ 1 2 x)) = "
         (augend '(+ 1 2 x)))
    
        (print "(multiplicand '(* 1 2 x)) = "
         (multiplicand '(* 1 2 x)))
        #t
    )
    (augend-test)
    ;(augend '(+ 1 2 x)) = (+ 2 x)
    ;(multiplicand '(* 1 2 x)) = (* 2 x)
    
    
    (print (deriv '(* (* x y) (+ x 3)) 'x))
    ; ((xy) * (x + 3))'
    ; = (xy * 1) + (y * (x + 3))
    ; = xy  + (y (x + 3))
    
    ;Result: (+ (* x y) (* y (+ x 3)))
    

    Ex 2.58a

    
    (print "===2.58 - a===")
    ;(x + (3 * (x + (y + 2)))) のような中置記法で表された代
    ;数式を微分するにはどのようにするかを示せ。問題を簡単に
    ;するため、+ と * は常に二つの引数を取り、式は完全に括弧
    ;でくくられていると仮定せよ。
    
    
    
    ;和は、2つ目の要素が記号 + であるリスト
    (define (sum? x) (and (pair? x) (eq? (cadr x) '+)))
    
    ;加数は、和のリストの1つ目の項
    (define (addend s) (car s))
    
    ;(define (augend s) (caddr s)) 変更なし
    
    ;積は、2つ目の要素が記号 * であるリスト
    (define (product? x) (and (pair? x) (eq? (cadr x) '*)))
    
    ;乗数は、積のリストの1つ目の項
    (define (multiplier p) (car p))
    
    ;被乗数は、積のリストの3つ目の項
    ;(define (multiplicand p) (caddr p) 変更なし
    
    
    (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))))
    (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))))
    
    (print "中置演算子")
    
    (define s (make-sum 3 'x))
    (print s)
    (print "addend=" (addend s))
    (print "augend=" (augend s))
    ;(3 + x)
    ;addend=3
    ;augend=x
    
    
    (define p (make-product 3 'x))
    (print p)
    (print "multiplier=" (multiplier p))
    (print "multiplicand=" (multiplicand p))
    ;(3 * x)
    ;multiplier=3
    ;multiplicand=x
    
    
    (print "(deriv '(x + (3 * (x + (y + 2)))) 'x)=" 
        (deriv '(x + (3 * (x + (y + 2)))) 'x))
    
    (print "(deriv '((x * y) * (x + 3)) 'x)=" (deriv '((x * y) * (x + 3)) 'x))
    ;(deriv '(x + (3 * (x + (y + 2)))) 'x)=4
    ;(deriv '((x * y) * (x + 3)) 'x)=((x * y) + (y * (x + 3)))
    

    Ex 2.58 b

    (print "===2.58 - b===")
    ;(x + 3 * (x + y + 2)) のような標準的な代数記法を認め
    ;ると、問題はずっと難しくなる。この記法では、必要のない
    ;括弧は省略し、乗算は加算より先に行われると仮定している。
    ;ここでの微分プログラムがそのような記法に対してもうまく
    ;動くように、適切な述語、セレクタ、コンストラクタを設計
    ;できるだろうか。
    
    (define (make-sum . a)
        (define (itr a formula num)
            ;debug
            ;(print a formula num) 
            (cond 
                ((null? a) 
                    (cond 
                        ((null? formula) num)
                        ((= num 0) formula)
                        (else (append formula (list '+ num)))
                    ))
                ((number? (car a)) (itr (cdr a) formula (+ num (car a))))
                (else 
                    (if 
                        (null? formula) 
                        (itr (cdr a) (list (car a)) num)
                        (itr (cdr a) (append formula (list '+ (car a))) num))
                )))
        (itr a nil 0))
    
    (print (make-sum 1 3 4 'x 'y))
    ;(x + y + 8)
    
    (define (make-product . a)
        (define (itr a formula num)
            ;debug
            ;(print a formula num) 
            (cond 
                ((null? a) 
                    (cond 
                        ((null? formula) num)
                        ((= num 1) formula)
                        (else (append formula (list '* num)))
                    ))
                ((number? (car a)) 
                    (if (= (car a) 0)
                        0
                        (itr (cdr a) formula (* num (car a)))))
                (else 
                    (if 
                        (null? formula) 
                        (itr (cdr a) (list (car a)) num)
                        (itr (cdr a) (append formula (list '* (car a))) num))
                )))
        (itr a nil 1))
    
    (print (make-product 1 3 4 'x 'y))
    ;(x * y * 12)
    (print (make-product 'x 'y 0))
    ;0
    
    (print "セレクタの設定")
    ;和は、2つ目の要素が記号 + であるリスト
    (define (sum? x) (and (pair? x) (eq? (cadr x) '+)))
    
    ;加数は、和のリストの1つ目の項
    (define (addend s) (car s))
    
    (define (augend s) 
        (if 
            (null? (cdddr s))
            (caddr s)
            (cddr s)))
    
    ;積は、2つ目の要素が記号 * であるリスト
    (define (product? x) (and (pair? x) (eq? (cadr x) '*)))
    
    ;乗数は、積のリストの1つ目の項
    (define (multiplier p) (car p))
    
    ;被乗数は、積のリストの3つ目の項
    (define (multiplicand p) 
        (if 
            (null? (cdddr p))
            (caddr p)
            (cddr p)))
    
    
    (define s (make-sum 3 'x 'y))
    (print s)
    (print "addend=" (addend s))
    (print "augend=" (augend s))
    (print "augendのaugend=" (augend (augend s)))
    ;(x + y + 3)
    ;addend=x
    ;augend=(y + 3)
    ;augendのaugend=3
    (print "(make-sum 1 3 5)=" (make-sum 1 3 5))
    (print "(make-sum 'x 'y)=" (make-sum 'x 'y))
    ;(make-sum 1 3 5)=9
    ;(make-sum 'x 'y)=(x + y)
    
    (define p (make-product 3 'x 'y))
    (print p)
    (print "multiplier=" (multiplier p))
    (print "multiplicand=" (multiplicand p))
    (print "multiplicandのmultiprcand=" (multiplicand (multiplicand p)))
    ;(x * y * 3)
    ;multiplier=x
    ;multiplicand=(y * 3)
    ;multiplicandのmultiprcand=3
    (print "(make-product 1 3 5)=" (make-product 1 3 5))
    (print "(make-product 'x 'y)=" (make-product 'x 'y))
    ;(make-product 1 3 5)=15
    ;(make-product 'x 'y)=(x * y)
    

    積のみ、和のみの式の微分

    (print "---deriv: sum---")
    (print (deriv (make-sum 'x 'y 3) 'x)) 
    ;1
    (print (deriv (make-sum 'x 'x 'y 3) 'x)) 
    ;2
    
    (print "---deriv: product---")
    (print (deriv (make-product 'x 'y 3) 'x)) 
    ;(((y * 3)))
    
    (print (deriv (make-product 'x 'x 'y 3) 'x)) 
    ;((x * (((y * 3)))) + ((x * y * 3)))
    

    括弧が多い!!!!

    あとは、+と*が混合した場合

    (print "---deriv: mix---")
    (print (deriv '(x + y * 3 * x) 'x)) 
    ;(((y * 3)) + 1)
    

    優先度とかは考えてない。

    優先度を考える

    (print "=== 優先順序を考慮しよう")
    ;和は、どこかに+があるやつ
    
    (define test-mix '(a * b + c))
    (define test-mix2 '(a + b * c))
    (define test-sum '(a + b + c))
    (define test-prod '(a * b * c))
    (print test-mix)
    (print test-mix2)
    (print test-sum)
    (print test-prod)
    
    (define (sum? x) 
        (define (itr xx)
            ;(print xx (car xx))
            (cond 
                ((null? xx) #f)
                ((not (pair? xx)) #f)
                ((null? (cdr xx)) #f)
                ((eq? (cadr xx) '+) #t)
                (else (itr (cddr xx)))))
        (itr x))
    (print "-sum?")
    (print (sum? test-mix))
    (print (sum? test-mix2))
    (print (sum? test-sum))
    (print (sum? test-prod))
    ;#t
    ;#t
    ;#t
    ;#f
    
    ;加数は、和のリストの1つ目の項
    (define (addend s) 
        (define (itr ss formula)
            (cond
                ((eq? (car ss) '+) formula)
                (else 
                    (itr (cdr ss) (append formula (list (car ss)))))
            ))
    (let ((ans (itr s nil)))
        (if 
            (null? (cdr ans))
            (car ans)
        ans)))
    
    
    (print "-addend")
    (print (addend test-mix))
    (print (addend test-mix2))
    (print (addend test-sum))
    ;(a * b)
    ;a
    ;a
    
    (define (augend s)
        (define (itr ss)
            (cond
                ((eq? (car ss) '+) (cdr ss))
                (else 
                    (itr (cdr ss))
            )))
    (let ((ans (itr s)))
        (if 
            (null? (cdr ans))
            (car ans)
        ans)))
    
    (print "-augend")
    (print (augend test-mix))
    (print (augend test-mix2))
    (print (augend test-sum))
    ;c
    ;(b * c)
    ;(b + c)
    
    ;積は、2つ目の要素が記号 * であるリスト
    ;(define (product? x) 
    ;    (define (itr xx)
    ;        ;(print xx (car xx))
    ;        (cond 
    ;            ((null? xx) #f)
    ;            ((not (pair? xx)) #f)
    ;            ((null? (cdr xx)) #f)
    ;            ((eq? (cadr xx) '*) #t)
    ;            (else (itr (cddr xx)))))
    ;    (itr x))
    
    (print (product? test-mix))
    (print (product? test-mix2))
    (print (product? test-sum))
    (print (product? test-prod))
    ;#t
    ;#f
    ;#f
    ;#t
    
    
    (print "===deriv===")
    (define (deriv exp var)
        ;(print 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)
                (make-product
                    (make-product 
                        (exponent exp) 
                        (make-exponentiation (base exp) (- (exponent exp) 1)))
                    (deriv (base exp) var)
                    ))
        (else (error "unknown expression type: DERIV" exp))))
    
    (print "---deriv: mix---")
    (print (deriv '(x + y * 3 * x) 'x)) 
    ;(((y * 3)) + 1)
    
    ;冪乗 にはたいおうしてなひ