プログラムを書かせるためのLispの使い方
この投稿は元々中国語で書かれ、CSDNに掲載されました。https://blog.csdn.net/lzw_java/article/details/11599993
多くのコードやアイデアは、「Ansi Common Lisp」P138~P141に基づいています。
問題：英語のテキストが与えられたとき、コンピュータはそのテキストを基にランダムで読みやすいテキストを生成することができますか？例えば：
The National Venture Capital Association estimates that wealth associated with a deal a big spending by regulations that will spend one another’s main reason these projects .
これは、コンピュータがポール・グレアムのいくつかの記事を学んだ後、ランダムに生成されたテキストです。これは「Venture」という単語から始まる文に拡張されます。驚くべきことに、テキストはしばしば読みやすいです。
アルゴリズム：各単語の後に現れる単語とその現れ方の回数を記録します。例えば、原文中に「I leave」が5回、「I want」が3回現れ、「I」が他の単語の前に現れない場合、ランダムなテキストを生成しているとき、「I」が見つかったとき、次の単語として「leave」を選択する確率は5/8です。「leave」が選択された場合、その後に現れる単語を確認し、そのプロセスを繰り返します。
それでは、Lispを使ってこの問題を解決してみましょう。
Lispのシンボルタイプはさまざまな文字列と句読点を記憶することができ、そのために使用します。リストを作成するために組み込みのハッシュテーブルを使用します：
(defparameter *words* (make-hash-table :size 10000))
リストはどうやって作成するのでしょうか？
(let ((prev '|.|))
(defun see (sym)
(let ((pair (assoc sym (gethash prev *words*))))
(if pair
(incf (cdr pair))
(push (cons sym 1) (gethash prev *words*))))
(setf prev sym)))
| 現在の単語はその下のkeywordで、assoc-listはそのvalueです。例えば、「I」の下には（( | leave | . 5) ( | want | . 3)）があります。単語が存在しない場合、単語が1です。 |
それでは、ランダムに単語を選ぶ方法を説明します。
(defun random-word (word ht)
(let* ((choices (gethash word ht))
(x (random (reduce #'+ choices :key #'cdr))))
(dolist (pair choices)
(decf x (cdr pair))
(if (minusp x)
(return (car pair))))))
reduce関数は巧妙に使われています。
それでは、与えられた単語を両側に拡張する方法について考えてみましょう？
1) テキストを逆転させ、逆リストを取得します。例えば、「I leave, I want」は「leave I, want I」になります。
2) ハッシュテーブルを逆転させ、もう一つのハッシュテーブルを作成します。そのテーブルでは、後の単語がキーであり、可能な前の単語とその数がassoc-listを形成します。
3) 運を試し、句読点から句を拡張し始め、与えられた単語が現れるまで続けます。
私は2番目の方法を使用しました：
(defparameter *r-words* (make-hash-table :size 10000))
(defun push-words (w1 w2 n)
(push (cons w2 n) (gethash w1 *r-words*)))
(defun get-reversed-words () ; a cat -> cat a
(maphash #'(lambda (k lst)
(dolist (pair lst)
(push-words (car pair) k (cdr pair))))
*words*))
元のハッシュテーブルをトラバースし、それから別のハッシュテーブルに順序を逆転させた各ペアの単語を挿入します。以下に、両側に拡張された文を自動生成するコードがあります：
(defparameter *words* (make-hash-table :size 10000))
(defconstant maxword 100)
(defparameter nwords 0)
(defconstant debug nil)
(let ((prev '|.|))
(defun see (sym)
(incf nwords)
(let ((pair (assoc sym (gethash prev *words*))))
(if pair
(incf (cdr pair))
(push (cons sym 1) (gethash prev *words*))))
(setf prev sym)))
(defun check-punc (c) ; char to symbol
(case c
(#\. '|.|) (#\, '|,|)
(#\; '|;|) (#\? '|?|)
(#\: '|:|) (#\! '|!|)))
(defun read-text (pathname)
(with-open-file (str pathname :direction :input)
(let ((buf (make-string maxword))
(pos 0))
(do ((c (read-char str nil 'eof)
(read-char str nil 'eof)))
((eql c 'eof))
(if (or (alpha-char-p c)
(eql c #\'))
(progn
(setf (char buf pos) c)
(incf pos))
(progn
(unless (zerop pos)
(see (intern (subseq buf 0 pos)))
(setf pos 0))
(let ((punc (check-punc c)))
(if punc
(see punc)))))))))
(defun print-ht (ht)
(maphash #'(lambda (k v)
(format t "~A ~A~%" k v))
ht))
(defparameter *r-words* (make-hash-table :size 10000))
(defun push-words (w1 w2 n)
(push (cons w2 n) (gethash w1 *r-words*)))
(defun get-reversed-words () ; a cat -> cat a
(maphash #'(lambda (k lst)
(dolist (pair lst)
(push-words (car pair) k (cdr pair))))
*words*))
(defun print-a-word (word ht)
(maphash #'(lambda (k lst)
(if (eql k word)
(format t "~A ~A~%" k lst)))
ht))
(if debug
(print-a-word '|leave| *r-words*))
(defun punc-p (sym) ; symbol to char, nil when fails.
(check-punc (char (symbol-name sym) 0)))
(defun random-word (word ht)
(let* ((choices (gethash word ht))
(x (random (reduce #'+ choices :key #'cdr))))
(dolist (pair choices)
(decf x (cdr pair))
(if (minusp x)
(return (car pair))))))
(defun gen-former (word str)
(let ((last (random-word word *r-words*)))
(if (not (punc-p last))
(progn
(gen-former last str)
(format str "~A " last)))))
(defun gen-latter (word str)
(let ((next (random-word word *words*)))
(format str "~A " next)
(if (not (punc-p next))
(gen-latter next str))))
(gen-latter '|leave| t)
(defun get-a-word (ht) ; get a random word
(let ((x (random nwords)))
(maphash #'(lambda (k v)
(dolist (pair v)
(decf x (cdr pair))
(if (minusp x)
(return-from get-a-word (car pair)))))
ht)))
(get-a-word *words*)
(defun gen-sentence (word str)
(gen-former word str)
(format str "~A " word)
(gen-latter word str))
(defun test ()
(setf nwords 0)
(read-text "essay.txt")
(get-reversed-words)
(let ((word (get-a-word *words*)))
(print word)
(gen-sentence word t)))
(test)