2010年6月8日火曜日

Multilayer perceptrons in Clojure - Part II (backpropagation of errors)


(defn feed-forward-for-backprop
"Feeds an input vector through the network layer by layer and returns all raw and activated output vectors for all layers"
[network input activation activation-prime]
(reduce
(fn [all-previous layer]
(let [[[previous] before-previous] (split-at 1 all-previous)
previous-outputs (cons 1 (seq (first previous))) ; (cons 1) adds the bias
all-previous (cons (cons previous-outputs (rest previous)) before-previous) ; we'll also store the bias in the outputs we return
unactivated-out
(map
(fn [unit] (reduce + (map * previous-outputs unit)))
layer)]
(cons (list (map activation unactivated-out) unactivated-out (map activation-prime unactivated-out)) all-previous)))
(list [input nil nil])
network))

(defn propagate-back
"Trains the network with the input vector / target vector pair, using the backpropagation algorithm."
[network input target activation activation-prime eta]
(let [[[last-act last-unact last-prime] :as outputs] (feed-forward-for-backprop network input activation activation-prime)
reversed-network (reverse network)
delta-o (map (fn [out prime target] (* prime (- out target))) last-act last-prime target)]
(second (reduce
(fn [[last-deltas new-network rest-count] [old-layer [acts unacts primes]]]
(let [old-layer-trans (apply map list old-layer)
deltas (and (pos? rest-count) (map (fn [prime weights] (* prime (reduce + (map * weights last-deltas)))) primes old-layer-trans))
new-weights (map (fn [unit last-delta] (map (fn [w act] (- w (* eta act last-delta))) unit acts)) old-layer last-deltas)]
[deltas (cons new-weights new-network) (dec rest-count)]))
[delta-o () (dec (count (rest outputs)))]
(map list reversed-network (rest outputs))))))

(defn shuffle
[coll]
(let [l (java.util.ArrayList. coll)]
(java.util.Collections/shuffle l)
l))

(defn train-network
[network inputs targets activation activation-prime eta]
(reduce (fn [network [input target]]
(propagate-back network input target activation activation-prime eta))
network
(map list inputs targets)))

(defn train-network-shuffle-data
[network inputs targets activation activation-prime eta]
(let [[inputs targets] (apply map list (shuffle (map list inputs targets)))]
(train-network network inputs targets activation activation-prime eta)))

(last (take 10 (iterate #(train-network-shuffle-data % binary-inputs xor-targets (create-sigmoid 1) (create-sigmoid-prime 1) 1) a-zero-2-1-1)))
(let [network *1] (doseq [m (map #(feed-forward network %1 [(create-sigmoid 1) step-function]) xor-targets)] (prn m)) network)
(last (take 1000 (iterate #(train-network-shuffle-data % binary-inputs xor-targets (create-sigmoid 1) (create-sigmoid-prime 1) 1) *1)))

0 件のコメント:

コメントを投稿

フォロワー