こんにちは!! tahara です。
少々事情があってある単語に関連する単語を自動的に取得したくなりました。 『集合知イン・アクション』 を参考に Common Lisp で書いてみました。
Yahoo の Web API を利用させていただきます。
- ウェブ検索とブログ検索で単語に関連するテキストを収集
- 日本語形態素解析で単語に分解
- 単語からタームベクトルを作成
(eval-when (:compile-toplevel :load-toplevel :execute) (require :drakma) (require :cxml) (require :cl-ppcre)) (defparameter *words* '("アナウンサー" "お医者さん" "イラストレーター" "宇宙飛行士" "タクシー運転手" "電車運転士" "バス運転士" "映画監督" "絵本作家" "演奏家" "歌手" "カメラマン" "看護師" "外交官" "画家" "高校の先生" "小学校の先生" "中学校の先生" "気象予報士" "キャビンアテンダント" "救急救命士" "銀行員" "警察官" "裁判官" "作詞家" "サッカー監督" "サッカー選手" "作曲家" "シェフ" "指揮者" "社長" "小説家" "消防士" "新聞記者" "動物のお医者さん" "政治家" "声優" "船長" "大工" "図書館司書" "俳優" "花火師" "花屋" "パイロット" "パン屋さん" "美容師" "ピアノニスト" "プロ野球選手" "弁護士" "幼稚園の先生") "これらの単語に関連する単語が欲しいのです。") (defparameter *yahoo-appid* "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx" "Yahoo Web API の アプリケーションID") (defparameter *yahoo-ma-url* "http://jlp.yahooapis.jp/MAService/V1/parse" "日本語形態素解析") (defparameter *yahoo-web-search-url* "http://search.yahooapis.jp/WebSearchService/V1/webSearch" "ウェブ検索") (defparameter *yahoo-blog-search-url* "http://search.yahooapis.jp/BlogSearchService/V1/blogSearch" "ブログ検索") (defparameter *occurrence-threshold* 5 "これより少ない出現頻度の単語は無視します。") (defparameter *stop-words* '("あれ" "いい" "こんな" "こちら" "こと" "これ" "それ" "ため" "とき" "ない" "もの" "よく" "以上" "一覧" "最新" "amp" "at" "by" "com" "gt" "http" "https" "jp" "lt") "これらの単語は無視します。") (defparameter *stop-words-regexps* (mapcar #'ppcre:create-scanner '("^[0-9０-９]+$" "^.$")) "これらの正規表現に一致する単語ま無視します。") ;; Drakma の設定 (setf drakma:*drakma-default-external-format* :utf-8) (pushnew '("application" . "xml") drakma:*text-content-types* :test #'equal) (defun stop-word-p (word) (or (find word *stop-words* :test #'string=) (some (lambda (x) (ppcre:scan x word)) *stop-words-regexps*))) (defun yahoo-ma-request (text) (drakma:http-request *yahoo-ma-url* :method :post :parameters `(("appid" . ,*yahoo-appid*) ("filter" . "1|9") ; 形容詞 名詞 ("sentence" . ,text)))) (defun text-to-words (text) (destructuring-bind (result-set schema-location (ma-result _ total-count filtered-count word-list)) (cxml:parse (yahoo-ma-request text) (cxml-xmls:make-xmls-builder)) (declare (ignorable result-set schema-location ma-result _ total-count filtered-count)) (loop for (_a _b (_c _d word)) in (cddr word-list) collect word))) (defun yahoo-web-search-request (query) (drakma:http-request *yahoo-web-search-url* :method :get :parameters `(("appid" . ,*yahoo-appid*) ("query" . ,query) ("results" . "50") ("format" . "html")))) (defun web-search (query) (destructuring-bind (result-set pgr . results) (cxml:parse (remove #\lf (yahoo-web-search-request query)) (cxml-xmls:make-xmls-builder)) (declare (ignorable result-set pgr)) (loop for (result _a (_title _b title) (_summary _c summary)) in results collect (list title summary)))) (defun yahoo-blog-search-request (query) (drakma:http-request *yahoo-blog-search-url* :method :get :parameters `(("appid" . ,*yahoo-appid*) ("query" . ,query) ("results" . "50")))) (defun blog-search (query) (destructuring-bind (result-set first-result-position . results) (cxml:parse (remove #\lf (yahoo-blog-search-request query)) (cxml-xmls:make-xmls-builder)) (declare (ignorable result-set first-result-position)) (loop for (result _a id rss-url (_title _b title) (_description _c description)) in results collect (list title description)))) (defun word-to-word-list (word) (remove-if #'stop-word-p (loop for i in '(web-search blog-search) append (text-to-words (format nil "~{~{~a ~a ~}~}" (funcall i word)))))) (defun word-count-alist (word) (let (alist) (loop for i in (word-to-word-list word) if (assoc i alist :test #'string=) do (incf (cdr (assoc i alist :test #'string=))) else do (setf alist (acons i 1 alist))) (setf alist (sort alist #'(lambda (x y) (>= (cdr x) (cdr y))))) (remove-if (lambda (x) (< (cdr x) *occurrence-threshold*)) alist))) (defun normalize (alist) "重みづけを、その平方和が 1 とらるように正規化する。" (loop with factor = (sqrt (loop for i in alist sum (expt (cdr i) 2))) for (word . magnitude) in alist collect (cons word (/ magnitude factor)))) (defun all-word-alist () (loop for word in *words* collect (print (cons word (normalize (word-count-alist word))))))
出力は次のとおりです。
("宇宙飛行士" ("宇宙" . 0.7740145) ("飛行士" . 0.5890963) ("山崎" . 0.09774244) ("若田" . 0.06604219) ("野口" . 0.05547544) ("地球" . 0.05547544) ("訓練" . 0.050192066) ("ステーション" . 0.047550377) ("毎日新聞" . 0.044908687) ("日本人" . 0.042267002) ("国際" . 0.042267002) ("日本" . 0.039625313) ("直子" . 0.039625313) ("スペースシャトル" . 0.03434194) ("ニュース" . 0.03434194) ("シャトル" . 0.03170025) ("帰還" . 0.03170025) ("家族" . 0.03170025) ("写真" . 0.029058563) ("ISS" . 0.029058563) ("情報" . 0.026416875) ("光一" . 0.026416875) ("聡一" . 0.026416875) ("JAXA" . 0.023775188) ("活動" . 0.023775188) ("飛行" . 0.023775188) ("紹介" . 0.023775188) ("産経新聞" . 0.023775188) ("映像" . 0.021133501) ("ミッション" . 0.021133501) ("NASA" . 0.021133501) ("交信" . 0.021133501) ("職業" . 0.018491814) ("毛利" . 0.018491814) ("滞在" . 0.018491814) ("撮影" . 0.018491814) ("研究" . 0.018491814) ("女性" . 0.018491814) ("サイト" . 0.018491814) ("搭乗" . 0.015850125) ("ページ" . 0.015850125) ("選抜" . 0.015850125) ("イベント" . 0.015850125) ("実現" . 0.015850125) ("アポロ" . 0.015850125) ("きぼう" . 0.013208438) ("航空" . 0.013208438) ("開発" . 0.013208438) ("機構" . 0.013208438) ("参加" . 0.013208438) ("さいたま市" . 0.013208438) ("試験" . 0.013208438) ("仕事" . 0.013208438) ("最後" . 0.013208438) ("月面" . 0.013208438) ("着陸" . 0.013208438) ("特集" . 0.013208438) ("時事通信" . 0.013208438) ("契約" . 0.013208438) ("サム" . 0.013208438))
さて、この出力を利用することができるかどうかがまた問題です。
