Project Euler Problem 24 - 思いついたら書く日記 Ex

問題24: 0〜9の10個の数字で辞書順に順列を作る。100万番目のパターンは何か[=>問題文]
　順列生成ロジックはライブラリに入れたいですね。さてどう作ろう。
　順列生成というと、私の場合再帰関数で作るのが一番最初に思い浮かびます。でも再帰で順列を作ると再帰の一番深いところでパターン生成が完了するんですよね。schemeなら継続とか大域脱出とか使うかも知れませんが、Emacas Lisp ではあまりスマートにパターンを取り出す方法が思いつきません。そこで発想を転換。再帰の深いところからパターンを取り出すのではなく、パターンができたら関数を呼んでもらうことにしましょう。要するにコールバックです。

問題24の解答（再帰＋コールバック）

;; Emacs Lisp
(require 'cl)

(defun permutation-walk (array walker)
  (let ((continue t)
        (dest (subseq array 0)))
    (labels
        ((repeat (src dest-index)
                 (if (zerop (length src))
                     (unless (funcall walker dest)
                       (setq continue nil))
                   (do ((i 0 (1+ i))
                        (next-index (1+ dest-index)))
                       ((or (>= i (length src))
                            (not continue)))
                     (aset dest dest-index (aref src i))
                     (repeat (vconcat (subseq src 0 i)
                                      (subseq src (1+ i)))
                             next-index)))))
      (repeat array 0))))

(defun problem024-walk (n)
  (let* ((save)
         (walker (lambda (str)
                   (if (zerop (decf n))
                       (progn (setq save str) nil)
                     t))))
    (permutation-walk "0123456789" walker)
    save))

(problem024-walk 1000000)

　permutation-walk は第一引数に順列パターンの元となる配列、第二引数にコールバック関数をとります。再帰で順列パターンを作成し、一つできるたびにコールバック walker を評価します。walker が「真」を返す限りは順列を作り続け、nilを返すか、順列を最後まで作り終わると処理は終了します。
　problem024-walk では、n をカウントダウンし、ゼロになった時点で渡された配列を save して nil を返して順列生成を中断させています。
　walker に渡されるのは順列生成で使っているワーク配列なので、walker側でバッファの内容を変更したり保存したりする場合、コピーをとる必要があります。

STLのやりかた

　呼び出すたびに次の順列パターンを返すイテレータを作るにはどうすればいいんでしょうか。「次の順列を作る」順列生成ライブラリというと、真っ先に思い浮かぶのは STL(C++)の next_permutation です。というわけで gcc のテンプレートライブラリを見てみると、こんな感じのロジックでした。

// C++/STL
bool next_permutation(std::vector<int> &vec){

  std::vector<int>::iterator first = vec.begin();
  std::vector<int>::iterator last = vec.end();

  if (first+1 == last) return false;

  std::vector<int>::iterator i = last -1;

  for(;;){
    std::vector<int>::iterator ii = i;
    --i;
    if (*i < *ii){
      std::vector<int>::iterator j = last;
      while (!(*i < *--j)){}
      std::iter_swap(i, j);
      std::reverse(ii, last);
      return true;
    }
    if (i == first){
      std::reverse(first, last);
      return false;
    }
  }
}

　実際はもっと読みにくく汎用的ですが、わかりやすく改変しています。なぜこれでいいのか完全には理解できていませんが、i, ii, j の3つのインデックス(イテレータ)で配列内の要素を比較し、大小関係によって要素を swap したり reverseしたりして次のパターンを生成しているようです。これを Emacs Lispでアレンジしてみました。

別解（クロージャでイテレータを作る）

;; Emacs Lisp
(require 'cl)

(defun make-permutation-iterator (vect)
  ;; クロージャの環境
  (lexical-let*
      ((vect (subseq vect 0))         ; 順列の元となる配列
       (last (length vect))           ; 配列の長さ
       (handler)                      ; ハンドラクロージャ保存用
       ;; 配列内の2要素を入れ替える関数
       (swap-vect (lambda (i j)
                    (unless (= (aref vect i) (aref vect j))
                      (let ((tmp (aref vect i)))
                        (setf (aref vect i) (aref vect j))
                        (setf (aref vect j) tmp)))))
       ;; 配列内の ahead 以降の要素を反転する関数
       (reverse-vect (lambda (ahead)
                       (do ((a ahead (1+ a)) (b (1- last) (1- b)))
                           ((>= a b))
                         (funcall swap-vect a b))))
       ;; 順列の次のパターンを生成する関数
       (rest-handler (lambda ()
                       (let ((i (1- last)))
                         (do ((result t))
                             ((not (eq result t)) result)
                           (let ((ii i))
                             (decf i)
                             (cond
                              ((< (aref vect i) (aref vect ii))
                               (let ((j last))
                                 (while (>= (aref vect i) (aref vect (decf j))))
                                 (funcall swap-vect i j)
                                 (funcall reverse-vect ii)
                                 (setq result vect)))
                              ((zerop i)
                               (funcall reverse-vect 0)
                               (setq result nil)
                               (setq handler (lambda () nil)))))))))
       ;; 最初に一回だけ評価する関数（vect をそのまま返す）
       (first-handler (lambda ()
                        (if (< 1 last)
                            (setq handler rest-handler)
                          (setq handler (lambda () nil)))
                        vect)))         ; lexical-let* ここまで
    ;; クロージャ（イテレータ）を返す
    (if (> 1 last)
        (lambda () nil)
      (progn
        (setq handler first-handler)
        (lambda () (funcall handler))))))

(defun problem024-iter (n)
  (let ((iter (make-permutation-iterator "0123456789")))
    (while (< 0 (decf n))
      (funcall iter))
    (funcall iter)))

(problem024-iter 1000000)

　make-permutation-iterator はクロージャを返します。このクロージャは評価するたびに次の順列パターンを返します。最後までパターンを作り終えると、以降は nil を返し続けます。
　動的スコープの Emacs Lisp では本来クロージャに環境が紐付けされませんが、cl モジュールで提供される lexical-let や lexical-let* を使うことで環境を持ったクロージャを作ることができます。
　こちらも iter が返すのはワーク配列なので変更や保存をするときにはコピーをとる必要があります。

どっちが速い？

　見たところどっこいどっこいかと思いましたが・・・

Function         Avg (sec)
===============  ===========
problem024-walk   13.359000
problem024-iter    6.979333

　ずいぶん差がつきました。約2倍です。walk は vconcat や subseq が頻繁に評価されるのでこれがボトルネックになっているのかもしれません。