Merge branch 'release/0.1.0'

Author: sandmark

.gitignore

@@ -9,3 +9,4 @@ pom.xml.asc
 /.nrepl-port
 .hgignore
 .hg/
+system_full.dic

README.md

@@ -1,40 +1,54 @@
 # Unmo - 形態素解析ベースの日本語チャットボット
 
-Unmo は日本語チャットボットプログラムです。
+Unmo は日本語チャットボットプログラムです。機械学習ではなく形態素解析に基づいてユーザーの発言を学習し、5 つの異なるエンジンが思考結果を返します。
+
+- ホワット (単純に聞き返す)
+- ランダム (学習したユーザーの発言からランダムに返す)
+- パターン (名詞を学習し、発言に関係する言葉を返す)
+- テンプレート (文章の名詞部分を他の名詞に置き換える)
+- マルコフ (マルコフ連鎖アルゴリズムから独自の文章を生成する)
+
+あくまでもユーザーの発言から文章を自動生成するだけなので、言葉の意味を理解しているわけではありません。そのため、乱暴な言葉ばかり使っていると乱暴なチャットボットに成長しますが、作者を恨まないでください。
+
+はじめのうちはホワットやランダムが多いと感じるかもしれませんが、辛抱強く話しかけていると辞書にバリエーションが増え、あるときはまともな、あるときは突拍子もない反応をするようになります。じっくり話してあげてください。
 
 ## インストール
