83's

Top > Archives > 2006 > December

December 01, 2006

Y combinatorってやつ 05:26

図書館に返さないといけないので、 あとでわかるようにThe Little SchemerのY combinatorの導出過程をなぞったやつをメモメモ。

Little Schemerはlengthでやってたけど、ここではリストの和を返す手続きを作ってみる。 「それapplyでできるよ!」ってのは置いといて。

(use gauche.test)

(define (eternity x)
  (eternity x))

(test-section "lambda, lambda, lambda, ...")

; 長さ0のリストの和までおk
(define sum0-a
  ((lambda (sum)
     (lambda (l)
       (cond ((null? l) 0)
             (else (+ (car l) (sum (cdr l)))))))
   eternity))

; 長さ1のリストの和までおk
(define sum1-a
  ((lambda (sum)
     (lambda (l)
       (cond ((null? l) 0)
             (else (+ (car l) (sum (cdr l)))))))
   sum0-a))

; 長さ2のリストの和までおk
(define sum2-a
  ((lambda (sum)
     (lambda (l)
       (cond ((null? l) 0)
             (else (+ (car l) (sum (cdr l)))))))
   sum1-a))

(test "sum0-a" 0 (cut sum0-a '()))
(test "sum1-a" 1 (cut sum1-a '(1)))
(test "sum1-a" 3 (cut sum2-a '(1 2)))

(test-section "lambdaの連鎖をDRY")

(define sum0-b
  ((lambda (mk-sum)
     (mk-sum eternity))
   (lambda (sum)
     (lambda (l)
       (cond ((null? l) 0)
             (else (+ (car l) (sum (cdr l)))))))))

(define sum1-b
  ((lambda (mk-sum)
     (mk-sum
       (mk-sum eternity)))
   (lambda (sum)
     (lambda (l)
       (cond ((null? l) 0)
             (else (+ (car l) (sum (cdr l)))))))))

(define sum2-b
  ((lambda (mk-sum)
     (mk-sum
       (mk-sum
         (mk-sum eternity))))
   (lambda (sum)
     (lambda (l)
       (cond ((null? l) 0)
             (else (+ (car l) (sum (cdr l)))))))))

(test "sum0-b" 0 (cut sum0-b '()))
(test "sum1-b" 1 (cut sum1-b '(1)))
(test "sum1-b" 3 (cut sum2-b '(1 2)))

(test-section "eternityの代わりにmk-sumを")

(define sum0-c
  ((lambda (mk-sum)
     (mk-sum mk-sum))
   (lambda (sum)
     (lambda (l)
       (cond ((null? l) 0)
             (else (+ (car l) (sum (cdr l)))))))))

(test "sum0-c" 0 (cut sum0-c '()))

(test-section "このsumはmk-sumだよね")

(define sum0-d
  ((lambda (mk-sum)
     (mk-sum mk-sum))
   (lambda (mk-sum)
     (lambda (l)
       (cond ((null? l) 0)
             (else (+ (car l) (mk-sum (cdr l)))))))))

(test "sum0-d" 0 (cut sum0-d '()))

(test-section "mk-sumの引数はリストじゃなくて。ちなみにこれで再帰が1回増やせる")

(define sum1-e
  ((lambda (mk-sum)
     (mk-sum mk-sum))
   (lambda (mk-sum)
     (lambda (l)
       (cond ((null? l) 0)
             (else (+ (car l) ((mk-sum eternity) (cdr l)))))))))

(test "sum1-e" 1 (cut sum1-e '(1)))

(test-section "これで良くね?")

(define sum-f
  ((lambda (mk-sum)
     (mk-sum mk-sum))
   (lambda (mk-sum)
     (lambda (l)
       (cond ((null? l) 0)
             (else (+ (car l) ((mk-sum mk-sum) (cdr l)))))))))

(test "sum-f" 0 (cut sum-f '()))
(test "sum-f" 1 (cut sum-f '(1)))
(test "sum-f" 3 (cut sum-f '(1 2)))
(test "sum-f" 6 (cut sum-f '(1 2 3)))

(test-section "(mk-sum mk-sum)はsum")

(define sum-g
  ((lambda (mk-sum)
     (mk-sum mk-sum))
   (lambda (mk-sum)
     ((lambda (sum)
        (lambda (l)
          (cond ((null? l) 0)
                (else (+ (car l) (sum (cdr l)))))))
      (lambda (x)
        ((mk-sum mk-sum) x))))))

;(define sum-g-eternity
;  ((lambda (mk-sum)
;     (mk-sum mk-sum))
;   (lambda (mk-sum)
;     ((lambda (sum)
;        (lambda (l)
;          (cond ((null? l) 0)
;                (else (+ (car l) (sum (cdr l)))))))
;      (mk-sum mk-sum))))) ; ここで先にループしてしまう

(test "sum-g" 0 (cut sum-g '()))
(test "sum-g" 1 (cut sum-g '(1)))
(test "sum-g" 3 (cut sum-g '(1 2)))
(test "sum-g" 6 (cut sum-g '(1 2 3)))

(test-section "抽出")

(define sum-h
  ((lambda (s)
     ((lambda (mk-sum)
        (mk-sum mk-sum))
      (lambda (mk-sum)
        (s (lambda (x)
             ((mk-sum mk-sum) x))))))
   (lambda (sum)
     (lambda (l)
       (cond ((null? l) 0)
             (else (+ (car l) (sum (cdr l)))))))))

(test "sum-h" 0 (cut sum-h '()))
(test "sum-h" 1 (cut sum-h '(1)))
(test "sum-h" 3 (cut sum-h '(1 2)))
(test "sum-h" 6 (cut sum-h '(1 2 3)))

(test-section "分離")

(define ?
  (lambda (s)
    ((lambda (mk-sum)
       (mk-sum mk-sum))
     (lambda (mk-sum)
       (s (lambda (x)
            ((mk-sum mk-sum) x)))))))

(define sum-i
  (? (lambda (sum)
      (lambda (l)
        (cond ((null? l) 0)
              (else (+ (car l) (sum (cdr l)))))))))

(test "sum-i" 0 (cut sum-i '()))
(test "sum-i" 1 (cut sum-i '(1)))
(test "sum-i" 3 (cut sum-i '(1 2)))
(test "sum-i" 6 (cut sum-i '(1 2 3)))

; これをY combinatorという
(define Y
  (lambda (p)
    ((lambda (f) (f f))
     (lambda (f)
       (p (lambda (x) ((f f) x)))))))

(test-section "lengthを使わないで再帰を定義")

(define length
  (Y (lambda (len)
       (lambda (l)
         (cond ((null? l) 0)
               (else (+ 1 (len (cdr l)))))))))

(test "length 0" 0 (cut length '()))
(test "length 3" 3 (cut length '(1 2 3)))
(test "length 5" 5 (cut length '(1 2 3 4 5)))

(test-end)

うーん、わかったようなそうでもないような。まあ流れだけだなぁ。

さて、また変な時間(21時〜3時)に寝てしまって、変な時間から起きてるわけだが。

バックトレースに色つけ 17:05

Railsでテストしてるときにエラーるとバックトレースが10数行出るけど、 そん中から見たいのは自分で書いたファイルだと思うんだけど、 これ探すのが微妙に大変でみんなどうしてるんだろうと常々疑問なんだけど、 オレは色を付けてみることにしてみたんだけど。

test_helper.rbに以下を追記。

require "redgreen"

class Test::Unit::Error
  def long_display
    old_long_display.sub('Error', Color.yellow('Error')).gsub(%r{^.*(/app/|/test/).*$}, Color.red('\&'))
  end
end

自分で書いたファイルの行が赤くなる。

バックトレース中の自分のファイルを赤く

11月読んだ本 18:46

なんだか読んだ気がしないが。

(´Д`)つThe Little Schemer

これはなかなか良い入門本だった。 見かけにだまされてはいけない。

オレは1年くらい前にScheme入門済みのはずだったんだけど、 Chapter 8の継続渡しとChapter 9のY Combinatorは 名前知ってるだけの状態だったので簡単にはいかなかった。

続編のThe Seasoned Schemerを勢いで購入してみた。 そして積む。

(´Д`)つBinary Hacks ―ハッカー秘伝のテクニック100選

さらさらっと眺めた。

(´Д`)つ若者はなぜ3年で辞めるのか? 年功序列が奪う日本の未来

かなり影響を受けた。 関係ないけど、説明がとてもすんなり入ってくる小気味の良い本だったような気がする。

あー、いい加減なレビューだな。

December 27, 2006

えっと、生きてます 08:42

今月はなんか鬱過ぎてなんもやってない。 寝てることが多かった気がする。風邪もひいたし。

精神的に疲れた1ヶ月だった。 やりたいこと一つでもできただろうか……。ないな。 なんとか気力を取り戻したいもんです。