From a05c1a3288dcf8d7b1500131ff79e545f6e55f24 Mon Sep 17 00:00:00 2001 From: Eric Schulte Date: Tue, 23 Nov 2010 15:38:29 -0700 Subject: [PATCH] caching nearest neighbor information for speedier som learning --- scripts/som-exp | 72 +++++++++++++++++++++---------------------------- src/neural_net/core.clj | 19 +++++++++++++ src/neural_net/som.clj | 28 +++++++++---------- 3 files changed, 61 insertions(+), 58 deletions(-) diff --git a/scripts/som-exp b/scripts/som-exp index 72d2205..e67b6ba 100755 --- a/scripts/som-exp +++ b/scripts/som-exp @@ -10,6 +10,8 @@ (:use [clojure.contrib math command-line])) (defn parse-arg [a] (if (string? a) (read-string a) a)) +(defn exp [pow] (expt Math/E pow)) +(defn neg [num] (- 0 num)) (defn make-net [d r shape] (let [name (fn [[x y]] (str x "-" y)) @@ -31,7 +33,7 @@ (= shape :line) (vec (map (comp vec list) (keys vs) (rest (keys vs)))) (= shape :rand) - (set (map (fn [_] (vec (pick (keys vs) 2))) (range (* 2 d d)))))] + (set (map (fn [_] (vec (pick (keys vs) 2))) (range (* d d)))))] (neural-net.core.Graph. vs es ))) (defn from-lambda "Select a point at random from a lambda shape" [] @@ -43,9 +45,6 @@ ((fn [x] [x (neg (Math/sin (* 2 x)))]) (- (rand (/ Math/PI 2)) (/ Math/PI 4))))))) -(defn exp [pow] (expt Math/E pow)) -(defn neg [num] (- 0 num)) - (def times (ref 0)) (with-command-line *command-line-args* @@ -54,11 +53,10 @@ [spread "spread of initial neurons" 1] [shape "initial neuron shape" :grid] [f "reporting frequency" 50] - [sigma "controls spread of learning" 2] + [sigma "controls spread of learning" 5] [tau1 "sigma time decay" 1000] [eta "initial value of eta" 0.1] [tau2 "eta time decay" 1000] - [lspread "maximum learning spread" 4] [gui "display the weights" true] [refresh "gui update speed in ms" 50] [delay "delay between training points" 0] @@ -70,11 +68,10 @@ spread (parse-arg spread) shape (parse-arg shape) f (parse-arg f) - sigma (parse-arg sigma) + sigma0 (parse-arg sigma) tau1 (parse-arg tau1) - eta (parse-arg eta) + eta0 (parse-arg eta) tau2 (parse-arg tau2) - lspread (parse-arg lspread) gui (parse-arg gui) refresh (parse-arg refresh) delay (parse-arg delay) @@ -85,37 +82,29 @@ x-mean (mean (map first epic)) y-mean (mean (map second epic)) epic (map (fn [[x y]] [(- x x-mean) (- y y-mean)]) epic) + som-graph (make-net side spread shape) som {:phi self-organizing-map:run :learn self-organizing-map:learn :train self-organizing-map:train - :max-spread lspread - :sigma0 sigma - :tau1 tau1 - :sigma (fn [t n] (* (t :sigma0) (exp (neg (/ n (t :tau1)))))) - :eta0 eta - :tau2 tau2 - :eta (fn [t n] (* (t :eta0) (exp (neg (/ n (t :tau2)))))) :update (fn [this dist n x] - (let [weights (((get (this :map) :vertices) n) :weights)] - (if (> dist 3) - (repeat (count weights) 0) - (map - (fn [x] - (let [eta ((this :eta) this @times) - sigma ((this :sigma) this @times)] - (* eta (exp (neg (/ (expt dist 2) - (* 2 (expt sigma 2))))) - x))) - (map - x weights))))) - :map (make-net side spread shape)}] + (let [mult (partial * + (* + (this :eta) + (exp + (neg (/ + (expt dist 2) + (* 2 (expt (this :sigma) 2)))))))] + (map mult (map - x (((get (this :map) :vertices) n) + :weights))))) + :map som-graph + :nn (nearest-neighbors som-graph)}] (doseq [[key val] [[:neurons/side side] [:spread spread] - [:sigma0 eta] + [:sigma0 sigma0] [:tau1 tau1] - [:eta0 eta] - [:tau2 tau2] - [:max-l-spread lspread]]] + [:eta0 eta0] + [:tau2 tau2]]] (println "#" key val)) (when gui @@ -125,13 +114,12 @@ (start-gui)) (dosync (ref-set net som)) - (dorun (map - (fn [point] - (dosync (ref-set times (inc @times))) - (dosync (ref-set pt point)) - (. Thread (sleep (/ delay 2))) - (dosync (ref-set net (second (train @net point nil nil)))) - (. Thread (sleep (/ delay 2)))) - (cond - (= data :lambda) (repeatedly from-lambda) - (= data :epic) (cycle epic)))))) + (loop [points (cond (= data :lambda) (repeatedly from-lambda) + (= data :epic) (cycle epic)) + time 0] + (let [sigma (* sigma0 (exp (neg (/ time tau1)))) + eta (* eta0 (exp (neg (/ time tau2)))) + my-net (assoc @net :sigma sigma :eta eta)] + (dosync (ref-set pt (first points))) + (dosync (ref-set net (second (train my-net (first points) nil nil))))) + (recur (rest points) (inc time))))) diff --git a/src/neural_net/core.clj b/src/neural_net/core.clj index 2485b6e..e535d97 100644 --- a/src/neural_net/core.clj +++ b/src/neural_net/core.clj @@ -7,6 +7,25 @@ (defn neighbors [#^neural-net.core.Graph g v] (keep identity (map (fn [[a b]] (cond (= a v) b (= b v) a)) (get g :edges)))) +(defn nearest-neighbors + ([#^neural-net.core.Graph g] (nearest-neighbors g (count (get g :vertices)))) + ([#^neural-net.core.Graph g max] + (let [edges (get g :edges) + vs (keys (get g :vertices)) + num-vs (count (keys (get g :vertices)))] + (reduce (fn [a v] + (assoc a + v (loop [now (set [v]) dist 0 added 0 out {}] + (let [new (set (mapcat (partial neighbors g) now))] + (if (or (> dist max) (>= added num-vs)) + out + (recur (difference new (keys out)) + (inc dist) + (+ added (count now)) + (reduce (fn [a v] (assoc a v dist)) + out now))))))) + {} vs)))) + (defn deps [#^neural-net.core.Graph g] (reduce (fn [o v] (assoc o v (set (map first (filter (fn [[a b]] (= v b)) (:edges g)))))) diff --git a/src/neural_net/som.clj b/src/neural_net/som.clj index 9636751..068341d 100644 --- a/src/neural_net/som.clj +++ b/src/neural_net/som.clj @@ -9,15 +9,9 @@ (defn self-organizing-map:learn "Return a map of learning spread through the map." [this x y d] - (let [verts (map first (reverse (sort-by second y))) - out (reduce (fn [a v] (assoc a v 0)) {} verts)] - (loop [ns [(first verts)] rem (set (rest verts)) dist 0 out out] - (if (or (empty? ns) (> dist (or (this :max-spread) 3))) - out - (let [m (filter (partial contains? rem) (mapcat (partial neighbors (this :map)) ns))] - (recur m (difference rem (set m)) (inc dist) - (reduce (fn [a n] (assoc a n ((this :update) this dist n x))) - out ns))))))) + (let [winner (first (first (reverse (sort-by second (or y (run this x))))))] + (reduce (fn [a [n d]] (assoc a n ((this :update) this d n x))) + {} (get (this :nn) winner)))) (defn self-organizing-map:train [this delta] (assoc this @@ -28,7 +22,13 @@ (get (this :map) :edges)))) (comment ; train a self organizing map - (let [som {:phi self-organizing-map:run + (let [som-g (neural-net.core.Graph. + {:a {:weights [ 1 0]} + :b {:weights [ 0 1]} + :c {:weights [-1 0]} + :d {:weights [ 0 -1]}} + [[:a :b] [:b :c] [:c :d]]) + som {:phi self-organizing-map:run :learn self-organizing-map:learn :train self-organizing-map:train :eta 1 @@ -36,12 +36,8 @@ (map (fn [x] (* (/ x (inc dist)) (this :eta))) (map - x (((get (this :map) :vertices) n) :weights)))) - :map (neural-net.core.Graph. - {:a {:weights [ 1 0]} - :b {:weights [ 0 1]} - :c {:weights [-1 0]} - :d {:weights [ 0 -1]}} - [[:a :b] [:b :c] [:c :d]])}] + :map som-g + :nn (nearest-neighbors som-g)}] (first (train som [0.8 0.2] nil nil))) ;; => ;; {:d (0.2 0.3), :c (0.6 0.06666666666666667), -- 2.11.4.GIT