2011/05/25

consでqueue

仕事のコードレビュー(？)でtlistを見た。(どんな職場だ)(良い職場だ)
どこかで見たと思ったらLOLとPAIPだった。LOLのtlistは基本的にはSICPのqueueと同じもので、PAIPにも同様のもの(tconc)とその改良版としてのqueueが掲載されていた。
まずは、LOLのtlist(基本的にSICPのqueueと同じもの)と、PAIPのtconc。
;; car : キューの内容へのポインタ
;; cdr : 最後のconsへのポインタ

(define (make-queue)
  (cons '() '()))

;; PAIP P.322 ～
(define (tconc item q)
  (set! (cdr q)
        (let ((v (cons item '())))
          (if (null? (cdr q))
              (set! (car q) v)
              (set! (cddr q) v))
          v))
  q)


;; LOL P.213 ～
;; SICP P.153 ～
(define (tlist-push! tl elm)
  (let ((x (cons elm '())))
    (if (null? (car tl))
        (set! (car tl) x)
        (set! (cddr tl) x))
    (set! (cdr tl) x)
    tl))

PAIP P.322 ～
tconcの実装には欠点がある。最初の要素をキューへ追加する場合と、次の要素を追加する場合で処理が異なるので、取るべきアクションを決定するために、if文を使用する必要があることである。下記に示したキューの定義では、賢明な技法を使用して欠点を回避している。最初に、2つのフィールドの順序が反転されている。consセルのcarが最後の要素で、cdrがキューの内容である。2番目に、空のキューは、cdr(キューの内容)はnilで、car(最後の要素)はcons自身である。

PAIPの改良版queue。以前gauche書いていたものを再掲。
;; PAIP P.322 ～
;; car : 最後のconsへのポインタ
;; cdr : キューの内容へのポインタ

(define (queue-contents q)
  (cdr q))

(define (make-queue)
  (rlet1 q (cons '() '())
         (set! (car q) q)))

(define (enqueue item q)
  (set! (car q)
        (rlet1 f (cons item '())
               (set! (cdr (car q)) f)))
  q)

(define (dequeue q)
  (pop! (cdr q))
  (when (null? (cdr q))
    (set! (car q) q))
  q)

(define (front q)
  (car (queue-contents q)))

(define (empty-queue? q)
  (null? (queue-contents q)))
(define (queue-append! q ls)
  (set! (cdr (car q)) ls)
  (set! (car q)
        (last-pair q))
  q)
実用 Common Lisp (IT Architects’Archive CLASSIC MODER)
written by time: 0 件のコメント:
labels : , ,

2011/05/23

カッコいい言語

さっき書いた「束縛」の話
で「Lisp Scheme Part31」を眺めてたらこんな一言があった。
284 : デフォルトの名無しさん : 2010/10/19(火) 22:42:57
どんなカッコいい言語を使うかより、どんなものを作ったかを誇れよ。
ごもっともでございますね。


もう一つポールグレアムとダークドレアムで笑ったけど、これは以前書いてた。これは憶えやすい。

そういや最近仕事で必要になる知識（の基礎部分）が本当にちょくちょくSICPに載ってる話だったりする。でも「（あーこれSICPに載ってたわ・・・。でも憶えてない、というよりちゃんと読んでない。。）」ということが結構あってorz状態。ちゃんと読まんといかんのでしょうな。

計算機プログラムの構造と解釈
written by time: 0 件のコメント:
labels :

何が何を束縛するって？

「変数（シンボル）が値を束縛する」のか「値が変数（シンボル）を束縛する」のかわからなくなる時ありませんか。私はよく混乱します。正確にはどっちだったっけ？と。

そういえばよくあることなんだけど、こないだもLispの「束縛」の厳密な言い回しについて混乱した。「シンボルが値を束縛する」んじゃなくて「値がシンボルを束縛する」で良いんだよな。
そこで、教えてもらったのが実にわかりやすかったのでここにメモっておきます。
@valvallow 自分もよく混乱します。 unbound variable と言うのだから束縛されるのは変数（シンボル）と覚えるとよい、と聞いてから大分混乱しなくなりました

あと、以前見かけたこれも。
203 : デフォルトの名無しさん : 2010/10/13(水) 18:56:05
(define a 1234)

では、正しいのはどれ？

（１）「aが1234を束縛している」
（２）「1234がaに束縛されている」
（３）「1234がaを束縛している」
（４）「aが1234に束縛されている」

（１）（２）が正しいように思い込んでる。
207 : デフォルトの名無しさん : 2010/10/13(水) 20:05:19
>>203
束縛が作られてもオブジェクト (値) の側は他の束縛を作ることもできるのに対し、
変数にとってはその束縛が唯一無二のものだってことを意識すると
「オブジェクトが変数を束縛している」ってことに納得できる。

R5RS だと 3.1 あたりに記述があるね。
「誤用しがちだけど、別に大して混乱もしないよ」ってことも書いてあるからぶっちゃけ気にしないで問題ないと思う。

せっかくなのでR5RSの3.1からも。
識別子は，構文の型の名前に，または値を格納できる場所の名前になり得る。構文の型の名前になっている識別子は，構文キーワード (syntactic keyword ) と呼ばれ，その構文に束縛 (bound ) されていると言われる。場所の名前になっている識別子は，変数 (variable) と呼ばれ，その場所に束縛されていると言われる。

ついでにこれ良いですね。

計算機プログラムの構造と解釈
written by time: 0 件のコメント:
labels :

2011/05/21

日記

3月にぎっくり腰をしたばかりですが、最近は首が痛いです。肩凝りもかなりヒドくてヤバそうなんですが、それとは別に首が痛いのです。姿勢が悪いのかなー。今週末こそ整体に行かなければ。

ぎっくり腰は10年ぶり。今回も前回も重いものを持ったわけではないのですがねー。そして同じく10年前に首がまわらなくなったことがあったので、今回も恐いです。10年前といえば、まだ高校生なんですけどね。


最近は「星を継ぐもの (創元SF文庫)」を読んで以降、続編の「ガニメデの優しい巨人 (創元SF文庫)」「巨人たちの星 (創元SF文庫 (663-3))」を読みました。これまーじ面白いっすね。ワクワク感ハンパない。引き込まれて帰ってこれない感もなかなかです。スケールは壮大だし、終盤の展開のスピード感や伏線の回収、どんでん返し、続編に続きそうな残る謎。今はさらに続編の「内なる宇宙〈上〉 (創元SF文庫)」を読みはじめたところです。帰ってこれない系の本が読みたいです。

で、今日ようやくビッグコミックで連載中の「星を継ぐもの」のマンガを読みました。今年の2月に連載が始まったそうで、今日読んだのは6話でした。どうやらアナザーストーリーなんですかね？ガニメアンの描写が楽しみ過ぎます。

ググったら画像（想像？）が。

最近、技術書を読んだり、家でのプログラミングから少し遠ざかったりしていました。それも落ちついてきて、技術書を読むことやプログラミングをする意欲が戻ってきた気がします。意欲が戻るというのも変ですね。なくなっていたわけではないです。

仕事の疲れもあって家でグッタリしていたりもしました。ご飯作ったり、ネット見たり。(仕事はハードじゃないですが、1年以上もブラブラしていたこともあり、働くとなかなか疲れます)

Scheme修行

ところで！「Scheme手習い」の続編「Scheme修行」（つまりThe Little Schemerの続編のThe Seasoned Schemerの和訳）がもうすぐ発売されるそうですね！おめでとうございます！
『Scheme修行』を印刷所に入校した！ http://bit.ly/l5UYPl 未訳だった"The Seasoned Schemer"の翻訳です。6月17日発売予定（だと思う）。これを読めば継続がわかります。この本については書きたいことがいっぱいあるけど140文字は少なすぎる

読むのが楽しみです！

この流れなら「The Reasoned Schemer」の和訳もそのうち・・・？

「The Little MLer」とか「A Little Java, A Few Patterns (Language, Speech, & Communication)」とかも読んでみたいなー。

outputz

outputzとか貼ってみる。情報はEmacsから。
初めはEmacsからgrowlするようにしてましたが、なかなかのウザさだったので切りました。
4月分。scheme三昧！scheme-mode三昧！4月の土日は見事にお休みしてますね。。
4/2011 Outputz
87,467bytes

powered by Outputz.
4/2011 Outputz
87,467bytes

powered by Outputz.
4/2011 Outputz
87,467bytes

powered by Outputz.

Scheme手習い
written by time: 0 件のコメント:
labels : , ,

フラットなリストをネストしたリストに

こういうリストを
(1 2 3 4 :hoge 5 6 7 8 9 10 :end 11 12 13 :foo 14 15 16 :bar 17 18 :baz 19 20 :end :end 21 22 :end 23 24)
こういう風に
(1 2 3 4 (:hoge 5 6 7 8 9 10 :end) 11 12 13 (:foo 14 15 16 (:bar 17 18 (:baz 19 20 :end) :end) 21 22 :end) 23 24)

あまり良い感じのコードも思い浮かばなかったので、素直に（愚直に？）書きました。(gauche)
(define (flat->nest start-pred end-pred ls
                    :optional (filter-func identity))
  (let rec ((ls ls)(acc '()))
    (if (null? ls)
        (values (reverse acc) '())
        (cond ((start-pred (car ls))
               (receive (nested rest)
                   (flat->nest start-pred end-pred (cdr ls) filter-func)
                 (rec rest (cons (filter-func (cons (car ls) nested)) acc))))
              ((end-pred (car ls))
               (values (reverse (cons (car ls) acc))
                       (cdr ls)))
              (else (rec (cdr ls)(cons (car ls) acc)))))))

実行
(define data
  '(1 2 3 4
      :hoge 5 6 7 8 9 10 :end
      11 12 13
      :foo 14 15 16 :bar 17 18 :baz 19 20 :end :end
      21 22 :end 23 24))

(flat->nest (^x (and (keyword? x)
                     (not (eq? :end x))))
            (^x (eq? :end x))
            data)

;; (1 2 3 4
;;    (:hoge 5 6 7 8 9 10 :end)
;;    11 12 13
;;    (:foo 14 15 16 (:bar 17 18 (:baz 19 20 :end) :end)
;;          21 22 :end)
;;    23 24)
いろいろとアレなので、どなたか良い感じにカッチョイイのがあったら教えてください。

追記

コメント欄より。
(define (flat->nest s e ls)
  (let loop ((a (pop! ls)))
    (cond ((null? ls) (cons a '()))
          ((s a)
           (let1 b (cons a (loop (pop! ls)))
             (cons b (loop (pop! ls)))))
          ((e a) (cons a '()))
          (else (cons a (loop (pop! ls)))))))
破壊的な操作も無条件に避けるのではなく、上手に取り入れないといけませんね。

Scheme手習い
written by time: 5 件のコメント:
labels : ,

scheme(gauche)でもsleep-sort

その他のソート

面白いすねー。

ソース

(use gauche.threads)

(define (sleep-sort . nums)
  (let* ((result '())
         (threads (map (^n (thread-start!
                            (make-thread
                             (^ _ (thread-sleep! n)
                                (push! result n)))))
                       nums)))
    (for-each (pa$ thread-join!) threads)
    (reverse result)))

(define-macro (macro-sleep-sort . nums)
  `(list ,@(apply sleep-sort nums)))

実行してみます。
(use math.mt-random)
(use srfi-1)

(define rand
  (let1 m (make <mersenne-twister>)
    (^n (mt-random-integer m n))))

(define (make-rand-list n)
  (list-tabulate n (^ _ (rand n))))

(time
 (apply sleep-sort (make-rand-list 10)))
;; ;(time (apply sleep-sort (make-rand-list 10)))
;; ; real   9.004
;; ; user   0.000
;; ; sys    0.016
;; (0 1 1 4 5 6 7 8 9 9)

(time
 (macro-sleep-sort 9 8 0 7 5 7 2 3 1))
;(time (macro-sleep-sort 9 8 0 7 5 7 2 3 1))
; real   0.000
; user   0.000
; sys    0.000
(0 1 2 3 5 7 7 8 9)

ところで、マクロには apply がないわけですし、可変長引数ではなくリストで受け取るようにしようとするわけです。が、コンパイルタイムに引数を評価してソートまで実行する方法がわからなくてevalしました。こういう時はどうしたら良いんでしょうか。何か良い方法があるんでしょうか。
(define-macro (macro-sleep-sort2 nums)
  (let ((nums (eval nums (current-module))))
    `(list ,@(apply sleep-sort nums))))


(time
 (macro-sleep-sort2 (make-rand-list 10)))
;; ;(time (macro-sleep-sort2 (make-rand-list 10)))
;; ; real   0.000
;; ; user   0.000
;; ; sys    0.000
;; (0 2 3 3 6 6 6 7 8 9)




written by time: 2 件のコメント:
labels : , , ,

2011/05/18

gauche に macrolet

私が書いたものではなく@kikuchan98さんが書いたものです。
ネタ元はもちろんcommon lispのmacrolet。どこまでcommon lispのmacroletと同様に動作するかはまだ不明です。

やろうと思えばこんなことまでできるんですね。

(define-macro (macrolet letargs . body)
  `(let-syntax
       ,(map (lambda (elm)
               (cons (car elm) `((,(with-module gauche.internal make-macro-transformer) (gensym) ,(cadr elm)))))
             letargs)
     ,@body))

(display
 (let ((n 9))
   (macrolet ((hoge (lambda x `(list ,@x)))
              (fuge (lambda x `(+ ,@x)))
              (square (lambda (x)
                        (let ((g!x (gensym)))
                          `(let ((,g!x ,x))
                             (* ,g!x ,g!x))))))
             (hoge 1 2 (fuge 1 2 3)(square (inc! n)))))
 )

;; -> (1 2 6 100)#<undef>


(undocumentedな？gauche.internalモジュールのmake-macro-transformerが使われています。というかユーザーが使うことは想定されていないものですよね・・・。なんつってもinternalですしおすし。)

@kikuchan98さんは自称LISP初心者ですが、gaucheでサクッとtemplate engineを書いたり、jsonに.（ドット）記法でアクセスできるwith-jsonマクロをgaucheでサクッと書いたり、すげーっす。。
曰く、伝統的マクロを書くということ（というよりLOLで言うところのquasiquoteの梯子の昇降か）はCのポインタ操作と似ていて馴染みやすいそうです。

ところでgaucheはあのソースコードが、あのプロジェクト全体が、一体どうやって管理されているのか私にはさっぱり想像できません。
これはgaucheソースコードリーディング勉強会（年単位で終わるのか・・・？）フラグかも。9LISPで。

追記

R6RSで書いてみた(define-syntax let-identifier-syntax(syntax-rules()((_((i f)...)b ...)(let-syntax((i(identifier-syntax f))...)b ...))))
(define-syntax let-identifier-syntax
  (syntax-rules ()
    ((_ ((i f) ...) b ...)
     (let-syntax ((i (identifier-syntax f)) ...)
       b ...))))
R6RSのマクロは複雑そうなので手がです・・・。伝統的マクロで良いかな、と。まだ今後のお楽しみ。

プログラミングGauche
written by time: 0 件のコメント:
labels : , ,
登録: 投稿 (Atom)