Scheme

2010年01月25日

Interpolative coding - tsubosakaの日記 より。

長さと出てくる値の最小値、最大値が分かっている狭義単調増加な自然数のリストを圧縮する方法の話。

最小値1、最大値20、長さ7の数列 [ 3, 8, 9, 11, 12, 13, 17 ] が17ビットに圧縮されるらしい。試してみたい。

まずはC++に翻訳しつつ写経。(Scheme編はこちら

続きを読む

(19:33) Φ

Schemeでも写経してみたの巻。C++編はこちら

#;'(べ、べつにS式で書かないと理解できないわけじゃないんだからね)

(define (lg x) (integer-length (- x 1)))

(define (interpolative-encode L L-length lo hi)
  (define (binary-encode x low high result)
    (let* ([range (+ (- high low) 1)]
           [bnum (lg range)]
           [enc (- x low)])
      (let loop ((i (- bnum 1)) (result result))
        (if (< i 0) result
            (loop (- i 1) (cons (if (logbit? i enc) 1 0) result))))))
  (define (iter f lo hi left right result)
    (cond [(= f 0) result]
          [(= f 1) (binary-encode (vector-ref L left) lo hi result)]
          [else
           (let* ([h (quotient f 2)]
                  [m (vector-ref L (+ left h))]
                  [f1 h]
                  [f2 (- f h 1)])
             (iter f2 (+ m 1) hi (+ left h 1) right
                   (iter f1 lo (- m 1) left (+ left h)
                         (binary-encode m (+ lo f1) (- hi f2) result))))]))
  (let1 L-length (vector-length L)
  (reverse! (iter L-length lo hi 0 L-length '())))


(define (interpolative-decode L L-length lo hi input-stream)
  (define (binary-decode low high iter)
    (let* ([range (+ (- high low) 1)]
           [bnum (lg range)])
      (let loop ((i 0) (dec 0) (iter iter))
        (if (= i bnum)
            (values (+ low dec) iter)
            (let1 b (car iter)
              (loop (+ i 1) (+ (* dec 2) (car iter)) (cdr iter)))))))
  (define (iter f lo hi left right input-stream)
    (cond [(= f 0) input-stream]
          [(= f 1)
           (receive (m stream) (binary-decode lo hi input-stream)
             (vector-set! L left m)
             stream)]
          [else
           (let* ([h (quotient f 2)]
                  [f1 h]
                  [f2 (- f h 1)])
             (receive (m stream) (binary-decode (+ lo f1) (- hi f2) input-stream)
               (vector-set! L (+ left h) m)
               (iter f2 (+ m 1) hi (+ left h 1) right
                     (iter f1 lo (- m 1) left (+ left h) stream))))]))
  (iter L-length lo hi 0 L-length input-stream))

(define (main args)
  (let* ([L #(3 8 9 11 12 13 17)]
         [lo 1]
         [hi 20]
         [L-length (vector-length L)]
         [Ldec (make-vector L-length)]) ; 結果格納用vec
    (print "original: " L)
    (let1 encoded-bitstream (interpolative-encode L L-length lo hi)
      (format #t "encoded (~d bits): ~a\n" (length encoded-bitstream) encoded-bitstream)
      (interpolative-decode Ldec L-length lo hi encoded-bitstream)
      (print "decoded: " Ldec))))

結果

original: #(3 8 9 11 12 13 17)
encoded (17 bits): (0 1 1 1 1 1 0 0 1 0 0 0 0 0 0 1 1)
decoded: #(3 8 9 11 12 13 17)

17bitに圧縮後、ちゃんと復号できて一安心。



(19:30) Φ

2010年01月19日

やったこと

  • 同じスクリプトをGaucheでもmoshでも動かそうと試行錯誤
    • cond-expandを使うにはmoshではimport文が先に必要
    • とりあえず、Gaucheで動かしたい時には最初のimportをコメントアウト、な方式で行きます
  • 途中で2つの大きな壁
    • moshをSnow Leopardで動かす →前編参照
    • c-wrapperをSnow Leopardで動かす →c-wrapperは32bitでならビルドする方法が見つかった。後述。
  • 小さな壁
    • ncurseswが文字化け → LC_ALL の値が環境依存?とりあえず6を0にしたらMacでは直ったっぽい
続きを読む

(23:37) Φ

2010年01月18日

higeponさんから始まったコードバトン、のSchemeブランチ(というか本流)がkazu634さんから回ってきた。

コードがmoshべったりになってるので、とりあえずmoshで動かしてみるか。

と思ったらこのマシンにはmoshが入っていない。

HEADを入れるにしてもmosh-0.2.0が要るみたいなので0.2.0を貰ってきて

$ ./configure
checking build system type... i386-apple-darwin10.2.0
checking host system type... i386-apple-darwin10.2.0
checking target system type... i386-apple-darwin10.2.0
checking for a BSD-compatible install... /usr/bin/install -c
...
configure: error: GNU MP not found, see http://gmplib.org/."For OSX, install GNU MP with "CFLAGS+=-m32 ./configure ABI=32 && make"

これは見たことありますね。GNU MPが入ってない旨のメッセージ。

続きを読む

(15:09) Φ

2010年01月14日

higeponさんから始まったコードバトンに参加。なぜかCommon Lispフォークの方に呼ばれた…

snmsts: 誰もアイデアが無いんだったら自薦者としてはmasatoiさん他薦として higepon(敬称含む)を推します。> naoya_tさん 個人的にはschemerを舐めていきたい。 (※下線は筆者)

Chaton COMMON LISP JP

SchemerとCLerの生暖かい交流(というか人材の奪い合い)が心に残ります。

やったこと

登録された単語からの検索機能 (hige:pan) を実装しました。

  • で、バトンもらったけどこれどうやって動かすのか
  • Snow LeopardにアップグレードしてからCL使ってなくて動かない><
  • sbcl をインストールし直した
  • sbcl にどうやって食わせるんだっけ
$ sbcl
This is SBCL 1.0.29, an implementation of ANSI Common Lisp.
More information about SBCL is available at <http://www.sbcl.org/>.

SBCL is free software, provided as is, with absolutely no warranty.
It is mostly in the public domain; some portions are provided under
BSD-style licenses.  See the CREDITS and COPYING files in the
distribution for more information.
* (load "scheme_baton.lisp")
; ...

T
* (in-package :cl-user)

#<PACKAGE "COMMON-LISP-USER">
* (in-package :hige)

#<PACKAGE "HIGE">
* 

(pon) (pin) (pun) とかして遊べるようになります。

  • 辞書から単語をassocしてくるだけの関数 search-dict の実装
  • 単語を入力し、search-dict で検索し、見つかれば意味を、見つからなければ "Not found." と返すだけの hige:pan を実装
  • aifマクロを追加(というか "On Lisp" からコピペ)
  • (loop :for ... :in ... :do ...)dolist で置き換えてみた

以下diffです:

続きを読む

(23:28) Φ

2009年08月23日

未来の自分のために、今日Schemeを書いててはまった事をメモっておきます。(srfi-1 の iota 関数的な例に書き換えてあります)

与えられた n に対し、リスト (0 1 ... n-1) を返す関数を named let で書くなら例えば

(define (foo n)
  (let loop ((i (- n 1)) (res '()))
    (if (< i 0) res
        (loop (- i 1) (cons i res)))))

srfi-1のiota関数はオプショナルパラメータでstart,stepを指定できるので、これは簡略版ということで。

(foo 1) => (0)

(foo 2) => (0 1)

(foo 3) => (0 1 2)

(foo 4) => (0 1 2 3)

(foo 5) => (0 1 2 3 4)

(foo 6) => (0 1 2 3 4 5)

...

逆順に積んで行って最後にreverseしても当然同じ結果です:

(define (bar n)
  (let loop ((i 0) (res '()))
    (if (= i n) (reverse res)
        (loop (+ i 1) (cons i res)))))

(bar 1) => (0)

(bar 2) => (0 1)

(bar 3) => (0 1 2)

(bar 4) => (0 1 2 3)

(bar 5) => (0 1 2 3 4)

(bar 6) => (0 1 2 3 4 5)

...

reverse! の方が速いかな?とか思ったりして

(define (bar! n)
  (let loop ((i 0) (res '()))
    (if (= i n) (reverse! res)
        (loop (+ i 1) (cons i res)))))

と書いてもまあ同じ結果が得られます。

(bar! 1) => (0)

(bar! 2) => (0 1)

(bar! 3) => (0 1 2)

(bar! 4) => (0 1 2 3)

(bar! 5) => (0 1 2 3 4)

(bar! 6) => (0 1 2 3 4 5)

...

例えば、(0 1 2 ... n-1) ではなく、先頭に 'A を付けた (A 0 1 2 ... n-1) のようなリストを(何らかの理由で)得たいとします。

(define (baz! n)
  (let loop ((i 0) (res '(A)))
    (if (= i n) (reverse! res)
        (loop (+ i 1) (cons i res)))))

と書いても同じになりそうなものなのですが、

(baz! 1) => (A 0)

(baz! 2) => (0 A 0 1)

(baz! 3) => (1 0 A 0 1 2)

(baz! 4) => (2 1 0 A 0 1 2 3)

(baz! 5) => (3 2 1 0 A 0 1 2 3 4)

(baz! 6) => (4 3 2 1 0 A 0 1 2 3 4 5)

...

のような結果に。

reverse! が let loop 環境のresを破壊し、baz!を再度呼び出した時にも(初期化されず)そのままなのが原因です。これはSchemeの仕様としては仕方のないことでしょうかね。ですが、それならその前のbar!もおかしくなっても良い気が…baz!との違いはresの初期値だけなので…

(ちなみにmit-schemeとかchickenとかでやってみたら同様の結果が出ました)

続きを読む

(22:58) Φ

2009年04月22日

きょうは諸般の事情により Shibuya.binpm に行けず無念でしたが、
yhara@Matz江市 が BiwaScheme + Ruby(Ramaze) で書いた「tickets」という二次元TODO管理ツール

をhackし、gitであんなことやこんなことが体験できました。

「かならず」やる事はだんだん右へ、「できれば」やる事はだんだん左へ行く仕様(※要手動リロード)です。シンプルで、わりと便利なので普段その辺に入れて使いたいです。(終わったチケットの処理はどうすればよいのかな)

(23:59) Φ

2009年03月08日

三田某所にて13:00〜

http://atnd.org/events/350

今日はR6RSはお休みかな

(11:40) Φ

2009年03月07日

[2日目に戻る]


moshでコードの実行時間を計測したい。

moshでベンチマークをどうやって取ってるかと思い script/bench2?.scm を見るとシェルから実行してる・・・

ypsilonでは (time-usage) を実行前と実行後に呼び、real,user,sys 各成分の差分を表示している。

※ypsilonのtime-usageとかformatの仕様がupdate3とtrunkで違うww

これをmoshに移植して実験。

シェルを使わずに時間を測れるようになった。めでたしめでたし。

続きを読む

(23:30) Φ

2009年03月06日

[1日目に戻る]


Project Eulerで沢山書いた地球温暖化コードをポータブルな形に書き直し、ypsilonについてるgambit-benchmarkをベースにしたオレオレbenchmarkを書こうとしている。(※これはLTで発表しようとして没になったテーマ)

ypsilon用の実行スクリプトを参考にmosh用のを書こうとしていたが、string-appendで動的に合成した名前のファイルをincludeできないっぽい。ファイル名が文字列リテラルなら行けるのだけれど。

逆引きschemeに載ってるincludeを書いても動かない。syntax-caseとかdatum->syntaxとか訳がわかっていない。藤田さんのTTのビデオ(YouTube,ニコ動)見たけどやはり分かっていない。ブロック崩しはちょっとかっこいい。

GaucheからR6RS環境への移行のハードルが思いのほか高いことを思い知った2日目。Reading Moshなう。


続きを読む

(23:27) Φ