カテゴリー : Book

「数学文章作法 基礎編」という本を結城さんが出すらしい.


【お知らせ】4月10日に刊行される結城浩の最新刊『数学文章作法 基礎編』(ちくま学芸文庫)を抽選で無料プレゼントいたします。 (^^)http://t.co/beAowBStFx
@hyuki
結城浩

ま,また僕に本を買わせる気ですか結城さんー!

IMG_7475]

実のところ,僕の所属する研究室には大分優遇してもらってて,技術書や数学書は研究費で購入してもらうことが多いです.修士二年間で買ってもらった本の総額はちょっとこの場では言えないぐらいになっています.

しかし,なぜか「数学ガールは自費で買う」という謎の制約を自分に課しており,これまでもそうしてきました.

閑話休題

今回結城さんが出す本は「数学文章作方(さくほうと読むらしい) 基礎編」という本で,おそらくは「数学ガール」を始めとした「一般人でも分かりやすく興味をひく数学本」を多く買いている結城浩さんの作法エッセンスがツラツラと書かれているのでしょう.「基礎」と言ってるのであまり崩せないでしょうが,結城さんらしい「作法」が読んでみたいです.

正直な話,僕みたいな学生にとっては「理科系の作文技術」という大定番があるので,文章作法本のような本を心待ちにしていたわけではありません.結局論文・文章を読み&書きまくることが一番の方法だと思いますしね.

しかし結城さんですよ.数学ガールの作者ですよ.それなら読みたいですよ.という感じで,この記事を書いた次第です.

作法本の発売が楽しみです.どのような内容になってるのでしょうか.

個人的には「数式と数式を繋ぐ論理の流れ,滑らかに説明(それでいて硬くなり過ぎない)する流麗な文章の書き方」などなど期待しています.一般向けの方々に文章を書くコツ等があるのかもしれませんしね.

C++ 始めました.

色々な事情から

C++製の正規表現エンジンを書くことになりました.

