Gaucheでradix sort

• 基数ソート - Wikipedia

その他のソート

• vallog:sort

ソース

• radix.scm

(define (radix-sort ls :optional (base 10))
  (define (digit-count num)
    (x->integer (ceiling (/ (log num)(log base)))))
  (define (digit-of index num)
    (modulo (quotient num (expt base index)) base))
  (define (list-set! ls n obj)
    (let/cc hop
      (let rec ((l ls)(n n))
        (if (zero? n)
            (begin (set! (car l) obj)
                   (hop ls))
            (rec (cdr l)(- n 1))))))
  (set! (setter list-ref) list-set!)
  (let1 count (digit-count (abs (apply max ls)))
    (let rec ((ls ls)(index 0))
      (if (< index count)
          (let1 buckets (make-list base '())
            (for-each
             (^e (let1 digit (digit-of index e)
                   (set! (list-ref buckets digit)
                         (cons e (list-ref buckets digit)))))
             ls)
            (rec (apply append (map reverse buckets))(+ index 1)))
          ls))))


(use gauche.sequence)

(define (test sorter n)
  (for-each (^i (let1 ls (shuffle (iota (expt 10 i)))
                  (print "; length = " (expt 10 i))
                  (time (sorter ls))
                  (print)))
            (iota n 2)))


(test radix-sort 6)
; length = 100
;(time (sorter ls))
; real   0.000
; user   0.000
; sys    0.000

; length = 1000
;(time (sorter ls))
; real   0.004
; user   0.000
; sys    0.000

; length = 10000
;(time (sorter ls))
; real   0.084
; user   0.080
; sys    0.000

; length = 100000
;(time (sorter ls))
; real   1.034
; user   1.030
; sys    0.010

; length = 1000000
;(time (sorter ls))
; real  13.469
; user  13.400
; sys    0.040

; length = 10000000
;(time (sorter ls))
; real 242.686
; user 241.360
; sys    0.610

;; vector version
(use srfi-43)
(define (radix-sort ls :optional (base 10))
  (define (digit-count num)
    (x->integer (ceiling (/ (log num)(log base)))))
  (define (digit-of index num)
    (modulo (quotient num (expt base index)) base))
  (define (put-buckets! vect buckets index)
    (vector-for-each
     (^(_ e)
       (let1 digit (digit-of index e)
         (vector-set! buckets digit
                      (cons e (vector-ref buckets digit)))))
     vect))
  (let ((buckets (make-vector base '()))
        (v (list->vector ls)))
    (dotimes (index (digit-count (abs (apply max ls))))
      (put-buckets! v buckets index)
      (set! v (list->vector (apply append (map reverse (vector->list buckets)))))
      (set! buckets (make-vector base '())))
    (vector->list v)))

(test radix-sort 6)

; length = 100
;(time (sorter ls))
; real   0.000
; user   0.010
; sys    0.000

; length = 1000
;(time (sorter ls))
; real   0.001
; user   0.000
; sys    0.000

; length = 10000
;(time (sorter ls))
; real   0.015
; user   0.020
; sys    0.000

; length = 100000
;(time (sorter ls))
; real   0.203
; user   0.210
; sys    0.000

; length = 1000000
;(time (sorter ls))
; real   2.309
; user   2.300
; sys    0.000

; length = 10000000
GC Warning: Repeated allocation of very large block (appr. size 80003072):
    May lead to memory leak and poor performance.
GC Warning: Repeated allocation of very large block (appr. size 80003072):
    May lead to memory leak and poor performance.
;(time (sorter ls))
; real  65.467
; user  35.900
; sys    3.370

参考

• いろいろなソートアルゴリズム
• Sorting algorithms/Radix sort - Rosetta Code

追記

GaucheのHEADで試したら、list-refのsetterを登録するところで、

*** ERROR: can't change the locked setter of procedure #

ということだった。試しに(setter list-ref)したらlist-set!があった。ということで、list-set!と(set! (setter list-ref) list-set!)を削除。

;; Gauche HEAD ver (Exists list-set!)
(define (radix-sort ls :optional (base 10))
  (define (digit-count num)
    (x->integer (ceiling (/ (log num)(log base)))))
  (define (digit-of index num)
    (modulo (quotient num (expt base index)) base))
  (let1 count (digit-count (abs (apply max ls)))
    (let rec ((ls ls)(index 0))
      (if (< index count)
          (let1 buckets (make-list base '())
            (for-each
             (^e (let1 digit (digit-of index e)
                   (set! (list-ref buckets digit)
                         (cons e (list-ref buckets digit)))))
             ls)
            (rec (apply append (map reverse buckets))(+ index 1)))
          ls))))

Gaucheでbucket sort

その他のソート

• vallog:sort

ソース

• バケットソート - Wikipedia

(define (bucket-sort ls)
  (let* ((min (apply min ls))
         (max (apply max ls))
         (buckets (make-vector (+ (- max min) 1) '())))
    (for-each (lambda (e)
                (let ((i (- e min)))
                  (vector-set! buckets i
                               (cons e (vector-ref buckets i)))))
                ls)
    (apply append (vector->list buckets))))


;;
;; test
;;

(use gauche.sequence)

(define (test sorter n)
  (for-each (^i (let1 ls (shuffle (iota (expt 10 i)))
                  (print "; length = " (expt 10 i))
                  (time (sorter ls))
                  (print)))
            (iota n 2)))


(test bucket-sort 6)
; length = 100
;(time (sorter ls))
; real   0.000
; user   0.000
; sys    0.000

; length = 1000
;(time (sorter ls))
; real   0.000
; user   0.000
; sys    0.000

; length = 10000
;(time (sorter ls))
; real   0.003
; user   0.010
; sys    0.000

; length = 100000
;(time (sorter ls))
; real   0.043
; user   0.040
; sys    0.000

; length = 1000000
;(time (sorter ls))
; real   1.032
; user   0.490
; sys    0.090

; length = 10000000
;(time (sorter ls))
; real   8.767
; user   8.490
; sys    0.240

参考

• Category:Sorting Algorithms - Rosetta Code
• いろいろなソートアルゴリズム

Gaucheでbubble sort

その他のソート

• vallog:sort

ソース

• bubble.scm

準備

(use math.mt-random)
(use srfi-1)

(define data
  '(1 0 9 2 8 4 3 6 7 8 9 5 0 1 2 3))

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

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

汚いけど末尾再帰で

(define (bubble-sort ls)
  (define (pass1 ls)
    (let rec ((ls ls)(acc '()))
      (cond ((null? (cdr ls))(reverse (cons (car ls) acc)))
            ((< (cadr ls)(car ls))
             (rec (cons (car ls)(cddr ls))(cons (cadr ls) acc)))
            (else (rec (cdr ls)(cons (car ls) acc))))))
  (let rec ((ls ls)(i (- (length ls) 1)))
    (if (or (null? ls)(zero? i))
        ls
        (rec (pass1 ls) (- i 1)))))

(bubble-sort data)
;; -> (0 0 1 1 2 2 3 3 4 5 6 7 8 8 9 9)

(time (bubble-sort (make-rand-list 1000)))
;(time (bubble-sort (make-rand-list 1000)))
; real   0.698
; user   0.687
; sys    0.015


(time (bubble-sort (make-rand-list 10000))
      (undefined))
;(time (bubble-sort (make-rand-list 10000)) (undefined))
; real  68.651
; user  68.250
; sys    0.203

vector + 副作用で

(define (bubble-sort! v)
  (let ((len (vector-length v)))
    (dotimes (_ len)
      (dotimes (i len)
        (when (< (+ i 1) len)
          (let ((cur (vector-ref v i))
                (next (vector-ref v (+ i 1))))
            (when (< next cur)
              (vector-set! v (+ i 1) cur)
              (vector-set! v i next)))))))
  v)

(let ((v (list->vector data)))
  (bubble-sort! v))
;; -> #(0 0 1 1 2 2 3 3 4 5 6 7 8 8 9 9)

(time
 (let ((v (list->vector (make-rand-list 1000))))
   (vector->list (bubble-sort! v))))
;(time (let ((v (list->vector (make-rand-list 1000)))) (bubble-sort! v)))
; real   0.698
; user   0.703
; sys    0.000


(time
 (let ((v (list->vector (make-rand-list 10000))))
   (vector->list (bubble-sort! v))
   (undefined)))
;(time (let ((v (list->vector (make-rand-list 10000)))) (vector->list (b ...
; real  67.471
; user  66.531
; sys    0.016

vector + 副作用版が速いだろうと思ったけど、末尾再帰版とほとんど変わらなかった。

参考

• Sorting algorithms/Bubble sort - Rosetta Code
• いろいろなソートアルゴリズム
• 文月の覚え書き: Schemeでバブルソート
• Gaucheでバブルソート？ - 計算機と戯れる日々
• LispとSchemeでバブルソート - DoMshi

計算で「桁数」「指定した桁の数」を求める

;; 桁数を求める
(x->integer (ceiling (/ (log (abs 1234))(log 10))))
;; -> 4

;; 指定した桁の数値を取得
(modulo (quotient 1234567 (expt 10 0)) 10)
;; -> 7
(modulo (quotient 1234567 (expt 10 1)) 10)
;; -> 6
(modulo (quotient 1234567 (expt 10 2)) 10)
;; -> 5

どこで見たのか忘れた。

追記

このrubyのコードで見たんだ。

• Sorting algorithms/Radix sort - Rosetta Code

permissionを数値で表示

stat --format %a filename

「755」とか表示される。

stat --format '%a %A' filename

「700 -rwx------」

0 ---
1 --x
2 -w-
3 -wx
4 r--
5 r-x
6 rw-
7 rwx

ssh越しにfindしてtarで固めてローカルにコピー

ssh valvallow@server 'find /hoge/piyo/fuga -maxdepth 1 -type f -name "foo-*" -print0 | xargs -0 tar -cf /dev/stdout' > foos.tar

findしなくても

ssh valvallow@server 'cd /hoge/piyo/fuga; tar zcf - foo-*' > foos.tar.gz

つまりこれのことですけどね。

• vallog: ssh, find, xargs, tarで本番環境ぶっ壊した

ssh越しにdiffを取る

ssh valvallow@server 'cat /hoge/piyo/fuga/foo.txt' | diff - ./foo.txt

パッチ

diff -c 元ファイル名 修正後ファイル名 > パッチファイル
patch < パッチファイル

emacsコマンドでbyte compile

emacs -Q -batch -f batch-byte-compile hogehoge.el

PHPのクロージャ

PHPは書いたことありませんが、仕事で読む機会が出てきました。
なので、emacsにphp-mode入れたり、php自体を入れてphp -aしてREPLで遊んでみたり。

cygwinはsetup.exeからphpが入らないので爆発してください。

で、5.X系からはクロージャがあるらしいので試してみた。
ドキュメント読まずにschemeのノリで以下のようにやってみた。
以下REPL垂れ流し。

$ php -a
Interactive shell

php > $double = function ($x){ $ret = $x * $x; print $ret . PHP_EOL; return  $ret;};
php > array_map($double, range(1, 5));
1
4
9
16
25

php > $inc = 5;
php > $x5 = function($x){ $ret = $inc * $x; print $ret; return $ret;};
php > array_map ($x5, range(1, 5));
PHP Notice:  Undefined variable: inc in php shell code on line 1
0PHP Notice:  Undefined variable: inc in php shell code on line 1
0PHP Notice:  Undefined variable: inc in php shell code on line 1
0PHP Notice:  Undefined variable: inc in php shell code on line 1
0PHP Notice:  Undefined variable: inc in php shell code on line 1
0

php > print $inc;
5
php > var_dump($x5);
object(Closure)#2 (1) {
  ["parameter"]=>
  array(1) {
    ["$x"]=>
    string(10) ""
  }
}

php > function return_func (){ return function($x){ return $x * $x;};};
php > return_func();
php > var_dump(return_func());
object(Closure)#3 (1) {
  ["parameter"]=>
  array(1) {
    ["$x"]=>
    string(10) ""
  }
}
php > return_func()(5);
PHP Parse error:  syntax error, unexpected '(' in php shell code on line 1
php > $fun = return_func();
php > $fun(5);
php > print $fun(5);
25

php > function counter_maker ($seed){ return function (){ $seed =  $seed + 1; return $seed;};};
php > $counter = counter_maker(0);
php > $counter();
PHP Notice:  Undefined variable: seed in php shell code on line 1
php >

これのどこがクロージャなわけ？と、思ったら、クロージャは構文が微妙に違うんですね。

で、ちゃんとドキュメント読んだら、以下のようにしてできました、と。

php > $x5 = function($x) use ($inc) { $ret = $inc * $x; print $ret; return $ret;};
php > array_map ($x5, range(1, 5));
510152025
php > $x5 = function($x) use ($inc) { $ret = $inc * $x; print $ret . PHP_EOL; return $ret;};
php > array_map ($x5, range(1, 5));
5
10
15
20
25

おーできたできた。へー。

PHP 5.3にはクロージャがあるってんで、試してみたら「全然閉包じゃねーじゃん！レキシカルスコープどこいった！」だったんだけど、調べてみたらuseで明示的に環境（というか引きずる参照）を指定してあげる必要があるらしく、やってみたらできた。これは興味深い（笑）

• Twitter / @valvallow: PHP 5.3にはクロージャがあるってんで、試してみ ...

よくよく考えたら、PHPのクロージャ構文はEmacs Lispのlexical-letとそっくりですね。

PHPは動的スコープなんですね！Emacs Lispと同じだと思えば怖くない！クロージャの実現方法も似てるしね！

• Twitter / @valvallow: PHPは動的スコープなんですね！Emacs Lisp ...

PHPはクロージャを導入するにあたって、言語自体を改造する必要があったわけだけど、Emacs Lispでクロージャを実現するlexical-letは「ただのマクロ」という点がすごい。Lispすげー！（って言っとけばいい？）

• Twitter / @valvallow: PHPはクロージャを導入するにあたって、言語自体を改 ...

そういえば、traitというのがあります。私はscalaか何かにあるってんで耳にしたことがあります。そのtrait（たぶんscalaのそれとまったく同じものというわけではないっぽい）がPHPの次期バージョンにも入るそうですね。

• 2011-07-07 - id:anatooのブログ

で、これ↑を読んで、どんなものかわかりました。mix-inしたいけど、interfaceの実装やabstractクラスの継承じゃできないので新しい概念を持ち込んだって感じですか。

wgetでpostする

例えば何かのweb apiにjsonをpostするとすると

wget -O hoge.json --post-data '{"date": "2011/07/27"}' http://valvallow:password@api.hoge.com/foo/bar/baz

wget --http-user 'valvallow' --http-password 'password' -O hoge.json --post-data '{"date": "2011/07/27"}' http://api.hoge.com/foo/bar/baz

wgetってurlの展開とかクローリングとかいろいろできるんですね。

ssh, find, xargs, tarで本番環境ぶっ壊した

find . -type f -name "foo-*.txt" -print0 | xargs -0 tar -cf /dev/stdout

とすればよかったところを

find . -type f -name "foo-*.txt" -print0 | xargs -0 tar -cf

としてファイルぶっ壊した。（tarにfを指定しているのにパスを渡さなかったのでxargsで渡された最後のファイルがtarの結果で上書きされた？）

しかも実際はサーバ（FreeBSD）の本番環境からローカルにファイルをまとめて取ってこようとして失敗。

ssh valvallow@server 'find /hoge/piyo/fuga -maxdepth 1 -type f -name "foo-*" -print0 | xargs -0 tar -cf' > ./foos.tar

すぐさまトラブル発生。gitで復活。。（ある意味すぐトラブル発生してよかった・・・）

そもそもxargsなんか使わずにこうすれば良いと教えてもらった。

ssh valvallow@server 'cd /hoge/piyo/fuga ; tar zcf - foo-*' > foos.tar.gz

日記

ブログ更新したいなーと思いながらなかなか書かずにいる。
もっとどうでも良い小ネタをチクチク書けば良いものを。

どうでも良いことを書いてみた。

日記

晩御飯

今日はスーパーにゴーヤがあったのでゴーヤチャンプルーを作りました。あとオクラの味噌汁と玉ねぎサラダと納豆（＋食べるラー油）。大変おいしく頂きました。

コバエ

で、自炊すると生ゴミがでます。暑くなると（たぶん）そこからコバエがたくさん発生します。
たくさんといっても、部屋に2～3引き、台所に4～5匹、そのくらいの認識でした。
昨日仕掛けたコバエ駆除トラップが大活躍。90匹近く駆除。（つーかなんでこんなにたくさんいんだよ

• vallog: コバエ

Emacs -> Shell

ところで。

Emacsを使い始めて2年半。Emacs引きこもり生活でした。

プログラミングもメモもTODO管理もファイラーもgitもsshもあれもこれも。

そろそろEmacs病を克服したいので、ここ最近はShellに移行ちう（ちょっと意味不明）。

ペアプログラミング

今日、@s1mpleさんが「読んでみたらー？」って本を貸してくれた！「ペアプログラミング―エンジニアとしての指南書」って本。ありがたや。

それにしても自分で購入した本がたくさん積まれています。それ以外に、借りた本で未読のものが溜まり始めました。まずい。

@aharisuさんに借りた「UNIXネットワークプログラミング入門」、@koki_hさんに借りた「C言語ではじめる音のプログラミング―サウンドエフェクトの信号処理」、母親に借りた数冊。

いったん返した方が良いのかもしれない。。

コバエ

コバエがうざかったのでやってみた。

ペットボトルの底を浅く切り取って1cmくらい水を入れ、めんつゆ（なかったので白だし）を少々と台所洗剤を数滴入れて台所に放置。
3時間後確認したら13匹沈んでた。（こんなにいたの・・・

• コバエ　駆除 - Google 検索

追記

容器を2つに増やして丸1日放置したら80～90匹入ってた。たくさん駆除できたことより家の中にこんだけコバエが居たことがショックだわ。しかし効果絶大過ぎだろ・・・。

日記（近況とか）

しばらくぶり。
6月末から徹夜とか泊り込みとかいろいろあってブログ書いてなかった。
しばらく書いてないとズルズルと書かない日が続くので、コレをキッカケに復活したい。

最近はLaTeXばっかり書いてた。

• TeX/LaTex

JSON＋LaTeX＋テンプレートエンジンで帳票を出すお仕事。
outputzは大半yatex-mode。
LaTeXすげーけどなかなかシンドイ。
あとcygwinでのコンパイル遅すぎ・・・orz

けっこうLaTeX書いたけど、場当たり的だったのでちゃんと入門したい。
TeXの基礎とか。

wikipediaのTeXの項目すごい面白い。バグ報告の話とかバージョン番号とか。

• TeX - Wikipedia

他は

• Emacsしか使えないってのがすごく不便なのでサーバーで作業するときにvimさわったり
• ちょっとくらいvimに慣れたい
• Emacs病が嫌になってきた
• PHP読んだり（今日から）
• GNU make、shell scriptの基礎的なところを知りたいなー
• 仕事で支障が出ないくらいにgitのことを知りたいなー
• 書き溜めてるメモをブログに書いておきたい（けどメンドイ）
• LaTeX
• GDとGauche-gd
• shellコマンド
• zsh
• GNU screen
• git

すごく眠くって、ここ最近の休みの日はほぼずっと寝てる。
しばらく本も読んでないので、積読にほこりががが。
晴耕雨読な生活に憧れるぅ・・・

つーかbloggerの管理画面（？）変わり過ぎてて引いた。

そういえば、TeXのソースコードは小説みたいらしい。

• Coders at Work—プログラミングの技をめぐる探求 | inquisitor