Hatena::Groupcsnagoya-sicp

クラなんとかの日記 このページをアンテナに追加 RSSフィード

|

2009-06-04親父最強

2.32

| 2.32 - クラなんとかの日記 を含むブックマーク はてなブックマーク - 2.32 - クラなんとかの日記 2.32 - クラなんとかの日記 のブックマークコメント

集合の述語 subsets を作る問題

集合S があって,

S に 要素x を加えた集合を S' とする.

S の部分集合全体を ss(S) と表現する.

ss(S') は,どうなるか.

ss(S') は ss(S) を含む.(∵S はS' の真部分集合であるから)

残りは,ss(S) の各要素集合に要素 x を加えたものである.

#!/usr/bin/env gosh
;; -*- coding: utf-8; -*-
; 

;; 準備

;; 答え
(define (subsets s)
  (if (null? s)
      (list (list))
      (let ((rest (subsets (cdr s))))
        (append rest (map (lambda (x) (cons (car s) x)) rest)))))

;; 確認
(define x (list 1 2 3))

(display x) (newline) ; => (1 2 3)
(display (subsets x)) (newline) ; => (() (3) (2) (2 3) (1) (1 3) (1 2) (1 2 3))

2.31

| 2.31 - クラなんとかの日記 を含むブックマーク はてなブックマーク - 2.31 - クラなんとかの日記 2.31 - クラなんとかの日記 のブックマークコメント

tree-map というtree をscan するmap のような関数を実装する問題

#!/usr/bin/env gosh
;; -*- coding: utf-8; -*-
; 

;; 準備
(define (square x) (* x x))

;; 答え
(define (tree-map proc tree)
  (map (lambda (sub-tree)
         (if (pair? sub-tree)
             (tree-map proc sub-tree)
             (proc sub-tree)))
       tree))

(define (square-tree tree)
  (tree-map square tree))


;; 確認
(define x (list 1
                (list 2 (list 3 4) 5)
                (list 6 7)))

(display x) (newline) ; => (1 (2 (3 4) 5) (6 7))
(display (square-tree x)) (newline); => (1 (4 (9 16) 25) (36 49))

2.30

| 2.30 - クラなんとかの日記 を含むブックマーク はてなブックマーク - 2.30 - クラなんとかの日記 2.30 - クラなんとかの日記 のブックマークコメント

square-tree を実装する問題

  1. 直接実装版
  2. map 版と再帰版

直接実装すると,スキャンする部分を自分で書かなきゃいけない分

ちょっと複雑になるか.

#!/usr/bin/env gosh
;; -*- coding: utf-8; -*-
; 

;; 準備
(define (square x) (* x x))

;; 答え
;; +直接版
(define (square-tree-d tree)
  (cond ((null? tree) (list))
        ((not (pair? tree)) (square tree))
        (else (cons (square-tree-d (car tree))
                    (square-tree-d (cdr tree))))))

;; +map と再帰版
(define (square-tree-m tree)
  (map (lambda (sub-tree)
         (if (pair? sub-tree)
             (square-tree-m sub-tree)
             (square sub-tree)))
       tree))

;; 確認
(define x (list 1
                (list 2 (list 3 4) 5)
                (list 6 7)))

(display x) (newline) ; => (1 (2 (3 4) 5) (6 7))
(display (square-tree-d x)) (newline); => (1 (4 (9 16) 25) (36 49))
(display (square-tree-m x)) (newline); => (1 (4 (9 16) 25) (36 49))

2.29

| 2.29 - クラなんとかの日記 を含むブックマーク はてなブックマーク - 2.29 - クラなんとかの日記 2.29 - クラなんとかの日記 のブックマークコメント

二つ手のモービルをモデル化する問題

こんな感じ.

        mobile(left, right)
left /           \ right
  branch        branch(length, structure(= mobile or 錘))

端点は,錘がある.

問題が長い.確認も面倒そうだ.*1

  • a. left-branch, right-branch, branch-length, branch-structure
  • b. total-weight
  • c. test-balanced
  • d. make-mobile, make-branch を変更したら,コードにどれくらいの変更が必要か?

d. は,公開インターフェイス(left-branch, right-branch, branch-length, branch-stracture) のみの変更で済む.

#!/usr/bin/env gosh
;; -*- coding: utf-8; -*-
; 

;; 準備
;; 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))

;; b.
(define (branch-weight branch)
  (let ((s (branch-structure branch)))
    (if (number? s)
        s
        (total-weight s))))

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

;; c.
(define (balanced? mobile)
  (define (branch-moment branch)
    (* (branch-length branch)
       (branch-weight branch)))
  (let* ((l-b (left-branch mobile))
         (r-b (right-branch mobile))
         (l-s (branch-structure l-b))
         (r-s (branch-structure r-b)))
    (and (or (number? l-s) (balanced? l-s))
         (or (number? r-s) (balanced? r-s))
         (= (branch-moment l-b)
            (branch-moment r-b)))))

;; 確認
(define x (make-mobile (make-branch 1 2) (make-branch 3 4)))
(define y (make-mobile (make-branch 6 2)
                       (make-branch 1 (make-mobile (make-branch 2 4)
                                                   (make-branch 1 8)))))

(display x) (newline) ; => ((1 2) (3 4))
(display y) (newline) ; => ((6 2) (1 ((2 4) (1 8))))
(display (total-weight x)) (newline) ; => 6
(display (total-weight y)) (newline) ; => 14
(display (balanced? x)) (newline); => #f
(display (balanced? y)) (newline); => #t

2.28

| 2.28 - クラなんとかの日記 を含むブックマーク はてなブックマーク - 2.28 - クラなんとかの日記 2.28 - クラなんとかの日記 のブックマークコメント

fringe を作る問題

deep-flatten と言った方がわかりやすいか?

deep-reverse-cons を作ってみた

#!/usr/bin/env gosh
;; -*- coding: utf-8; -*-
; 

;; 準備

;; 答え
(define (fringe tree)
  (define (iter res items)
    (if (null? items)
        res
        (let ((e (car items)))
          (iter (if (pair? e) (iter res e) (cons e res)) (cdr items)))))
  (reverse (iter (list) tree)))

;; 確認
(define x (list (list 1 2) (list 3 4)))

(display x) (newline) ; => ((1 2) (3 4))
(display (fringe x)) (newline) ; => (1 2 3 4)
(display (fringe (list x x))) (newline) ; => (1 2 3 4 1 2 3 4)
(display (fringe (list (list x) (list x)))) (newline) ; => (1 2 3 4 1 2 3 4)

2.27

| 2.27 - クラなんとかの日記 を含むブックマーク はてなブックマーク - 2.27 - クラなんとかの日記 2.27 - クラなんとかの日記 のブックマークコメント

