テキストファイルから2-gramのマルコフ連鎖によって文生成を行う．

malkov-chain.lisp

#|
    はじめてのAIプログラミング C言語で作る人工知能と人工無能
    のgenby2gram.cを参考にしました
    
    テキストファイルから2-gram解析を行い，その連鎖によって文を生成します
    Usage: ./malkov-chain p1 p2 p3
       p1: テキストファイル
       p2: 開始文字
       p3: 生成する文の数
|#

(declaim (ftype (function (fixnum list) list) collect-n-gram))
(defun collect-n-gram (n l)
  "charリストからn-gramのリストを生成する"
  (declare (optimize (speed 3) (debug 0) (safety 0))
           (fixnum n) (list l))
  (loop for i below (- (length l) (1- n))
              collect (cons (nth i l) (nth (1+ i) l))))

(declaim (ftype (function (fixnum list) list) collect-all))
(defun collect-all (n l)
  (declare (optimize (speed 3) (debug 0) (safety 0))
           (fixnum n) (list l))
  (labels ((f (src dst)
             (if (eq src '())
               dst
               (f (cdr src) (append (collect-n-gram n (car src)) dst)))))
    (f l '())))

(declaim (ftype (function (character list) list) collect-ch-list))
(defun collect-ch-list (ch lst)
  "charリストのリストからn-gramのリストを生成する"
  (declare (optimize (speed 3) (debug 0) (safety 0))
           (character ch) (list lst))
  (loop for i in lst
        when (eq (nth 0 i) ch)
        collect i))

(declaim (ftype (function (character list) string) gen-malkov))
(defun gen-malkov (startch 2-gram-list)
  "2-gramのリストからマルコフ連鎖によって文字列を生成する"
  (declare (optimize (speed 3) (debug 0) (safety 0))
           (character startch) (list 2-gram-list))
  (let ((len (length 2-gram-list))
        (gl '())
        (chain (list startch)))
    (labels ((next (c)
               (declare (optimize (speed 3) (debug 0) (safety 0))
                        (character c))
                 (if (eq c #\。)
                   (concatenate 'string chain)
                   (progn (setq gl (collect-ch-list c 2-gram-list))
                        (if (>= (length gl) 1)
                          (let ((nextch (cdr (nth (random (length gl)) gl))))
                            (progn (setq chain (append chain (list nextch)))
                                   (next nextch)))
                          (let ((nextch (cdr (nth (random len) 2-gram-list))))
                            (progn (setq chain (append chain (list nextch)))
                                   (next nextch))))))))
      (next startch))))

(defun load-file-as-char (file)
  "ファイルから文字列を改行文字で区切ったcharリストとして読み込む"
  (with-open-file (s file :direction :input
                     :element-type 'character
                     :external-format :utf-8)
        (loop for l = (loop for p = (read-char s nil nil)
                            while (not (or (eq p #\Newline) (eq p nil)))
                            collect p)
              while (> (length l) 0)
              collect l)))

(defun args ()
  #+sbcl sb-ext:*posix-argv*
  #+ccl ccl:*command-line-argument-list*)

(defun main ()
  (setq *random-state* (make-random-state t))
  (if (<= (length (args)) 3)
    (format t "Usage: command p1 p2 p3~%p1: テキストファイルのパス~%p2: 開始文字~%p3: 生成する行数~%")
    (let ((2-gram-list (collect-all 2 (load-file-as-char (nth 1 (args))))))
      (loop for i below (parse-integer (nth 3 (args)))
            do (format t "~A~%" (gen-malkov (nth 0 (concatenate 'list (nth 2 (args)))) 2-gram-list))))))

(declaim (optimize (speed 3) (debug 0) (safety 0)))

(defun make-app (app-name)
  #+sbcl (sb-ext:save-lisp-and-die app-name
                          :toplevel #'main
                          :executable t)
  #+ccl (ccl:save-application app-name
                      :toplevel-function #'main
                      :prepend-kernel t))

(make-app "malkov-chain")