Common Lispで日常のテキスト処理 — #:g1

Posted 2010-12-12 10:05:00 GMT

いよいよ今日はLISP365の最終日です。
LISP365のHTMLから参加者のエントリーの情報を抜き出して加工し、次のまとめエントリーにしようと考えているのですが、ついでなので、そういう自分の日常作業手順を書いてみようかなと思います。

データを取得

HTTPクライアントでスクレイピング、という感じが多いと思うのですが、今回は、エントリーの必要な部分だけファイルにコピペで抜き出しました。
コメントのHTMLにミスがあったりするため少し手作業で修正。問題の発見方法については、次のHTMLをS式に変換の関数で発見できるので、それで場所を特定して修正しました。

HTMLをS式に変換

作成したHTMLの断片が纒まったファイルは、
<div>
 ...
</div>
が連鎖しているという内容なので、ひとつずつ読んでは、S式で出力するものを作成します
(defun read-xml-elt (&optional (s *standard-input*) (eof-error-p T) eof-value)
  (declare (ignore eof-error-p))
  (if (eq eof-value (peek-char t s nil eof-value))
      eof-value
      (or (xmls:parse s)
          eof-value)))
こんな感じで作ってみました。READ-LINEのXML版みたいなそうでもないようなものです。
パーズには、(http://www.cliki.net/XMLS)を使います。XMLS:PARSEがEOFに遭遇するとNILを返すのですが、SCAN-STREAMで使うには都合が悪いのでEOF-VALUEを引数として受けとるようにしています。
組み立てられるS式は、エントリーごとに
("div" (("class" "comment_entry"))
  ("h4" NIL
   ("img"
    (("width" "18")
     ("src"
      "http://a3.twimg.com/profile_images/849769127/g000001-48x48_normal.jpg")
     ("height" "18") ("alt" "G000001-48x48_normal")))
   ("a" (("href" "/users/2658")) "g000001") "-"
   ("span" (("class" "comment_date")) "(2010/12/11 22:48)"))
  ("p" NIL "【2010/12/11】"
   ("a" (("href" "http://g000001.cddddr.org/1292071752"))
    "メタプログラミングRuby的CLOS (2) - わだばLisperになる - cadr group")
   ("br" NIL) "いよいよ明日で最後か!"))
という感じです。
(タグ 内容)もしくは、((タグ 属性) 内容)
という形式が多いと思いますが、XMLSは、
(タグ ((属性名 値) ...) 内容)
という形式のようです。

S式から必要な情報を抜き出し

XPATHなどあると思うのですが、今回の場合、使い方を調べるより作った方が早いので、適当なものを作ります。
(defun find-elt (path data)
  (if (null path)
      data
      (let ((data (find (car path) data
                        :test (lambda (x y) (and (stringp y) (string= x y)))
                        :key #'zl:car-safe)))
        (find-elt (cdr path) data))))

(defun attribute (name elt) (let ((alist (second elt))) (second (assoc name alist :test #'string=))))

(defun content (elt) (third elt))

みてのとおり同じ階層に同じキーが並んでいても最初のものだけしか読みません。良いんです。良いんです。
(content (find-elt '("p" "a") エントリー))
;=> "メタプログラミングRuby的CLOS (2) - わだばLisperになる - cadr group"
こんな感じで抜き出すことができます。

S式から文字列を作成

(defun elt-to-entry (elt count-tab out)
  (let* ((date (content (find-elt '("p") elt)))
         (url (attribute "href" (find-elt '("p" "a") elt)))
         (title (content (find-elt '("p" "a") elt)))
         (name (content (find-elt '("h4" "a") elt)))
         (count (incf (gethash name count-tab 0)))
         (hatena-p (ppcre:create-scanner "hatena.ne.jp")))
    (format out
            "~A ~A: ~A<br />"
            (normalize-date date)
            (if (and (ppcre:scan hatena-p url) (< 1 count))
                title
                (write-xml-to-string `("a" (("href" ,url)) ,title)))
            name)))
のようにしてエントリーのS式を文字列に変換します。

いろいろ調整しているところ

- WRITE-XML-TO-STRING
XMLSのWRITE-XMLが文字列を出力するようにしたものです。書き方によっては、いらなかったかもしれません。
(defun write-xml-to-string (xml)
  (with-output-to-string (out)
    (xmls:write-xml xml out)))
- NORMALIZE-DATE
【2010/1/1】だったり、【2010/01/01】だったりするものを【2010/01/01】に正規化するものです。
日常作業では割と多い気がしますが、もっと汎用的に作っておいてライブラリに入れておくのも良いかなと思いました。
(defun normalize-date (string)
  (ppcre:register-groups-bind ((#'parse-integer yyyy)
                               (#'parse-integer dd)
                               (#'parse-integer mm))
                              ("【(\\d+)/(\\d+)/(\\d+).*】" string)
    (format nil "【~D/~2,'0D/~2,'0D】" yyyy dd mm)))
- HATENA-P
はてな日記は、はてな日記のURLがエントリー中にあるとそのエントリーにトラックバックを飛します。
今回、トラックバックが何十と飛んでしまうのを防止するため、最初の一回目だけ飛すようにしているところです。
hatena-p (ppcre:create-scanner "hatena.ne.jp")
...

(if (and (ppcre:scan hatena-p url) (< 1 count)) title (write-xml-to-string `("a" (("href" ,url)) ,title)))

- 集計
ハッシュテーブルを使ってエントリー数を集計し、それをALISTに変換し、ソートして出力します。
- 実行させる部分
RUNというまとめ関数を作成して入出力をまとめます。
使っているライブラリは、Series、Alexandria、f-underscoreです。
WITH-<、WITH->は、WITH-OPEN-FILEと書くのが面倒なので簡単に書けるようにしたものです。
(defun run ()
  (let ((count-tab (make-hash-table :test #'equal)))
    (with-< (in "/tmp/memo-2010-12-12.txt")
      (with-> (out "/tmp/foo.html")
        (collect-stream out
                        (scan-stream in #'read-xml-elt)
                        (f (elt out)
                          (elt-to-entry elt count-tab out)))
        ;; 集計
        (iterate (((name cnt)
                   (scan-alist (sort (alexandria:hash-table-alist count-tab)
                                     #'>
                                     :key #'cdr))))
          (format out "~A: ~D回<br />" name cnt))))))
最近は、このRUNのようにとりあえず関数にまとめて、slime-interactive-evalで(run)を実行するのが気に入っています。
メリットとしては、バッファやカーソルの位置に関わらず実行できるところでしょうか。

HTMLを加工して文字列にしたり、再度HTMLを組み立てたりは、実行結果をみつつ作業することが多い気がします。
自分は、こういう時にはLISPの対話環境は割と便利だなと思っています。
LISPは敷居が高い、日常的な作業に使えない、と思っている方は、まずは、こういう処理で遊んでみるのも良いのではないでしょうか。

comments powered by Disqus