硬貨の組み合わせ問題（貪欲法の簡単な例題）

貪欲法や欲張り法（greedy algorithm, greedy strategy）と呼ばれるアルゴリズムの話。

このアルゴリムのよく知られた例は、ある金額を実現する硬貨の組合せの中で枚数が最も少ないものを求める問題。たとえば「765円のお釣を払う場合、500円硬貨1枚、100円硬貨2枚、50円硬貨1枚、10円硬貨1枚、5円硬貨1枚の計6枚」という結果は「高額の硬貨から順番に使って払う」ことによって求まる。「高い硬貨から使っていくという点で『欲張り』」らしい。

とても分かりやすいアルゴリズムである反面、局所的に最善の選択を繰り返すに過ぎないので、条件次第では最適解が求まらないこともある。

以下はこの問題を解く具体的な例だが、1円玉から500円玉のそれぞれについて枚数に制限を加えた形になっている。また、Elispなので金額と枚数の組を表すのに連想リスト（association list）を使っている。

;;; 引数は、金額と、利用可能な硬貨を表す連想リスト（金額と枚数）
(defun solve (yen coins)
  (if (zerop yen) nil
    (let ((n (min (/ yen (caar coins))
                  (cdar coins) )))
      (cons (cons (caar coins) n)
            (solve (- yen (* n (caar coins)))
                   (cdr coins) )))))

