Permalink
Browse files

Export cascade.clj to https://github.com/timmc/cascade

Moved to: b03e4a330da156bd621be85fb20b3506cc6efdd4
  • Loading branch information...
1 parent d1797b4 commit f408778fc57c5b229b4ca7562037c698778ca2e3 @timmc committed Mar 10, 2012
Showing with 3 additions and 337 deletions.
  1. +2 −1 project.clj
  2. +0 −200 src/timmcHW3/cascade.clj
  3. +1 −1 src/timmcHW3/core.clj
  4. +0 −135 test/timmcHW3/test/cascade.clj
View
@@ -1,7 +1,8 @@
(defproject timmcHW3 "1.1.1"
:description "Tim McCormack HW3 submission for CS 4300, Spring 2011"
:dependencies [[org.clojure/clojure "1.2.0"]
- [org.clojure/clojure-contrib "1.2.0"]]
+ [org.clojure/clojure-contrib "1.2.0"]
+ [org.timmc/cascade "0.1.0"]]
:main timmcHW3.core
;:warn-on-reflection true
:uberjar-name "timmcHW3-standalone.jar")
View
@@ -1,200 +0,0 @@
-(ns timmcHW3.cascade
- "Manage state dirtiness dependency cascades using a persistent data structure.
-
-
- State update dependencies are modeled as a directed acyclic graph of nodes
- that can be clean or dirty, where setting a node as dirty turns the nodes
- at all outedges dirty recursively. The clean state is represented as
- boolean true and dirty as boolean false.
- Each node is associated with an optional \"cleaner\" function intended to
- update that aspect of the relying program's state. When a dependant node
- needs to be marked clean, it cleans all of its own dependencies and then
- calls its own cleaner function. There is no strict guarantee that a node's
- cleaner will not be called multiple times in case of a diamond in the
- graph, so cleaners must be idempotent. (However, the cleanup algorithm
- does try to avoid this scenario as a performance measure.)
-
- Nota Bene: Cleaner functions should not attempt to modify the cascade they
- are called from. The desire to write such code is an indication that the
- cascade object is missing a state or two.
-
- Recommended usage: (create ...) a cascade, specifying all nodes at once,
- and save it in a ref. Use (dirty ...) whenever a piece of your program's
- state has changed, and (clean ...) on that node in order to force it
- to become clean again. clean is a fast operation on clean nodes. You may find
- it useful to add an :all node that depends (transitively) on all other nodes.
- All functions besides create, add, set-all, dirty, and clean are provided
- mainly for testing and debugging purposes, and are not recommended for use
- in core logic paths.
-
- Copyright 2011 Tim McCormack; free-licensed under GPL v3."
- (:require [clojure.set :as set])
- (:gen-class))
-
-; Implementation details:
-;;; - Top object is a map
-;;; - Keys of map are keywords representing nodes of state
-;;; - Values of map are themselves maps:
-;;; - :clean? <boolean> - whether this node is clean
-;;; - :deps <set<keyword>>} - nodes that this node depends on
-;;; - :cleaner <fn> - the cleaner for this node of the relying program's state
-
-
-;;; TODO list:
-;;; - Change implementation (add indirection) to accomodate below changes
-;;; - Keep a set of top-level nodes (no dependants)
-;;; - Add a helper clean-all that cleans all the top-level nodes.
-
-
-
-(defn clean?
- "Check if a node is clean."
- [cascade node-kw]
- (-> cascade node-kw :clean?))
-
-(defn node-names
- "Return a set of node keywords."
- [cascade]
- (set (keys cascade)))
-
-(defn states
- "Return a map of node names to states."
- [cascade]
- (into {} (for [[name {state :clean?}] cascade] [name state])))
-
-(defn add
- "Given a cascade, return a new cascade with the new node, cleaner function,
- and either a list of dependencies or the current cleanliness state.
- The dependency nodes must already exist, and the new node must not.
- The cleaner is expected to be a nullary function and will only be called
- when the dependencies are clean. nil is accepted for this value.
- If there are no dependencies, the initial boolean state must be given
- instead. Otherwise, initial state is computed by conjunction of the states of
- dependent nodes."
- [cascade node-kw cleaner-fn req-kws-or-clean?]
- (when (contains? cascade node-kw)
- (throw (IllegalArgumentException.
- (str "Node keyword already exists in cascade: " node-kw))))
- (when (coll? req-kws-or-clean?)
- (when (empty? req-kws-or-clean?)
- (throw (IllegalArgumentException.
- "Must provide initial state or non-empty coll of dependencies.")))
- (doseq [d req-kws-or-clean?]
- (when-not (contains? cascade d)
- (throw (IllegalArgumentException.
- (str "Dependency keyword does not exist in cascade: " d))))))
- (let [[initial deps] (if (coll? req-kws-or-clean?)
- [(every? true? (map #(clean? cascade %)
- req-kws-or-clean?))
- (set req-kws-or-clean?)]
- [req-kws-or-clean?
- #{}])]
- (assoc cascade node-kw {:clean? initial :deps deps :cleaner cleaner-fn})))
-
-(defn create
- "Create a cascade manager and initialize by add'ing each triplet of arguments
- in order."
- [& adds]
- (when-not (zero? (mod (count adds) 3))
- (throw (IllegalArgumentException.
- "Must provide triplets of arguments to cascade creator.")))
- (reduce #(apply add %1 %2) {} (partition 3 adds)))
-
-(defn cleaner
- "Get the thunk that will be called to clean this node's program state."
- [cascade node-kw]
- (-> cascade node-kw :cleaner))
-
-(defn dependencies-1
- "Return the set of node keywords that this node depends immediately upon."
- [cascade node-kw]
- (-> cascade node-kw :deps))
-
-(defn dependencies
- "Return the full set of node keywords that this node depends upon."
- [cascade node-kw]
- (apply set/union (for [d (dependencies-1 cascade node-kw)]
- (conj (dependencies cascade d) d))))
-
-(defn set-all
- "Set all nodes to the given state. Useful in initialization."
- [cascade state]
- (into {} (for [[k vm] cascade]
- [k (assoc vm :clean? state)])))
-
-(defn- set-single
- "Set a single node to the given state *without* propagating."
- [c n s]
- (assoc-in c [n :clean?] s))
-
-(defn dependants-1
- "Provide the set of immediate dependants of a node."
- [c n]
- (set (filter (fn [k] (some #(= n %)
- (-> c k :deps)))
- (keys c))))
-
-(defn dependants
- "Provide set of all eventual dependents of a node."
- [c n]
- (loop [accum #{}
- worklist #{n}]
- (let [next-layer (apply set/union (map (partial dependants-1 c)
- worklist))]
- (if (seq next-layer)
- (recur (set/union accum next-layer) next-layer)
- accum))))
-
-(defn- dirty-set
- "Dirty all the nodes in the given set."
- [c ns]
- (if (empty? ns)
- c
- (let [n (first ns)]
- (if (clean? c n)
- (recur (set-single c n false)
- (into (rest ns) (dependants-1 c n)))
- (recur c (rest ns))))))
-
-(defn dirty
- "Mark these nodes and all dependents dirty."
- [cascade & nodes]
- (when-not (set/superset? (set (keys cascade)) nodes)
- (throw (IllegalArgumentException.
- ^String (apply str "Nodes do not exist in cascade: "
- (set/difference nodes (keys cascade))))))
- (dirty-set cascade (into #{} nodes)))
-
-(defn- to-clean*
- "Recursive portion of to-clean -- expect nils and duplicates in fn list."
- [c n]
- (if (clean? c n)
- {:fns [] :nodes #{}}
- (let [dirty-parents (filter (complement (partial clean? c))
- (dependencies-1 c n))
- parcleans (map (partial to-clean* c) dirty-parents)
- pfns (map :fns parcleans)
- pnodes (map :nodes parcleans)]
- {:fns (concat (apply concat pfns) [(cleaner c n)])
- :nodes (conj (apply set/union pnodes) n)})))
-
-(defn to-clean
- "Return {:fns <coll<fn>> :nodes <set<keyword>>} where :fns is the sequence of
- nullary functions that must be successfully called to clean the node and
- its dependencies, and :nodes is the set of nodes that will be changed."
- [c n]
- (update-in (to-clean* c n) [:fns]
- #(remove nil? (distinct %))))
-
-(defn clean
- "Run all cleaners necessary to get the specified node clean,
- and return updated cascade."
- [cascade node-kw]
- (when-not (contains? cascade node-kw)
- (throw (IllegalArgumentException.
- (str "Cascade does not contain key " node-kw))))
- (let [{thunks :fns affected :nodes} (to-clean cascade node-kw)
- success (reduce #(set-single %1 %2 true) cascade affected)]
- (doseq [t thunks] (t))
- success))
-
View
@@ -9,7 +9,7 @@
(:import [timmcHW3.user-data UserData])
(:use timmcHW3.state)
(:import [timmcHW3.state Viewpoint ProgState])
- (:require [timmcHW3.cascade :as dirt])
+ (:require [org.timmc.cascade :as dirt])
(:require [timmcHW3.history :as hist])
(:import
[javax.swing SwingUtilities UIManager
@@ -1,135 +0,0 @@
-(ns timmcHW3.test.cascade
- (:use [timmcHW3.cascade] :reload)
- (:use [clojure.test]))
-
-(deftest empty-create
- (is (empty? (create))))
-
-;;; Error checking only to prevent cycles in the graph, nothing more.
-
-(deftest bad-create
- (is (thrown-with-msg? Exception #"triplet"
- (create :foo nil))))
-
-(deftest bad-add
- (is (thrown-with-msg? Exception #"does not exist"
- (add (create) :foo #() [:bar])))
- (is (thrown-with-msg? Exception #"already exists"
- (add (create :foo nil false) :foo nil true))))
-
-
-(deftest explicit-state
- (is (= (clean? (create :foo #() true) :foo) true))
- (is (= (clean? (create :foo #() false) :foo) false)))
-
-(def trimix
- (create :foo #() true
- :bar #() false
- :baz #() true
- :qux #() [:foo :bar :baz]))
-
-(deftest create-and-test
- (is (= (clean? trimix :foo) true))
- (is (= (clean? trimix :bar) false))
- (is (= (clean? trimix :baz) true))
- (is (= (clean? trimix :qux) false)))
-
-(deftest infer-state
- (is (= (clean? (create :foo #() true :bar #() [:foo]) :bar) true))
- (is (= (clean? (create :foo #() false :bar #() [:foo]) :bar) false)))
-
-(deftest basic-setall
- (is (= (clean? (set-all trimix true) :bar) true))
- (is (= (clean? (set-all trimix false) :baz)) false))
-
-(def sample
- (create :dim #() true
- :pose #() true
- :xform #() [:pose :dim]
- :hover nil true
- :udata nil true
- :painting #() [:udata :xform :hover]
- :mode #() [:udata]
- :toolstate #() [:mode]))
-
-(deftest read-names
- (is (= (node-names sample)
- #{:dim :pose :xform :hover :udata :painting :mode :toolstate})))
-
-(deftest read-states
- (is (= (states sample)
- {:dim true :pose true :xform true :hover true :udata true
- :painting true :mode true :toolstate true})))
-
-(deftest get-cleaner
- (let [updater #()
- basic (create :foo updater false :bar nil true)]
- (is (= (cleaner basic :foo) updater))
- (is (nil? (cleaner basic :bar)))))
-
-(deftest find-dependencies
- (is (= (dependencies-1 sample :udata) #{}))
- (is (= (dependencies-1 sample :painting) #{:udata :hover :xform}))
- (is (= (dependencies sample :painting) #{:udata :hover :xform :pose :dim})))
-
-(deftest find-dependants
- (is (= (dependants-1 sample :udata) #{:painting :mode}))
- (is (= (dependants sample :udata) #{:painting :mode :toolstate}))
- (is (empty? (dependants sample :toolstate))))
-
-(deftest dirtying
- (let [d-toolstate (dirty sample :toolstate)
- d-udata (dirty sample :udata)]
- (is (= (clean? d-toolstate :toolstate) false))
- (is (= (clean? d-toolstate :dim) true))
- (is (= (clean? d-toolstate :mode) true))
- (is (= (clean? d-udata :udata) false))
- (is (= (clean? d-udata :painting) false))
- (is (= (clean? d-udata :mode) false))
- (is (= (clean? d-udata :toolstate) false))
- (is (= (clean? d-udata :xform) true))))
-
-(deftest bad-dirty
- (is (thrown-with-msg? Exception #"do not exist.*albert"
- (dirty sample :albert))))
-
-(def l0 (ref 0))
-(def l1 (ref 0))
-(def l3 (ref 0))
-(def l0! (fn [] (dosync (ref-set l0 (inc @l0)))))
-(def l1! (fn [] (dosync (ref-set l1 (inc @l1)))))
-(def l3! (fn [] (dosync (ref-set l3 (inc @l3)))))
-(def diamond (dirty (create :l0 l0! true
- :l1 l1! [:l0]
- :l2a nil [:l1]
- :l2b #() [:l1]
- :l3 l3! [:l2a :l2b])
- :l1))
-
-(deftest cleaning-list
- (let [{dfns :fns dnodes :nodes} (to-clean diamond :l3)]
- (is (= (count dfns) 3))
- (is (every? (complement nil?) dfns))
- (is (not (some #(= % l0!) dfns)))
- (is (some #(= % l1!) dfns))
- (is (some #(= % l3!) dfns))
- (is (distinct? dfns))
- (is (= (count dnodes) 4))
- (is (not (contains? dnodes :l0)))))
-
-(deftest total-cleanup
- (dosync
- (ref-set l0 0)
- (ref-set l1 0)
- (ref-set l3 0)
- (let [result (clean diamond :l3)]
- (is (= @l0 0))
- (is (= @l1 1)) ; For performance. (Cleaners should be repeatable.)
- (is (= @l3 1))
- (is (clean? result :l3))
- (is (clean? result :l1)))))
-
-(deftest bad-clean
- (is (thrown-with-msg? Exception #"does not contain.*albert"
- (clean diamond :albert))))
-

0 comments on commit f408778

Please sign in to comment.