2018-01-17: メモ: Common LispからRust/Goを呼び出す

RustはCの共有ライブラリを出力できるそうなのでCommon LispのCFFIから呼べるかどうか試してみた。

参考:

Rustで共有ライブラリをつくる

以下のような内容のfib.rsファイルをつくる。

#[no_mangle]
pub extern fn fib(n: u32) -> u32 {
    if n <= 1 {
        n
    } else {
        fib(n - 1) + fib(n - 2)
    }
}

次のようにビルドすると、libfib.soファイルができる。

rustc --crate-type="dylib" fib.rs

Common Lisp側から呼び出す

(ql:quickload :cffi)

;; さきほどビルドした共有ライブラリを読み込む
(cffi:load-foreign-library "/home/wiz/program/rust/libfib.so")

;; ラッパー関数を定義
(cffi:defcfun "fib" :int (n :int))

(time (fib 40))
;; Evaluation took:
;;   1.189 seconds of real time
;;   1.192000 seconds of total run time (1.192000 user, 0.000000 system)
;;   100.25% CPU
;;   4,033,898,326 processor cycles
;;   0 bytes consed

;; => 102334155

普通にできた!!

なおこの場合Common Lispで書いた方が速い

(defnt (fib2 fixnum) ((n fixnum))
  (if (<= n 1)
      n
      (+ (fib2 (- n 1))
         (fib2 (- n 2)))))

(time (fib2 40))
;; Evaluation took:
;;   0.787 seconds of real time
;;   0.788000 seconds of total run time (0.788000 user, 0.000000 system)
;;   100.13% CPU
;;   2,671,326,658 processor cycles
;;   0 bytes consed
  
;; => 102334155

追記: Rustの最適化オプションを有効化してみる

Rustにも最適化オプションがあるらしい

rustc --crate-type="dylib" -C opt-level=3 fib.rs

として上と同様の手順を踏んでみると、最適化ありのCommon Lisp版より速くなった。

(time (fib 40))
;; Evaluation took:
;;   0.708 seconds of real time
;;   0.712000 seconds of total run time (0.712000 user, 0.000000 system)
;;   100.56% CPU
;;   2,404,129,682 processor cycles
;;   0 bytes consed

追記2: Goでもやってみる

GoにもCの共有ライブラリを出力できるビルドオプションがあるらしい

libgofib.go

package main

import (
    "C"
    "log"
)

//export fib
func fib(n int) int {
    if (n < 2) { return n }
    return fib(n - 2) + fib(n - 1)
}

func init() {
    log.Println("Loaded!!")
}

func main() {
}

これを以下のようにビルドする。

go build -buildmode=c-shared -o libgofib.so libgofib.go

Common Lispから呼び出す。

(cffi:load-foreign-library "/home/wiz/program/golang/libgofib.so")
(cffi:defcfun "fib" :int (n :int))
(time (fib 40))

;; Evaluation took:
;;   0.733 seconds of real time
;;   0.736000 seconds of total run time (0.736000 user, 0.000000 system)
;;   100.41% CPU
;;   2,485,210,416 processor cycles
;;   0 bytes consed

感想

簡単なC-APIを書けるだけのRust/Go力があればそのコード資産に簡単にアクセスできるというのは非常にうれしい。 Common Lispはそれ自体がかなり速いためにスピードのために外部ライブラリを呼ぶ必要性はあまりないのだが、ユーザ人口が少ないのでライブラリの物量不足になっており、アクセス可能なコード資産が増えるのはいいことである。 反面、外部ライブラリをCommon Lispのプロジェクトに組込むときはビルド時のエラーや依存関係など余計に考えなければならないことが増えるのでそういったところでの苦労が予想される。


2018-01-09: AutoEncoder by Forest: ランダムフォレストをオートエンコーダとして使う

この前のShibuya.lispの懇親会で教えてもらった論文(AutoEncoder by Forest)を読んだのでcl-random-forest (解説記事)で再現してみた。 どうやらDeepForestの研究グループらしい。

どのような内容なのか一言でいうと、入力データがランダムフォレストの各決定木のどの葉ノードに入るかが分かれば、元の入力を再構成できるという話だった。つまり、エンコードは入力データから各決定木の葉ノードのインデックスを調べ、そのベクトルを出力することに対応する。逆にデコードは葉ノードから根ノードへ逆に辿っていき、入力の範囲を制限していき、最後にそこから代表値を選ぶことに対応する。エンコーダの訓練は通常のランダムフォレストでモデルを作るだけなので、GPUを使ったニューラルネットのオートエンコーダよりも100倍速いと主張されている。(なおデコード速度では負けている模様)

