迷路の最短ルートを探索するEmacs Lisp

元ネタ: http://okajima.air-nifty.com/b/2010/01/post-abc6.html

幅優先検索を使えば一瞬で解けるのでいちいち晒すほどのネタではありませんが、解決手順をEmacs Lispでアニメーションできたら面白いかなと思ったのでやってみました。

C-x bで適当なバッファを作って迷路を入力します。ちょっと試したいという方は以下の迷路をコピペするとよいでしょう。

**************************
*S* *                    *
* * *  *  *************  *
* *   *    ************  *
*    *                   *
************** ***********
*                        *
** ***********************
*      *              G  *
*  *      *********** *  *
*    *        ******* *  *
*       *                *
**************************

次に以下の関数を評価します。後は先ほどのバッファでM-x solve-mazeすれば解決手順をアニメーションしてくれます。

(defun solve-maze ()
  (interactive)
  (save-excursion
    (loop with delay = 0.03
          with q
          with qe
          with m = (make-vector (buffer-size) nil)
          with d = '(backward-char previous-line forward-char next-line)
          with e
          initially
          (goto-char (point-max))
          (search-backward "S")
          (setq q (setq qe (list (cons 0 (point)))))
          until e
          until (read-event nil nil delay)
          while q
          for n = (caar q)
          for p = (cdar q)
          do
          (goto-char p)
          (loop until e
                for f in d
                do
                (save-excursion
                  (call-interactively f)
                  (cond
                   ((and (eq (char-after) ? )
                         (null (aref m (point))))
                    (sit-for delay)
                    (aset m (point) (1+ n))
                    (setcdr qe (list (cons (1+ n) (point))))
                    (setq qe (cdr qe)))
                   ((eq (char-after) ?G)
                    (loop until (eq n 0)
                          for p = nil
                          do
                          (loop until p
                                for f in d
                                do
                                (save-excursion
                                  (call-interactively f)
                                  (when (eq (aref m (point)) n)
                                    (setq n (1- (aref m (point)))
                                          p (point))
                                    (delete-char 1)
                                    (insert "$")
                                    (sit-for delay))))
                          (goto-char p))
                    (setq e t)))))
          (setq q (cdr q)))))

auto-completeに関数と変数の情報源を追加

ac-source-symbolsは大雑把すぎるので、もう少し細かく制御できる情報源を追加しました。一つは関数をオムニ補完するac-source-functionsという情報源で、もう一つは変数を補完するac-source-variablesという情報源です。

