src/neural_net/core.clj

   1 (ns neural-net.core)
   2
   3 (defprotocol Neural
   4   "Protocol implemented by any element of a neural network."
   5   (run     [this x]     "Evaluates the net")
   6   (train   [this x y d] "Trains the net returning the updated net and deltas")
   7   (collect [this key]   "Collect key from the network")
   8   (inputs  [this]       "Number of inputs")
   9   (outputs [this]       "Number of outputs")
  10   (check   [this]       "Ensure that the number of inputs matches the outputs"))
  11
  12 (extend-protocol
  13  Neural
  14  ;; a map initializes a single neural element
  15  clojure.lang.IPersistentMap
  16  (run     [this x]     ((this :phi) ((this :accum) x (this :weights))))
  17  (train   [this x y d] ((fn [delta] [delta ((this :train) this delta)])
  18                         ((this :learn) this x (or y (run this x)) d)))
  19  (collect [this key]   (this key))
  20  (inputs  [this]       (count (this :weights)))
  21  (outputs [this]       1)
  22  (check   [this]       nil)
  23  ;; a list of many ns in the same layer
  24  clojure.lang.ISeq
  25  (run     [this x]     (vec (map (fn [n] (run n x)) this)))
  26  (train   [this x y d]
  27           (let [trained (map (fn [n d] (train n x (run n x) d)) this d)]
  28             [(vec (apply map (comp vec list) (vec (map first trained))))
  29              (map second trained)]))
  30  (collect [this key]   (map (fn [el] (collect el key)) this))
  31  (inputs  [this]       (apply max (map inputs this)))
  32  (outputs [this]       (reduce + (map outputs this)))
  33  (check   [this]
  34           (filter identity
  35                   (map-indexed (fn [i err] (when (not (empty? err)) {i err}))
  36                                (map check this))))
  37  ;; a vector of ns in different layers
  38  clojure.lang.IPersistentVector
  39  (run     [this x]
  40           (reduce (fn [x layer] (run layer (if (vector? x) x [x]))) x this))
  41  (train   [this x y d]
  42           (let [xs (reverse (reduce
  43                              (fn [xs layer] (cons (run layer (first xs)) xs))
  44                              [x] this))
  45                 trained (reduce (fn [ds [x n y]]
  46                                   (cons (train n x y (first (first ds))) ds))
  47                                 [(cons d nil)]
  48                                 (reverse (map list xs this (rest xs))))
  49                 deltas (map first trained)
  50                 net (map second trained)]
  51             [(first (first trained)) (vec (map second (butlast trained)))]))
  52  (collect [this key] (vec (map (fn [el] (collect el key)) this)))
  53  (inputs  [this]     (inputs (first this)))
  54  (outputs [this]     (outputs (last this)))
  55  (check   [this]
  56           (let [boundries (map (fn [el] [(inputs el) (outputs el)]) this)]
  57             (filter identity
  58                     (map-indexed
  59                      (fn [i [a b]]
  60                        (when (not (= (second a) (first b)))
  61                          {:at i :from (second a) :to (first b)}))
  62                      (map (fn [a b] [a b]) boundries (rest boundries)))))))