deep-reverse を作る問題

reverse の要素それぞれに deep-reverse を書けるタイミングがあればよい

#!/usr/bin/env gosh
;; -*- coding: utf-8; -*-
; 

;; 準備

;; 答え
; 2.18 より
(define (reverse items)
  (define (iter rev rest)
    (if (null? rest)
        rev
        (iter (cons (car rest) rev) (cdr rest))))
  (iter (list) items))

(define (deep-reverse tree)
  (define (iter rev rest)
    (if (null? rest)
        rev
        (let ((e (car rest)))
          (iter (cons (if (pair? e) (deep-reverse e) e) rev) (cdr rest)))))
  (iter (list) tree))

;; 確認
;(define x (list (list 1 2) (list 3 4)))
(define x (list (list (list 1 2)) (list (list 3 4) (list 5 6))))

(display x) (newline) ; => ((1 2) (3 4))
(display (reverse x)) (newline) ; => ((3 4) (1 2))
(display (deep-reverse x)) (newline) ;=> ((4 3) (2 1))

*1:実際確認のコードの方が頭使った気がする

2009-04-17三昧

2.26

| 2.26 - クラなんとかの日記 を含むブックマーク はてなブックマーク - 2.26 - クラなんとかの日記 2.26 - クラなんとかの日記 のブックマークコメント

#!/usr/bin/env gosh
;; -*- coding: utf-8; -*-
; 

;; 準備

;; 答え

;; 確認
(define x (list 1 2 3))
(define y (list 4 5 6))

(display (append x y)) (newline) ; => (1 2 3 4 5 6)
(display (cons x y)) (newline) ; => ((1 2 3) 4 5 6)
(display (list x y)) (newline) ; => ((1 2 3) (4 5 6))

2.25

| 2.25 - クラなんとかの日記 を含むブックマーク はてなブックマーク - 2.25 - クラなんとかの日記 2.25 - クラなんとかの日記 のブックマークコメント

#!/usr/bin/env gosh
;; -*- coding: utf-8; -*-
; 

;; 準備

;; 答え

;; 確認
(display ((lambda (x)
            (display x) (newline)
            (car (cdr (car (cdr (cdr x))))))
          (list 1 3 (list 5 7) 9))) (newline)

(display ((lambda (x)
            (display x) (newline)
            (car (car x)))
          (list (list 7)))) (newline)

(display ((lambda (x)
            (display x) (newline)
            (car (cdr (car (cdr (car (cdr (car (cdr (car (cdr (car (cdr x)))))))))))))
          (list 1 (list 2 (list 3 (list 4 (list 5 (list 6 7)))))))) (newline)

2.23

| 2.23 - クラなんとかの日記 を含むブックマーク はてなブックマーク - 2.23 - クラなんとかの日記 2.23 - クラなんとかの日記 のブックマークコメント

begin を使っているあたりがあまり綺麗じゃない気がする.

#!/usr/bin/env gosh
;; -*- coding: utf-8; -*-
; for-each

;; 準備

;; 答え
(define (for-each proc items)
  (if (null? items)
      #f
      (begin
        (proc (car items))
        (for-each proc (cdr items)))))

;; 確認
(display (for-each (lambda (x) (display x) (newline))
                   (list 57 321 88))) (newline)

2.22

| 2.22 - クラなんとかの日記 を含むブックマーク はてなブックマーク - 2.22 - クラなんとかの日記 2.22 - クラなんとかの日記 のブックマークコメント

何がおかしいのかを指摘せよ.という問題.

前者のanswer 部は,(cons head tail) なので,先頭に追加する.

追加する要素は,(car things) なのでリストの前から順に使う.

つまり,(a b c d) のリストならば,最初に a が先頭に追加され(a) となり,

次に,b が追加され,(b a) のように逆順になる.

後者は,(cons head tail) の head に現在のリスト,

tail に追加する値を指定している.

つまり,(a b c d) のリストが与えられたなら,最初は空リストなので,

head = (), tail = a つまり,(() . a) 同様に,((() . a) . b)

のようにリストを消費することになる.

逆順が問題であれば,返す値を (reverse answer) すればよい.

以下は,サンプルコード.コピペ用に

続きを読む

2.21

| 2.21 - クラなんとかの日記 を含むブックマーク はてなブックマーク - 2.21 - クラなんとかの日記 2.21 - クラなんとかの日記 のブックマークコメント

#!/usr/bin/env gosh
;; -*- coding: utf-8; -*-
; square-list

;; 準備

;; 答え
(define nil (list))
(define (square x) (* x x))

(define (square-list items)
  (if (null? items)
      nil
      (cons (square (car items)) (square-list (cdr items)))))

(define (square-list2 items)
  (map square items))

;; 確認
(display (square-list (list 1 2 3 4))) (newline) ; => (1 4 9 16)
(display (square-list2 (list 1 2 3 4))) (newline) ; => (1 4 9 16)

2.20

| 2.20 - クラなんとかの日記 を含むブックマーク はてなブックマーク - 2.20 - クラなんとかの日記 2.20 - クラなんとかの日記 のブックマークコメント

#!/usr/bin/env gosh
;; -*- coding: utf-8; -*-
; same-parity

;; 準備

;; 答え
;; (use gauche.collection)
;; (define (same-parity . l)
;;   (filter (if (even? (car l)) even? odd?) l))

(define (same-parity . l)
  (define (iter pred r l)
    (if (null? l)
        (reverse r)
        (let ((head (car l)))
          (iter pred (if (pred head) (cons head r) r) (cdr l)))))
  (iter (if (even? (car l)) even? odd?) (list) l))

;; 確認
(display (same-parity 1 2 3 4 5 6 7)) (newline) ; => (1 3 5 7)
(display (same-parity 2 3 4 5 6 7)) (newline) ; => (2 4 6)

2.19

| 2.19 - クラなんとかの日記 を含むブックマーク はてなブックマーク - 2.19 - クラなんとかの日記 2.19 - クラなんとかの日記 のブックマークコメント

全組合せを網羅するので,コインの順序は無関係.

#!/usr/bin/env gosh
;; -*- coding: utf-8; -*-
; count-charge

;; 準備

;; 答え
(define (first-denomination coin-values)
  (car coin-values))
(define (except-first-denomination coins-values)
  (cdr coins-values))
(define (no-more? coins-values)
  (null? coins-values))

; 問題 2.19 より
(define us-coins (list 50 25 10 5 1))
(define uk-coins (list 100 50 20 10 5 2 1 0.5))