ac-source-functionsは(の直後のシンボルに対してオムニ補完を行います。従来のac-source-symbolsでは、(の直後でも変数などを入力できたため、若干精度に問題がありました。ac-source-variablesはac-source-symbolsと同じくシンボルに対して補完を行いますが、変数のみを補完するので、例えば関数の引数に関数が補完候補となるようなことはありません。これもac-source-symbolsでは問題でした。

この二つは同時に使用することが推奨されます。また、ac-source-functionsはオムニ補完なのでac-source-variablesより優先度が高く設定されている*1必要があります。設定例は次のようになるでしょう。

(add-hook 'emacs-lisp-mode-hook
          (lambda ()
            (setq ac-sources (append '(ac-source-functions ac-source-variables) ac-sources))))

ac-source-symbolsとac-source-variablesは共存することができますが、基本的にはこの二つの情報源を使用する場合はac-source-symbolsは使わないほうがいいでしょう。

さらに今回、情報源の記号に対応しました。次のスクリーンショットを見てもらえば分かると思いますが、補完候補の右端にfという記号があります。これはac-source-functionsによって生成された補完候補であることを示しています。他にもvやsがあり、前者はac-source-variables、後者はac-source-symbolsになります。

また、実験的ではありますが、ヘルプにも対応しています。ヘルプが利用可能な情報源はac-source-functions, ac-source-variables, ac-source-symbolsです。ヘルプを表示するには補完候補にカーソルをあわせて少し待ちます。すると自動的にヘルプが表示されるはずです。ちなみにスクロールバーの表示に小さなバグがあります。

ヘルプを表示しないようにするには次のコードを評価してください。正式なやり方ではないですが悪しからず。

(setq ac-quick-help-delay 9999)

*1:ac-sourcesで先頭にあるということ

popup.elによるポップアップメニュー、カスケードポップアップメニュー、ツールチップの実現

さまざまな現代的なインターフェースを実現できるようpulldown.elを大幅に拡張しました。それに伴って抽象度も上がったため、pulldown.elという名前は少し内容にそぐわなくなりました。そこでpulldown.elあらためpopup.elという名前で開発を続けていくことにしました*1マーケティング的にはあまりよろしくないと思いますが、主な利用者はauto-completeだけなのでまあいいでしょう。

成果物はいつも通りauto-completeのリポジトリから取得できます。

http://github.com/m2ym/auto-complete

さて、今回の拡張で何ができるようになったかですが、おそらく次のスクリーンショットを見れば一目瞭然かと思われます。


見ての通り、多階層ポップアップメニューとツールチップが実現できるようになっています。元々、これらの機能を実装するつもりはなかったのですが、auto-completeの機能拡張でいずれ必要になるので、結局実装してしまった次第です。

popup.elではポップメニューであれツールチップであれ、結局はpopup-create, popup-set-line, popup-draw, popup-deleteの一連の流れに従います。ただ、ユーザーがいちいちこの流れを記述するのは面倒なので、簡単に利用できるヘルパー関数が用意されています。ちなみに、auto-completeは少し複雑な流れになっているので自分でポップアップを管理しています。

ポップアップメニューを表示するにはpopup-menu関数を使います。詳しくはソースコードを見てもらうとして*2、基本的な使い方だけ紹介しておきます。

popup-menu関数は引数としてメニューとなるリストを渡します。

(popup-menu '(Foo Bar Baz))

これを評価すると次のようになります。

popup-menu関数を呼びだすと、内部では同期的なイベントループが開始されます。キーボードによるメニューの操作は全てこのイベントループで処理され、選択されたアイテムが関数の返り値になります。

次のようにscroll-barキーワードやmarginキーワードを指定しておくと、若干見やすいインターフェースになります。

(popup-menu '(Foo Bar Baz) :scroll-bar t :margin t)

多階層ポップアップメニューを表示するにはpopup-cascade-menu関数を使います。この関数はpopup-menu関数のラッパーですが、第一引数のリストを構造的に解釈して多階層ポップアップメニューとして表示します。

(popup-cascade-menu '(A
                      (B
                       B-1
                       B-2)
                      (C
                       (C-1
                        C-1-1
                        C-1-2)
                       C-2)
                      D))

リストの要素がconsセルの場合、メニューアイテムがそのconsセルのcar、子メニューのリストがそのconsセルのcdrになります。

スクリーンショットは冒頭に載せてあるので割愛します。

ツールチップを表示するにはpopup-tip関数を使います。この関数は第一引数にツールチップとして表示したい文字列を取ります。

(popup-tip "Hello world!")

文字列内に改行がある場合や、ある行がある幅より大きい場合*3、その行は折り返されます。

(popup-tip "First line\nSecond line\nThird line")

popup-menu関数のように内部でイベントループを開始したりはしませんが、read-eventで同期的にキー入力を待ちます。何らかのキー入力があった場合は、ツールチップを削除して従来の動作に委譲します。

おそらく真っ先に思いつく利用ケースは、ポイントしているシンボルのドキュメントをツールチップで表示することでしょう。次のコードはdefunのドキュメントをツールチップで表示するものです。

(popup-tip (documentation 'defun))

変数のドキュメントも引けるように次のような関数を定義します。

(defun doc (symbol)
  (or (ignore-errors (documentation symbol))
      (ignore-errors (documentation-property symbol 'variable-documentation))))

さらにポイントしているシンボルのドキュメントをツールチップで表示するコマンドを定義します。

(defun doc-at-point ()
  (interactive)
  (let* ((symbol (symbol-at-point))
         (doc (doc symbol)))
    (when (and doc (null popup-instances))
      (popup-tip doc :margin t))))

これを評価して、適当なシンボルの上でM-x doc-at-pointすると、そのシンボルのドキュメントがツールチップで表示されると思います。

さらに進んで、タイマーで自動的にドキュメントを表示するのも良いかもしれません。

(defvar doc-timer nil)
(defvar doc-delay 1.0)
(defvar doc-tip-point nil)

(defun doc-timer ()
  (when (and (not (eq doc-tip-point (point)))
             (not (minibufferp)))
    (setq doc-tip-point (point))
    (doc-at-point)))

(setq doc-timer (run-with-idle-timer doc-delay doc-delay 'doc-timer))

popup.elを利用することにより、これまで不可能だったインターフェースを実現できるようになります。是非ご利用ください。

*1:重複しそうな名前だけどググってもヒットしないので大丈夫でしょう

*2:ドキュメントはまだです、すみません

*3:ソースコードを見てください

指定したポイントにうまくツールチップを表示できない

x-show-tip関数を使えばマウスカーソルからの任意の相対位置にツールチップを表示できますが、あくまでマウスカーソルと併用することを前提とされているため、きわめてありえるケース、つまりバッファ上の論理的なポイント付近にツールチップを表示することができません。

posn-at-point関数を使ってポジションを取得し、そのポジションにフレームやウィンドウのマージンを加味し、最終的にx-show-tip関数のピクセル座標指定でのツールチップ表示を使えば、なんとか目的を達成できそうに思えますが、メニューバーやツールバーの高さを取得する正当な手段がないため、正確な座標を算出できません。

以下がそのコードです。コメントアウトされている位置にメニューバーとツールバーの高さが入る必要があります。

(let* ((frame (selected-frame))
       (point (point))
       (position (posn-at-point point))
       (window (posn-window position))
       (frame-params (frame-parameters frame))
       (x-y (posn-x-y position))
       (inside-edges (window-inside-pixel-edges window))
       (x (+ (car x-y)
             (car inside-edges)
             (assoc-default 'left frame-params 'eq 0)))
       (y (+ (cdr x-y)
             (cadr inside-edges)
             (assoc-default 'top frame-params 'eq 0)
             ;; title bar height + menu bar height
             )))
  (x-show-tip "Hello" frame `((left . ,x) (top . ,y))))

ツールバーに関してはtool-bar-images-pixel-height変数などを駆使して、無理矢理算出できそうな気もしますが、メニューバーに関しては今のところお手上げです。

そしてこんな簡単なことに大切な時間を使うのが不毛で仕方ありません。

scratchバッファで不用意に評価されないようにする

scratchバッファの存在意義であるC-j(カーソルの直前にあるS式を評価して出力)ですが、関数定義中などでは一時的に通常の動作(改行+インデント)に戻ってほしいことがあります。次のコードを評価すると、まさにその挙動を手に入れることができます。

(defadvice eval-print-last-sexp (around eval-print-last-sexp-or-newline-and-indent activate)
  (condition-case nil
      (progn
        (scan-lists (point) -1 (point-min))
        (newline-and-indent))
    (scan-error ad-do-it)))

これによりトップレベルのS式のみが評価対象になります。scratchバッファでの作業が大分快適になると思います。

auto-completeに大文字小文字を区別しないオプションを追加しました

ac-ignore-case変数をtあるいはsmartにすることにより、大文字小文字を区別せずに補完できるようになりました。デフォルトはnilです。ac-ignore-case変数をtにすると、無条件に大文字小文字を区別しなくなります。smartにすると、プリフィックス(補完中文字列)に大文字が含まれない場合のみ、大文字小文字を区別しなくなります。

なお、case-fold-searchまわりでまだケアできてない部分があると思います。そのあたりはおいおい修正していきます。

loopマクロのcollect節でintoを使うと非常に遅い

loopマクロでcollect節と一緒にintoを使うと演算コストが非常に大きくなるという話。

原因を探るためにintoなしとintoありのloopマクロをmacroexpandで展開してpretty-printしてみます。どちらの演算式も返す値は同じになります。

;; intoなし
(pp (macroexpand-all '(loop for i from 1 to 10000 collect i)))

;; intoあり
(pp (macroexpand-all '(loop for i from 1 to 10000 collect i into x finally return x)))
;; 結果

;; intoなし
(cl-block-wrapper
 (catch '--cl-block-nil--
   (let*
       ((i 1)
        (--cl-var-- nil))
     (while
         (<= i 10000)
       (setq --cl-var--
             (cons i --cl-var--))
       (setq i
             (+ i 1)))
     (nreverse --cl-var--))))

;; intoあり
(cl-block-wrapper
 (catch '--cl-block-nil--
   (let*
       ((i 1)
        (x nil))
     (while
         (<= i 10000)
       (setq x
             (nconc x
                    (list i)))
       (setq i
             (+ i 1)))
     x)))

intoなしの方は、高速なリスト生成手法としてよく知られたpush/nreverseイディオムが使用されています。それに対して、intoありの方は、nconcでリストの末尾に逐一値を追加しているのが分かります(参照されるタイミングが不明なため、常に追加順を保たないといけない)。Lispのリスト構造に詳しい方ならすぐに気付くと思いますが、nconcは結合されるリストの末尾コンスセルを走査するため、結合されるリストが長くなればなるほど演算コストが増加します。そのため、intoありのcollectは指数関数的に演算コストが増加するのです。

実際、以下のようなベンチマークを取ってみるとその違いが歴然としていることが分かります。

(require 'benchmark)
(let ((gc-cons-threshold (* 1024 1024 32)))
  (garbage-collect)
  (message "push: %s" (benchmark-run-compiled 1
                          (funcall (lambda ()
                                     (loop for i from 1 to 10000 collect i)))))
  (garbage-collect)
  (message "nconc: %s" (benchmark-run-compiled 1
                           (funcall (lambda ()
                                      (loop for i from 1 to 10000 collect i into l))))))
結果
push: (0.001274 0 0.0)
nconc: (0.39666999999999997 0 0.0)

push/nreverse版では1msで完了するのに対し、nconc版では396msもかかっています。

この結果をふまえて、intoありcollectは利用しないよう促すつもりでしたが、ふと自作パッケージをgrepしてみると見事にauto-complete.elで利用していました。これがJoel Spolskyの言う「抽象化の漏れ」なのかと、自分を戒めながらヒシヒシと感じたのでした。

参考
  • info cl :: Loop Facility
  • Joel on Software