Clojureで単純パーセプトロンを書いてみた.

 機械学習を学習しているので, とりあえず, 単純パーセプトロンを書いてみました. 理論と比べると, 実装は非常に簡単(というかシンプル)でした.

 機械学習系のアルゴリズムは, immutableなClojure向きではないような気もしますが, 単純パーセプトロンなら, 大量の配列のupdateの作業がないので, 大丈夫でした.

 参考文献は, 以下のブログ中のスライド.

単純パーセプトロンをPythonで組んでみる - 銀座で働くデータサイエンティストのブログ

 単純パーセプトロンは, 線形分離可能な分類問題において, 識別関数を求めるアルゴリズムです.

 求める分離関数を g(x) = w . x + bとすると, アルゴリズムとしては(参考文献のスライドにもありますが),
R = max_i(||x_i||)
repeat
  modified? ← false  for i = 0 to (サンプルの総数) - 1 do

    if (label_i * (w . x_i) + b < 0) then
      modified? ← true
      w ← w + ((学習係数) * label_i) x_i
      b ← b + (学習係数) * label_i * R
    end if
  end for
until (not modified? or ループ上限に達する.)

x_i : i番目のサンプル(教師データ)を表すベクトル(2次元なら(x, y)など)
label_i : i番目のサンプルのラベル(どちらのクラスタに属するか, -1 or 1)
(学習係数) : 1未満の値

 で良いようです.
(2014/11/20 : modified?と終了判定が間違っていたので修正)

 ソースコードは以下のようになりました.(incanterを使ってます.)

	(require '[incanter.core :as in]
	'[incanter.stats :as st]
	'[incanter.charts :as ch])
	(defn generate-sample-cluster [x y sd n]
	(let [generate-by #(st/sample-normal n :mean (+ % (rand 2)) :sd sd)]
	(map vector (generate-by x) (generate-by y))))
	(defn plot-clusters-with-function [f [fcluster & rclusters :as clusters]]
	(let [init-plot (ch/scatter-plot (map first fcluster) (map second fcluster))
	all-x-elements (map first (apply concat clusters))
	x1 (apply min all-x-elements)
	x2 (apply max all-x-elements)]
	(reduce #(ch/add-points %1 (map first %2) (map second %2))
	(ch/add-function init-plot f x1 x2)
	rclusters)))
	(defn merge-clusters-with-label [[cluster-a cluster-b]]
	(concat (map #(vector -1 %) cluster-a)
	(map #(vector 1 %) cluster-b)))
	(defn inner-product [xs ys]
	(reduce + (map * xs ys)))
	(defn norm [xs]
	(in/sqrt (reduce + (map #(in/pow % 2) xs))))
	(defn loop-to-fix [label+xss]
	(let [limit 10000 ;; limit of loop (when faild to learn)
	roh 0.2 ;; learning coefficient
	r (apply max (map (comp norm second) label+xss))] ;; R = max_i (|[xs_i]|)
	(letfn [(modify [[modified? ws bias] [label xs]]
	(if (< (* label (+ (inner-product ws xs) bias)) 0)
	[true ;; update
	(map #(+ %1 (* roh label %2)) ws xs)
	(+ bias (* roh label r))]
	[modified? ws bias]))] ;; nothing wrong
	(loop [ws [0 0] bias 1 i 0]
	(let [[modified? ws bias] (reduce modify [false ws bias] label+xss)]
	(if (or (not modified?) (< limit i))
	[ws bias]
	(recur ws bias (inc i))))))))
	;; ws = [a b], xs = (x, y) (or = (x_1, x_2))
	;; g(xs) = (ws . xs) + bias = ax + by + bias = 0
	;; y = - (ax + bias) / b
	(defn display-result [[[a b] bias] two-clusters]
	(plot-clusters-with-function
	(fn [x] (- (/ (+ (* a x) bias) b)))
	two-clusters))
	(defn sperceptron [two-clusters]
	(let [label+xss (merge-clusters-with-label two-clusters)
	ws+bias (loop-to-fix label+xss)]
	(in/view (display-result ws+bias two-clusters))
	ws+bias))
	(sperceptron [(generate-sample-cluster 4 2 2 100)
	(generate-sample-cluster -3 10 2 100)])

view raw simple-perceptron.clj hosted with ❤ by GitHub

 というわけで, 実行してみると, 以下のようになりました.