+### 必要なもの
+実行には JVM（Java 仮想マシン）が必要です。https://java.com/ja/download/ からダウンロード・インストールしてください。
+
+また、形態素解析エンジンとして [Sudachi](https://github.com/WorksApplications/Sudachi/releases) を使用しています。辞書ファイルが必要になりますので、リンク先から `sudachi-0.1.1-dictionary-full.zip` をダウンロード・展開し、 `system_full.dic` を `unmo-x.x.x-standalone.jar` と同じディレクトリに置いてください。
 
-実行には JVM（Java 仮想マシン）が必要です。
-https://java.com/ja/download/ からダウンロード・インストールしてください。
+Unmo 本体は https://github.com/sandmark/unmo-clojure/releases からダウンロードすることができます。
 
-Unmo 本体は https://github.com/sandmark/unmo-clojure/ から
-ダウンロードすることができます。
+- `system_full.dic`
+- `sudachi_fulldict.json`
+- `unmo-x.x.x-standalone.jar`
 
-## Usage
+上記 3 つのファイルが同じディレクトリにあれば準備完了です。
 
-FIXME: explanation
+## 使い方
 
-    $ java -jar unmo-0.1.0-standalone.jar [args]
+Unmo はコンソールアプリケーションであるため、コマンドを実行する必要があります。
 
-## Options
+Unix 系なら端末エミュレータ、Mac OS ならターミナル、Windows ならコマンドプロンプトを起動し、 `cd` コマンドで `unmo-x.x.x-standalone.jar` のあるディレクトリへ移動します。その後、
 
-FIXME: listing of options this app accepts.
+    $ java -jar unmo-0.1.0-standalone.jar
+    
+と打ち込んで Enter キーを叩けば起動します。
 
-## Examples
+ひとしきり会話を楽しんだら、話しかけずに Enter キーを押せば終了します。
 
-...
+## アンインストール
 
-### Bugs
+`unmo-x.x.x-standalone.jar` のあるディレクトリを削除してください。
 
-...
+## 謝辞
 
-### Any Other Sections
-### That You Think
-### Might be Useful
+このプログラムは Ruby 用の書籍 [恋するプログラム](https://amzn.to/2FAG0AA) を参考に制作されました。著者である秋山智俊さんに多大な感謝を申し上げます。
 
 ## License
 
-Copyright © 2018 sandmark
+Copyright © 2018-2019 sandmark
 
 Distributed under the Eclipse Public License either version 1.0 or
 any later version.

project.clj

@@ -1,9 +1,18 @@
-(defproject unmo "0.1.0-SNAPSHOT"
+(defproject unmo "0.1.0"
   :description "A japanese legacy chatbot using Sudachi, a morphological analyser for modern era."
   :url "https://github.com/sandmark/unmo-clojure/"
   :license {:name "Eclipse Public License"
             :url "http://www.eclipse.org/legal/epl-v10.html"}
-  :dependencies [[org.clojure/clojure "1.10.0-RC5"]]
+  :repositories [["Sonatype" "https://oss.sonatype.org/content/repositories/snapshots"]]
+  :dependencies [[org.clojure/clojure "1.10.0"]
+                 [bigml/sampling "3.2"]
+                 [fipp "0.6.14"]
+                 [com.worksap.nlp/sudachi "0.1.1-SNAPSHOT"]]
+  :plugins [[lein-environ "1.1.0"]
+            [lein-eftest "0.5.3"]
+            [lein-auto "0.1.3"]]
   :main ^:skip-aot unmo.core
   :target-path "target/%s"
-  :profiles {:uberjar {:aot :all}})
+  :profiles {:dev {:dependencies [[alembic "0.3.2"]
+                                  [eftest "0.5.3"]]}
+             :uberjar {:aot :all}})

src/unmo/core.clj

@@ -1,7 +1,71 @@
 (ns unmo.core
-  (:gen-class))
+  (:gen-class)
+  (:require [unmo.responder :refer [response]]
+            [unmo.dictionary :refer [study save-dictionary load-dictionary]]
+            [unmo.morph :refer [analyze]]
+            [unmo.version :refer [unmo-version]]
+            [bigml.sampling [simple :as simple]]))
+
+(def ^{:private true
+       :doc "デフォルトで使用される辞書ファイル名"}
+  dictionary-file
+  "dict.clj")
+
+(defn- rand-responder
+  "確率によって変動するResponderを返す。
+  :what     10%
+  :random   20%
+  :pattern  30%
+  :template 20%
+  :markov   20%"
+  []
+  (-> [:what :random :pattern :template :markov]
+      (simple/sample :weigh {:what     0.1
+                             :random   0.2
+                             :pattern  0.3
+                             :template 0.2
+                             :markov   0.2})
+      (first)))
+
+(defn- format-response
+  "Responder からの結果を整形して返す。"
+  [{:keys [responder response error]}]
+  (let [responder-name (-> responder (name) (clojure.string/capitalize))]
+    (if error
+      (str responder-name "> 警告: " (:message error))
+      (str responder-name "> " response))))
+
+(defn- dialogue
+  "ユーザーからの発言、形態素解析結果、辞書を受け取り、AIの思考結果を整形した文字列を返す。"
+  ([input parts dictionary]
+   (dialogue input parts dictionary (rand-responder)))
+  ([input parts dictionary responder]
+   (let [res (-> {:input input
+                  :dictionary dictionary
+                  :parts parts
+                  :responder responder}
+                 (response))]
+     (case (get-in res [:error :type])
+       :fatal (format-response res)
+       nil    (format-response res)
+       (recur input parts dictionary :random)))))
 
 (defn -main
-  "I don't do a whole lot ... yet."
+  "標準入力からユーザーの発言を受け取り、Responder の結果を表示して繰り返す。"
   [& args]
-  (println "Hello, World!"))
+  (println (format "Unmo version %s launched." unmo-version))
+  (print "> ")
+  (flush)
+
+  (loop [input (read-line)
+         dictionary (load-dictionary dictionary-file)]
+    (if (clojure.string/blank? input)
+      (do (println "Saving dictionary...")
+          (save-dictionary dictionary dictionary-file)
+          (println "Quit."))
+      (let [parts (analyze input)
+            res (dialogue input parts dictionary)]
+        (println res)
+        (print "> ")
+        (flush)
+        (recur (read-line) (study dictionary input parts))))))

src/unmo/dictionary.clj