(define (cc amount coin-values)
  (cond ((= amount 0) 1)
        ((or (< amount 0) (no-more? coin-values)) 0)
        (else
         (+ (cc amount
                (except-first-denomination coin-values))
            (cc (- amount
                   (first-denomination coin-values))
                coin-values)))))

;; 確認
(display (cc 100 us-coins)) (newline) ; => 292
(display (cc 100 (reverse us-coins))) (newline) ; => 292
(display (cc 5 uk-coins)) (newline) ; => 292
(display (cc 5 (reverse uk-coins))) (newline) ; => 292

2.18

| 2.18 - クラなんとかの日記 を含むブックマーク はてなブックマーク - 2.18 - クラなんとかの日記 2.18 - クラなんとかの日記 のブックマークコメント

#!/usr/bin/env gosh
;; -*- coding: utf-8; -*-
; reverse

;; 準備

;; 答え
(define (reverse items)
  (define (iter rev rest)
    (if (null? rest)
        rev
        (iter (cons (car rest) rev) (cdr rest))))
  (iter (list) items))

;; 確認
(display (reverse (list 1 4 9 16 25))) (newline)
(display (reverse (list))) (newline)

2.17

| 2.17 - クラなんとかの日記 を含むブックマーク はてなブックマーク - 2.17 - クラなんとかの日記 2.17 - クラなんとかの日記 のブックマークコメント

#!/usr/bin/env gosh
;; -*- coding: utf-8; -*-
; last-pair

;; 準備

;; 答え
(define (last-pair list)
  (if (null? (cdr list))
      list
      (last-pair (cdr list))))

;; 確認
(display (last-pair (list 23 72 149 34))) (newline)
(display (last-pair (list))) (newline)

2.16

| 2.16 - クラなんとかの日記 を含むブックマーク はてなブックマーク - 2.16 - クラなんとかの日記 2.16 - クラなんとかの日記 のブックマークコメント

これを見て,実装しようと思ったんだけど,

多項式の解ってどうすんだっけ?と思って終了.

  • f(x)=(x + 1)\times (x - 1) \hspace{5em} \rm{when} \hspace{5em} x = [-2, 2)

みたいなのを想定してるみたい.

  • 同じ数を認識する
  • 範囲内の変曲点を考慮する

必要があるのでしょうね.

一般的な式を簡単に計算することは難しそうです.

2009-04-12ここからが,合宿の本当の始まりだ

問題 2.14

| 問題 2.14 - クラなんとかの日記 を含むブックマーク はてなブックマーク - 問題 2.14 - クラなんとかの日記 問題 2.14 - クラなんとかの日記 のブックマークコメント

(R1 * R2) / (R1 + R2) と 1 / {(1 / R1) + (1 / R2)} の比較は下の結果を見てもらうとして.

\begin{eqnarray} P(A + A) \approx P(A) \\ P(A * B) \approx P(A) + P(B)\\ P(A / B) \approx P(A) + P(B) \end{eqnarray}

こんな感じになるので,区間同士の掛け算,割り算を使うと誤差的には不利になる.

ここで一方の区間の誤差が極端に小さい(Bの方)場合,

\begin{eqnarray} P(A * B) \approx P(A) + P(B) \approx P(A) \\ P(A / B) \approx P(A) + P(B) \approx P(A) \end{eqnarray}

になるので,相対誤差が掛け算割り算を経由しても近い値に収まる.

今回は,part2 の方が定数項(相対誤差=零)を使って,全体の相対誤差を抑えている.

part1 は,分母の掛け算と全体の割り算で,相対誤差が累積している.

#!/usr/bin/env gosh
;; -*- coding: utf-8; -*-
; 範囲を持った数表現(interval) - percent

;; 準備

;; 答え

;; 回答 2.12 より
(define (make-center-percent c p)
  (let ((w (/ (* c p) 100.0)))
    (make-interval (- c w)
                   (+ c w))))
(define (percent i)
  (let ((w (width i))
        (c (center i)))
    (* (/ w c) 100)))

;; 2.1.4 より
(define (center i)
  (/ (+ (lower-bound i) (upper-bound i)) 2))
(define (width i)
  (/ (- (upper-bound i) (lower-bound i)) 2))

;; 回答 2.11
(define (mul-interval x y)
  (define (cmp-interval x value)
    (cond ((< value (lower-bound x)) -1)
          ((< (upper-bound x) value) 1)
          (else 0)))
  (let ((x_cmp_0 (cmp-interval x 0))
        (y_cmp_0 (cmp-interval y 0)))
    (cond ((and (< x_cmp_0 0) (< y_cmp_0 0))
           (make-interval (* (lower-bound x) (lower-bound y))
                          (* (upper-bound x) (upper-bound y))))
          ((and (< x_cmp_0 0) (= y_cmp_0 0))
           (make-interval (* (upper-bound x) (lower-bound y))
                          (* (upper-bound x) (upper-bound y))))
          ((and (< x_cmp_0 0) (> y_cmp_0 0))
           (make-interval (* (upper-bound x) (lower-bound y))
                          (* (lower-bound x) (upper-bound y))))
          ((and (= x_cmp_0 0) (< y_cmp_0 0))
           (make-interval (* (lower-bound x) (upper-bound y))
                          (* (upper-bound x) (upper-bound y))))
          ((and (= x_cmp_0 0) (> y_cmp_0 0))
           (make-interval (* (upper-bound x) (lower-bound y))
                          (* (lower-bound x) (lower-bound y))))
          ((and (> x_cmp_0 0) (< y_cmp_0 0))
           (make-interval (* (lower-bound x) (upper-bound y))
                          (* (upper-bound x) (lower-bound y))))
          ((and (> x_cmp_0 0) (= y_cmp_0 0))
           (make-interval (* (lower-bound x) (upper-bound y))
                          (* (lower-bound x) (lower-bound y))))
          ((and (> x_cmp_0 0) (> y_cmp_0 0))
           (make-interval (* (upper-bound x) (upper-bound y))
                          (* (lower-bound x) (lower-bound y))))
          (else
           (make-interval (min (* (upper-bound x) (lower-bound y))
                               (* (lower-bound x) (upper-bound y)))
                          (max (* (lower-bound x) (lower-bound y))
                               (* (upper-bound x) (upper-bound y))))))))

; 回答 2.10 より
(define (div-interval x y)
  (define (include-interval i value)
    (and (<= (lower-bound i) value)
         (<= value (upper-bound i))))
  (if (include-interval y 0)
      (error "divider include zero value")
      (mul-interval x
                    (make-interval (/ 1.0 (upper-bound y))
                                   (/ 1.0 (lower-bound y))))))

; 回答 2.8 より
(define (sub-interval x y)
  (add-interval x
                (make-interval (- (upper-bound y))
                               (- (lower-bound y)))))

