etsavの日記： 圧縮コメントアウト そにょ２

こないだの思いつき の続き。

Emacs Lisp で圧縮できないかなー、 と思いまして。 とりあえず前処理として、 ブロックソーティング など実装してみよーかと。 こちらの解説 を参考にしまして。

最初、 『Lisp だから再帰ぐるぐるー♪』なんてやってたら、 なんかすぐにスタック使い切っちゃうのねぃ。 max-lisp-eval-depth の値を大きくすれば動くみたいですけど、 デフォルトの値にはなんか意図があるんだろうからと、 再帰を回避して書き直し。

エンコード側はこんな：

(defun initial-pointer-list (number-of-pointers)
  (let ((pointers (make-list number-of-pointers 0))
        (i -1))
    (mapcar (lambda (p) (setq i (1+ i)))
            pointers)))

(defun find-zero (pointers)
  (let ((idx 0))
    (catch 'loop
      (while (< idx (length pointers))
        (if (zerop (elt pointers idx)) (throw 'loop idx)
          (setq idx (1+ idx)))))))

(defun burrows-wheeler-transform (str)
  (let* ((len (length str))
         (pointers (initial-pointer-list len))
         (strstr (concat str str)))
    (setq pointers
          (sort pointers
                (lambda (p1 p2)
                  (string< (substring strstr p1 (+ p1 len))
                           (substring strstr p2 (+ p2 len))))))
    (list (apply 'string
                 (mapcar (lambda (i) (elt strstr (+ i len -1)))
                         pointers))
          (find-zero pointers))))

burrows-wheeler-transform 関数に文字列を入れると、 変換後の文字列とデコード開始点を示す数字ひとつのリストを返します。 目的がコメントアウトコードの圧縮なので、 試しにこんなコード：

#include <iostream>

using namespace std;

int
main(
    int argc,
    char** argv
)
{
    for (int i = 0; i < argc; i++)
    {
        cout << argv[i] << " ";
    }
    cout << endl;

    return 0;
}

を入れますと、 変換後の文字列は：

;;>{,}{(▽
);}v▽
t▽
);▽
   ▽
▽
▽
▽
▽
▽
▽
                <"rn=i]tteit<*<   < ;t; g e    ▽
n +▽
*r+ic  ld"00c< <<     mvipmenh    gga n  tundcr mr nrrrrc   [a#s▽
(<dca▽
ari ieiiiificcsoat aaaauue onuunnsselt▽
oogg ▽
▽

てな感じ（改行の位置がわかりやすいように▽を入れてますが、 これは文字列に含まれません）。 ランレングスだけで随分圧縮出来そうですねぃ。

そぃで、 デコード側：

(defun associate-occurrence (char-list)
  (let ((occurrence (make-vector 256 0)))
    (mapcar (lambda (c)
              (cons c
                    (aset occurrence c (1+ (aref occurrence c)))))
            char-list)))

(defun find (elem list)
  (let ((idx 0))
    (catch 'loop
      (while (< idx (length list))
        (if (equal elem (elt list idx)) (throw 'loop idx)
          (setq idx (1+ idx)))))))

(defun inverse-burrows-wheeler-transform (transformed)
  (let* ((str (append (car transformed) nil))
         (sorted (sort (copy-sequence str) '<))
         (result (make-string (length str) 0))
         (i 0)
         c)
    (setq str (associate-occurrence str))
    (setq sorted (associate-occurrence sorted))
    (setq c (elt sorted (cadr transformed)))
    (while (< i (length str))
      (aset result i (car c))
      (setq c (elt sorted (find c str)))
      (setq i (1+ i)))
    result))

当然、 (inverse-burrows-wheeler-transform (burrows-wheeler-transform 文字列)) の結果は 文字列 になります。

さて次はどーしましょ。 move-to-front かなぁ……？