@@ -0,0 +1,82 @@
+(ns unmo.dictionary
+  (:require [unmo.util :refer [conj-unique file-exists?]]
+            [unmo.morph :refer [noun?]]
+            [fipp.edn :refer [pprint] :rename {pprint fipp}]))
+
+(defn- parts->markov
+  "形態素解析結果をマルコフ辞書形式に変換する。"
+  ([dictionary [[prefix1 _] [prefix2 _] & parts]]
+   (->> parts
+        (map first)
+        (parts->markov dictionary prefix1 prefix2)))
+
+  ([dictionary prefix1 prefix2 [suffix & rest]]
+   (if (not suffix)
+     (update-in dictionary [prefix1 prefix2] conj-unique "%ENDMARK%")
+     (-> dictionary
+         (update-in [prefix1 prefix2] conj-unique suffix)
+         (recur prefix2 suffix rest)))))
+
+(defn- study-markov
+  "形態素解析結果から文節のつながりを記録し、学習する。
+  実装を簡単にするため、3単語以上で構成された文章のみ学習する。"
+  [dictionary parts]
+  (if (< (count parts) 3)
+    dictionary
+    (let [[start _] (first parts)]
+      (-> dictionary
+          (update-in [:markov :starts start] (fnil inc 0))
+          (update-in [:markov :dictionary] parts->markov parts)))))
+
+(defn- study-template
+  "形態素解析結果に基づき、名詞の数をキー、名詞を%noun%に置き換えた発言のリストを値として学習する。
+  重複、ないし名詞が無い発言は学習しない。
+  学習した結果をdictionaryの:templateに定義して返す。"
+  [dictionary parts]
+  (letfn [(->noun [[word _ :as part]]
+            (if (noun? part)
+              "%noun%"
+              word))]
+    (let [nouns-count (->> parts (filter noun?) (count))
+          template    (->> parts (map ->noun)   (apply str))]
+      (if (zero? nouns-count)
+        dictionary
+        (update-in dictionary [:template nouns-count] conj-unique template)))))
+
+(defn- study-pattern
+  "形態素解析結果に基づき、名詞をキー、発言のベクタを値として学習する。重複は学習しない。
+   学習した結果をdictionaryの:patternに定義して返す。"
+  [dictinoary input parts]
+  (let [nouns (->> parts (filter noun?) (map first))
+        merge-unique (partial merge-with (comp distinct concat))
+        make-pattern #(update %1 %2 conj-unique input)]
+    (->> nouns
+         (reduce make-pattern {})
+         (update-in dictinoary [:pattern] merge-unique))))
+
+(defn- study-random
+  "文字列inputを辞書dictionaryの:randomベクタに追加して返す。重複は追加しない。"
+  [dictionary input]
+  (update dictionary :random conj-unique input))
+
+(defn study
+  "文字列inputと形態素解析結果partsを受け取り、辞書dictionaryに保存したものを返す。"
+  [dictionary input parts]
+  (-> dictionary
+      (study-random input)
+      (study-pattern input parts)
+      (study-template parts)
+      (study-markov parts)))
+
+(defn save-dictionary
+  "辞書dictionaryをpprintし、指定されたファイルに保存する。"
+  [dictionary filename]
+  (let [data (with-out-str (fipp dictionary))]
+    (spit filename data :encoding "UTF-8")))
+
+(defn load-dictionary
+  "指定されたファイルから辞書をロードして返す。"
+  [filename]
+  (if (file-exists? filename)
+    (-> filename (slurp :encoding "UTF-8") (read-string))
+    {}))

src/unmo/morph.clj

@@ -0,0 +1,33 @@
+(ns unmo.morph
+  (:import [com.worksap.nlp.sudachi DictionaryFactory Tokenizer$SplitMode]))
+
+(def ^:private tokenizer
+  "Sudachiの形態素解析インスタンス"
+  (try
+    (let [settings (slurp "sudachi_fulldict.json" :encoding "UTF-8")]
+      (-> (DictionaryFactory.) (.create settings) (.create)))
+    (catch java.io.FileNotFoundException e
+      (println (.getMessage e))
+      (println "形態素解析ライブラリSudachiの設定ファイルと辞書を用意してください。")
+      (System/exit 1))))
+
+(def ^:private split-mode
+  "Sudachiの形態素解析オプション"
+  {:a Tokenizer$SplitMode/A :b Tokenizer$SplitMode/B :c Tokenizer$SplitMode/C})
+
+(defn analyze
+  "与えられた文字列に対して形態素解析を行い、[形態素 表層系]のリストを返す"
+  ([text] (analyze text :c))
+  ([text mode]
+   (letfn [(->parts [token]
+             (let [parts   (->> (.partOfSpeech token) (clojure.string/join \,))
+                   surface (.surface token)]
+               [surface parts]))]
+     (->> (.tokenize tokenizer (mode split-mode) text)
+          (map ->parts)
+          (filter (comp (complement empty?) first))))))
+
+(defn noun?
+  "与えられた形態素が名詞かどうかを判定する"
+  [[word part]]
+  (-> #"名詞,(一般|普通名詞|固有名詞|サ変接続|形容動詞語幹)" (re-find part) (boolean)))

src/unmo/responder.clj

@@ -0,0 +1,78 @@
+(ns unmo.responder
+  (:require [unmo.morph :refer [noun?]]))
+
+(defmulti response
+  "渡された発言オブジェクトに対する返答を :response キーに設定して返す。どの思考エンジンが使用されるかは :responder キーの値で変わる。"
+  :responder)
+
+(defn- markov-generate
+  "単語と辞書を受け取り、その単語から始まる文章をマルコフ連鎖で生成して返す。"
+  ([dictionary prefix1 prefix2] (markov-generate 30 dictionary prefix1 prefix2 [prefix1 prefix2]))
+  ([times dictionary prefix1 prefix2 result]
+   (let [suffix (-> dictionary (get-in [prefix1 prefix2]) (rand-nth))]
+     (cond (zero? times)          (apply str result)
+           (= "%ENDMARK%" suffix) (apply str result)
+           :else (->> (conj result suffix)
+                      (recur (dec times) dictionary prefix2 suffix))))))
+
+(defmethod
+  ^{:doc "MarkovResponderは形態素解析結果partsを受け取り、最初の単語またはランダムな単語から始まる文章を生成して返す。"}
+  response :markov [{:keys [parts dictionary] :as params}]
+  (if (empty? (:markov dictionary))
+    (assoc params :error {:type :dictionary-empty
+                          :message "マルコフ辞書が空です"})
+    (let [starts (get-in dictionary [:markov :starts])
+          markov (get-in dictionary [:markov :dictionary])
+          word   (ffirst parts)
+          prefix1 (if (contains? starts word)
+                    word
+                    (-> starts (keys) (rand-nth)))
+          prefix2 (-> (get markov prefix1) (keys) (rand-nth))]
+      (assoc params :response (markov-generate markov prefix1 prefix2)))))
+
+(defmethod
+  ^{:doc "TemplateResponderは入力inputの名詞を調べ、辞書のテンプレートの%noun%をその名詞で置き換えて返す。"}
+  response :template [{:keys [parts dictionary] :as params}]
+  (let [nouns (->> parts (filter noun?) (map first))
+        nouns-count (count nouns)
+        ->response #(clojure.string/replace-first %1 #"%noun%" %2)]
+    (if-let [templates (get-in dictionary [:template nouns-count])]
+      (->> nouns
+           (reduce ->response (rand-nth templates))
+           (assoc params :response))
+      (-> params
+          (assoc :error {:type :no-match
+                         :message "一致するテンプレートがありません。"})))))
+
+(defmethod
+  ^{:doc "PatternResponderは入力inputに正規表現でマッチするパターンを探し、そのうちランダムなものを返す。"}
+  response :pattern [{:keys [input dictionary] :as params}]
+  (letfn [(match? [[pattern phrases]]
+            (-> (re-pattern pattern) (re-find input)))]
+    (if-let [[pattern phrases] (->> (:pattern dictionary) (filter match?) (first))]
+      (let [match  (-> (re-pattern pattern) (re-find input) (first))
+            phrase (rand-nth phrases)
+            text   (clojure.string/replace phrase #"%match%" match)]
+        (assoc params :response text))
+      (assoc params :error {:type :no-match :message "パターンがありません"}))))
+
+(defmethod
+  ^{:doc "RandomResponderは入力に関係なく、:dictionary -> :random に定義されたVectorからランダムな値を返す。"}
+  response :random [{:keys [dictionary] :as params}]
+  (let [random (:random dictionary)]
+    (if (empty? random)
+      (assoc params :error {:message "ランダム辞書が空です。"
+                            :type :fatal})
+      (assoc params :response (rand-nth random)))))
+
+(defmethod
+  ^{:doc "WhatResponderは入力 :input に対し、常に 'inputってなに？' と返す。"}
+  response :what [{:keys [input] :as params}]
+  (->> (str input "ってなに？")
+       (assoc params :response)))
+
+(defmethod
+  ^{:doc "Responderの指定がない、もしくは存在しないResponderを指定された場合、IllegalArgumentException例外を投げる。"}
+  response :default [{:keys [responder]}]
+  (throw (IllegalArgumentException.
+          (str "Responder " responder " が存在しません。"))))

src/unmo/util.clj

@@ -0,0 +1,12 @@
+(ns unmo.util
+  (:require [clojure.java.io :as io]))
+
+(defn conj-unique
+  "コレクションcollに要素xがない場合のみconjを適用する。"
+  [coll x]
+  (if (some #{x} coll)
+    coll
+    (conj coll x)))
+
+(defn file-exists? [filename]
+  (.exists (io/as-file filename)))

src/unmo/version.clj

@@ -0,0 +1,3 @@
+(ns unmo.version)
+
+(def unmo-version "0.1.0")