(実を言うと大学3年の時に, 学科のプロジェクトで3D格闘ゲームを作成したことがあるんですが,, そいつは *C++*製, ライブラリにOpenSceneGraph を使っていました. 規模的には3000行ぐらい.

とりあえず C++ の知識やデザパタ, エフェスタ(effective style) に関してなんにも知らない.

ということで

技術書に頼ることにしました. といってもまるっきり素人向けだと読むのがたるいし時間も勿体無いので

  • 各言語共通ではなく, C++ に特化した良書
  • TL上の C++er さんたちが推してる良書
  • C++ の仕組みが分かる良書

に絞って選んだつもり(しらんけど.

 

こんな感じ

C++積んでみた

C++はピアソン・エデュケーション一強?

ここらへん に比べると「まだまだ積み込みが甘い!」と言われそうですが,

おいおい”入門”だぜ?

ってことで:-)

エンジンの実装と並行して読み進めるのが良いか, ある程度読んで実装に進むのが良いか…

とりあえずは C++製エンジンのRE2 のコードやら上の本等読み進めて行く感じで. (大丈夫か?

Russ Cox 先生なら素晴らしいコードに仕上がってるはず!!!

 

SICP Reading #20 [3.1 ~ 3.2.3] 局所の入れ物としてのフレーム

院試/学会が無事終了したということでSICP勉強会再開.
2章の残りをまとめるのがメンドクサイのでそのまま3章に突入するなど :-p

環境/フレーム

SICPで定義されるScheme処理系では, 式の評価に必要な変数(名前)と値の対応を格納してる環境という構造があり, 環境はさらにフレームで構成される.

たとえば, 式

(define (square x)
        (* x x))

を実行した時の環境を考えてみると.

のような図で説明することができるとのこと(SICP表記とはちょっと変えてるけど).

(define (square x)
  (* x x))

をもうちょっと詳しく考えてみると, これは

(define square
  (lambda (x)
     (* x x)))

の syntax-sugar なので, すなわち.

defineは

現在のフレームに 名前と値 の対応を書き込む.

lambdaは

関数のオブジェクト(クロージャ)を返す. オブジェクトはlambda 実行持の環境の参照を持つ.

lambda 実行時の環境への参照を持つというのがミソで, これがすなわちレキシカルクロージャーってことかな.

内部定義とかでは, このフレームが連鎖してくとのこと.

ここまでわかれば, 問題も楽勝.

問題 3.10

手続き make-withdraw が以下のように与えれた場合.

(define (make-withdraw initial-amount)
  (let ((balance initial-amount))
    (lambda (amount)
      (if (>= balance amount)
          (begin (set! balance (- balance amount))
                 balance)
          "Insufficient founds"))))

次の式を実行した時の環境構造を示せというもの.

(define W1 (make-withdraw 100))
(W1 50)
(define W2 (make-withdraw 100))

まず

make-withdraw の定義文の syntax-sugar を剥ぎ取る!! (わかりやすくね.)

let は ((lambda でクロージャを作って) 適用する) syntax-sugar.

(let ((<var> <exp>)) <body>)

((lambda (<var>) body) <exp>)

また, define の syntax-sugar も剥ぎとると, make-withdraw の定義は

(define make-withdraw
  (lambda (initial-amount)
    ((lambda (balance)
       (lambda (amount)
         (if (>= balance amount)
             (begin
               (set! balance (- balance amount))
               balance)
             "Insufficient funds")))
     initial-amount)))

となる.

(lambda (initial-amount) ~~) が実行されると, 大域環境を環境に持ったクロージャが返る. それに対して defineで make-withdraw という名前で環境に書き込む. この時点での環境構造を図で表すとこんな感じ.

lambda と define のここの役割がわかれば, 簡単.
この調子で問題をといてみる.

W1を定義

微妙に説明してなかったけど, 関数オブジェクトに引数を与えるということは, 引数に対応するフレームを追加し, 関数オブジェクトのコード本体を実行するということなので, initial-amount が載ってるフレームが新規に作成される.

ここで

make-withdraw に対応した関数オブジェクトのコード部分

((lambda (balance)
       (lambda (amount)
             <body>)))
     initial-amount)

では, 度のlambda が実行される. しかも, 1度目のlambda は名前がつけられないまま適用される!! (その結果として評価されるべきlambda 式が返る)

結果を図にしてみる.

ここで,

  • フレームE1は, (make-withdraw 100)という関数実行持に作られたフレーム
  • フレームE2は,名前もつけられないまま実行された (lambda (balance) ) を initial-balance を引数で実行した時に作成されたフレーム
  • (W1 50) を実行してみる

    (W1 50)を実行すると, W1に対応する関数オブジェクトのコード内部で, (set! balance ~) によって balance の値を書き換えるる. ここで, 「balance の値を書き換える」とは, フレームをたどって, balance に対応する値を書き換えるということなので, 結果は

    と, 構造は変わらず, フレームE2の balance の値が変更される.

    W2を定義

    ここで, もうひとつの講座オブジェクト W2 を作るとどうなるのか? と言う問題.

    (define W2 (make-withdraw 100))

    W2を上記の式で定義すると, W1と同様のプロセスを辿る. ここで重要なのは, 生成されるフレーム(環境)は別ということ.

    図で注目する点として,

    1. W1, W2 の関数オブジェクトは, それぞれ異なる環境への参照を持ってる.
    2. W1, W2 の関数オブジェクトは, コード部を共有してる.

    1点目が, W1, W2をそれぞれ別のオブジェクトとして扱える基礎となってるのは言うまでもないですね.
    2点目に関しては, SICP 「処理系の実装による」と注記されていた. (この辺は5章でやるのかな?)

    今回は

    Scheme の実行モデル, クロージャ, 再代入…. いろいろ開眼した気がする.
    *複雑なので図にミスあるかも >< 指摘, 訂正大歓迎です.

SICP Reading #19 [2.2.3] 公認インターフェースとしての並び

春休みはSICPガッツリ進めるぜ!と意気込んでいたけど、微妙に時間を割けてない感じで不甲斐ない。。
とりあえず溜まってる更新をサラッと済ませる。

全てはリスト処理

まず例として以下のコード実装を

木を引数にとり、奇数である葉の二乗を返す
(define (sum-odd-squares tree)
  (cond ((null? tree) 0)
        ((not (pair? tree))
         (if (odd? tree) (squares tree) 0))
        (else (+ (sum-odd-squares (car tree))
                 (sum-odd-squares (cdr tree))))))
引数n以下の偶数のFibonacci数のリストを返す
(define (even-fibs n)
  (defien (next k)
    (if (> k n)
        '()
        (let ((f (fib k)))
          (if (even? f)
              (cons f (next (+ k 1)))
              (next (+ k 1)))))))

2つの手続きの実装を見てみると、当然全く違う処理の流れに見える。
(どちらも再帰だけど、木の処理は二重再帰だしね)

だけど、どちらも抽象的に記述すると似通っていて、かつどちらも

  • enumerate (数え上げ)
  • accumulate (リスト演算)
  • map (リスト変換)
  • filter (リストのフィルタ)

という高階な処理で記述できるよね、という感じ。

  • 木の葉を数え上げる[enumerate]
  • 奇数でフィルタ[filter]
  • 選ばれた要素を二乗[map]
  • 要素を0初期値で加算[accumulate]

及び

  • 整数を0からnまで数え上げる[enumerate]
  • それぞれの要素でFibonacci数を計算[map]
  • 偶数でフィルタ[filter]
  • 要素を空リスト初期値でcons[accumulate]

よって

処理なんて全部(?)こんな感じのリスト処理に落とせるじゃん!明白じゃん!
“リスト”というデータ構造の処理に落とし込むことで、プログラミングの各ステージが明瞭だし、独立性が高くなるね(っていうことかな?)。

問題2.33

map, append, lengthの実装穴埋め問題

(define (accumulate op initial sequence)
  (if (null? sequence)
      initial
      (op (car sequence)
          (accumulate op initial (cdr sequence)))))

(define (map p sequence)
  (accumulate (lambda (x y) (cons (p x) y)) '() sequence))

(map (lambda (x) (* x x)) '(1 2 3 4 5 6 7 8 9 10))
;gosh> (1 4 9 16 25 36 49 64 81 100)

(define (append seq1 seq2)
  (accumulate cons seq2 seq1))

(append '(1 2 3) '(4 5))
;gosh> (1 2 3 4 5)

(define (length sequence)
  (accumulate (lambda (x y) (+ y 1)) 0 sequence))

(length '(1 2 3 4 4 890))
;gosh> 6

問題2.34

hornerの方法を使って、xの多項式の演算をaccumulateで実装する問題

(add-load-path ".")
(load "q2-33")

(define (horner-eval x coefficient-sequence)
  (accumulate (lambda (this-coeff higher-terms)
                (+ this-coeff (* higher-terms x)))
              0
              coefficient-sequence))

(horner-eval 2 '(1 3 0 5 0 1))
;gosh> 79
;; 実質こういうこと
;; (let1 x 2 (+
;;            1
;;            (* 3 x)
;;            (* 5 (expt x 3))
;;            (expt x 5)))

問題2.35

2.2.2節のcount-leavesをaccumulateで。
提示された条件では、mapを使ってたけど最初に思い浮かんだのは以下な実装

(add-load-path ".")
(load "q2-33")

;;2.2.2の実装は
(define (count-leaves x)
  (cond ((null? x) 0)
        ((not (pair? x)) 1)
        (else (+ (count-leaves (car x))
                 (count-leaves (cdr x))))))

;;accumulate版. map使わない方が自然に思いついた
(define (count-leaves t)
  (accumulate (lambda (x y)
                (+ (if (pair? x) (count-leaves x) 1)
                   y))
              0
              t))

(count-leaves '(1 2 (3 4) (5 6) (7 8 (9 1))))
;gosh> 10

一応、指定通りmapを使ってみた版も

;;map使う場合(提示された条件)
(define (count-leaves t)
  (accumulate (lambda (x y) (+ x y))
              0
              (map (lambda (x) (if (pair? x)
                                   (count-leaves x)
                                   1)) t)))

accumulateに渡すのはリスト!!
ってのが自然だと思うかから、mapの中で再帰して最終的に各部分木の葉の数のリストに変換して一気に処理するほうが見通しがいいかもしれないと思った。

問題2.36

accumulateのmulti-list対応版

(add-load-path ".")
(load "q2-33.scm")

(define (accumulate-n op init seqs)
  (if (null? (car seqs))
      '()
      (cons (accumulate op init (map
                                 (lambda (x) (car x))
                                 seqs))
            (accumulate-n op init (map (lambda (x) (cdr x))
                                       seqs)))))

テストしてみないと不安..

(add-load-path ".")
(load "q2-37.scm")

(use gauche.test)
(test-start "accumulate-n")

(define s '((1 2 3) (4 5 6) (7 8 9) (10 11 12)))

(print "s = " s)
(test* "(accumulate-n + 0 s)"
       '(22 26 30)
       (accumulate-n + 0 s))
(test-end)
SHINYA% gosh q2-36.test.scm
Testing accumulate-n ...
s = ((1 2 3) (4 5 6) (7 8 9) (10 11 12))
test (accumulate-n + 0 s), expects (22 26 30) ==> ok
passed.

(テスト少な!!)まぁOK?

問題2.37

ベクトル演算。 ベクトルなんて所詮リストのリストだよね!
小さい手続きから実装していくと、意外に簡単に実装できた。 C++のオブジェクトで実装して結構苦戦した記憶が。。(まぁそっちでは逆行列とかも導出してたわけだけど)

(add-load-path ".")
(load "q2-36")

(define map (with-module gauche map))
(define v1 '(1 2 3))
(define v2 '(4 5 6))
(define m  '((1 2 3) (4 5 6) (7 8 9)))

(define (dot-product v w)
  (accumulate + 0 (map * v w)))

(dot-product v1 v2)
;gosh> 32

(define (matrix-*-vector m v)
  (map (lambda (x) (dot-product x v)) m))

(matrix-*-vector m v1)
;gosh> (14 32 50)

(define (transpose mat)
  (accumulate-n cons '() mat))

m
;gosh> ((1 2 3) (4 5 6) (7 8 9))
(transpose m)
;gosh> ((1 4 7) (2 5 8) (3 6 9))

(define (matrix-*-matrix m n)
  (let ((cols (transpose n)))
    (map (lambda (x)
           (map (lambda (y) (dot-product x y))
                cols)) m)))

(define m1 '((1 2) (3 4)))

(matrix-*-matrix m1 m1)
;((7 10) (15 22))

(matrix-*-matrix '((1 2 3)
                   (4 5 6)
                   (7 8 9))
                 '((1 0 0)
                   (0 1 0)
                   (0 0 1)))
;基本行列Eとの掛け算. E*A = A*E = A
;gosh> ((1 2 3) (4 5 6) (7 8 9))

問題2.34

accumulateは要素同士の演算を右から左に行なう。逆に演算したい場合は
再帰で評価を保留しておくべし。

(define (fold-right op initial sequence)
  (if (null? sequence)
      initial
      (op (car sequence)
          (fold-right op initial (cdr sequence)))))

(define (fold-left op initial sequence)
  (define (iter result rest)
    (if (null? rest)
        result
        (iter (op result (car rest))
              (cdr rest))))
  (iter initial sequence))

この二つのaccumulate実装で、結果が同じとなるような演算opの定義についての問題。
「op: 交換則がなりたつ演算の場合(加算,乗算) fold-right/leftの結果は同値」かな。

;;成り立つ
(fold-right + 0 (list 1 2 3 4 5 6))
;gosh> 21
(fold-left  + 0 (list 1 2 3 4 5 6))
;gosh> 21
(fold-right * 1 (list 1 2 3 4 5 6))
;gosh> 720
(fold-left  * 1 (list 1 2 3 4 5 6))
;gosh> 720

;;成り立たない
(fold-right / 1 (list 1 2 3))
;(/ 1 (/ 2 (/ 3 1))) -> 3/2
(fold-left  / 1 (list 1 2 3))
;(/ (/ (/ 1 1) 2) 3) -> 1/6
(fold-right list '() (list 1 2 3))
;gosh> (1 (2 (3 ())))
(fold-left list '() (list 1 2 3))
;gosh> (((() 1) 2) 3)

問題2.39

実装の穴埋め問題

(add-load-path ".")
(load "q2-38.scm")
;; with fold-right
(define (reverse-fr sequence)
  (fold-right (lambda (x y)
                (append y (list x))) '() sequence))
;(append (append (append '() '(3)) '(2)) '(1))

;; with fold-left
(define (reverse-fl sequence)
  (fold-left (lambda (x y)
               (cons y x)) '() sequence))
;(cons 3 (cons 2 (cons 1 '())))

appendはリストの末尾までたどってポインタを入れ替えるからO(n), consはセルで包むだけなのでO(1) (多分)。
かつfold-rightは再帰ので(null? sequence)という最終条件が来るまで式が展開されるので、再帰が深いとスタックをヒープにコピーする作業でガツンと遅くなる場合がある(らしい)。

(use srfi-1)
(time (begin (reverse-fr (iota 1200 0)) #t))
;gosh> ;(time (begin (reverse-fr (iota 1200 0)) #t))
; real   0.271
; user   0.270
; sys    0.000
;#t

(time (begin (reverse-fl (iota 500000 0)) #t))
;gosh> ;(time (begin (reverse-fl (iota 500000 0)) #t))
; real   0.236
; user   0.240
; sys    0.010
;#t

;;スケールするのは反復的プロセス!!

(time (begin (fold-right * 1 (iota 10000 0)) #t))
(time (begin (fold-left  * 1 (iota 10000 0)) #t))

;append -> O(n)
;cons   -> O(1)

まぁ、appendの遅延なんて取るに足らないと思うけど。

上記の件はid:yamanetoshiさんのブログでshiroさんがコメントしてくれてたり。

goshを-fcollect-starsオプションで起動するとスタックオーバーフローの回数やら時間やらが見れるらしい。使わせてもらいますとも。

SICP Reading #18 [2.2.2] 階層構造

前節で扱った非常にシンプルなデータ構造リストを組み合わせて、木などの階層構造も表現できるよね。という感じらしい。

問題2.24

(list 1 (list 2 (list 3 4)))

を評価した結果のデータ構造を図で書け、という問題。書いたけど見せれる物ではないのでここではスルー。

問題2.25

提示されたリストから、”7″をとりだす操作をcar と cdrで書け!という問題。

(define l1 '(1 3 (5 7) 9))
(car (cdr (car (cdr (cdr l1)))))
;gosh> 7
(car (cdaddr l1))
;gosh> 7

(define l2 '((7)))
(car (car l2))
;gosh> 7
(caar l2)
;gosh> 7

(define l3 '(1 (2 (3 (4 (5 (6 7)))))))
(car (cdr (car (cdr (car (cdr (car (cdr (car (cdr (car (cdr l3))))))))))))
;gosh> 7

問題2.26

リスト演算を評価した結果を予想する問題。
とりあえず結果から。

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

(append x y)
;gosh> (1 2 3 4 5 6)

(cons x y)
;gosh> ((1 2 3) 4 5 6)

(list x y)
;gosh> ((1 2 3) (4 5 6))

リスト は お尻がnilな対の連鎖。
appendは第一引数のリストの末尾のnilを台に引数に変更する命令。
なので第一引数はリストじゃなくてはならないけど、第二引数はリストじゃなくても良い。
でも、その場合は結果はリストじゃなくなる(末尾がnilでない)。

(append x 3)
;gosh> (1 2 3 . 3)
(list? (append x 3))
;gosh> #f

consした結果が((1 2 3) 4 5 6)ってのは一瞬アレ?って思ったけど、cdrした結果が(4 5 6)となることを考えれば当然。

listはx, yのリストを作ってx, yをそれぞれ置き換えればok.

問題

listの入れ子にも対応したreverse手続きdeep-reverseを定義する問題。
reverse対象のlistの要素がlistなら、再帰的にreverseすれば良いので、いかな定義に

(define (deep-reverse lst)
  (let iter ((lst lst) (rev '()))
    (if (null? lst) rev
        (iter (cdr lst) (cons
                         (if (pair? (car lst))
                             (deep-reverse (car lst))
                             (car lst))
                         rev)))))

テスト

僕のとは気合い違うテスト。
実はid:yamanetoshiさんが書いてたり :-)

(add-load-path ".")
(load "q2-27")

(use gauche.test)
(test-start "deep-reverse")
(test-section "deep-reverse")
(test* "'() to '()"
      '()
      (deep-reverse '()))

(test* "'(1) to '(1)"
      '(1)
      (deep-reverse '(1)))

(test* "'(1 2) to '(2 1)"
      '(2 1)
      (deep-reverse '(1 2)))

(test* "'((1 2) 3 4) to '(4 3 (2 1))"
      '(4 3 (2 1))
      (deep-reverse '((1 2) 3 4)))

(test* "'((1 2) (3 4)) to '((4 3) (2 1))"
      '((4 3) (2 1))
      (deep-reverse '((1 2) (3 4))))

(test* "'(1 2 3 (4 5) 6 (7 8)) to '((8 7) 6 (5 4) 3 2 1)"
      '((8 7) 6 (5 4) 3 2 1)
      (deep-reverse '(1 2 3 (4 5) 6 (7 8))))

(test* "'(1 (2 3 (4 5)) 6 (7 (8))) to '(((8) 7) 6 ((5 4) 3 2) 1)"
      '(((8) 7) 6 ((5 4) 3 2) 1)
      (deep-reverse '(1 (2 3 (4 5)) 6 (7 (8)))))
(test-end)
SHINYA% gosh q2-27.test.scm
Testing deep-reverse ...
<deep-reverse>-----------------------------------------------------------------
test '() to '(), expects () ==> ok
test '(1) to '(1), expects (1) ==> ok
test '(1 2) to '(2 1), expects (2 1) ==> ok
test '((1 2) 3 4) to '(4 3 (2 1)), expects (4 3 (2 1)) ==> ok
test '((1 2) (3 4)) to '((4 3) (2 1)), expects ((4 3) (2 1)) ==> ok
test '(1 2 3 (4 5) 6 (7 8)) to '((8 7) 6 (5 4) 3 2 1), expects ((8 7) 6 (5 4) 3 2 1) ==> ok
test '(1 (2 3 (4 5)) 6 (7 (8))) to '(((8) 7) 6 ((5 4) 3 2) 1), expects (((8) 7) 6 ((5 4) 3 2) 1) ==> ok
passed.

問題2.28

木構造(入れ子リスト)のデータを受け取り、木のすべての葉を左から右に順に並べたリストを返す手続きを実装する問題
要は、tree->list

(define x (list (list 1 2) (list 3 4)))

(define (fringer tree)
  (cond ((null? tree) '())
        ((pair? tree)
         (append (fringer (car tree))
                 (fringer (cdr tree))))
        (else (list tree))))

なんで”fringer”って名前なのか微妙に謎

以下な感じで動いてる。

(fringer x)
;gosh> (1 2 3 4)

(fringer (list x x))
;gosh> (1 2 3 4 1 2 3 4)
(fringer (cons x x))
;gosh> (1 2 3 4 1 2 3 4)
(fringer (append x x))
;gosh> (1 2 3 4 1 2 3 4)

問題2.29

木構造を用いて2進モービルを表現し、色々な演算を定義していく。
最初2進モービルってなんぞ?って感じだったけど、まぁ天秤みたいなモノのことらしい。
天秤に天秤をぶらさげることもできるので、まぁcompositeパターン。

定義は以下。

;;2進モービル(天秤)
(define (make-mobile left right)
  (list left right))

(define (make-branch length structure)
  (list length structure))

選択子(インタフェース)の定義

consではなくlistなので、2番目の要素が取りたい場合はcadr(cdrするとlistが帰る)。

(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 (mobile-weight mobile)
  (+ (branch-weight (left-branch mobile))
     (branch-weight (right-branch mobile))))

(define (branch-weight branch)
  (if (pair? (branch-structure branch))
      (mobile-weight (branch-structure branch))
      (branch-structure branch)))

ブランチが釣り合ってるか判定する手続き

rootのブランチだけでなく、全ての部分ブランチが釣り合ってる場合にのみ#tを返すという制約が。

(define (branched? mobile)
  (if (not (pair? mobile)) #t
      (let ((lb (left-branch mobile))
            (rb (right-branch mobile)))
        (if (= (* (branch-weight lb) (branch-length lb))
               (*   (branch-weight rb) (branch-length rb)))
            (and (branched? (branch-structure lb))
                 (branched? (branch-structure rb)))
            #f))))

この実装だと、部分木の重さを調べるmobile-weightが余分に呼び出されてしまうけど、memoizeすればいいじゃん。ってことでスルー:-)

ここでテスト

(add-load-path ".")
(load "q2-29.scm")

(use gauche.test)
(test-start "mobile test")

(define b1 (make-branch 4 8))
(define b2 (make-branch 8 4))
(define m1 (make-mobile b1 b2))

(test* "mobile test 1"
       #t
       (branched? m1))

(define b3 (make-branch 3 6))
(define b4 (make-branch 9 2))
(define m2 (make-mobile b3 b4))

(test* "mobile test 2"
       #t
       (branched? m2))

(define b5 (make-branch 2 m1))
(define b6 (make-branch 3 m2))
(define m3 (make-mobile b5 b6))

(test* "mobile test 3"
       #t
       (branched? m3))

(test-end)
SHINYA% gosh q2-29.test.scm
Testing mobile test ...
test mobile test 1, expects #t ==> ok
test mobile test 2, expects #t ==> ok
test mobile test 3, expects #t ==> ok
passed.

あまり気合いの入ってないテストだけど、とりあえずOKぽい!

mobileのlistをconsにした場合

mobileのデータ構造をlistからconsの入れ子に変更した場合どうなる?という問題。
データ構造と処理を、インタフェースで区切っていたおかげでインタフェースの変更のみでOK

;;list を cons にした場合
(define (make-mobile left right)
  (cons left right))

(define (make-branch length structure)
  (cons length structure))

;;インターフェースのみを変更 cadr -> cdr
(define (right-branch mobile)
  (cdr mobile))

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

2進の場合はconsが最適。 n進(そんなのあるのか?)だとlistな必要が。

問題2.30

問題2.21で実装したsquare-listの木構造版を実装する問題。

(define (square x) (* x x))

(define (square-tree tree)
  (if (null? tree) '()
      (cons (if (pair? (car tree))
                (square-tree (car tree))
                (square (car tree)))
            (square-tree (cdr tree)))))

mapを使うと以下な感じで実装できる。

(define (map proc items)
  (if (null? items) '()
      (cons (proc (car items))
            (map proc (cdr items)))))

(define (mapped-square-tree tree)
  (map (lambda (t) (if (pair? t)
                       (mapped-square-tree t)
                       (square t))) tree))

テスト

一応書いたのでテスト

(add-load-path ".")
(load "q2-30")

(use gauche.test)
(test-start "square-tree")
;;(test-section "make-rat")
(test* "square-tree"
       '(1 (4 (9 16) 25) (36 49))
       (square-tree
        (list 1
              (list 2 (list 3 4) 5)
              (list 6 7))))

(test* "square-tree (use map)"
       '(1 (4 (9 16) 25) (36 49))
       (mapped-square-tree
        (list 1
              (list 2 (list 3 4) 5)
              (list 6 7))))

(test-end)
SHINYA% gosh q2-30.test.scm
Testing square-tree ...
test square-tree, expects (1 (4 (9 16) 25) (36 49)) ==> ok
test square-tree (use map), expects (1 (4 (9 16) 25) (36 49)) ==> ok
passed.

問題2.31

2.30の実装を抽象化し、mapのtree版を実装する問題

(add-load-path ".")
(load "q2-30")

(define (tree-map proc tree)
  (if (null? tree) '()
      (cons (if (pair? (car tree))
                (tree-map proc (car tree))
                (proc (car tree)))
            (tree-map proc (cdr tree)))))

tree-mapを用いると、square-treeが

(define (square-tree proc tree) (treemap square tree))

と定義できる。これは嬉しい。

問題2.32

最後に若干質の違う問題。
冪集合の問題。
Xの冪集合は、Xの先頭要素xを除いた集合の冪集合とその各要素にxを加えた集合の和集合。
日本語でも再帰的な定義。以下のコードは上の定義をそのままコードに落とした感じ。

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

ちなみに、gaucheでsubsetsを実行すると

(subsets '(1 2 3))
;gosh> (() #0=(3) #1=(2) #2=(2 . #0#) (1) (1 . #0#) (1 . #1#) (1 . #2#))

となっているけど、これはどうやら同値なオブジェクトを共有しているということらしい。

(define s (subsets '(1 2 3)))
(eq? (list-ref s 3) (cdr (list-ref s 7)))
;gosh> #t

手続きeq?は
“ふたつとも同じ型で、ドット対かベクター、または、文字列でメモリの同じ場所にあるとき”
なので、メモリ節約のソレかな。実装はハッシュとか?

 
Better Tag Cloud