`(Hello ,world)

ツッコミ、添削大歓迎です。いろいろ教えてください。

2008-02-20

Burrows-Wheeler Transform

| 23:54

http://golf.shinh.org/p.rb?BWT

Schemeで:

(use srfi-1)

; カリー化
(define (curry f . arg)
        (lambda rest
          (apply f (append arg rest))))

; 文字列の回転
(define (roll-str s n)
        (string-append (string-copy s n)
                       (substring s 0 n)))

; リスト中に要素が現れた場所を返す
(define (index x ls)
        (let ((rest (member x ls)))
          (if rest (- (length ls) (length rest))
            #f)))

; 文字列リストのけつをつないだ文字列を取得
(define (take-tail-string ls)
        (apply string-append
               (map (lambda (s) (string-copy s (- (string-length s) 1)))
                    ls)))

; Burrows-Wheeler Transform
(define (bwt s)
        (let ((mtx (sort (map (curry roll-str s) (iota (string-length s))))))
          (cons (index s mtx)
                (take-tail-string mtx))))

(port-for-each
 (lambda (s)
   (let ((res (bwt s)))
     (format #t "~d ~A~%" (car res) (cdr res))))
 (lambda () (read-line (current-input-port) #t)))
トラックバック - http://cadr.g.hatena.ne.jp/mokehehe/20080220