;;; 例1.
;;; 金額: 765円、
;;; 使える硬貨: 500円*1、100円*1、50円*3、10円*3、5円*3、1円*3
(solve 765 '((500 . 1) (100 . 1) (50 . 3) (10 . 3) (5 . 3) (1 . 3)))
=> ((500 . 1) (100 . 1) (50 . 3) (10 . 1) (5 . 1))

;;; 例2.
;;; 金額: 623円、
;;; 使える硬貨: 500円*0、100円*5、50円*3、10円*1、5円*2、1円*5
(solve 623 '((500 . 0) (100 . 5) (50 . 3) (10 . 1) (5 . 2) (1 . 10)))
=> ((500 . 0) (100 . 5) (50 . 2) (10 . 1) (5 . 2) (1 . 3))

参考

• Algorithms with Python / 欲張り法
• Amazon.co.jp： プログラミングコンテストチャレンジブック: 秋葉 拓哉, 岩田 陽一, 北川 宜稔: 本

RangeオブジェクトとSelectionオブジェクト

JavaScriptにおけるRangeオブジェクトとSelectionオブジェクトの使いかたとして、次の2つのケースを書いておく。

1. 選択範囲のテキストを取得する
2. 指定したノードを選択状態にする

1. 選択範囲のテキストを取得する

マウスで選択したテキストがアラートで表示される、という簡単な例題。

IE以外の場合

まずSelectionオブジェクトを取得して、そこからさらにRangeオブジェクトを取得する（それぞれ、getSelectionメソッドとgetRangeAtメソッドを使う）。RangeオブジェクトのtoStringメソッドで求めるテキストが得られる。

    <p id="p">foo bar baz</p>

    <script type="text/javascript">
      document.getElementById('p').onmouseup = function(){
        var range = window.getSelection().getRangeAt(0);
        alert(range.toString());
      }
    </script>
    

Windows7のFirefox, Chrome, Safariで期待通りに動作した。

IEの場合

考え方は同じだが、使用するメソッドが異なる。

• Selectionオブジェクト … documentオブジェクトのselectionプロパティ
• Rangeオブジェクト（IEの場合はTextRangeオブジェクトと言う） … SelectionオブジェクトのcreateRangeメソッド
• テキスト … TextRangeオブジェクトのtextプロパティ

    <p id="p">foo bar baz</p>

    <script type="text/javascript">
      document.getElementById('p').onmouseup = function(){
        var range = document.selection.createRange();
        alert(range.text);
      };
    </script>
    

2. 指定したノードを選択状態にする

HTMLの中の任意の要素を選択状態（明暗が反転した状態）にする、という簡単な例題。

IE以外の場合

SelectionオブジェクトのselectAllChildrenメソッドを使う。引数として渡した要素が、子要素を含めて選択状態になる。

    <p id="p">foo bar baz</p>

    <script type="text/javascript">
      window.getSelection().selectAllChildren(document.getElementById('p'));
    </script>
    

これもWindows7のFirefox, Chrome, Safariで期待通りに動作した。

IEの場合

IEの場合は、Selectionを使わない。

まずはTextRangeオブジェクトを生成し、それが指定の要素を含むようにmoveToElementTextメソッドを実行する。さらにselectメソッドを実行して、要素を選択状態にする。

    <p id="p">foo bar baz</p>

    <script type="text/javascript">
      var range = document.body.createTextRange();
      range.moveToElementText(document.getElementById('p'));
      range.select();
    </script>
    

とりあえず以上。テキストの追加、削除、比較などについてはリファレンスを参考に。

参考

• W3C
  • Document Object Model Range
• MS
  • selection Object (document, HTMLDocument Constructor)
  • TextRange Object
• Mozilla
  • range - MDC Doc Center
  • Selection - MDC Doc Center
• Blogほか
  • Rangeオブジェクトメモ - ぬるま湯に浸かりながら
  • 選択範囲の取得について　getselection | blog.wonder-boys.net
  • DOM Range のテストケースを書きました - IT戦記

Firefox で PDF ファイルを開けない場合

問い合わせがあったので調べた。これ↓を参照してもらったら解決したので、念のため記録。

Firefox で PDF ファイルを表示する | 操作方法 | Firefox ヘルプ

EmacsでS式を pretty print する関数

pp-eval-last-sexpなど、頭に"pp-"が付く関数を利用するとS式を分かりやすく表示できる（"pp" は pretty print の略で、pp.el の中にいくつかの関数が定義されている）。

たとえば、Emacsの xml-parser を使ってこのブログのフィードXMLをS式に変換したとする。それを単純に表示すると、次のように一行に出力されてとても分かりにくい。

((feed ((xmlns . "http://www.w3.org/2005/Atom") (xmlns:openSearch . "http://a9.com/-/spec/opensearch/1.1/") (xmlns:georss . "http://www.georss.org/georss") (xmlns:thr . "http://purl.org/syndication/thread/1.0") (xmlns:gd . "http://schemas.google.com/g/2005") (xmlns:feedburner . "http://rssnamespace.org/feedburner/ext/1.0") (gd:etag . "W/\"DkQHRn8yfip7ImA9WhZRGUo.\"")) (id nil "tag:blogger.com,1999:blog-7510134520604525369") (updated nil "2011-04-17T02:18:57.196+09:00") (title nil "Technical Memorandum") (subtitle ((type . "html")) "備忘録") 以下略…

一方、 pp-* を使った場合には、次のように表示される。

((feed
  ((xmlns . "http://www.w3.org/2005/Atom")
   (xmlns:openSearch . "http://a9.com/-/spec/opensearch/1.1/")
   (xmlns:georss . "http://www.georss.org/georss")
   (xmlns:thr . "http://purl.org/syndication/thread/1.0")
   (xmlns:gd . "http://schemas.google.com/g/2005")
   (xmlns:feedburner . "http://rssnamespace.org/feedburner/ext/1.0")
   (gd:etag . "W/\"DkQHRn8yfip7ImA9WhZRGUo.\""))
  (id nil "tag:blogger.com,1999:blog-7510134520604525369")
  (updated nil "2011-04-17T02:18:57.196+09:00")
  (title nil "Technical Memorandum")
  (subtitle
   ((type . "html"))
   "備忘録")
  (link
   ((rel . "http://schemas.google.com/g/2005#feed")
    (type . "application/atom+xml")
    (href . "http://dminor11th.blogspot.com/feeds/posts/default")))
以下略…

だいぶ分かりやすくなりました。

上の例を作るために使用したプログラム

xml-parse-region が返すオブジェクトを、pp-to-string で整形。

;; wgetプロセスの番兵（process sentinel）を定義しておく
(defun wget-callback (process event)
  (switch-to-buffer (process-buffer process))
  (end-of-buffer)
  (save-excursion
    (insert (pp-to-string (xml-parse-region (point-min) (point-max))))))
=> wget-callback

;; 非同期プロセスとして wget を実行
;; バッファ *wget* に結果を出力
(let ((proc
       (start-process
        "wget"
        "*wget*"
        "/usr/local/bin/wget"
        "-qO-"
        "http://feeds.feedburner.com/TechnicalMemorandum?format=xml")))
  (set-process-coding-system proc 'utf-8-dos 'utf-8-dos)
  (set-process-sentinel proc 'wget-callback))
=> wget-callback

なお、外部プロセスとしてwgetを呼び出しているので、wgetがインストールされていない場合やパスが異なる場合は動かないと思われる。

参考

• elisp - PPRINT in Emacs Lisp? - Stack Overflow:

順列を求めるプログラム（Perl、Elisp）

"Higher-Order Perl" という本を読む。順列を求めるプログラムが載っている。何かの役にたつかもしれないから覚えとこう、と思い実際に書いてみる。ついでにEmacs Lispでも書いてみる。

Perlで順列（permutation）を求める

Higher-Order Perl: - Google ブックス より、そのまま引用。

sub permute{
  my @items = @{ $_[0] };
  my @perms = @{ $_[1] };
  unless(@items){
    print "@perms\n";
  } else {
    my(@newitems, @newperms, $i);
    foreach $i (0 .. $#items) {
      @newitems = @items;
      @newperms = @perms;
      unshift(@newperms, splice(@newitems, $i, 1));
      permute([@newitems], [@newperms]);
    }
  }
}
# sample call:
permute([qw(red yellow blue green)], []);

"permute.pl"というファイルに保存し、実行してみる。

$ perl ./permute.pl
green blue yellow red
blue green yellow red
green yellow blue red
yellow green blue red
blue yellow green red
yellow blue green red
green blue red yellow
blue green red yellow
green red blue yellow
red green blue yellow
blue red green yellow
red blue green yellow
green yellow red blue
yellow green red blue
green red yellow blue
red green yellow blue
yellow red green blue
red yellow green blue
blue yellow red green
yellow blue red green
blue red yellow green
red blue yellow green
yellow red blue green
red yellow blue green

順序が反対になって出力されるのが気になるが（red yellow blue green が最初に出力されて欲しい）、これはunshiftをpushに変えれば済む話なのでよしとする。

Emacs Lispの場合

loopは使わずに、マップ関数で実現。

(defun permute (lat)
  (cond
   ((null lat) '(()))
   (t (mapcan
       (lambda (atm)
         (mapcar (lambda (lst) (cons atm lst))
                 (permute (remove* atm lat :count 1))))
       lat))))

Perlよりだいぶすっきり。しかし一つひとつの関数が濃い。

実行結果。

(permute '(red yellow blue green))
=> ((red yellow blue green) (red yellow green blue)
    (red blue yellow green) (red blue green yellow)
    (red green yellow blue) (red green blue yellow)
    (yellow red blue green) (yellow red green blue)
    (yellow blue red green) (yellow blue green red)
    (yellow green red blue) (yellow green blue red)
    (blue red yellow green) (blue red green yellow)
    (blue yellow red green) (blue yellow green red)
    (blue green red yellow) (blue green yellow red)
    (green red yellow blue) (green red blue yellow)
    (green yellow red blue) (green yellow blue red)
    (green blue red yellow) (green blue yellow red))

導出について

上記の関数を作るときの考え方を書いておく。

まず、具体的な計算例を想像して分析してみる。たとえば3要素のリスト (a b c) に対して期待される結果は ((a b c) (a c b) (b a c) (b c a) (c a b) (c b a)) となる。

このうち、最初の2つの部分リスト ((a b c) (a c b)) は、 a を リスト (b c) と (c b) に cons した形なので次式で表せる。

(mapcar (lambda (lst) (cons 'a lst)) '((b c) (c b)))

さらに、第二引数の((b c) (c b))は、(b c)の順列だから、(permute '(b c))と表せる。

(mapcar (lambda (lst) (cons 'a lst)) (permute '(b c)))

残り4つの部分リストも同様に(mapcar (lambda ...) (permute ...))の形で表し、これらを連結（nconc）する。

(nconc
 (mapcar (lambda (lst) (cons 'a lst)) (permute '(b c)))
 (mapcar (lambda (lst) (cons 'b lst)) (permute '(a c)))
 (mapcar (lambda (lst) (cons 'c lst)) (permute '(a b))))

同じようなコードの重複を無くすため、mapcanを使って変形する。

(mapcan
 (lambda (atm)
   (mapcar (lambda (lst) (cons atm lst))
           (permute (remove* atm '(a b c) :count 1))))
 '(a b c))

remove*は第1引数と等しい要素を第2引数からすべて削除する関数だが、キーワードパラメータとして :count 1 を指定すれば削除する個数を制限できる。

この段階で再帰的関数の主要部分ができたので、(a b c)を関数の引数 lat として defun に変換する。

(defun permute (lat)
  (cond
   ((null lat) ???)
   (t (mapcan
       (lambda (atm)
         (mapcar (lambda (lst) (cons atm lst))
                 (permute (remove* atm lat :count 1))))
       lat))))

あとは保留してある「???」の部分、すなわち再帰が終了する場合の式を考えれば完成。

そのため、要素1個のリスト (a) の順列を求める過程を具体的にトレースしてみる。

(permute '(a))
;; cond の t に対応する式
=> (mapcan
    (lambda (atm)
      (mapcar (lambda (lst) (cons atm lst))
              (permute (remove* atm '(a) :count 1))))
    '(a))
;; mapcan を評価して、atm を 'a に置換
=> (nconc
    (mapcar (lambda (lst) (cons 'a lst))
            (permute (remove* 'a '(a) :count 1))))
;; remove* と nconc を評価（引数が1個なので nconc は実質的に何もしない）
=> (mapcar (lambda (lst) (cons 'a lst))
            (permute nil))

ここまで展開すると、(a)の順列を求めた結果が ((a)) となるためには(permute nil) の結果が (()) であればよいということがきっと分かる。

(mapcar (lambda (lst) (cons 'a lst))
            '(()))
=> ((a))

よって、保留した部分も '(()) と書けばよい。これでようやく関数が完成。

(defun permute (lat)
  (cond
   ((null lat) '(()))
   (t (mapcan
       (lambda (atm)
         (mapcar (lambda (lst) (cons atm lst))
                 (permute (remove* atm lat :count 1))))
       lat))))

参考

• Higher-Order Perl: - Google ブックス

Windows7でのEmacsとGoogle日本語入力の組み合わせ

SKKを使っているのでずっと知らなかったが、GNUが配布しているWindows用バイナリ：Index of /gnu/emacs/windows ではMS-IMEを使った日本語入力ができないらしい（もう少し詳しく言うと、入力はできるが変換候補が画面の端のほうに表示されるため、スムーズに漢字を選べない）。これを解決するためにIMEパッチなるものが存在することも知った。

この現象が出るかどうかはIMEに依存し、使用するIMEによって症状が異なるらしい。試しにWindows7のタスクバーやコントロールパネルでIMEを「Google日本語入力」に切り替えてからEmacsを再起動すると、普通に入力できた（Emacsのカーソルのある場所に変換候補が表示された）。

試した環境：

OS

Windows 7 Home Premium

Emacs

GNU Emacs 23.3.1 (i386-mingw-nt6.1.7600)

Google日本語入力

GoogleJapaneseInput-1.0.556.0 （Google日本語入力で、「ばーじょん」と入力、変換することで分かる）

ATOKとかその他のIMEでどうなるかは分からないが、とりあえずGoogle日本語入力を使う限りはEmacsにIMEパッチを当てなくても済むようだ（…ちょっと試しただけなので何とも言えないかな）。

参考

• Index of /gnu/emacs/windows
• emacs 23.2.91のIMEパッチ - gnupackの開発メモ
• Google 日本語入力 - ダウンロード

Emacs Lisp で迷路の最短路問題（最小のターン数を求める）

幅優先探索アルゴリズム（breadth-first search, BFS）は、初期状態から1回の遷移でたどり着ける全ての状態、2回の遷移でたどり着ける全ての状態、…という順番で探索するアルゴリズム。
深さ優先探索アルゴリズムと同じく初期状態からたどり着ける全ての状態を探索するが、初期状態に近い状態から順番に探索するので最短経路が確実に求まる。

例題：迷路の最短路（経路は求めずに距離だけ）

問題

通路と壁からできている迷路があり、1ターンに隣接する上下左右4マスの通路（いわゆる「4近傍」）へ移動できる。スタートからゴールまで移動するのに必要な最小のターン数を求める（ただし、スタートからゴールまで移動できると仮定）。

迷路の例

....####..####.#...#
.#.##.......#.#.....
.#S#...#.##.#.#..##.
.###....#..##....#.#
........####..#####.
##.#..#.#....#.#..#.
.#.###..#.#.##..#.#.
...#.#....#.##..###.
#..#...#.####G.##.#.
...#.#.#......#...##
##...#.....###.#.#.#
#.#..#####.#...####.
###....###.##.###.##

ここで、 S, G, ., # はそれぞれスタート、ゴール、通路、壁を表す。

解（Emacs Lispの場合）

一般的な解法では、迷路と同じサイズの二次元配列を最初に用意しておき、探索をしながらスタート地点からのターン数、すなわち距離の値を配列に記録していく。また、二次元配列を初期化するときに特異な値を代入することで、その座標が探索済みかどうか判断できるようにしておく。
この解法を踏まえつつ、次の変更を加えてEmacs Lispで実装した。

• 二次元配列は使わず、探索済みの座標をリストに記録していく
• 探索済み座標のリストには、ターン数もセットで記録する。要素は、行・列・ターン数の3要素をもつリストになるので、たとえば '((0 1 1) (1 0 1) (0 2 2) (1 2 2) ...) というような形になる
• 迷路の座標と一対一に対応する配列を持たないので経路を求めることはできないが、ターン数だけを求めるのでこれでよしとする

;;; 幅優先探索（BFS）の例題：迷路の最短路問題
(defun minimum-distance ()
  "カーソルを迷路の下に移動させて実行すると、スタート（S）とゴール（G）の距離をミニバッファに出力。探索した場所を / に置換しながら進む。"
  (interactive)
  (save-excursion
    (search-backward "S")
    (let* ((flg t)                      ;発見したらnil
           (dist 0)                     ;距離
           (visited)                    ;探索済み座標のリスト
           (queue (list-next-positions dist))) ;探索する座標のリスト
      (while (and queue flg)         ;探索対象あり、かつ未発見の場合
        (funcall                     ;queueからpopした要素に関数を適用
         (lambda (pos)                  ;ゴールか調べつつ、queueに追加
           (progn
             (goto-line (first pos))
             (move-to-column (second pos))
             (sit-for 0.05)
             (cond
              ((eq (char-after) ?G) ;ゴールかどうか
               (message "Answer: %d" (third pos)) ;結果表示
               (setf flg nil))                    ;while終了
              (t (insert ?/)
                 (delete-char 1)
                 (backward-char)
                 (setf queue            ;次の探索対象をqueueに追加
                       (append
                        queue
                        (list-next-positions (third pos)) ))))))
         (pop queue) )))))

(defun list-next-positions (dist)
  "現在のカーソル位置から次の探索位置を求める補助関数。結果はリストにして返す。また、動的スコープを利用してminimum-distance の中の visited も変更する。"
  (let* ((row (line-number-at-pos))
         (col (current-column))
         (poslist `((,(1- row) ,col)    ;移動方向 上
                    (,row ,(1+ col))    ;右
                    (,(1+ row) ,col)    ;下
                    (,row ,(1- col))))) ;左
    (setf visited                   ;呼び出し元の visited を変更
          (mapcar
           (lambda (pos) (append pos `(,(1+ dist)))) ;距離を追加
           (remove-if
            (lambda (pos)
              (let ((row (first pos))
                    (col (second pos)) )
                (or (< col 0)      ;列がマイナスの場所は対象外
                    (progn (goto-line (first pos)) ;通路かゴール以外は対象外
                           (move-to-column (second pos))
                           (not (find (char-after) '(?. ?G))))
                    (some (lambda (v)   ;探索済みなら対象外
                            (and (eq row (first v)) (eq col (second v))))
                          visited))))
            poslist)))))

実行＆結果

1. *scratch*バッファなどで、".", "#", "S", "G" を使った迷路のASCIIアートを描く（SからGまで辿り着けるようになっていること）。
2. M-x minimum-distance を実行する。
3. 通路"."が"/"に置換されていき、"G"に逹するとミニバッファにターン数が表示される。

参考

• Amazon.co.jp： プログラミングコンテストチャレンジブック: 秋葉 拓哉, 岩田 陽一, 北川 宜稔: 本
• 幅優先探索 - Wikipedia

CSRの鍵長を確かめるコマンドなど

SSLサーバー証明書の更新時期になったので、CSRを作りなおした。2011年からは「RSA暗号の鍵長が2048ビット以上でないといけない」とのことなので、opensslのコマンドに -newkey rsa:2048 というオプションが必要になる。

openssl req -new -nodes -newkey rsa:2048 -keyout myserver.key -out myserver.csr

さらに、念のため2048ビットのCSRができているか確認したいなら、次のコマンドを打てばいいだろう。といってもただ単にCSRの内容をテキストで出力して、先頭を切り出しているだけだが。

openssl req -text -in ./myserver.csr | head

コマンドの結果、次のようなテキストが出力される。

Certificate Request:
    Data:
        Version: 0 (0x0)
        Subject: C=JP, ST=Tokyo, L=Setagaya-ku, O=foo Inc., CN=foo.example.com
        Subject Public Key Info:
            Public Key Algorithm: rsaEncryption
            RSA Public Key: (2048 bit)
                Modulus (2048 bit):

「RSA Public Key: (2048 bit)」と記されているので、RSA暗号の鍵長は2048ビットになっているに違いない。

参考

• sp800-57-Part1-revised2_Mar08-2007.pdf アメリカ合衆国の国立標準技術研究所(National Institute of Standards andTechnology, NIST)のガイドライン

Emacs でキータイプのたびに音を鳴らしてみる on Windows7

最近、「Ommwriter」というテキストエディタ（？）の存在を知った。

デモ動画を見て真っ先に「いいなあ」と思ったのは、キーをタイプするたびに気持ちいい音が出るところ。これならEmacs でもできるだろうと思って試してみた。

環境は次のとおり。

OS

Windows 7 Home Premium

Emacs

GNU Emacs 23.3.1 (i386-mingw-nt6.1.7600)

Emacsから外部プロセスを使って音を出す

Emacsで任意の音声ファイルを再生することはできなそうなので、外部のコマンドを利用して鳴らす方針にする。とはいえ、Windows環境だからコマンドラインから音声を再生するコマンドがあるのかがわからない。Linux環境であればコマンドもいろいろありそうだが…。

しばらくWebサイトを漂流した結果、QuickView 2.52、MPXPLAY 1.50、(Free)CDP 1.1/2.1、OpenCP 2.60、XTC-PLAY 0.97c などがあるとわかった。試した結果、"Mpxplay" が動作したのでこれにした。

Mpxplayのインストール

Welcome to the PDSoft Homepage から、"Mpxplay v1.57 for Win32"をダウンロードして、C:/Program Files (x86)/MPXP157W/に置く。

音源

次に、それっぽい音源を用意しなければならない。

クリック音みたいな短い音で自由に使える素材がないかなあと探した結果、このサイト「全ての効果音・SE1｜フリー音素材01SoundEarth」がみつかった。ここから「ボタン音・ワンショット系」のmp3をとりあえず10個（b_001.mp3 から b_010.mp3 まで）ダウンロードして、~/.emacs.d/mp3/ に配置。

以上で必要なものがそろったので、次はEmacsを使っての実験。以下のようなコードを*scratch*バッファで実行してみて音が出ればOK。

(let ((sndfile
       (concat (getenv "HOME") "/.emacs.d/mp3/" "b_001.mp3")))
  (start-process
   "my-test-process"
   nil
   "C:/Program Files (x86)/MPXP157W/MPXPLAY" "-f0" "-xel" sndfile))

ここで、start-procesが非同期に外部コマンドを実行するための組み込み関数。また、外部コマンドであるMPXPLAYに指定しているオプションの意味は、以下のとおり（Mpxplayに付属のREADME.TXTより抜粋）。

-f0 : no screen output (some warning/error messages are not displayed in this mode (ie: serial-control and LCD errors))
-xel : exit at end of (play)list (has effect in directory browser and in jukebox queue too)

Mpxplayのプロセスが増える問題（.iniファイルを消すと解決）

いまいち原因がわからないのだが、Mxplayを続けて実行すると音が出なくなり、プロセスが残るという現象が出て困った。

具体的には "Warning: mpxplay.ini is read-only!"というメッセージを出力されるので、mxplay.ini を思いきって消したら解決した。この現象はEmacsを経由しない場合、つまりWindowsのコマンドプロンプトからでも発生したので、Mxplay自身の問題というか仕様なのだろう。

キー押下で音を出す設定

Emacsでは、a や b などの普通のキーを押したときにself-insert-commandというコマンドが走る。よって、このコマンドに音を出す処理を advice として追加してやれば済みそうなのだが、実はうまくいかない（self-insert-commandは特別な扱いになっているようだ）。

そこで、self-insert-commandを自作の関数でラップし、キー押下時にラッパー関数のほうが実行されるようにする。さらに、ラッパー関数に advice として音を出す処理を追加する。

elispコード

以下を*scratch*バッファで実行すると、音が出るようになるはず。

(defcustom my-sound-dir
  (concat (getenv "HOME") "/.emacs.d/mp3/")
  "音声ファイルの場所")

;;; Can't advise SELF-INSERT-COMMAND, so create a wrapper procedure.
(defun self-insert-wrapper (n)
  (interactive "p")
  (self-insert-command n))

;;; Advise SELF-INSERT-WRAPPER to execute  after every keypress
(defadvice self-insert-wrapper (after ad-self-insert-wrapper activate)
  "入力された文字に応じて音声ファイルを選び、外部プロセスを呼ぶ"
  (let ((sndfile
         (concat my-sound-dir "b_" (format "%03d" (1+ (% (char-before) 10))) ".mp3")))
    (start-process
     "proc-sound"
     nil
     "C:/Program Files (x86)/MPXP157W/MPXPLAY" "-f0" "-xel" sndfile)))

;; Remap SELF-INSERT-COMMAND to be SELF-INSERT-WRAPPER.
(global-set-key [remap self-insert-command] 'self-insert-wrapper)

実際に使えるか、という問題

上のコードを実行して、実際に音を出しながらキーをタイプしてみたところ、ときどき砂時計が出てきてしまった… 残念ながら、実用に耐えない、という結論（とりあえず）。

ビープ音（ベル）だけ変える場合

ビープ音というのは Ctrl-g を押したときなどに鳴る音。これは頻繁に鳴るわけではないので、性能の問題は無視できるだろう。下記のコードを実行すれば、ランダムなピープ音が鳴るようになる。

(defcustom my-sound-dir
  (concat (getenv "HOME") "/.emacs.d/mp3/")
  "音声ファイルの場所")

(setq ring-bell-function
      (lambda ()
        (let ((sndfile (concat my-sound-dir "b_" (format "%03d" (1+ (random 10))) ".mp3")))
          (start-process
           "proc-sound"
           nil
           "C:/Program Files (x86)/MPXP157W/MPXPLAY" "-f0" "-xel" sndfile))))

ここで重要な組み込み関数／変数は、ring-bell-function。これにセットしたlambda式は、ビープ音を鳴らすタイミングで実行される。

参考

• Welcome - Ommwriter
• コマンドラインで .wav ファイルを再生する | Windowsのかゆいとこ (Window XP 以前ならば、"sndrec32.exe"が使えるらしい)
• play wav/mp3 via dos (command line)
• Welcome to the PDSoft Homepage
• 全ての効果音・SE1｜フリー音素材01SoundEarth
• Text editor with comment wrapping - Stack Overflow