restructure to pull cell and propagator from net
also starting to remove references from between cell and propagator, keeping them both as dependencies of naive-scalar-net only
This commit is contained in:
parent
20f56f44ff
commit
35e86859e8
3 changed files with 192 additions and 78 deletions
44
src/prop_net/cell.clj
Normal file
44
src/prop_net/cell.clj
Normal file
|
@ -0,0 +1,44 @@
|
||||||
|
(ns prop-net.cell)
|
||||||
|
|
||||||
|
(def nothing [])
|
||||||
|
(defn nothing? [content]
|
||||||
|
(= content nothing))
|
||||||
|
|
||||||
|
(defprotocol ICell
|
||||||
|
(neighbors [this])
|
||||||
|
(content [this])
|
||||||
|
(add-content! [this increment])
|
||||||
|
(new-neighbor! [this new-neighbor]))
|
||||||
|
|
||||||
|
(defrecord Cell
|
||||||
|
[neighbors
|
||||||
|
content]
|
||||||
|
ICell
|
||||||
|
(neighbors [this] (deref (:neighbors this)))
|
||||||
|
(content [this] (deref (:content this)))
|
||||||
|
(add-content! [this increment]
|
||||||
|
(let [prev-content (deref (:content this))]
|
||||||
|
;; if there is some change return :ok, otherwise essentially a nop
|
||||||
|
(cond (nothing? increment) nil
|
||||||
|
(nothing? prev-content)
|
||||||
|
(do (reset! (:content this) increment)
|
||||||
|
:ok)
|
||||||
|
:else (if (= prev-content increment)
|
||||||
|
;; in event of same increment noop
|
||||||
|
nil
|
||||||
|
;; in event of conflicting increment throw
|
||||||
|
(throw (ex-info "Inconsistency!"
|
||||||
|
{:content prev-content
|
||||||
|
:increment increment}))))))
|
||||||
|
(new-neighbor! [this new-neighbor]
|
||||||
|
(let [old-neighbors (deref (:neighbors this))]
|
||||||
|
(do (swap! (:neighbors this) conj new-neighbor)
|
||||||
|
;; add input
|
||||||
|
;;(alert-propagator new-neighbor)
|
||||||
|
:ok))))
|
||||||
|
|
||||||
|
;; returns an initialized cell
|
||||||
|
(defn make-cell []
|
||||||
|
(map->Cell
|
||||||
|
{:neighbors (atom #{})
|
||||||
|
:content (atom nothing)}))
|
|
@ -1,64 +1,6 @@
|
||||||
(ns prop-net.naive-scalar-net)
|
(ns prop-net.naive-scalar-net
|
||||||
|
(:require [prop-net.propagator :as p]
|
||||||
|
[prop-net.cell :as c]))
|
||||||
|
|
||||||
|
|
||||||
;; private definitions at the ns scope so that cells can access them, but
|
|
||||||
;; everything must be accessed through the prop-network closure itself
|
|
||||||
(def ^:private nothing [])
|
|
||||||
(defn- nothing? [thing] (= thing nothing))
|
|
||||||
|
|
||||||
(defn- alert-propagators [& propagators]
|
|
||||||
(run! (fn [propagator]
|
|
||||||
(print propagator)
|
|
||||||
(when (not (fn? propagator))
|
|
||||||
(throw (ex-info "Alerting a non-procedure" {:propagator propagator})))
|
|
||||||
(swap! propagators-ever-alerted #(conj % propagator))
|
|
||||||
(swap! alerted-propagators #(conj % propagator)))
|
|
||||||
propagators))
|
|
||||||
|
|
||||||
(defn- alert-propagator [p]
|
|
||||||
(alert-propagators p))
|
|
||||||
|
|
||||||
;; ;; TODO check that adding a neighbor always adds propagator to this set
|
|
||||||
;; ;; and they are never removed
|
|
||||||
;; (defn- alert-all-propagators []
|
|
||||||
;; (apply alert-propagators (vector @propagators-ever-alerted)))
|
|
||||||
|
|
||||||
(defprotocol ICell
|
|
||||||
(neighbors [this])
|
|
||||||
(content [this])
|
|
||||||
(add-content! [this increment])
|
|
||||||
(new-neighbor! [this new-neighbor]))
|
|
||||||
|
|
||||||
(defrecord Cell
|
|
||||||
[neighbors
|
|
||||||
content]
|
|
||||||
ICell
|
|
||||||
(neighbors [this] (deref (:neighbors this)))
|
|
||||||
(content [this] (deref (:content this)))
|
|
||||||
(add-content! [this increment]
|
|
||||||
(let [prev-content (deref (:content this))]
|
|
||||||
(cond (nothing? increment) :ok
|
|
||||||
(nothing? prev-content)
|
|
||||||
(do (reset! (:content this) increment)
|
|
||||||
(apply alert-propagators (vector (deref (:neighbors this))))
|
|
||||||
:ok)
|
|
||||||
:else (if (not (= prev-content increment))
|
|
||||||
(throw (ex-info "Inconsistency!"
|
|
||||||
{:content prev-content
|
|
||||||
:increment increment}))))))
|
|
||||||
(new-neighbor! [this new-neighbor]
|
|
||||||
(let [old-neighbors (deref (:neighbors this))]
|
|
||||||
(do (swap! (:neighbors this) conj new-neighbor)
|
|
||||||
(alert-propagator new-neighbor)
|
|
||||||
:ok))))
|
|
||||||
|
|
||||||
;; returns an initialized cell
|
|
||||||
(defn make-cell []
|
|
||||||
(map->Cell
|
|
||||||
{:neighbors (atom #{})
|
|
||||||
:content (atom nothing)}))
|
|
||||||
|
|
||||||
;; currently not implementing abort semantics
|
;; currently not implementing abort semantics
|
||||||
|
|
||||||
|
@ -68,35 +10,100 @@
|
||||||
(def ^:private done :done)
|
(def ^:private done :done)
|
||||||
|
|
||||||
(defprotocol IPropNet
|
(defprotocol IPropNet
|
||||||
(alerted-propagators [this])
|
"A Naive Scalar Propagation Network. Add Cells and Propagators, wire them
|
||||||
(last-value-of-run [this])
|
together and run. Cells should update based on wiring"
|
||||||
(propagators-ever-alerted [this])
|
;; introspect methods
|
||||||
(cells [this])
|
(alerted-propagators [this]
|
||||||
(initialize-scheduler! [this])
|
"")
|
||||||
(add-content-to-cell! [this cell-key content])
|
(propagators-ever-alerted [this]
|
||||||
(add-cell! [this cell-key])
|
"")
|
||||||
(cell [this cell-key]))
|
(get-cells [this]
|
||||||
|
"returns hash-map of all cells in network")
|
||||||
|
(propagators [this]
|
||||||
|
"returns hash-map of all propagators in network")
|
||||||
|
(get-cell [this cell-key]
|
||||||
|
"returns reference to a given cell")
|
||||||
|
(cell-content [this cell-key]
|
||||||
|
"returns content of a given cell")
|
||||||
|
(propagator [this prop-key]
|
||||||
|
"returns reference to a given propagator")
|
||||||
|
|
||||||
|
;; mutation methods
|
||||||
|
(add-cell! [this cell-key]
|
||||||
|
"")
|
||||||
|
(add-content-to-cell! [this cell-key content]
|
||||||
|
"")
|
||||||
|
(add-propagator! [this func]
|
||||||
|
"")
|
||||||
|
(add-neighbor-to-cell! [this cell-key prop-key]
|
||||||
|
"")
|
||||||
|
(add-output-to-propagator! [this prop-key cell-key]
|
||||||
|
"")
|
||||||
|
|
||||||
|
;; run methods
|
||||||
|
(initialize-scheduler! [this]
|
||||||
|
"")
|
||||||
|
(last-value-of-run [this]
|
||||||
|
"")
|
||||||
|
(simulate! [this]
|
||||||
|
"")
|
||||||
|
(halt! [this]
|
||||||
|
""))
|
||||||
|
|
||||||
|
(defn- deref-get [rec key] (deref (key rec)))
|
||||||
|
|
||||||
|
;; TODO re-implementing with reference to PropNet
|
||||||
|
;; children should not make calls on each other, only return things to do?
|
||||||
(defrecord PropNet
|
(defrecord PropNet
|
||||||
[alerted-propagators
|
[alerted-propagators
|
||||||
last-value-of-run
|
last-value-of-run
|
||||||
cells
|
cells
|
||||||
|
all-propagators
|
||||||
propagators-ever-alerted]
|
propagators-ever-alerted]
|
||||||
IPropNet
|
IPropNet
|
||||||
(alerted-propagators [this] (deref (:alerted-propagators this)))
|
;; introspect methods INFO - complete
|
||||||
(last-value-of-run [this] (deref :last-value-of-run))
|
(alerted-propagators [net] (deref-get net :alerted-propagators))
|
||||||
(cells [this] (deref cells))
|
(propagators-ever-alerted [net] (deref-get net :propagators-ever-alerted))
|
||||||
|
(get-cells [net] (deref-get net :cells))
|
||||||
|
(propagators [net] (deref-get net :all-propagators))
|
||||||
|
(get-cell [net cell-key]
|
||||||
|
(cell-key (get-cells net)))
|
||||||
|
(cell-content [net cell-key] (deref-get (get-cell net cell-key)
|
||||||
|
:content))
|
||||||
|
(propagator [net prop-key] (deref-get (propagators net)
|
||||||
|
prop-key))
|
||||||
|
;; mutation methods
|
||||||
|
(add-cell! [net cell-key]
|
||||||
|
(swap! (:cells net) assoc cell-key (c/make-cell))
|
||||||
|
(get-cells net))
|
||||||
|
(add-content-to-cell! [this cell-key content]
|
||||||
|
(let [cur-cell (get-cell this cell-key)]
|
||||||
|
;; add the content
|
||||||
|
;; get the propagators - if any then add to alert list
|
||||||
|
(try (if (c/add-content! cur-cell content)
|
||||||
|
(let [props-to-alert (vec (c/neighbors cur-cell))]
|
||||||
|
;; add propagators to the list
|
||||||
|
(swap! (:alerted-propagators this) into props-to-alert)
|
||||||
|
(swap! (:propagators-ever-alerted this) into props-to-alert)
|
||||||
|
:ok)
|
||||||
|
(throw (ex-info "Unexpected c/add-constant! nil result"
|
||||||
|
{:cell cur-cell})))
|
||||||
|
(catch Exception e
|
||||||
|
(prn e)))))
|
||||||
|
;; (add-propagator! [this prop-key func])
|
||||||
|
;; (add-neighbor-to-cell! [this cell-key propagator])
|
||||||
|
;; (add-output-to-propagator! [this prop-key cell])
|
||||||
|
|
||||||
|
;; run methods
|
||||||
|
(last-value-of-run [net] (deref-get net :last-value-of-run))
|
||||||
(initialize-scheduler! [this]
|
(initialize-scheduler! [this]
|
||||||
(reset! (:alerted-propagators this) alerted-propagators*)
|
(reset! (:alerted-propagators this) alerted-propagators*)
|
||||||
(reset! (:last-value-of-run this) done)
|
(reset! (:last-value-of-run this) done)
|
||||||
(reset! (:propagators-ever-alerted this) propagators-ever-alerted*)
|
(reset! (:propagators-ever-alerted this) propagators-ever-alerted*)
|
||||||
:ok)
|
:ok)
|
||||||
(add-content-to-cell! [this cell-key content] '())
|
;; (simulate! [net])
|
||||||
(add-cell! [this cell-key]
|
;; (halt! [net])
|
||||||
(swap! (:cells this) assoc cell-key (make-cell))
|
)
|
||||||
(:cells this))
|
|
||||||
(cell [this cell-key] (get (:cells this) cell-key)))
|
|
||||||
|
|
||||||
;; returns a propnet
|
;; returns a propnet
|
||||||
(defn make-prop-net []
|
(defn make-prop-net []
|
||||||
(map->PropNet
|
(map->PropNet
|
||||||
|
@ -106,4 +113,22 @@
|
||||||
;; this makes lookup easier as callers to prop-net do not need to hold
|
;; this makes lookup easier as callers to prop-net do not need to hold
|
||||||
;; on to references of the cells themselves
|
;; on to references of the cells themselves
|
||||||
:cells (atom {})
|
:cells (atom {})
|
||||||
|
:all-propagators (atom {})
|
||||||
:propagators-ever-alerted (atom #{})}))
|
:propagators-ever-alerted (atom #{})}))
|
||||||
|
|
||||||
|
;; just some testing stuff
|
||||||
|
(defn tmp-net []
|
||||||
|
(let [this-net (make-prop-net)]
|
||||||
|
(add-cell! this-net :32)
|
||||||
|
(add-cell! this-net :f-32)
|
||||||
|
(add-cell! this-net :5)
|
||||||
|
(add-cell! this-net :c*9)
|
||||||
|
(add-cell! this-net :9)
|
||||||
|
(add-content-to-cell! this-net :32 32)
|
||||||
|
this-net))
|
||||||
|
|
||||||
|
(defn -main []
|
||||||
|
(println (tmp-net)))
|
||||||
|
|
||||||
|
(defn reload "tool for refreshing the repl" []
|
||||||
|
(use 'prop-net.naive-scalar-net :reload))
|
||||||
|
|
45
src/prop_net/propagator.clj
Normal file
45
src/prop_net/propagator.clj
Normal file
|
@ -0,0 +1,45 @@
|
||||||
|
(ns prop-net.propagator
|
||||||
|
(:require [prop-net.cell :as c]))
|
||||||
|
|
||||||
|
|
||||||
|
(defprotocol IPropagator
|
||||||
|
(inputs [this])
|
||||||
|
(output [this])
|
||||||
|
(add-input! [this input-cell])
|
||||||
|
(add-output! [this output-cell])
|
||||||
|
(apply! [this]))
|
||||||
|
|
||||||
|
(defrecord Propagator
|
||||||
|
[inputs output function]
|
||||||
|
IPropagator
|
||||||
|
(inputs [this] (deref (:inputs this)))
|
||||||
|
(output [this] (deref (:output this)))
|
||||||
|
(add-input! [this input-cell]
|
||||||
|
;; this is some java shenanigans prop_net.cell.Cell
|
||||||
|
(when (not (instance? prop_net.cell.Cell input-cell))
|
||||||
|
(throw (ex-info "Input must be a cell" {:input input-cell})))
|
||||||
|
(let [old-inputs (deref (:inputs this))]
|
||||||
|
(do (swap! (:inputs this) conj input-cell)
|
||||||
|
:ok)))
|
||||||
|
(add-output! [this output-cell]
|
||||||
|
;; TODO for some reason instance? is not evaluating to true here, but types should really be checked
|
||||||
|
;; from the net itself
|
||||||
|
;; (when (not (instance? prop_net.cell.Cell output-cell))
|
||||||
|
;; (throw (ex-info "Output must be a cell" {:output output-cell
|
||||||
|
;; :type (type output-cell)})))
|
||||||
|
(if (c/nothing? (deref (:output this)))
|
||||||
|
(do (reset! (:output this) output-cell)
|
||||||
|
:ok)
|
||||||
|
(throw (ex-info "Output already set" {:propagator this :conflict output}))))
|
||||||
|
(apply! [this]
|
||||||
|
(let [input-cells (deref (:inputs this))
|
||||||
|
output-cell (deref (:outputs this))]
|
||||||
|
(c/add-content! output-cell (apply (:function this)
|
||||||
|
(map c/content input-cells))))))
|
||||||
|
|
||||||
|
(defn function->propagator
|
||||||
|
[func]
|
||||||
|
(map->Propagator
|
||||||
|
{:inputs (atom #{})
|
||||||
|
:output (atom c/nothing)
|
||||||
|
:function func}))
|
Loading…
Reference in a new issue