決定木の非終端ノードには分岐に使う特徴とその閾値が保存されており、データが分岐に入ってくるとそのデータの中の対応する特徴を調べて、閾値を越えていれば左の子ノードに、そうでなければ右の子ノードへと進む。それを繰り返して葉ノードに到達したとき、その経路は入力データの範囲を制限するルールの羅列になっているはずだ。逆に、入力データがどの葉ノードに入ったかさえ分かれば、親ノードを辿っていくことで決定木からルールの羅列を得ることもできる。

さらに、決定木が複数あるときは、そのルールの羅列のANDを取ることで、より入力の範囲を絞り込める。

以下の図は上記論文のFigure1だが、n個ある決定木の葉ノードが分かれば、そこから各決定木の分岐の経路(赤い線)が一意に決まり、そこから入力の範囲を求められる。

autoencoder-by-forest-figure1.png

例えばx1に関する条件であれば、決定木1から 2.7 > x1 >= 0 であることが分かり、決定木2から x1 >= 0.5 であることが分かり、決定木nから x1 < 1.6 であることが分かるので、見えている範囲からだけでも 1.6 > x1 >= 0.5 の範囲にあることが分かる。この上と下の平均を取るなどして代表値を出してx1の値の復元値ということにする。

実際にやってみた

まずノードに親ノードへのリンクを新たに持たせるようにした。 特徴量ごとに上限と下限の値を保存する配列を用意し、葉ノードから逆にたどりながら更新していく関数reconstruction-backwardと、さらにそれを各決定木についてやり、最後に下限と上限の平均を取って返す関数reconstruction-forestを定義する。

(defun reconstruction-backward (node input-range-array)
  (let ((parent-node (node-parent-node node)))
    (if (null parent-node)
        input-range-array
        (let ((attribute (node-test-attribute parent-node))
              (threshold (node-test-threshold parent-node)))
          (if (eq (node-left-node parent-node) node)
              (when (> threshold (aref input-range-array 0 attribute)) ; left-node
                (setf (aref input-range-array 0 attribute) threshold))
              (when (< threshold (aref input-range-array 1 attribute)) ; right-node
                (setf (aref input-range-array 1 attribute) threshold)))
          (reconstruction-backward parent-node input-range-array)))))