; 回答 2.7 より
(define (upper-bound interval)
  (cdr interval))
(define (lower-bound interval)
  (car interval))

; 問題文 2.7 より
(define (make-interval a b)
  (cons a b))

; 2.1.4 より
(define (add-interval x y)
  (make-interval (+ (lower-bound x) (lower-bound y))
                 (+ (upper-bound x) (upper-bound y))))

;; 確認
(use slib)
(require 'printf)

(define (display-center-percent i)
  (printf "[c:%10.7f, p:%10.7f%%]" (center i) (percent i)))

(define (display-interval i)
  (format #t "[l:%10.7f, u:%10.7f]" (lower-bound i) (upper-bound i)))

(define R1 (make-center-percent 3.0 10.0))
(define R2 (make-center-percent 4.0 10.0))

(define (part1 i1 i2)
  (div-interval (mul-interval i1 i2) (add-interval i1 i2)))
(define (part2 i1 i2)
  (define one (make-interval 1.0 1.0))
  (div-interval one
                (add-interval (div-interval one i1) (div-interval one i2))))

(display "(R1 * R2) / (R1 + R2)     = ")
(display-center-percent (part1 R1 R2)) (newline)
(display "1 / {(1 / R1) + (1 / R2)} = ")
(display-center-percent (part2 R1 R2)) (newline)

(newline)

(display "A/A") (newline)
(for-each
 (lambda (p)
   (define A (make-center-percent 100.0 p))
   (printf "parcent %5.2f%% => " p)
   (display-center-percent (div-interval A A))
   (newline))
 '(10.0 1.0 0.1 0.01 0.0))
(display "A/B") (newline)
(for-each
 (lambda (p_a)
   (for-each
    (lambda (p_b)
      (define A (make-center-percent 100.0 p_a))
      (define B (make-center-percent 100.0 p_b))
      (printf "p_a %5.2f%%, p_b %5.2f%% => " p_a p_b)
      (display-center-percent (div-interval A B))
      (newline))
    '(10.0 1.0 0.1 0.0)))
 '(10.0 1.0 0.0))
$ ./2.14.scm
(R1 * R2) / (R1 + R2)     = [c: 1.7835498, p:29.2233010%]
1 / {(1 / R1) + (1 / R2)} = [c: 1.7142857, p:10.0000000%]

A/A
parcent 10.00% => [c: 1.0202020, p:19.8019802%]
parcent  1.00% => [c: 1.0002000, p: 1.9998000%]
parcent  0.10% => [c: 1.0000020, p: 0.1999998%]
parcent  0.01% => [c: 1.0000000, p: 0.0200000%]
parcent  0.00% => [c: 1.0000000, p: 0.0000000%]
A/B
p_a 10.00%, p_b 10.00% => [c: 1.0202020, p:19.8019802%]
p_a 10.00%, p_b  1.00% => [c: 1.0011001, p:10.9890110%]
p_a 10.00%, p_b  0.10% => [c: 1.0001010, p:10.0989901%]
p_a 10.00%, p_b  0.00% => [c: 1.0000000, p:10.0000000%]
p_a  1.00%, p_b 10.00% => [c: 1.0111111, p:10.9890110%]
p_a  1.00%, p_b  1.00% => [c: 1.0002000, p: 1.9998000%]
p_a  1.00%, p_b  0.10% => [c: 1.0000110, p: 1.0999890%]
p_a  1.00%, p_b  0.00% => [c: 1.0000000, p: 1.0000000%]
p_a  0.00%, p_b 10.00% => [c: 1.0101010, p:10.0000000%]
p_a  0.00%, p_b  1.00% => [c: 1.0001000, p: 1.0000000%]
p_a  0.00%, p_b  0.10% => [c: 1.0000010, p: 0.1000000%]
p_a  0.00%, p_b  0.00% => [c: 1.0000000, p: 0.0000000%]

2009-04-11SICP 加速会という名の合宿を行いました

問題 2.13

| 問題 2.13 - クラなんとかの日記 を含むブックマーク はてなブックマーク - 問題 2.13 - クラなんとかの日記 問題 2.13 - クラなんとかの日記 のブックマークコメント

用語

中央値
center
許容誤差
width
(パーセント)相対許容誤差
percent

以下,percent を P と略記する.

問題は,P(A\times B) \approx {\rm f}(P(A), P(B)) のように表現したい.ということ.

2つの区間の積の相対許容誤差は,全区間が正の範囲内と仮定すると,

P(A\times B) = \{W(A\times B) / C(A\times B) \} \times 100

ここで,

\left\{ \begin{eqnarray} A\times B &=& \[\{C(A) - W(A)\}\times\{C(B) - W(B)\},\hspace{2em} \{C(A) + W(A)\}\times\{C(B) + W(B)\}\] \\ W(A\times B) &=& \frac{1}{2}\[\{C(A) + W(A)\}\times\{C(B) + W(B)\} - \{C(A) - W(A)\}\times\{C(B) - W(B)\}\] \\ &=& C(A)\cdot W(B) + C(B)\cdot W(A) \\ C(A\times B) &=& \frac{1}{2}\[\{C(A) - W(A)\}\times\{C(B) - W(B)\} + \{C(A) + W(A)\}\times\{C(B) + W(B)\}\] \\ &=& C(A)\cdot C(B) + W(A)\cdot W(B) \end{eqnarray}

ここで,相対許容誤差は中央値より十分小さいという仮定から,

C(A\times B) \approx C(A)\cdot C(B)

これらを最初の式に代入すると,

\begin{eqnarray} P(A\times B) &\approx & \[\{C(A)\cdot W(B) + C(B)\cdot W(A)\} / \{C(A)\cdot C(B)\}\] \times 100 \\ &=& \{W(B) / C(B) + W(A) / C(A)\} \times 100 \\ &=& P(A) + P(B) \end{eqnarray}

問題 2.12

| 問題 2.12 - クラなんとかの日記 を含むブックマーク はてなブックマーク - 問題 2.12 - クラなんとかの日記 問題 2.12 - クラなんとかの日記 のブックマークコメント

#!/usr/bin/env gosh
;; -*- coding: utf-8; -*-
; 範囲を持った数表現(interval) - percent

;; 準備

;; 答え
(define (make-center-percent c p)
  (let ((w (/ (* c p) 100.0)))
    (make-interval (- c w)
                   (+ c w))))
(define (percent i)
  (let ((w (width i))
        (c (center i)))
    (* (/ w c) 100)))

;; 2.1.4 より
(define (center i)
  (/ (+ (lower-bound i) (upper-bound i)) 2))
(define (width i)
  (/ (- (upper-bound i) (lower-bound i)) 2))

;; 回答 2.11
(define (mul-interval x y)
  (define (cmp-interval x value)
    (cond ((< value (lower-bound x)) -1)
          ((< (upper-bound x) value) 1)
          (else 0)))
  (let ((x_cmp_0 (cmp-interval x 0))
        (y_cmp_0 (cmp-interval y 0)))
    (cond ((and (< x_cmp_0 0) (< y_cmp_0 0))
           (make-interval (* (lower-bound x) (lower-bound y))
                          (* (upper-bound x) (upper-bound y))))
          ((and (< x_cmp_0 0) (= y_cmp_0 0))
           (make-interval (* (upper-bound x) (lower-bound y))
                          (* (upper-bound x) (upper-bound y))))
          ((and (< x_cmp_0 0) (> y_cmp_0 0))
           (make-interval (* (upper-bound x) (lower-bound y))
                          (* (lower-bound x) (upper-bound y))))
          ((and (= x_cmp_0 0) (< y_cmp_0 0))
           (make-interval (* (lower-bound x) (upper-bound y))
                          (* (upper-bound x) (upper-bound y))))
          ((and (= x_cmp_0 0) (> y_cmp_0 0))
           (make-interval (* (upper-bound x) (lower-bound y))
                          (* (lower-bound x) (lower-bound y))))
          ((and (> x_cmp_0 0) (< y_cmp_0 0))
           (make-interval (* (lower-bound x) (upper-bound y))
                          (* (upper-bound x) (lower-bound y))))
          ((and (> x_cmp_0 0) (= y_cmp_0 0))
           (make-interval (* (lower-bound x) (upper-bound y))
                          (* (lower-bound x) (lower-bound y))))
          ((and (> x_cmp_0 0) (> y_cmp_0 0))
           (make-interval (* (upper-bound x) (upper-bound y))
                          (* (lower-bound x) (lower-bound y))))
          (else
           (make-interval (min (* (upper-bound x) (lower-bound y))
                               (* (lower-bound x) (upper-bound y)))
                          (max (* (lower-bound x) (lower-bound y))
                               (* (upper-bound x) (upper-bound y))))))))

; 回答 2.10 より
(define (div-interval x y)
  (define (include-interval i value)
    (and (<= (lower-bound i) value)
         (<= value (upper-bound i))))
  (if (include-interval y 0)
      (error "divider include zero value")
      (mul-interval x
                    (make-interval (/ 1.0 (upper-bound y))
                                   (/ 1.0 (lower-bound y))))))

; 回答 2.8 より
(define (sub-interval x y)
  (add-interval x
                (make-interval (- (upper-bound y))
                               (- (lower-bound y)))))

; 回答 2.7 より
(define (upper-bound interval)
  (cdr interval))
(define (lower-bound interval)
  (car interval))

; 問題文 2.7 より
(define (make-interval a b)
  (cons a b))

; 2.1.4 より
(define (add-interval x y)
  (make-interval (+ (lower-bound x) (lower-bound y))
                 (+ (upper-bound x) (upper-bound y))))

;; 確認
(define ohm (make-center-percent 6.8 10.0))

(define (display-center-percent i)
  (format #t "[c:~a, p:~a]" (center i) (percent i)))

(define (display-interval i)
  (format #t "[l:~a, u:~a]" (lower-bound i) (upper-bound i)))

(display-center-percent ohm) (newline)
(display-interval ohm) (newline)

問題 2.11

| 問題 2.11 - クラなんとかの日記 を含むブックマーク はてなブックマーク - 問題 2.11 - クラなんとかの日記 問題 2.11 - クラなんとかの日記 のブックマークコメント

区間の端点の符号を考える.つまり区間と零との比較を考える.

区間A=\[L(A),\hspace{2em} U(A)\]に対しては,以下の3通りが考えられる.

\left\{ \begin{eqnarray} 0 & < & L(A) & < & U(A) & \hfill{325}\hspace{10} \rm(1) \\ L(A) & < & 0 & < & U(A) & \hfill{325}\hspace{10} \rm(2) \\ L(A) & < & U(A) & < & 0 & \hfill{325}\hspace{10} \rm(3) \end{eqnarray}

積の場合,2つの区間A, B を必要とするので,

考えるのは3×3の9 通りになる.

引数の状態
(1)-(1)\[L(A)\cdot L(B),\hspace{2em} U(A)\cdot U(B) \]
(1)-(2)\[U(A)\cdot L(B),\hspace{2em} U(A)\cdot U(B) \]
(1)-(3)\[U(A)\cdot L(B),\hspace{2em} L(A)\cdot U(B) \]
(2)-(1)\[L(A)\cdot U(B),\hspace{2em} U(A)\cdot U(B) \]
(2)-(2)\[{\rm min}(U(A)\cdot L(B),\hspace{2em} L(A)\cdot U(B)),\hspace{2em} {\rm max}(L(A)\cdot L(B),\hspace{2em} U(A)\cdot U(B)) \]
(2)-(3)\[U(A)\cdot L(B),\hspace{2em} L(A)\cdot L(B) \]
(3)-(1)\[L(A)\cdot U(B),\hspace{2em} U(A)\cdot L(B) \]
(3)-(2)\[L(A)\cdot U(B),\hspace{2em} L(A)\cdot L(B) \]
(3)-(3)\[U(A)\cdot U(B),\hspace{2em} L(A)\cdot L(B) \]

符号が負の数を両辺に掛けると,不等号が反転することに注意.

(1)-(1) の場合

L(B) < U(B)の両辺に,L(A), U(A)を掛ける\begin{eqnarray} L(A)\cdot L(B)&<&L(A)\cdot U(B) \\ U(A)\cdot L(B) &<& U(A)\cdot U(B) \end{eqnarray}

小さい方,大きい方同士を比較すると\begin{eqnarray} L(A)\cdot L(B) &<& U(A)\cdot L(B) \\ L(A)\cdot U(B) &<& U(A)\cdot U(B) \end{eqnarray}

なので,解は\[L(A)\cdot L(B),\hspace{2em} U(A)\cdot U(B)\]

(1)-(2) の場合

L(B) < U(B)の両辺に,L(A), U(A)を掛ける\begin{eqnarray} L(A)\cdot L(B)&<&L(A)\cdot U(B) \\ U(A)\cdot L(B) &<& U(A)\cdot U(B) \end{eqnarray}

小さい方,大きい方同士を比較すると\begin{eqnarray} L(A)\cdot L(B) &>& U(A)\cdot L(B) \\ L(A)\cdot U(B) &<& U(A)\cdot U(B) \end{eqnarray}

(L(B)のみ負なので)

なので,解は\[U(A)\cdot L(B),\hspace{2em} U(A)\cdot U(B)\]

(1)-(3) の場合

L(B) < U(B)の両辺に,L(A), U(A)を掛ける\begin{eqnarray} L(A)\cdot L(B)&<&L(A)\cdot U(B) \\ U(A)\cdot L(B) &<& U(A)\cdot U(B) \end{eqnarray}

小さい方,大きい方同士を比較すると\begin{eqnarray} L(A)\cdot L(B) &>& U(A)\cdot L(B) \\ L(A)\cdot U(B) &>& U(A)\cdot U(B) \end{eqnarray}

(L(B),U(B)ともに負なので)

なので,解は\[U(A)\cdot L(B),\hspace{2em} L(A)\cdot U(B)\]

(2)-(1) の場合

L(B) < U(B)の両辺に,L(A), U(A)を掛ける\begin{eqnarray} L(A)\cdot L(B)&>&L(A)\cdot U(B) \\ U(A)\cdot L(B) &<& U(A)\cdot U(B) \end{eqnarray}

小さい方,大きい方同士を比較すると\begin{eqnarray} L(A)\cdot U(B) &<&0&<& U(A)\cdot L(B) \\ L(A)\cdot L(B) &<&0&<& U(A)\cdot U(B) \end{eqnarray}

(L(A) のみが負なので,符号は明らか)

なので,解は\[L(A)\cdot U(B),\hspace{2em} U(A)\cdot U(B)\]

(2)-(2) の場合

L(B) < U(B)の両辺に,L(A), U(A)を掛ける\begin{eqnarray} L(A)\cdot L(B)&>&L(A)\cdot U(B) \\ U(A)\cdot L(B) &<& U(A)\cdot U(B) \end{eqnarray}

小さい方,大きい方同士を比較するが,関係は決められない.

なので,解は\[{\rm min}(L(A)\cdot U(B),\hspace{2em} U(A)\cdot L(B)),\hspace{2em} {\rm max}(L(A)\cdot L(B),\hspace{2em} U(A)\cdot U(B))\]

以降同じなので割愛します.

#!/usr/bin/env gosh
;; -*- coding: utf-8; -*-
; 範囲を持った数表現(interval) - mul

;; 準備

;; 答え
(define (mul-interval x y)
  (define (cmp-interval x value)
    (cond ((< value (lower-bound x)) -1)
          ((< (upper-bound x) value) 1)
          (else 0)))
  (let ((x_cmp_0 (cmp-interval x 0))
        (y_cmp_0 (cmp-interval y 0)))
    (cond ((and (< x_cmp_0 0) (< y_cmp_0 0))
           (make-interval (* (lower-bound x) (lower-bound y))
                          (* (upper-bound x) (upper-bound y))))
          ((and (< x_cmp_0 0) (= y_cmp_0 0))
           (make-interval (* (upper-bound x) (lower-bound y))
                          (* (upper-bound x) (upper-bound y))))
          ((and (< x_cmp_0 0) (> y_cmp_0 0))
           (make-interval (* (upper-bound x) (lower-bound y))
                          (* (lower-bound x) (upper-bound y))))
          ((and (= x_cmp_0 0) (< y_cmp_0 0))
           (make-interval (* (lower-bound x) (upper-bound y))
                          (* (upper-bound x) (upper-bound y))))
          ((and (= x_cmp_0 0) (> y_cmp_0 0))
           (make-interval (* (upper-bound x) (lower-bound y))
                          (* (lower-bound x) (lower-bound y))))
          ((and (> x_cmp_0 0) (< y_cmp_0 0))
           (make-interval (* (lower-bound x) (upper-bound y))
                          (* (upper-bound x) (lower-bound y))))
          ((and (> x_cmp_0 0) (= y_cmp_0 0))
           (make-interval (* (lower-bound x) (upper-bound y))
                          (* (lower-bound x) (lower-bound y))))
          ((and (> x_cmp_0 0) (> y_cmp_0 0))
           (make-interval (* (upper-bound x) (upper-bound y))
                          (* (lower-bound x) (lower-bound y))))
          (else
           (make-interval (min (* (upper-bound x) (lower-bound y))
                               (* (lower-bound x) (upper-bound y)))
                          (max (* (lower-bound x) (lower-bound y))
                               (* (upper-bound x) (upper-bound y))))))))

; 問題 2.10 より
(define (div-interval x y)
  (define (include-interval i value)
    (and (<= (lower-bound i) value)
         (<= value (upper-bound i))))
  (if (include-interval y 0)
      (error "divider include zero value")
      (mul-interval x
                    (make-interval (/ 1.0 (upper-bound y))
                                   (/ 1.0 (lower-bound y))))))

; 問題 2.8 より
(define (sub-interval x y)
  (add-interval x
                (make-interval (- (upper-bound y))
                               (- (lower-bound y)))))

; 問題 2.7 より
(define (upper-bound interval)
  (cdr interval))
(define (lower-bound interval)
  (car interval))

; 問題文 2.7 より
(define (make-interval a b)
  (cons a b))

; 2.1.4 より
(define (add-interval x y)
  (make-interval (+ (lower-bound x) (lower-bound y))
                 (+ (upper-bound x) (upper-bound y))))

(define (mul-interval-org 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 i1 (make-interval 1 2))
(define i2 (make-interval -1 1))
(define i3 (make-interval -2 -1))

(define (display-interval-org-and-new x y)
  (define (display-interval-2d i)
    (format #t "[~@d, ~@d]" (lower-bound i) (upper-bound i)))
  (define (display-prompt x y)
    (display-interval-2d x)
    (display " * ")
    (display-interval-2d y)
    (display " = "))
  (let ((org-result (mul-interval-org x y))
        (new-result (mul-interval x y)))
    (display-prompt x y)
    (display-interval-2d new-result)
    (if (equal? org-result new-result)
        (display " org and new result are same"))
    (newline)))

(display-interval-org-and-new i1 i1)
(display-interval-org-and-new i1 i2)
(display-interval-org-and-new i1 i3)
(display-interval-org-and-new i2 i1)
(display-interval-org-and-new i2 i2)
(display-interval-org-and-new i2 i3)
(display-interval-org-and-new i3 i1)
(display-interval-org-and-new i3 i2)
(display-interval-org-and-new i3 i3)

問題 2.10

| 問題 2.10 - クラなんとかの日記 を含むブックマーク はてなブックマーク - 問題 2.10 - クラなんとかの日記 問題 2.10 - クラなんとかの日記 のブックマークコメント

とりあえず,error 関数を使ってみた.

#!/usr/bin/env gosh
;; -*- coding: utf-8; -*-
; 範囲を持った数表現(interval) - sub

;; 準備

;; 答え
(define (div-interval x y)
  (define (include-interval i value)
    (and (<= (lower-bound i) value)
         (<= value (upper-bound i))))
  (if (include-interval y 0)
      (error "divider include zero value")
      (mul-interval x
                    (make-interval (/ 1.0 (upper-bound y))
                                   (/ 1.0 (lower-bound y))))))

; 問題 2.8 より
(define (sub-interval x y)
  (add-interval x
                (make-interval (- (upper-bound y))
                               (- (lower-bound y)))))

; 問題 2.7 より
(define (upper-bound interval)
  (cdr interval))
(define (lower-bound interval)
  (car interval))

; 問題文 2.7 より
(define (make-interval a b)
  (cons a b))

; 2.1.4 より
(define (add-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)))))

;; 確認
(define (display-interval interval)
  (display "[")
  (display (lower-bound interval))
  (display ", ")
  (display (upper-bound interval))
  (display "]"))

(define i_1 (make-interval 1.0 2.0))
(define i_2 (make-interval 3.0 4.0))
(display "[1.0, 2.0] = ")
(display-interval i_1) (newline)
(display "[1.0, 2.0] + [3.0, 4.0] = ")
(display-interval (add-interval i_1 i_2)) (newline)
(display "[3.0, 4.0] - [1.0, 2.0] = ")
(display-interval (sub-interval i_2 i_1)) (newline)
(display "[1.0, 2.0] * [3.0, 4.0] = ")
(display-interval (mul-interval i_1 i_2)) (newline)
(display "[1.0, 2.0] / [3.0, 4.0] = ")
(display-interval (div-interval i_1 i_2)) (newline)

(display "[1.0, 2.0] / [-3.0, 4.0] = ")
(newline)
(div-interval i_1 (make-interval -3.0 4.0))
$ ./2.10.scm
[1.0, 2.0] = [1.0, 2.0]
[1.0, 2.0] + [3.0, 4.0] = [4.0, 6.0]
[3.0, 4.0] - [1.0, 2.0] = [1.0, 3.0]
[1.0, 2.0] * [3.0, 4.0] = [3.0, 8.0]
[1.0, 2.0] / [3.0, 4.0] = [0.25, 0.6666666666666666]
[1.0, 2.0] / [-3.0, 4.0] =
gosh: "error": divider include zero value

問題 2.9

| 問題 2.9 - クラなんとかの日記 を含むブックマーク はてなブックマーク - 問題 2.9 - クラなんとかの日記 問題 2.9 - クラなんとかの日記 のブックマークコメント

ここで,upper-bound = U, lower-bound = L, center = C, width = W とする.

A = \[L(A), U(A)\], B = \[L(B), U(B)\] という範囲があるとする.

まず,和と差を考える.

2つの区間の和と差はそれぞれ,以下の通り.

A + B = \[L(A) + L(B), U(A) + U(B)\]

A - B = \[L(A) - U(B), U(A) - L(B)\]

ここで,それぞれの区間の幅を考える.

\begin{eqnarray} W(A + B) &=& \frac{1}{2}\[\{L(A) + L(B)\} + \{U(A) + U(B)\}\] \\ &=& \frac{1}{2}\[\{L(A) + U(A)\} + \{L(B) + U(B)\}\] \\ &=& W(A) + W(B) \end{eqnarray}

\begin{eqnarray} W(A - B) &=& \frac{1}{2}\[\{L(A) - U(B)\} + \{U(A) - L(B)\}\] \\ &=& \frac{1}{2}\[\{L(A) + U(A)\} - \{L(B) + U(B)\}\] \\ &=& W(A) - W(B) \end{eqnarray}

次に,積を考える.仮に全ての数が正の数である範囲を考える.

2つの区間の積は,以下の通り.

A \times  B = \[L(A) \cdot  L(B), U(A) \cdot  U(B)\]

区間の幅は,以下の通り.

\begin{eqnarray} W(A \times B) &=& \frac{1}{2}\[\{L(A) \cdot  L(B)\} + \{U(A) \cdot  U(B)\} \\ &=& \frac{1}{2}\[\{C(A) - W(A)\} \cdot  \{C(B) - W(B)\} + \{C(A) + W(A)\} \cdot  \{C(A) + W(A)\}\] \\ &=& \frac{1}{2}\[C(A)\cdot C(B)-C(A)\cdot W(B)-C(B)\cdot W(A)+W(A)\cdot W(B) + C(A)\cdot C(B) + C(A)\cdot W(B) + C(B)\cdot W(A) + W(A)\cdot W(B)\] \\ &=& C(A)\cdot C(B)+W(A)\cdot W(B) \end{eqnarray}

よって,商も同様に元の区間の幅のみで表現できない.

問題 2.8

| 問題 2.8 - クラなんとかの日記 を含むブックマーク はてなブックマーク - 問題 2.8 - クラなんとかの日記 問題 2.8 - クラなんとかの日記 のブックマークコメント

#!/usr/bin/env gosh
;; -*- coding: utf-8; -*-
; 範囲を持った数表現(interval) - sub

;; 準備

;; 答え
(define (sub-interval x y)
  (add-interval x
                (make-interval (- (upper-bound y))
                               (- (lower-bound y)))))

; 問題 2.7 より
(define (upper-bound interval)
  (cdr interval))
(define (lower-bound interval)
  (car interval))

; 問題文 2.7 より
(define (make-interval a b)
  (cons a b))

; 2.1.4 より
(define (add-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)))))

;; 確認
(define (display-interval interval)
  (display "[")
  (display (lower-bound interval))
  (display ", ")
  (display (upper-bound interval))
  (display "]"))

(define i_1 (make-interval 1.0 2.0))
(define i_2 (make-interval 3.0 4.0))
(display "[1.0, 2.0] = ")
(display-interval i_1) (newline)
(display "[1.0, 2.0] + [3.0, 4.0] = ")
(display-interval (add-interval i_1 i_2)) (newline)
(display "[3.0, 4.0] - [1.0, 2.0] = ")
(display-interval (sub-interval i_2 i_1)) (newline)
(display "[1.0, 2.0] * [3.0, 4.0] = ")
(display-interval (mul-interval i_1 i_2)) (newline)
(display "[1.0, 2.0] / [3.0, 4.0] = ")
(display-interval (div-interval i_1 i_2)) (newline)

問題 2.7

| 問題 2.7 - クラなんとかの日記 を含むブックマーク はてなブックマーク - 問題 2.7 - クラなんとかの日記 問題 2.7 - クラなんとかの日記 のブックマークコメント

これは実装するだけ.

#!/usr/bin/env gosh
; -*- coding: utf-8; -*-
; 範囲を持った数表現(interval) - upper/lower

;; 準備

;; 答え
(define (upper-bound interval)
  (cdr interval))
(define (lower-bound interval)
  (car interval))

; 問題文 2.7 より
(define (make-interval a b)
  (cons a b))

; 2.1.4 より
(define (add-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)))))

;; 確認
(define (display-interval interval)
  (display "[")
  (display (lower-bound interval))
  (display ", ")
  (display (upper-bound interval))
  (display "]"))

(define i_1 (make-interval 1.0 2.0))
(define i_2 (make-interval 3.0 4.0))
(display-interval i_1) (newline)
(display-interval (add-interval i_1 i_2)) (newline)
(display-interval (mul-interval i_1 i_2)) (newline)
(display-interval (div-interval i_1 i_2)) (newline)
(display-interval (mul-interval i_1 (make-interval -3.0 -4.0))) (newline)
$ ./2.7.scm
[1.0, 2.0]
[4.0, 6.0]
[3.0, 8.0]
[0.25, 0.6666666666666666]
[-8.0, -3.0]

2009-03-31一人準備会などを敢行す

2.6

| 2.6 - クラなんとかの日記 を含むブックマーク はてなブックマーク - 2.6 - クラなんとかの日記 2.6 - クラなんとかの日記 のブックマークコメント

チャーチ数n を,f^n(x) で表現できると仮定する.

(例えば,n=2 のとき,チャーチ数はf^2(x) = f(f(x)) のように表現できる.ということ)

zero は,f^0(x)=x でOK

add-1 は,f^{n+1}(x)=f(f^n(x)) でOK

数学的帰納法より,自然数n はチャーチ数n として表現できる.

ここまでわかれば,one, two の実装はそのままやればよい.

以下では,数値を表示するのに,f=inc を使っている.

inc を n 回適応して,x = 0 とすれば,チャーチ数表現を数値に変換できる.

; -*- coding: utf-8; -*-
; Church numerals

;; 準備

;; 答え
(define one
  (lambda (f)
    (lambda (x)
      (f x))))

(define two
  (lambda (f)
    (lambda (x)
      (f (f x)))))

(define (plus a b)
  (lambda (f)
    (lambda (x)
      ((a f) ((b f) x)))))

; 問題 2.6 より
(define zero
  (lambda (f)
    (lambda (x)
      x)))

(define (add-1 n)
  (lambda (f)
    (lambda (x)
      (f ((n f) x)))))

;; 確認
(define (display-church n)
  (define (inc x) (+ x 1))
  (display ((n inc) 0)))

(display "zero = ")
(display-church zero) (newline)
(display "one = ")
(display-church one) (newline)
(display "two = ")
(display-church two) (newline)
(display "(+ 1 0) = ")
(display-church (add-1 zero)) (newline)
(display "(+ 1 2) = ")
(display-church (add-1 two)) (newline)
(display "(+ (+ 1 2) 2) = ")
(display-church (plus (add-1 two) two)) (newline)
$ gosh 2.6.scm
zero = 0
one = 1
two = 2
(+ 1 0) = 1
(+ 1 2) = 3
(+ (+ 1 2) 2) = 5

2.5

| 2.5 - クラなんとかの日記 を含むブックマーク はてなブックマーク - 2.5 - クラなんとかの日記 2.5 - クラなんとかの日記 のブックマークコメント

2, 3 は互いに素なので,

x = 2^a * 3^b ならば,a, b は1つに決まる.

つまり,x を 2(又は 3) で割っていって割り切れなくなったら,

その回数がa(又は b) となる.

2で割り切れないある数に3 を何回掛けても,2 で割り切れる状態にはならない.

逆もそう.これが互いに素ということ.

結果が変化無いのがちょっと面白い.

; -*- coding: utf-8; -*-
; 素数の積によって cons, car, cdr を表現する.

;; 準備

;; 答え
(define base-car 2) ; 互いに素である必要がある
(define base-cdr 3)
  
(define (** k n)
  (define (loop r i)
    (if (= i 0)
        r
        (loop (* r k) (- i 1))))
  (loop 1 n))

(define (divide-times x k) ; x を k で何回割ることができるか
  (define (loop i r)
    (if (not (= (remainder r k) 0))
        i
        (loop (+ i 1) (/ r k))))
  (loop 0 x))

(define (cons x y)
  (* (** base-car x)
     (** base-cdr y)))

(define (car z)
  (divide-times z base-car))

(define (cdr z)
  (divide-times z base-cdr))

;; 確認
(define pair (cons 1 2))
(display (car pair)) (newline)
(display (cdr pair)) (newline)
$ gosh 2.5.scm
1
2

2.4

| 2.4 - クラなんとかの日記 を含むブックマーク はてなブックマーク - 2.4 - クラなんとかの日記 2.4 - クラなんとかの日記 のブックマークコメント

lambda に慣れてないと難しい?

cons は,『「2引数の関数」を引数に取るような関数』を返す.

渡された引数の関数に初期値の第一,第二引数を渡す.

car は,与えられた引数を関数と見做し,第一引数として

「第一引数を返す関数」を適応した結果を返す.

結果,cons に car を適応すると,

  • 「cons の結果の関数」の引数に「第一引数を返す関数」を渡す.
  • 「第一引数を返す関数」にcons の初期値(第一引数,第二引数)を渡す.
  • cons の初期値のうち第一引数が返される.

同様に,cdr は,引数に「第二引数を返す関数」を渡して適応すればよい.

; -*- coding: utf-8; -*-
; cons, car, cdr の新しい手続き

;; 準備

;; 答え
(define (cdr z)
  (z
   (lambda (p q) q)))

; 問題2.4 問題文
(define (cons x y)
  (lambda (m)
    (m x y)))

(define (car z)
  (z
   (lambda (p q) p)))

;; 確認
(define pair (cons 1 2))
(display (car pair)) (newline)
(display (cdr pair)) (newline)
$ gosh 2.4.scm
1
2

MarvEaselryMarvEaselry2017/05/07 14:13References On Effects Of Amoxicillin Cephalexin And Sore Throat <a href=http://byuvaigranonile.com>viagra</a> Sildenafil 50 Mg In Uk Does Amoxicillin Suspension Treat Abladder Infection

KennerenKenneren2017/06/16 19:59Kamagra Without Prescription <a href=http://viacheap.com>generic viagra</a> Citalopram Without Perscription Comment Durer Longtemps <a href=http://how-much-is-kamagra.kamagpills.com>How Much Is Kamagra</a> Compra Kamagra Rxpills Cialis <a href=http://cial40mg.com/cheapest-cialis-online.php>Cheapest Cialis Online</a> Finasteride 1 Mg 5 Mg Comprar Propecia

|