- 数字の英単語（ZERO〜NINE）が文字単位でつながる有向グラフをマルコフ連鎖として実装しました。
- 各文字からの遷移先と出現回数をハッシュテーブルとalistで管理し、重み付きランダム選択で次の文字を決めます。
:beginと:endシンボルを境界として、単語の開始・終了を遷移テーブルに自然に組み込んでいます。- NINE・FIVE・SEVEN・ONEが
E→I→N→Eのループを共有するため、生成列が長く連鎖することがあります。
1. 文字の遷移グラフ
SNSのタイムラインに、こんな有向グラフが流れてきました。
ノードはアルファベット1文字で、矢印は「この文字の次にこの文字が来る」という遷移を示しています。
たとえば Z から E、R、O とたどると ZERO が読めます。
ZERO から ONE、ONE から TWO……と全数字がつながるグラフ構造になっている、という図解です。
このグラフを見ていたら、マルコフ連鎖を思い出しました1。
各エッジに重みを付ければ、ランダムな文字列を生成するコードを Common Lisp で実装してみました。
1.1. マルコフ連鎖とは
「マルコフ連鎖」とは、次の状態が現在の状態だけで決まる確率的なプロセスです。
以前の経路は気にせず、「今どこにいるか」だけが次の行き先を決める仕組みで、この性質を使うと、遷移の確率さえ定義すれば、連鎖をたどるだけでランダムな系列を生成できます。
今回の例で言うと、文字 E にいるとき、次に I N R のどれに進むかは E だけで決まります。
そこに至るまでに Z を経由したか S を経由したかは影響しません。
今回は重みを使い、同じ遷移が複数の単語に登場するほど選ばれやすくなるようにしました。
2. 遷移テーブルの設計
2.1. :begin と :end を境界に置く
マルコフ連鎖の開始と終了は、キーワードシンボルにしました。
各単語の先頭文字の前に :begin から、末尾文字の後に :end へのエッジを追加し、「どの文字で始まりやすいか」が重みとして自然に決まります2。
ZERO・ONE・TWO・THREE・FOUR・FIVE・SIX・SEVEN・EIGHT・NINE の10語から集計すると、:begin の遷移先は Z O T F S E N になります。
(defparameter *number-words*
'("ZERO" "ONE" "TWO" "THREE" "FOUR"
"FIVE" "SIX" "SEVEN" "EIGHT" "NINE"))Code language: Lisp (lisp)2.2. ハッシュテーブルと alist の組み合わせ
遷移テーブルは、 from をキー、(to . count) の alist を値とするハッシュテーブルにしました。
(make-hash-table :test #'equal)Code language: Lisp (lisp):begin や :end というシンボルと #\Z のような文字が混在するので、:test #'equal を使いました。
ハッシュテーブルにエッジを追加する関数 add-edge は、次のように書きました。
table から from に対する alist entry をまず取り出し、to がすでにあれば cdr のカウントをインクリメント、なければ acons で先頭に追加します。
(defun add-edge (table from to)
(let* ((entry (gethash from table))
(bucket (assoc to entry :test #'equal)))
(if bucket
(incf (cdr bucket))
(setf (gethash from table)
(acons to 1 entry)))))Code language: Lisp (lisp)table を第1引数にしているのは、「操作対象のオブジェクトを先に置く」という Common Lisp の慣習に合わせたためです。acons は新しいコンスセルを先頭に付けるだけなので、既存の alist を破壊しません3。
make-transition-tableは、単語リストを元に遷移テーブルを生成します。
(defun make-transition-table (words)
(let ((table (make-hash-table :test #'equal)))
(loop for word in words
do (let ((letters (coerce word 'list)))
(add-edge table :begin (first letters))
(loop for (a b) on letters
while b
do (add-edge table a b))
(add-edge table (car (last letters)) :end)))
table))Code language: Lisp (lisp)文字列は、coerce word 'list で文字のリストに変換し、一文字ずつグラフにエッジを追加しています4。loop for (a b) on letters は on キーワードによるリストの CDR 方向の走査と分割束縛を組み合わせた書き方です5。
3. 重み付きランダム選択
ここからは、遷移テーブルを元にランダム文字列を生成しています。
まずは、一文字追加する関数 pick-next です。
(defun pick-next (from table)
(let* ((choices (gethash from table))
(total (reduce #'+ choices :key #'cdr)))
(loop with r = (random total)
for (to . weight) in choices
do (decf r weight)
when (<= r 0)
return to)))Code language: Lisp (lisp)r を削っていく方式で、(random total) で 0 以上 total 未満の整数を取り6、alist を順にたどりながら weight を引き続け、0以下になった時点の to を返します。acons が先頭に追加するため、alist の順序は追加順の逆になりますが、重み付きランダムの正しさには影響しません。
3.1. 生成ループと実行
pick-nextを繰り返して、文字列を生成します。
(defun generate-sequence (table &key (max 50))
(loop with state = :begin
repeat max
for next = (pick-next state table)
until (eq next :end)
do (setf state next)
collect state))Code language: Lisp (lisp):begin から出発し、:end に到達したらループを抜けます。max は上限で、THREE の E 自己ループが長く続いた場合に止める役割を持ちます。collect state は until の判定の後に評価されるので、:end 自体は列に含まれません。
出力は、文字を繋げるだけです。
(defun print-sequence (seq)
(format t "~{~a~^~}~%" seq))Code language: Lisp (lisp)~^ はリストの最後の要素の後では展開されないので、セパレータなしで文字を連結できます7。
実行するといくつかパターンが出てきます。
:begin -> TWONEREINEFIVENIVEREIN -> :end
:begin -> ZEREIN -> :end
:begin -> SIXNINEINEINEINEINEIN -> :endCode language: CSS (css)NINE・FIVE・SEVEN・ONE がこのループを共有しているので、E から I、N、E のループにはまると長い列が生成されます。
3.2. コード全体
;; Markov chain over letter sequences of English number words
;; Based on the directed graph: ZERO ONE TWO THREE FOUR FIVE SIX SEVEN EIGHT NINE
(defparameter *number-words*
'("ZERO" "ONE" "TWO" "THREE" "FOUR"
"FIVE" "SIX" "SEVEN" "EIGHT" "NINE"))
;; --- Transition table ---
;; trans[from] = alist of (to . count)
;; :begin and :end are used as boundary markers
(defun add-edge (table from to)
(let* ((entry (gethash from table))
(bucket (assoc to entry :test #'equal)))
(if bucket
(incf (cdr bucket))
(setf (gethash from table)
(acons to 1 entry)))))
(defun make-transition-table (words)
(let ((table (make-hash-table :test #'equal)))
(loop for word in words
do (let ((letters (coerce word 'list)))
(add-edge table :begin (first letters))
(loop for (a b) on letters
while b
do (add-edge table a b))
(add-edge table (car (last letters)) :end)))
table))
(defparameter *transitions*
(make-transition-table *number-words*))
;; --- Weighted random pick ---
;; (pick-next :begin *transitions*) => one of Z O T F S
(defun pick-next (from table)
(let* ((choices (gethash from table))
(total (reduce #'+ choices :key #'cdr)))
(loop with r = (random total)
for (to . weight) in choices
do (decf r weight)
when (<= r 0)
return to)))
;; --- Generator ---
;; Generates a sequence of letters starting from :begin,
;; stopping when :end is reached or max-steps is exceeded.
;;
;; (generate-sequence *transitions*) ;=> (Z E R O)
;; (generate-sequence *transitions* :max 30) ;=> (T H R E E ...)
(defun generate-sequence (table &key (max 50))
(loop with state = :begin
repeat max
for next = (pick-next state table)
until (eq next :end)
do (setf state next)
collect state))
;; --- Pretty printer ---
(defun print-sequence (seq)
(format t "~{~a~^~}~%" seq))
;; --- Main ---
(defun main ()
(let* ((seq (generate-sequence *transitions* :max 30)))
(format t ":begin -> ")
(print-sequence seq)
(format t "-> :end~%")
(format t "(~a letters)~%" (length seq))))
#-swank(main)
Code language: Lisp (lisp)3.3. 【補足】頻出単語
このマルコフ連鎖でどんな単語が出て来やすいのか、10,000回生成して、頻度表を作りました。
| 順位 | 文字列 | 出現数 |
|---|---|---|
| 1 | t | 1,282 |
| 2 | se | 896 |
| 3 | fix | 513 |
| 4 | n | 507 |
| 5 | tht | 458 |
| 6 | e | 431 |
| 7 | fight | 334 |
| 8 | our | 325 |
| 9 | nix | 278 |
| 10 | o | 266 |
| 11 | fin | 252 |
| 12 | ne | 205 |
| 13 | night | 162 |
| 14 | ththt | 156 |
| 15 | finix | 119 |
| 16 | fightht | 116 |
| 17 | nin | 115 |
| 18 | fine | 104 |
| 19 | seve | 102 |
| 20 | seix | 101 |
| 21 | oure | 92 |
| 22 | see | 89 |
| 23 | finight | 84 |
| 24 | seight | 72 |
| 25 | sein | 68 |
| 26 | thththt | 64 |
| 27 | nine | 63 |
| 28 | on | 61 |
| 29 | ee | 58 |
| 30 | eix | 57 |
(defun sequence-to-string (seq)
(format nil "~{~a~}" seq))
(defun frequent-generated-words()
(let* ((table (make-transition-table *number-words*))
(freq (make-hash-table :test #'equal)))
(loop repeat 10000
do (let ((word (sequence-to-string (generate-sequence table))))
(incf (gethash word freq 0))))
(let* ((pairs (loop for k being the hash-keys of freq
using (hash-value v)
collect (cons k v)))
(sorted (sort pairs #'> :key #'cdr))
(top30 (subseq sorted 0 (min 30 (length sorted)))))
(format t "~%順位 出現数 文字列~%")
(format t "~a~%" (make-string 50 :initial-element #\-))
(loop for (word . count) in top30
for rank from 1
do (format t "~3d ~5d ~a~%" rank count word)))))
Code language: Lisp (lisp)- マルコフ連鎖とは、次の状態が現在の状態のみに依存する確率的なプロセスです。各ノードからの遷移確率（ここでは重み）を定義すれば、確率的な系列を生成できます。 – Markov chain – Wikipedia
:beginと:endを境界マーカーとして使うパターンは、テキスト生成のマルコフ連鎖では一般的な設計です。系列の開始・終了確率を遷移テーブルに統合することで、生成ロジックを一本化できます。 – The Common Lisp Cookbook – Hash Tables- HyperSpec の
aconsのエントリには “Side Effects: None.” と明記されています。既存のリストを変更せず新しいコンスを返すため、元の alist を保持したまま更新後の alist を得られます。 – CLHS: Function ACONS coerceは第1引数のオブジェクトを第2引数の型に変換します。文字列に対して'listを指定すると文字のリストが得られます。逆に文字のリストから文字列に戻すには(coerce chars 'string)とします。 – CLHS: Function COERCEonは各反復でリストの連続するサブリストを変数に束縛し、(a b)の形で先頭2要素を取り出せます。 – Loop, iteration, mapping – The Common Lisp Cookbookrandomに整数を渡すと、0以上その整数未満の整数を返します。HyperSpec には “Returns a pseudo-random number that is a non-negative number less than limit.” と定義されています。 – CLHS: Function RANDOM~^は「Escape Upward」ディレクティブで、~{~}の反復内でリストの残り要素が尽きたときに反復を終了します。~{~a~^,~}のようにセパレータの直前に置くことで、末尾にセパレータが付かない形式を作れます。 – CLHS: Section 22.3.7.4 Tilde Circumflex: Escape Upward