2011/07/31

Gaucheでradix sort

  • 基数ソート - Wikipedia

その他のソート

ソース

(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

参考



追記

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

その他のソート

ソース

(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

参考




Gaucheでbubble sort

その他のソート

ソース

準備
(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 + 副作用版が速いだろうと思ったけど、末尾再帰版とほとんど変わらなかった。

参考



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

;; 桁数を求める
(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のコードで見たんだ。

プログラミングGauche

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

UNIXという考え方―その設計思想と哲学

2011/07/30

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

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

2011/07/29

ssh越しにdiffを取る

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

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

UNIXという考え方―その設計思想と哲学

emacsコマンドでbyte compile

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

Emacsテクニックバイブル ~作業効率をカイゼンする200の技~

2011/07/28

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で明示的に環境(というか引きずる参照)を指定してあげる必要があるらしく、やってみたらできた。これは興味深い(笑)
よくよく考えたら、PHPのクロージャ構文はEmacs Lispのlexical-letとそっくりですね。


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

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

そういえば、traitというのがあります。私はscalaか何かにあるってんで耳にしたことがあります。そのtrait(たぶんscalaのそれとまったく同じものというわけではないっぽい)がPHPの次期バージョンにも入るそうですね。
で、これ↑を読んで、どんなものかわかりました。mix-inしたいけど、interfaceの実装やabstractクラスの継承じゃできないので新しい概念を持ち込んだって感じですか。

Emacsテクニックバイブル ~作業効率をカイゼンする200の技~

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の展開とかクローリングとかいろいろできるんですね。

2011/07/27

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

2011/07/26

日記

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

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

2011/07/19

日記

晩御飯

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

コバエ

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

Emacs -> Shell

ところで。
Emacsを使い始めて2年半。Emacs引きこもり生活でした。
プログラミングもメモもTODO管理もファイラーもgitもsshもあれもこれも。
そろそろEmacs病を克服したいので、ここ最近はShellに移行ちう(ちょっと意味不明)。

ペアプログラミング

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

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

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

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

ペアプログラミング―エンジニアとしての指南書

2011/07/18

コバエ

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

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

追記

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


2011/07/14

日記(近況とか)

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

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

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

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

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

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

つーかbloggerの管理画面(?)変わり過ぎてて引いた。

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

The LATEXコンパニオン (アスキーアジソンウェスレイシリーズ)