適当な画像ファイルを用意する

適当な画像ファイルがいくつか必要になった。

Common Lisp の Vecto を使って作った。

(eval-when (:compile-toplevel :load-toplevel :execute)
  (require :vecto))

(defpackage #:vvv
  (:use #:cl #:vecto))

(in-package #:vvv)

(defparameter *font*
  "/usr/share/fonts/truetype/vlgothic/VL-PGothic-Regular.ttf")

(defun foo (file str)
  (with-canvas (:width 90 :height 90)
    (set-font (get-font *font*) 60)
    (draw-centered-string 35 25 str)
    (save-png file)))

(defun main (from to)
  (loop for i from (char-code from) to (char-code to)
     for c = (code-char i)
     do (foo (format nil "/tmp/~a.png" c) (string c))))

(main #\A #\E)
(main #\ま #\も)

(incf vocto)

Common Lisp から Yahoo の日本語形態素解析を使う

XML を XMLS に変換すれば destructuring(destructuring-bind と loop) なバインドで簡単に処理できる。

• DRAKMA で Web API をたたいて XML を取得。
• Closure XML で XMLS に変換。これで S 式の世界。
• destructuring-bind で word_list 部分をとりだす。
• loop で形態素を集める。

これだけ簡単だと SAX とか DOM とか XPath なんてとても使う気になれないよね。

(eval-when (:compile-toplevel :load-toplevel :execute)
  (require :drakma)
  (require :cxml)
  (require :cl-ppcre))

(defvar *yahoo-appid* "アプリケーションID")
(defvar *yahoo-url* "http://jlp.yahooapis.jp/MAService/V1/parse")

(setf drakma:*drakma-default-external-format* :utf-8)

(defun yahoo-http-request (text)
  (drakma:http-request
   *yahoo-url*
   :method :post
   :parameters `(("appid" . ,*yahoo-appid*)
                 ("filter" . "1|2|5|9|10") ; 形容詞 形容動詞 連体詞 名詞 動詞
                 ("sentence" . ,text))))

(defun text-to-words (text)
  (destructuring-bind (result-set
                       schema-location
                       (ma-result
                        _
                        total-count
                        filtered-count
                        word-list))
      (cxml:parse (yahoo-http-request text) (cxml-xmls:make-xmls-builder))
    (declare (ignorable result-set schema-location ma-result _
                        total-count filtered-count))
    (print word-list)
    (loop for (_a _b (_c _d word)) in (cddr word-list)
         collect word)))


(text-to-words "貘の鼻は長くて、羊はもこもこしている。
ところで貘の腹巻は白と黒のどちらだったろうか？")
;;=> ("貘" "鼻" "長く" "羊" "もこもこ" "し" "貘" "腹巻" "白" "黒" "どちら")

Common Lisp で 1 を返す関数 lambda constantly *

;; 次の3つは 0 を返す関数
(lambda () 1)
(constantly 1)
#'*

;; 昨日の↓は
(subseries (scan-fn t (lambda () 1) #'1+) 0 10)

;; こう書ける
(subseries (scan-fn t #'* #'1+) 0 10)

ただし (constantly 1) 以外は引数なしでコールしなければならない。 (constantly 1) はどんな引数を渡しても1が返る。

SBCL での constantly の定義がこれ。

(defun constantly (value)
  #!+sb-doc
  "Return a function that always returns VALUE."
  (lambda ()
    ;; KLUDGE: This declaration is a hack to make the closure ignore
    ;; all its arguments without consing a &REST list or anything.
    ;; Perhaps once DYNAMIC-EXTENT is implemented we won't need to
    ;; screw around with this kind of thing. -- WHN 2001-04-06
    (declare (optimize (speed 3) (safety 0)))
    value))

すごいよね？

constantly の存在を今日まで知らなくて g000001 に教えてもらった。