(defun reconstruction-forest (forest datamatrix datum-index)
  (let* ((dim (forest-datum-dim forest))
         (input-range-array (make-array (list 2 dim) :element-type 'double-float))
         (result (make-array dim :element-type 'double-float)))

    ;; initialize input-range-array
    (loop for i from 0 below dim do
      (setf (aref input-range-array 0 i) most-negative-double-float
            (aref input-range-array 1 i) most-positive-double-float))

    ;; set input-range-array for each dtree
    (dolist (dtree (forest-dtree-list forest))
      (reconstruction-backward
       (find-leaf (dtree-root dtree) datamatrix datum-index)
       input-range-array))

    ;; 片側しか抑えられていない場合はとりあえず0を入れておく
    (loop for i from 0 below dim do
      (when (= (aref input-range-array 0 i) most-negative-double-float)
        (setf (aref input-range-array 0 i) 0d0))
      (when (= (aref input-range-array 1 i) most-positive-double-float)
        (setf (aref input-range-array 1 i) 0d0)))

    (loop for i from 0 below dim do
      (setf (aref result i) (/ (+ (aref input-range-array 0 i)
                                  (aref input-range-array 1 i))
                               2d0)))
    result))

MNISTでやってみる

;; まずLIBSVMデータセットのMNISTのデータを読み込む
(defparameter mnist-dim 784)
(defparameter mnist-n-class 10)

(let ((mnist-train (clol.utils:read-data "/home/wiz/datasets/mnist.scale" mnist-dim :multiclass-p t)))
  ;; Add 1 to labels in order to form class-labels beginning from 0
  (dolist (datum mnist-train) (incf (car datum)))
  (multiple-value-bind (datamat target)
      (clol-dataset->datamatrix/target mnist-train)
    (defparameter mnist-datamatrix datamat)
    (defparameter mnist-target target)))

;; ランダムフォレストを作る
;; 親ノードを記録するオプションSAVE-PARENT-NODE?を真にしておくことに注意
(defparameter mnist-forest
  (make-forest mnist-n-class mnist-datamatrix mnist-target
               :n-tree 500 :bagging-ratio 0.1 :max-depth 15 :n-trial 28 :min-region-samples 5
               :save-parent-node? t))

;; 再構成を実行
(defparameter *reconstruction*
  (reconstruction-forest mnist-forest mnist-datamatrix 0))

;; 葉ノードのインデックスのベクトルとしてエンコード
(defparameter index-datum (encode-datum mnist-forest mnist-datamatrix 0))
;; デコード
(defparameter *reconstruction2* (decode-datum mnist-forest index-datum))

この*reconstruction*に再構成した結果が入っている。make-forestのオプションを色々変えてプロットしてみると以下のようになる。

  • :n-tree 100 :bagging-ratio 0.1 :max-depth 40 :n-trial 28 :min-region-samples 5 reconstruction-ntree100-bagging0_1-depth40-ntrial28.png
  • :n-tree 500 :bagging-ratio 0.1 :max-depth 15 :n-trial 28 :min-region-samples 5 reconstruction-ntree500-bagging0_1-depth15-ntrial28.png
  • :n-tree 1000 :bagging-ratio 0.1 :max-depth 30 :n-trial 28 :min-region-samples 5 reconstruction-ntree1000-bagging0_1-depth30-ntrial28.png
  • :n-tree 500 :bagging-ratio 0.1 :max-depth 15 :n-trial 1 :min-region-samples 5 reconstruction-ntree500-bagging0_1-depth15-ntrial1.png
  • :n-tree 1000 :bagging-ratio 0.1 :max-depth 30 :n-trial 1 :min-region-samples 5 reconstruction-ntree1000-bagging0_1-depth30-ntrial1.png

cl-random-forestでランダムフォレストを学習するときは、ランダムに何回か枝を分岐させてみて、情報利得(エントロピーやジニ係数の減少幅など)が最も大きいものを残す。この情報利得の計算時に教師信号が使われるのだが、逆に言えば、分岐の試行回数が1回で、完全にランダムに分岐を決める場合(completely-random tree forestsとかExtremely Randomized Treesとか呼ばれる)は教師信号はまったく使われないので教師なし学習と見なせる。

下2つは分岐の試行回数:ntrialが1回なので、completely-random tree forestと言える。再構成の精度はこちらの方が良いことが分かる。上3つは教師信号の情報を使って、正しい分類ができるように学習したランダムフォレストから再構成した画像であり、分類に必要のない情報は捨てられていることが分かる。分類上重要になる中心付近の特徴に対しては多くの分岐が割かれており、逆に周辺の真っ黒になっている部分には対応する枝の分岐が無いので上限も下限も設定されていない。

感想

  • 実装は簡単だったし勉強になった気がする
  • データに対応する葉ノードのインデックスのベクトルを新たな特徴量とするという部分は前に実装したGlobal Refinement of Random Forestとまったく同じだなと思った
  • オートエンコーダとして役に立つかは未知数(ノイズには強いらしい)
  • 次はDeepForestを実装する(予定)

2018-01-01: RoswellのスクリプトでREST APIのクライアントを書いて実行ファイルにするまで

rosスクリプト

前に書いたsituated-program-challengeの問題で、REST APIのクライアントはコマンドラインにするそうなのでrosスクリプトでやってみた。 rosスクリプトはRoswellでインストールされた処理系およびライブラリ環境を使ってスクリプトを書くもので、メモリイメージをダンプすることで実行ファイルにもできる。 rosスクリプトにしておくことでコマンドライン引数の取り扱いなどの処理系ごとの違いを吸収できる。

まずは以下のようにしてひな形を作る。

ros init client

そうするとカレントディレクトリにclient.rosというファイルができる。その中身は

#!/bin/sh
#|-*- mode:lisp -*-|#
#|
exec ros -Q -- $0 "$@"
|#
(progn ;;init forms
  (ros:ensure-asdf)
  ;;#+quicklisp (ql:quickload '() :silent t)
  )

(defpackage :ros.script.client.3723612865
  (:use :cl))
(in-package :ros.script.client.3723612865)

(defun main (&rest argv)
  (declare (ignorable argv)))
;;; vim: set ft=lisp lisp:

ライブラリを使う場合はquickloadの行を編集する。 rosスクリプトの実行時には、ここで最後に定義したmain関数が呼ばれる。main関数のargvにコマンドライン引数が文字列のリストとして入っている。

situated-program-challengeで指定されているコマンド

第1引数がURLで、第2引数がHTTPメソッド、それ以降がキーワードオプションになる。例えば、

./client http://localhost:5000/groups get
./client http://localhost:5000/groups post group-name=group4 admin-member-ids=1,2,3
./client http://localhost:5000/members/1/groups/1 post admin=true
./client http://localhost:5000/groups/1/venues get
./client http://localhost:5000/members/1 get

POSTメソッドではキーワードオプションの部分をJSONに直してHTTPクライアントから送信する必要があるので、キーワードオプションを連想リストにする関数argstr->assocを定義してみた。

CLIENT.3723612865> (argstr->assoc "keyword=hoge")
("keyword" . "hoge")
CLIENT.3723612865> (argstr->assoc "keyword=123")
("keyword" . 123)
CLIENT.3723612865> (argstr->assoc "keyword=1,2,3")
("keyword" 1 2 3)

まとめると、

#!/bin/sh
#|-*- mode:lisp -*-|#
#|
exec ros -Q -- $0 "$@"
|#
(progn ;;init forms
  (ros:ensure-asdf)
  #+quicklisp (ql:quickload '(:dexador :cl-json :cl-ppcre) :silent t)
  )

(defpackage :ros.script.client.3723612865
  (:use :cl))
(in-package :ros.script.client.3723612865)

(defun argstr->assoc (str)
  (let* ((pair (ppcre:split "=" str))
         (key (car pair))
         (val (cadr pair))
         (val-list
           (mapcar (lambda (str)
                     (cond ((ppcre:scan "^[0-9]*$" str) (parse-integer str))
                           ((string= str "true") t)
                           ((string= str "false") nil)
                           (t str)))
                   (ppcre:split "," val))))
    (if (= (length val-list) 1)
        (cons key (car val-list))
        (cons key val-list))))

(defun main (&rest argv)
  (assert (>= (length argv) 2))
  (let* ((url (car argv))
         (method (intern (string-upcase (cadr argv))))
         (keyargs (mapcar #'argstr->assoc (cddr argv)))
         (json (if keyargs (cl-json:encode-json-alist-to-string keyargs))))
    (multiple-value-bind (res status)
        (ecase method
          (get (dex:get url))
          (post (dex:post url :content json
                              :headers '(("content-type" . "application/json")))))
      (format *standard-output* "~A~%" res)
      (format *error-output* "~A~%" status))))

実行ファイル出力

ros initした時点で実行可能権限が付いているのでそのまま実行できるが、処理系を起動したりライブラリをロードする時間が若干かかる。

$ time ./client.ros http://localhost:5000/members/1 get
{"member-id":1,"first-name":"Satoshi","last-name":"Imai","email":"satoshi.imai@gmail.com"}
200
0.881 secs

ros buildすることでロード済みのメモリイメージをダンプでき、clientという実行ファイルができる。

ros build client.ros

実行ファイルのサイズは16MBくらいになった。これを実行してみると4倍くらい速くなっている。

$ time ./client http://localhost:5000/members/1 get
{"member-id":1,"first-name":"Satoshi","last-name":"Imai","email":"satoshi.imai@gmail.com"}
200
0.210 secs

ros buildにはいろいろオプションがあって、例えばイメージの圧縮を切ったりもできる。

ros build client.ros --disable-compression

実行ファイルのサイズは65Mくらいになった。これを実行してみるとさらに速くなる。(curlよりは遅いが・・・)

$ time ./client http://localhost:5000/members/1 get
{"member-id":1,"first-name":"Satoshi","last-name":"Imai","email":"satoshi.imai@gmail.com"}
200
0.045 secs

$ time curl http://localhost:5000/members/1
{"member-id":1,"first-name":"Satoshi","last-name":"Imai","email":"satoshi.imai@gmail.com"}
0.020 secs

rosスクリプト自体はただのテキストファイルなので数KBしかなく、それほどスピードを必要としないならビルドは必要ないと思うが、ビルドするとそのファイル単体で実行できるのでLisp処理系やライブラリをインストールする必要がなく、配布するにはいいと思う。使い分けていこう。


2017-12-27: メモ: Clojureの遅延シーケンスについて

プログラミングClojureのフィボナッチ数の例

プログラミングClojureを読んでいて、遅延シーケンスの例としてフィボナッチ数が出てくるのだが、いまいち感覚が掴めなかったのでREPLでいじくりまわしてみた。

遅延シーケンスによるフィボナッチ数の定義は、

(defn lazy-seq-fib
  ([]
   (concat [0 1] (lazy-seq-fib 0N 1N)))
  ([a b]
   (let [n (+ a b)]
     (lazy-seq
      (cons n (lazy-seq-fib b n))))))

(take 10 (lazy-seq-fib))
; => (0 1 1N 2N 3N 5N 8N 13N 21N 34N)

Clojureでは同名の関数で引数の数によって振る舞いを切り換えることができる。 最初の引数なしの場合が基底部分で、次の2引数の場合が帰納部分ということになる。

ランダムな無限シーケンス

ほぼ同じ構造で、帰納部分で乱数をくっつけるだけのシーケンスをつくってみる。

(defn random-seq
  ([]
   (concat [-2 -1] (random-seq 0N 1N)))
  ([a b]
   (let [n (rand 1)]
     (println "a: " a ", b: " b ", n: " n)
     (lazy-seq
      (cons n (random-seq b n))))))

(take 10 (random-seq))
; => (-2 -1 0.8592130206713182 0.7569570617739411 0.4014687684829018 0.2033552985966114 0.12564206892627539 0.6095217849824555 0.1040247746814027 0.9866658377796264 0.982991751770464 0.27706913712472747 0.39140441828392025)

帰納部分でのprintlnの印字結果は

a:  0N                   b:  1N                   n:  0.8592130206713182
a:  1N                   b:  0.8592130206713182   n:  0.7569570617739411
a:  0.8592130206713182   b:  0.7569570617739411   n:  0.4014687684829018
a:  0.7569570617739411   b:  0.4014687684829018   n:  0.2033552985966114
a:  0.4014687684829018   b:  0.2033552985966114   n:  0.12564206892627539
a:  0.2033552985966114   b:  0.12564206892627539  n:  0.6095217849824555
a:  0.12564206892627539  b:  0.6095217849824555   n:  0.1040247746814027
a:  0.6095217849824555   b:  0.1040247746814027   n:  0.9866658377796264
a:  0.1040247746814027   b:  0.9866658377796264   n:  0.982991751770464
a:  0.9866658377796264   b:  0.982991751770464    n:  0.27706913712472747
a:  0.982991751770464    b:  0.27706913712472747  n:  0.39140441828392025

aとかbにはそのシーケンスでの前の値が入っていることが分かる。フィボナッチ数では2つ前までの値を見ているので帰納部分が2引数だったというわけだ。

基底部分でのrandom-seqの返り値は帰納部分でconsしている値(n)の列であることが分かる。基底部分での引数は捨てられる、というか次回以降の計算に使われるだけで返り値には現れない。ので、便宜上concatで基底部分での値をくっつけていたというわけだ。

ということは3つ前までの値を見るなら帰納部分の引数の数を3にすればいい。

(defn random-seq3
  ([]
   (concat [-3 -2 -1] (random-seq3 0N 1N 2N)))
  ([a b c]
   (let [n (rand 1)]
     (println "a: " a ", b: " b ", c: " c ", n: " n)
     (lazy-seq
      (cons n (random-seq3 b c n))))))

(take 10 (random-seq3))
; => (-3 -2 -1 0.7207027379256533 0.8851641826010639 0.6057102914278899 0.7351487328660473 0.10841825608663269 0.8877903748856399 0.2971740991711813)
a:  0N                   b:  1N                   c:  2N                   n:  0.7207027379256533
a:  1N                   b:  2N                   c:  0.7207027379256533   n:  0.8851641826010639
a:  2N                   b:  0.7207027379256533   c:  0.8851641826010639   n:  0.6057102914278899
a:  0.7207027379256533   b:  0.8851641826010639   c:  0.6057102914278899   n:  0.7351487328660473
a:  0.8851641826010639   b:  0.6057102914278899   c:  0.7351487328660473   n:  0.10841825608663269
a:  0.6057102914278899   b:  0.7351487328660473   c:  0.10841825608663269  n:  0.8877903748856399
a:  0.7351487328660473   b:  0.10841825608663269  c:  0.8877903748856399   n:  0.2971740991711813
a:  0.10841825608663269  b:  0.8877903748856399   c:  0.2971740991711813   n:  0.03815903888726235

なるほど。

ランダムウォーク

ランダムな値をくっつけるだけだと前の値を使っていないじゃないか、ということで、シーケンスの直前の要素に0を中心とした乱数を足していくランダムウォーク列を定義してみる。

(defn random-walk
  ([]
   (cons 0.0 (random-walk 0.0)))
  ([pre]
   (let [n (+ pre (- (rand 1.0) 0.5))]
     (lazy-seq
      (cons n (random-walk n))))))

(require '[gnuplot.core :as g])

(g/raw-plot!
 [[:set :title "simple-test"]
  [:plot
   (g/list ["-" :title "path" :with :lines])]]
 [(mapv (fn [elm1 elm2] [elm1 elm2])
        (take 20000 (random-walk))
        (take 20000 (random-walk)))])

clojure-lazy-seq-random-walk.png

直前の位置だけではなくてその前の移動での変化量を減衰させて次の移動に影響させる、慣性みたいなものを導入してみたりできる。

(defn random-walk2
  ([]
   (concat [0.0 0.0] (random-walk2 0.0 0.0)))
  ([prepre pre]
   (let [n (+ (* 0.2 (- pre prepre))
              pre
              (* 0.8 (- (rand 1.0) 0.5)))]
     (lazy-seq
      (cons n (random-walk2 pre n))))))

N次のマルコフ連鎖なんかも綺麗に書けそうだ。

まとめ

遅延シーケンス完全に理解した!


2017-12-23: Common LispでREST APIを作ってみる

(Lisp Advent Calendar 2017参加記事)

situated-program-challenge

最近、中野を拠点としたClojureのミートアップイベントclj-nakanoが誕生し、これまでに二回開催されている。

先日自分も参加してきたが、その中で主催者の中村さんからRich Hickeyの講演内容を紹介する発表があった。そこでの彼(RH)の主張は「長期間、継続的に動き続けるプログラムで、現実世界の変化に対応して変化し続けていかなければならないようなプログラムでは、静的型付け言語で書くと問題が多く発生する」というものだった。

そこで、本当にそう言えるのかを検証するために、situated-program-challengeと題してREST APIを実装する課題が中村さんから提案された。 これはミートアップイベントの管理をするシステムで、与えられた仕様をもとにバージョン1を実装後、APIやDBのテーブル構造などに変更が加えられ、それに対応するバージョン2を作る。その変更に要した労力がどれくらいだったかを言語ごとに比較するのが目的だ。

前回のclj-nakanoでは、

が紹介された。他の言語でもsituated-program-challengeのレポジトリからフォークすることで参加できる。

今回はこれをCommon Lispでやってみることにした。とりあえずバージョン1のRESTサーバを作るところまでやってみたものが以下のレポジトリになる。

使ったライブラリ

ほぼShibuya.lispに来ているメンバー(主に深町さん)のプロダクトで出来ている。

NingleでJSONの受け渡しをするAPIのエンドポイントを作る

NingleはごくシンプルなWebアプリケーションフレームワークで、URLとLisp関数を結び付ける役割を果たす。 まず準備として、ningleアプリケーションのインスタンスを生成し、サーバの起動/停止を行なう関数や、URLとLisp関数の対応付けをラップするマクロdefrouteを定義しておく。

(defparameter *app* (make-instance 'ningle:<app>))
(defparameter *handler* nil)

;; サーバの起動
(defun start (&key (port 5000))
  (setf *handler*
	(clack:clackup *app*
                       :server :woo
                       :use-default-middlewares nil
                       :port port)))

;; サーバの停止
(defun stop () (clack:stop *handler*))

;; *app*のルーティングテーブルに関数を登録するマクロ
(defmacro defroute (name (params &rest route-args) &body body)
  `(setf (ningle:route *app* ,name ,@route-args)
         (lambda (,params)
           (declare (ignorable ,params))
           ,@body)))

次にREST APIのエンドポイントを定義する。defrouteの第一引数はエンドポイントのURLであり、URL内にパラメータを含むことができる。仮引数のparamsには、URL内のパラメータ:member-id:event-idに対応する値と、HTTPクライアントから渡されるJSONデータをパースした値が連想リストとして入っている。

試しにHTTPクライアントdexadorを使ってJSONデータをPOSTメソッドで送信してみると、defrouteのparamsの値がURLとJSONデータのパラメータの連想リストになっていることが分かる。

;; エンドポイントの定義
(defroute "/members/:member-id/meetups/:event-id" (params :method :POST)
  (print params)
  '(200 (:content-type "application/json")
    ("{\"HELLO\":10}")))

;; HTTPクライアントでJSONデータをPOST
(dex:post "http://localhost:5000/members/123/meetups/321"
          :content "{\"FIRST_NAME\": \"Satoshi\", \"LAST_NAME\": \"Imai\"}"
          :headers '(("content-type" . "application/json")))

;; paramsの中身を表示
;; (("LAST_NAME" . "Imai") ("FIRST_NAME" . "Satoshi") (:MEMBER-ID . "123") (:EVENT-ID . "321"))

;; "{\"HELLO\":10}" ← 返り値1: HTTPクライアントが受け取るJSONデータ
;; 200              ← 返り値2: HTTPステータス
;; (それ以降の返り値は省略)

以下のようなマクロwith-protect-to-jsonを定義しておけば、本体部分で属性リストを返すとJSONに変換してステータス番号と一緒にクライアントに送ってくれる。また、何かエラーが発生したときにはその例外のエラーメッセージをクライアントに送る。このような毎回似たようなパターンが繰り返し現われるような構文はマクロとしてくくり出しておくと便利だ。

試しに割り算を行うエンドポイントを作って、ゼロ除算で例外を起こさせてみる。

(defmacro with-protect-to-json (&body body)
  `(handler-case
       `(200 (:content-type "application/json")
             (,(jojo:to-json (progn ,@body))))
     (error (e)
       `(500 (:content-type "application/json")
             (,(jojo:to-json (list :|error| (format nil "~A" e))))))))

(defun asc (key alist)
  (cdr (assoc key alist :test #'string=)))

;; URLパラメータの割り算をする
(defroute "/numerator/:numer/denominator/:denom" (params :method :GET)
  (with-protect-to-json
    (list :answer (/ (parse-integer (asc :numer params))
                     (parse-integer (asc :denom params))))))

;; 9を3で割った結果を返す
(dex:get "http://localhost:5000/numerator/9/denominator/3")
;; "{\"ANSWER\":3}"
;; 200

;; ゼロ除算
(dex:get "http://localhost:5000/numerator/1/denominator/0")
;; debugger invoked on a DEXADOR.ERROR:HTTP-REQUEST-INTERNAL-SERVER-ERROR in thread
;; #<THREAD "main thread" RUNNING {1001928083}>:
;;   An HTTP request to "http://localhost:5000/numerator/1/denominator/0" returned 500 internal server error.

;; {"error":"arithmetic error DIVISION-BY-ZERO signalled\nOperation was (/ 1 0)."}

ORマッパーMitoでDBへのアクセス

situated-program-challengeではPostgreSQLを使うとのこと。Common Lispには昔からPostgreSQL向けのPostmodernというORマッパーがあるが、Shibuya.lispで以前深町さんがMitoという新しいORマッパーの発表をされていたのを思い出したので使ってみることにした。

MitoはMySQL、PostgreSQL、SQLite3に対応しているのでこれだけでも使う理由になる。

DBへの接続設定

(defun connect-db ()
  (mito:connect-toplevel :postgres :database-name "meetup" :username "meetup" :password "password123"))

テーブル定義

テーブルはメタオブジェクトプロトコル(MOP)で拡張されたクラスによって定義する。 けっこう書く量が多かったので、カラムと型の対応を並べるだけでテーブルを定義できるようにdeftableというマクロを定義した。

カラムの型には、:text:integerといったデータ型の他に、deftableで定義した他のクラスも指定することができる。あと特に何も指定していなくてもidcreated-atupdated-atの3つのカラムが自動的に追加され、idが主キーになる。主キーは陽に指定することもできるが、複合主キーは指定できないようだ。この時点でsituated-program-challenge指定のテーブル構造とは微妙に異なるがあまり気にしないことにする。

(defmacro deftable (table-name superclass-list &body column-type-pairs)
  `(defclass ,table-name (,@superclass-list)
     ,(mapcar (lambda (col)
		(let* ((col-symbol (if (listp col) (car col) col))
		       (col-name (symbol-name col-symbol))
                       (col-type (if (listp col) (cadr col)))
                       (col-primary (if (find :primary-key col) t nil)))
		  (list col-symbol
			:accessor (intern (concatenate 'string (symbol-name table-name) "-" col-name))
			:initarg (intern col-name :keyword)
                        :col-type col-type
                        :primary-key col-primary)))
       column-type-pairs)
     (:metaclass mito:dao-table-class)))

(deftable groups ()
  (name :text))

(deftable members ()
  (first-name :text)
  (last-name  :text)
  (email      :text))

(deftable groups-members ()
  (group-ref  groups)
  (member-ref members)
  (admin      :boolean))

(deftable meetups ()
  (title    :text)
  (start-at :timestamp)
  (end-at   :timestamp)
  (venue-id :integer)
  (group-id :integer))

(deftable meetups-members ()
  (meetup-ref meetups)
  (member-ref members))

(deftable venues ()
  (name        :text)
  (postal-code :text)
  (prefecture  :text)
  (city        :text)
  (street1     :text)
  (street2     :text)
  (group-id    :integer))

テーブル生成

mito:table-definitionでテーブルを生成するSQLを確認することができ、mito:execute-sqlでそのSQLを実際に実行することができる。上で定義したテーブルをまとめて生成するには、

(defparameter *table-list*
  '(groups groups-members meetups meetups-members members venues))

(defun create-all-table ()
  (dolist (table *table-list*)
    (mito:execute-sql (car (mito:table-definition table)))))

データの取得/登録

テーブルに対応するクラスから生成したインスタンスがそのテーブルのデータアクセスオブジェクト(DAO)になる。mito:find-daomito:select-daoでDBからDAOを取得できる。

;; IDで取得
(mito:find-dao 'members :id 1)
;; #<MEMBERS {100CDE8C53}>

;; 全部を取得
(mito:select-dao 'members)
;; (#<MEMBERS {100C5D7363}> #<MEMBERS {100C5D89D3}> #<MEMBERS {100C5DA043}>)

;; 条件で取得
(mito:select-dao 'members (mito.dao::where (:= :last-name "Yamada")))
;; (#<MEMBERS {100CCBE3F3}> #<MEMBERS {100CCBFA63}>)

データを登録するときは、テーブルのクラスのインスタンスを作り、mito:insert-daoで登録する。

(defparameter *new-member*
  (make-instance 'members :first-name "Satoshi"
                          :last-name "Imai"
                          :email "satoshi.imai@gmail.com"))

(mito:insert-dao *new-member*)
関係テーブルのDAOから参照しているテーブルのDAOをまとめて取得する

レコードIDなどを介して複数のテーブル間の対応関係を取っているようなテーブルがある。 SQLでやるときはJOINでテーブルを結合してからSELECTするのだと思うのだが、Mitoでは関係テーブルのクラスでSELECTするときに参照するクラスを指定することで、参照先のDAOもまとめて取得することができる。こうすることで一回のSELECTで複数のテーブルのDAOを取ってくることができる。

例えば、上で定義したgroups-membersクラスはカラムの型としてgroupsクラスとmembersクラスを指定した。groups-membersクラスに対してselect-daoし、その要素をdescribeしてみるとgroup-refとmember-refスロットは空である。

(describe (car (mito:select-dao 'groups-members)))
;; #<GROUPS-MEMBERS {100D633873}>
;;   [standard-object]

;; Slots with :INSTANCE allocation:
;;   CREATED-AT                     = @2017-12-25T16:31:23.000000+09:00
;;   UPDATED-AT                     = @2017-12-25T16:31:23.000000+09:00
;;   SYNCED                         = T
;;   ID                             = 1
;;   GROUP-REF                      = #<unbound slot>
;;   GROUP-REF-ID                   = 2
;;   MEMBER-REF                     = #<unbound slot>
;;   MEMBER-REF-ID                  = 1
;;   ADMIN                          = T

ここでselect-daoのincludes節で参照するテーブルのクラスを指定してやると、group-refとmember-refスロットにそれぞれのDAOが入っていることが分かる。

(describe (car (mito:select-dao 'groups-members (includes 'members 'groups))))
;; #<GROUPS-MEMBERS {100DA8D5F3}>
;;   [standard-object]

;; Slots with :INSTANCE allocation:
;;   CREATED-AT                     = @2017-12-25T16:31:23.000000+09:00
;;   UPDATED-AT                     = @2017-12-25T16:31:23.000000+09:00
;;   SYNCED                         = T
;;   ID                             = 1
;;   GROUP-REF                      = #<GROUPS {100DAAB823}>
;;   GROUP-REF-ID                   = 2
;;   MEMBER-REF                     = #<MEMBERS {100DAA1963}>
;;   MEMBER-REF-ID                  = 1
;;   ADMIN                          = T

例: membersの参照/登録

ここまでの内容から、実際にメンバーを参照/登録するエントリを作ってみるとこうなる。

(defun members-dao->plist (dao)
  (list :|member-id|  (object-id dao)
        :|first-name| (members-first-name dao)
        :|last-name|  (members-last-name dao)
        :|email|      (members-email dao)))

(defroute "/members" (params :method :get)
  (with-protect-to-json
    (mapcar #'members-dao->plist (select-dao 'members))))

(defroute "/members" (params :method :post)
  (with-protect-to-json
    (let ((dao (make-instance 'members
                              :first-name (asc "first-name" params)
                              :last-name  (asc "last-name" params)
                              :email      (asc "email" params))))
      (insert-dao dao)
      (members-dao->plist dao))))

(cl-json:decode-json-from-string (dex:get "http://localhost:5000/members"))

;; (((:MEMBER-ID . 1) (:FIRST-NAME . "Satoshi") (:LAST-NAME . "Imai")
;;   (:EMAIL . "satoshi.imai@gmail.com"))
;;  ((:MEMBER-ID . 2) (:FIRST-NAME . "Taro") (:LAST-NAME . "Yamada")
;;   (:EMAIL . "taro.yamada@hoge.com"))
;;  ((:MEMBER-ID . 3) (:FIRST-NAME . "Hanako") (:LAST-NAME . "Yamada")
;;   (:EMAIL . "hanako.yamada@hoge.com")))

(defparameter *members4*
  (jojo:to-json '(:|first-name| "Ichiro"
                  :|last-name|  "Suzuki"
                  :|email|      "ichiro.suzuki@fuga.com")))

(cl-json:decode-json-from-string
 (dex:post "http://localhost:5000/members"
           :content *members4*
           :headers '(("content-type" . "application/json"))))

;; ((:MEMBER-ID . 4) (:FIRST-NAME . "Ichiro") (:LAST-NAME . "Suzuki")
;;  (:EMAIL . "ichiro.suzuki@fuga.com"))

(cl-json:decode-json-from-string (dex:get "http://localhost:5000/members"))

;; (((:MEMBER-ID . 1) (:FIRST-NAME . "Satoshi") (:LAST-NAME . "Imai")
;;   (:EMAIL . "satoshi.imai@gmail.com"))
;;  ((:MEMBER-ID . 2) (:FIRST-NAME . "Taro") (:LAST-NAME . "Yamada")
;;   (:EMAIL . "taro.yamada@hoge.com"))
;;  ((:MEMBER-ID . 3) (:FIRST-NAME . "Hanako") (:LAST-NAME . "Yamada")
;;   (:EMAIL . "hanako.yamada@hoge.com"))
;;  ((:MEMBER-ID . 4) (:FIRST-NAME . "Ichiro") (:LAST-NAME . "Suzuki")
;;   (:EMAIL . "ichiro.suzuki@fuga.com")))

まとめ

  • Ningleなどを使ってREST APIを作ってみた
  • DB操作にはORマッパーMitoを使ってみた
  • エントリごとに似たパターンが多いのでマクロでコードサイズをかなり圧縮できる
  • クライアントはコマンドラインで使えるようにとのことなので、Rosスクリプトでやろうと思う