Hatena::ブログ(Diary)

mtsuyuguの日記

2009-03-05

徹子の部屋 twitter bot リリースしました

個人ブログの方でも書きましたが徹子の部屋 twitter bot "tetsuko_room"をリリースしました。朝 9 時にその日の徹子の部屋のゲストを紹介してくれるというただそれだけのボットです。

徹子の部屋に旬の人が出るのを見逃したくない方、若手芸人が潰される様子を見逃したくない方、小沢昭一とのコスプレの会を見逃したくない方、年末のタモリの会を見逃したくない方、どうぞ follow してご利用くださいませ。

拙作の姉妹ボットとして伊集院光 bot "titon"もあります。こちらは伊集院ラジオで喋ったキャラクターが毎時 0 分を知らせしてくれるのと、毎朝6時にその日に伊集院が出演する番組について教えてくれるボットです。併せてご愛顧のほどお願いいたします。

不具合を見つけた場合は @mtsuyugu まで d をお願いします。ソース一式は github で公開しています

2008-12-07

Exercise 4.9

while の展開を行う処理を考えてみる。 束縛変数のない名前付き let でループさせれば等価になるはずなので、

(define (while-predicate exp) (cadr exp))
(define (while-body exp) (cddr exp))
(define (while->let exp)
  (let->combination
    (make-named-let 'while
                    '()
                    (list (make-if (while-predicate exp)
                             (make-begin (append (while-body exp) '((while))))
                             '#t )))))

としてみた。while の値が #t になっているけど、ここは別に何でもいいと思う。ちなみにGauche は while の値は不定みたいだ。

実際に展開させてみると、

gosh> (while-expand '(while (< i 10) (set! i (+ i 1)) (print i)))
((lambda ()
   (define while
     (lambda () (if (< i 10)
                  (begin (set! i (+ i 1))
                         (print i)
                         (while))
                  #t)))
   (while)))

となる。手続きの名前に while を使ってるけど、定義した後で即座に呼び出しているので評価時に実は別のモノに束縛されてました、みたいなことにはならないはず。

gosh> (define i 0)
i
gosh> (eval (while-expand '(while (< i 10) (set! i (+ i 1)) (print i))) '())
1
2
3
4
5
6
7
8
9
10
#t

うまくいった。ただ、実際には名前付き let を let に展開した時のように while の body の部分も逐次展開していく必要がある。

2008-12-06

Exercise 4.8

今度は名前付き let を lambda に展開する問題。

一瞬どうするの?と戸惑ったけど、具体例を書いてみると

(let foo ((a 1)
          (b 2))
       (print "abc")
       (+ 1 a b))

(lambda (a b)
   (define foo (lambda (a b)
                  (print "abc")
                  (+ 1 a b)))
   (foo 1 2))

に変換するということが分かった(変な例ですが…)ので、それをそのまま起こして、

(define (make-lambda parameters body)
  (cons 'lambda (cons parameters body)))
(define (make-let bind body)
  (cons 'let (cons bind body)))
(define (make-define name exp)
  (list 'define name exp))

(define (let->combination exp)
  (let* ((name (if (let-named? exp) (let-name exp) #f))
         (body (let-body (if name (cdr exp) exp)))
         (bind (let-bind (if name (cdr exp) exp)))
         (procedure (make-lambda (let-parameters bind) body)))
    (if name
      (cons (make-lambda (let-parameters bind)
                         (list (make-define name procedure)
                               (cons name (let-parameters bind))))
            (let-arguments bind))
      (cons procedure (let-arguments bind)))))

となった。

Exercise 4.7

今度は let* 式を等価の let 式に変形する問題

(define (make-let bind body)
  (cons 'let (cons bind body)))
(define (let-parameters exp) (map car (car exp)))
(define (let-arguments exp) (map cadr (car exp)))
(define (let-bind exp) (cadr exp))
(define (let-body exp) (cddr exp))
(define (let-first-bind exp) (car exp))
(define (let-rest-bind exp) (cdr exp))

(define (let*->nested-lets exp)
  (let*->nested-lets-iter (let-bind exp) (let-body exp)))
(define (let*->nested-lets-iter bind body)
  (make-let (list (let-first-bind bind))
            (if (null? (let-rest-bind bind))
              body
              (list (let*->nested-lets-iter (let-rest-bind bind) body)))))

実際に動かしてみて

gosh> (let*->nested-lets  '(let* ((x 3) (y (+ x 2))) (+ x y) (* x y)))
(let ((x 3)) (let ((y (+ x 2))) (+ x y) (* x y)))

となるので、let式への展開は OK。

ただし、これをさらに Exercise 4.6 で作成した let->combination で lambda まで展開させた場合、

(let->combination  (let*->nested-lets  '(let* ((x 3) (y (+ x 2))) (+ x y) (* x y))))
((lambda (x) (let ((y (+ x 2))) (+ x y) (* x y))) 3)

と、一番外側の let しか展開されないので、そのまま評価器の eval に乗せることはできない。

Exercise 4.6

let 式を等価の lambda 式に変形する問題。

(define (let->combination exp)
    (let ((body (let-body exp))
          (bind (let-bind exp)))
      (cons (cons 'lambda (cons (let-parameters bind) body))
            (let-arguments bind))))

(define (let-parameters exp) (map car exp))
(define (let-arguments exp) (map cadr exp))
(define (let-bind exp) (cadr exp))
(define (let-body exp) (cddr exp))

とやってみた。 Gauche 上で動かしてみて、

gosh> (let->combination '(let ((a 1)(b 2)) (print "abc") (+ a b)))
((lambda (a b) (print "abc") (+ a b)) 1 2)
gosh> (eval (let->combination '(let ((a 1)(b 2)) (print "abc") (+ a b))) '())
abc
3

と出るので、おそらく正しい。

Exercise 4.5

(cond (test => recipient))
 普通の cond に変換する
(cond (test (recipient test)))
 if に展開する。
(if test (recipient test))

と変形できるので、cond の処理は次のようになる。

(define (cond-arrow-caluse? clause)
  (eq? (cadr clause) '=>))
(define (cond-arrow-recipient clause) (caddr clause))

(define (expand-clauses clauses)
  (if (null? clauses)
      '#f                          ; no else clause
      (let ((first (car clauses))
            (rest (cdr clauses)))
        (if (cond-else-clause? first)
          (if (null? rest)
            (sequence->exp (cond-actions first))
            (error "ELSE clause isn't last -- COND->IF"
                   clauses))
          (if (cond-arrow-clause? first)     ; <== ココを追加した
            (make-if (cond-predicate first)
                     (list (cond-arrow-recipient first) (cond-predicate first))
                     (expand-clauses rest))
            (make-if (cond-predicate first)
                     (sequence->exp (cond-actions first))
                     (expand-clauses rest)))))))

2008-10-04

マルチステートメント

a=10;  b=20;  c=a+b;

 のように書くのがマルチステートメントです。1行に複数の命令を記述する、とても気持ち悪い記述方法です。

 でも昔はちゃんと意味がありました。まだコンピューターが貧弱だった時代、マルチステートメントで記述することで、

  • ちょっとだけメモリが節約され、
  • ちょっとだけ処理スピードが上がった、

 のです。

コーディングスタイルの常識をぶち壊せ (2/2):CodeZine(コードジン)

マルチステートメントでメモリ節約、処理スピードが上がる、ってどういう事だろう?

と思ったらどうやらインタプリタ言語での話のようだ。

2008-09-30

compact-number-list

higepon さんの d:id:higepon:20080925:1222326246 をやってみました。

こういう問題です。

整列済みの number のリストがある。

'(1 3 4 5 6 12 13 15)

このようなリストで数が連続している部分は '(1 2 3) -> '(1 . 3) のように両端のみを書くような記法を導入する。

最初の例のリストであれば以下のようになる。

'(1 (3 . 6) (12 . 13) 15)

このようなリストの変換をするコードを書きたい。

http://d.hatena.ne.jp/higepon/20080925/1222326246

で、わたしの書いたコードがこちら。

(use srfi-1)

(define (compact-number-list lst)
  (define (consec? a b)
    (if (pair? a)
      (= (+ (cdr a) 1) b)
      (= (+ a 1) b)))
  (define (update-range a b)
    (if (pair? a)
      (cons (car a) b)
      (cons a b)))
  (let loop ((result (list (car lst)))
             (rest (cdr lst)))
    (if (null? rest)
      (reverse result)
      (let ((prev (car result))
            (now (car rest)))
        (loop (if (consec? prev now)
                (cons (update-range prev now) (cdr result))
                (cons now result))
              (cdr rest))))))

(define (expand-compacted-list lst)
  (append-map (lambda (x)
                (if (pair? x)
                  (iota (- (cdr x) (car x) (- 1)) (car x))
                  (list x)))
              lst))

(compact-number-list '(1 3 4 5 6 12 13 15))

(expand-compacted-list  (compact-number-list '(1 3 4 5 6 12 13 15)))

流れは higepon さんのと同じですが、if を loop の中に入れて、苦し紛れながらもスッキリさせてみました。

逆の expand もやってみましたけど、こちらは瞬殺。