neural_net/core.clj

   1 (ns neural-net.core
   2   (:use clojure.contrib.math))
   3
   4 (defprotocol Neural
   5   "Protocol implemented by any element of a neural network."
   6   (run     [this x]     "Evaluates the net")
   7   (learn   [this x y d] "Trains the net using d returning the updated net")
   8   (train   [this x y d] "Learn and apply results returning the trained net")
   9   (inputs  [this]       "Number of inputs")
  10   (outputs [this]       "Number of outputs")
  11   (collect [this key]   "Collect key from the network")
  12   (check   [this]       "Ensure that the number of inputs matches the outputs"))
  13
  14 (extend-protocol
  15  Neural
  16
  17  clojure.lang.IPersistentMap ; a map initializes a single neural element
  18  (run     [this x]     ((this :phi) ((this :accum) x (this :weights))))
  19  (learn   [this x y d] ((this :learn) this x (or y (run this x)) d))
  20  (train   [this x y d] ((fn [delta] [delta ((this :train) this delta)])
  21                         (learn this x y d)))
  22  (inputs  [this]       (count (this :weights)))
  23  (outputs [this]       1)
  24  (collect [this key]   (this key))
  25  (check   [this]       nil)
  26
  27  clojure.lang.ISeq               ; a list of many ns in the same layer
  28  (run     [this x]     (vec (map (fn [n] (run n x)) this)))
  29  (learn   [this x y d]
  30           (vec (apply map (comp vec list)
  31                       (vec (map (fn [n d] (learn n x (run n x) d)) this d)))))
  32  (train   [this x y d]
  33           (let [trained (map (fn [n d] (train n x (run n x) d)) this d)]
  34             [(vec (apply map (comp vec list) (vec (map first trained))))
  35              (map second trained)]))
  36  (inputs  [this]       (apply max (map inputs this)))
  37  (outputs [this]       (reduce + (map outputs this)))
  38  (collect [this key]   (map (fn [el] (collect el key)) this))
  39  (check   [this]
  40           (filter identity
  41                   (map-indexed (fn [i err] (when (not (empty? err)) {i err}))
  42                                (map check this))))
  43
  44  clojure.lang.IPersistentVector   ; a vector of ns in different layers
  45  (run     [this x]     (reduce (fn [x layer] (run layer x)) x this))
  46  (learn   [this x y d]
  47           (let [xs (reverse (reduce
  48                              (fn [xs layer] (cons (run layer (first xs)) xs))
  49                              [x] this))]
  50             (reduce (fn [d [x n y]] (learn n x y d))
  51                     d (reverse (map list xs this (rest xs))))))
  52  (train   [this x y d]
  53           (let [xs (reverse (reduce
  54                              (fn [xs layer] (cons (run layer (first xs)) xs))
  55                              [x] this))
  56                 trained (reduce (fn [ds [x n y]]
  57                                   (cons (train n x y (first (first ds))) ds))
  58                                 [(cons d nil)]
  59                                 (reverse (map list xs this (rest xs))))
  60                 deltas (map first trained)
  61                 net (map second trained)]
  62             [(first (first trained)) (vec (map second (butlast trained)))]))
  63  (inputs  [this]     (inputs (first this)))
  64  (outputs [this]     (outputs (last this)))
  65  (collect [this key] (vec (map (fn [el] (collect el key)) this)))
  66  (check   [this]
  67           (let [boundries (map (fn [el] [(inputs el) (outputs el)]) this)]
  68             (filter identity
  69                     (map-indexed
  70                      (fn [i [a b]]
  71                        (when (not (= (second a) (first b)))
  72                          {:at i :from (second a) :to (first b)}))
  73                      (map (fn [a b] [a b]) boundries (rest boundries)))))))
  74
  75 (comment
  76   ;; run a single simple neuron
  77   (let [n {:phi     identity
  78            :accum   (comp (partial reduce +) (partial map *))
  79            :weights [1 1]}]
  80     (run n [1 1]))                      ; 2
  81
  82   ;; show the numbers of inputs and outputs of some networks
  83   (let [n {:weights [1 2 1 4 1]}]
  84     (outputs [n (list n n) n])          ; 1
  85     (outputs (list n (list n n) n))     ; 4
  86     (inputs [n (list n n) n])           ; 5
  87     (inputs (list n (list n n) n)))     ; 5
  88
  89   ;; evaluate a single neuron
  90   (run {:phi identity
  91         :accum (comp (partial reduce +) (partial map (fn [x w] (* x w))))
  92         :weights [0.5 1]}
  93        [1 0])                           ; 0.5
  94
  95   ;; evaluate a network
  96   (let [n {:phi identity
  97            :accum (comp (partial reduce +) (partial map (fn [x w] (* x w))))}
  98         n1 (assoc n :weights [1 1])
  99         n2 (assoc n :weights [2 2])]
 100     (run [(list n1 n2) n2] [1 2]))      ; 18
 101
 102   ;; learning on a perceptron
 103   (defn perceptron:learn [this x y d]
 104     (let [dir ((fn [dif] (if (= dif 0) 0 (/ dif (abs dif)))) (- d y))]
 105       (vec (map (fn [x] (* dir (this :eta) x)) x))))
 106
 107   (let [n {:phi identity
 108            :weights [1 1]
 109            :accum (comp (partial reduce +) (partial map (fn [x w] (* x w))))
 110            :learn perceptron:learn
 111            :eta 0.1}]
 112     (learn n [0 1] (run n [0 1]) 0))    ; [0.1 0.0]
 113
 114   (let [n {:phi identity
 115            :weights [0 0]
 116            :accum (comp (partial reduce +) (partial map (fn [x w] (* x w))))
 117            :learn perceptron:learn
 118            :train (fn [n delta]
 119                     (assoc n :weights (vec (map + (n :weights) delta))))
 120            :eta 0.01}
 121         epic [[[0 0] 0]
 122               [[0 1] 1]
 123               [[1 0] 2]
 124               [[1 1] 3]]
 125         x [1 1]
 126         d 1]
 127     (= d (run (second (train n x (run n x) d)) x))      ; true
 128     ((second (train n [0 1] (run n [0 1]) 0)) :weights) ; [1.0 0.9]
 129     ;; converting binary to decimal
 130     ((reduce (fn [m _]
 131                (reduce
 132                 (fn [n p]
 133                   (second (train n (first p) (run n (first p)) (second p))))
 134                 m epic)) n (range 100))
 135      :weights))              ; [2.0000000000000013 1.0000000000000007]
 136
 137   ;; back propagation learning
 138   (defn back-prop:run [v]
 139     {:v v :y v})
 140
 141   (defn back-prop:learn [this x res d]
 142     ((fn [gradient]
 143        (vec (map
 144              (fn [y w]
 145                {:delta-w (* (this :eta) gradient y)
 146                 :weight w
 147                 :gradient gradient})
 148              (map :y x) (this :weights))))
 149      (if (and (map? d) (get d :desired))
 150        (* (- (d :desired) (res :y))     ; output layer
 151           ((this :d-phi) (res :v)))
 152        (* ((this :d-phi) (get res :v 1)) ; hidden layer
 153           (reduce + (map (fn [a] (* (a :gradient) (a :weight)))
 154                          (if (vector? d) d (vec (list d)))))))))
 155
 156   (let [n {:phi   back-prop:run
 157            :d-phi (fn [_] 1)
 158            :accum (comp (partial reduce +)
 159                         (partial map (fn [x w] (* (x :y) w))))
 160            :learn back-prop:learn
 161            :eta 0.1}
 162         n1 (assoc n :weights [1 1])
 163         n2 (assoc n :weights [2 2])
 164         x [{:y 1} {:y 1}]
 165         d {:desired 3}]
 166     (run n1 x)
 167     ;; =>
 168     ;; {:v 2, :y 2}
 169     ;;
 170     (run (list n1 n2) x)
 171     ;; =>
 172     ;; [{:v 2, :y 2} {:v 4, :y 4}]
 173     ;;
 174     (run [(list n1 n2) n1] x)
 175     ;; =>
 176     ;; {:v 6, :y 6}
 177     ;;
 178     (learn n1 x (run n1 x) {:desired 3})
 179     ;; => [{:delta-w 0.1, :weight 1, :gradient 1}
 180     ;;     {:delta-w 0.1, :weight 1, :gradient 1}]
 181     ;;
 182     (learn (list n1 n2) x nil [{:desired 3} {:desired 3}])
 183     ;; =>
 184     ;; [[{:delta-w 0.1, :weight 1, :gradient 1}
 185     ;;   {:delta-w -0.1, :weight 2, :gradient -1}]
 186     ;;  [{:delta-w 0.1, :weight 1, :gradient 1}
 187     ;;   {:delta-w -0.1, :weight 2, :gradient -1}]]
 188     ;;
 189     (learn (list n1 n2) x nil (learn n1 x (run n1 x) {:desired 3}))
 190     ;; =>
 191     ;; [[{:delta-w 0.1, :weight 1, :gradient 1}
 192     ;;   {:delta-w 0.1, :weight 2, :gradient 1}]
 193     ;;  [{:delta-w 0.1, :weight 1, :gradient 1}
 194     ;;   {:delta-w 0.1, :weight 2, :gradient 1}]]
 195     (learn [n1] x nil {:desired 3})
 196     ;; =>
 197     ;; [{:delta-w 0.1, :weight 1, :gradient 1}
 198     ;;  {:delta-w 0.1, :weight 1, :gradient 1}]
 199     (learn [(list n1 n2) n2] x nil {:desired 3})
 200     ;; =>
 201     ;; [[{:delta-w -1.8, :weight 1, :gradient -18}
 202     ;;   {:delta-w -1.8, :weight 2, :gradient -18}]
 203     ;;  [{:delta-w -1.8, :weight 1, :gradient -18}
 204     ;;   {:delta-w -1.8, :weight 2, :gradient -18}]]
 205     )
 206
 207   ;; learning binary representations with back-propagation
 208   (let [n {:phi   back-prop:run
 209            :d-phi (fn [_] 1)
 210            :accum (comp (partial reduce +)
 211                         (partial map (fn [x w] (* (x :y) w))))
 212            :learn back-prop:learn
 213            :train (fn [n delta] (assoc n :weights
 214                                       (vec (map + (n :weights)
 215                                                 (map :delta-w delta)))))
 216            :eta 0.1
 217            :weights [0.5 0.5 0.5]}
 218         epic [[[0 0 0] 0]
 219               [[0 0 1] 1]
 220               [[0 1 0] 2]
 221               [[0 1 1] 3]
 222               [[1 0 0] 4]
 223               [[1 0 1] 5]
 224               [[1 1 0] 6]
 225               [[1 1 1] 7]]
 226         net [(repeat 3 n) n]
 227         trained (reduce
 228                  (fn [m _]
 229                    (reduce
 230                     (fn [n p]
 231                       (let [x (vec (map (fn [el] {:y el}) (first p)))
 232                             d {:desired (second p)}]
 233                         ;; (println (format "x:%S->%S run:%S"
 234                         ;;                  x (d :desired) ((run n x) :y)))
 235                         (second (train n x (run n x) d))))
 236                     m epic)) net (range 20))]
 237
 238     ;; converting binary to decimal
 239     (map
 240      (fn [p]
 241        [(first p) (second p)
 242         ((run trained (map (fn [el] {:y el}) (first p))) :y)])
 243      epic))
 244   ;; =>
 245   ;; ([[0 0 0] 0 0.0]
 246   ;;  [[0 0 1] 1 1.0000000325609912]
 247   ;;  [[0 1 0] 2 2.0000000163062657]
 248   ;;  [[0 1 1] 3 3.000000048867257]
 249   ;;  [[1 0 0] 4 3.9999998651699054]
 250   ;;  [[1 0 1] 5 4.999999897730897]
 251   ;;  [[1 1 0] 6 5.999999881476171]
 252   ;;  [[1 1 1] 7 6.999999914037161])
 253
 254   ;; check if inputs match the outputs
 255   (let [n {:phi   back-prop:run
 256            :d-phi (fn [_] 1)
 257            :accum (comp (partial reduce +)
 258                         (partial map (fn [x w] (* (x :y) w))))
 259            :learn back-prop:learn
 260            :eta 0.1}
 261         n0 (assoc n :weights [1])
 262         n1 (assoc n :weights [1 1])
 263         n2 (assoc n :weights [2 2])
 264         x [{:y 1} {:y 1}]
 265         d {:desired 3}]
 266     (check [(list n1 n2) n2
 267             (list n1 n1) (list n1 n1 n2 n2 n1)])) ; ({:at 1, :from 1, :to 2})
 268   )