Factor out subproblem trait

Factor out subproblem trait

--- src/angelic/search/implicit/fah_astar_eval2.clj
+++ src/angelic/search/implicit/fah_astar_eval2.clj
@@ -19,7 +19,9 @@
 ;; Here we properly deal with weirdness of stubs/inner-sps decreaseing as they add
 ;; children, by makig sure to do the updates synchronously.

-
+;; TODO: organize
+;; TODO: remove extra stub indirection step when not needed?
+;; (i.e., either reverse directions, or just have get-stub-output when known..)
 ;; TODO: pessimistic

 ;; TODO: pseudo-solve
@@ -78,12 +80,12 @@
    ^ArrayList outputs (ArrayList.)]
   []
   Watched
-  (add-watcher! [sw w] #_(println :AW sw w) #_ (assert (not (some #(= % w) watchers)))
+  (add-watcher! [sw w] #_(println :AW sw w)
     (.add watchers w)
-    (doseq [o (doall (seq outputs))] (swap! *out-count* inc) (w o))#_ (println :WF sw))
+    (doseq [o (doall (seq outputs))] (swap! *out-count* inc) (w o)) )
   (add-output! [sw o] ;               (println :AO sw o) (Thread/sleep 10)
     (.add outputs o)
-    (doseq [w (doall (seq watchers))] (swap! *out-count* inc) (w o)) #_(println :OF sw))
+    (doseq [w (doall (seq watchers))] (swap! *out-count* inc) (w o)))
   (get-outputs [sw] (doall (seq outputs))))

@@ -136,30 +138,29 @@
 (defprotocol Evaluable
   (evaluate!      [s]))

-(defn can-evaluate? [s]
+(defn can-evaluate? [s]
   (instance? angelic.search.implicit.fah_astar_eval2.Evaluable s))

 ;; Stub implements node, watched, possibly Evaluable, cached, Summarizable
-;;  -- Has at most a single output.
-;; Reward does not include output -- so stub + output reward gives consistent picture.
-;; Watchers of stub must include it as OR- in their summaries.
-;; Stubs cannot be subsumption children.
-;; TODO: codify these constraints somehow.
-
+;;  -- Has at most a single output, not included in local reward -- goes dead
 (defprotocol Stub
   (stub-name   [s])
   (input-set   [s]))

-(traits/deftrait simple-stub [name inp] [] [] Stub (input-set [s] inp) (stub-name [s] name))
+(defn get-stub-output [s] (util/safe-singleton (get-outputs s)))
+
+(traits/deftrait simple-stub [name inp] [] [simple-cached-node simple-watched]
+  Stub (input-set [s] inp) (stub-name [s] name))

 (defmethod print-method angelic.search.implicit.fah_astar_eval2.Stub [s o]
   (print-method (format "#<ST$%8h %s>" (System/identityHashCode s) (stub-name s)) o))
+

 (defprotocol Subproblem
   (stub              [s])
   (output-set        [s])
   (tree-summarizer   [s] "Summarizer that includes children.")
-  (terminal?         [s] "Subproblem will not return further outputs.")
+  (terminal?         [s] "Subproblem will not return any outputs.")
   (refine-input      [s refined-input-set] "Return a child stub."))

 (defn subproblem-name [s] (stub-name (stub s)))
@@ -174,42 +175,47 @@
 ;; All children are tree summarizers.
 ;; Non-subsuming children must be added by calling connect-child-sp!
 (defprotocol TreeSummarizer
-  (get-inner-sp      [ts] "Get subproblem for this ts")
   (top-down-bound    [s])
   (add-top-down-bound! [s b]))

 ;; TODO: propagate top-down-bounds downward in smarter way using existing IS?
 ;; TODO: we need to make sure tree sums get called on add-output! first to ensure
 ;;       consistency with top-down-bounds ?
-(defn make-tree-summarizer [inner-sp init-bound]
- (let [tdb-atom (atom init-bound)
-       ret (traits/reify-traits [simple-cached-node]
-            TreeSummarizer
-            (get-inner-sp [ts] inner-sp)
-            (top-down-bound [s] @tdb-atom)
-            (add-top-down-bound! [s b]
-             (when (< b @tdb-atom) ;; ;; Note: adding < current max-reward actually hurts...
-               (reset! tdb-atom b)
-               (doseq [c (summaries/node-ordinary-children s)]
-                 (when (instance? angelic.search.implicit.fah_astar_eval2.TreeSummarizer c)
-                   (add-top-down-bound! c b)))
-               (summaries/summary-changed! s)))
-            summaries/Summarizable
-            (summarize [s] (or-summary s @tdb-atom)))]
-   (connect-and-watch! ret inner-sp
-     (fn [child-sp]
-       (summaries/connect! ret (tree-summarizer child-sp) false)
-       (add-top-down-bound! (tree-summarizer child-sp) @tdb-atom)
-       (summaries/summary-changed! ret))) ;; TODO: speedup?
-   ret))
-
+
+(defn tree-summarizer? [s] (instance? angelic.search.implicit.fah_astar_eval2.TreeSummarizer s))
+
+(defn make-tree-summarizer [init-bound]
+ (let [tdb-atom (atom init-bound)]
+   (traits/reify-traits [simple-cached-node]
+     TreeSummarizer (top-down-bound [s] @tdb-atom)
+                    (add-top-down-bound! [s b]
+                      (when (< b @tdb-atom) ;; ;; Note: adding < current max-reward actually hurts...
+                        (reset! tdb-atom b)
+                        (doseq [c (summaries/node-ordinary-children s)]
+                          (when (tree-summarizer? c)
+                            (add-top-down-bound! c b)))
+                        (summaries/summary-changed! s)))
+     summaries/Summarizable (summarize [s] (or-summary s @tdb-atom)))))
+
+(defn init-tree-summarizer! [ts inner-sp subsuming-sp]
+  (connect-and-watch! ts inner-sp
+    (fn [child-sp]
+      (summaries/connect! ts (tree-summarizer child-sp) false)
+      (add-top-down-bound! (tree-summarizer child-sp) (top-down-bound ts))
+      (summaries/summary-changed! ts))) ;; TODO: speedup?
+  (when subsuming-sp (summaries/connect! ts (tree-summarizer subsuming-sp) true)))
+
+;; TODO: top-down bound business does not actually help at all ?
+;; TODO: look at this.
 (comment         (let [my-sum (summaries/summary ret)
                 child-sum (summaries/summary (tree-summarizer child-sp))]
             (when-not (summary/>= my-sum child-sum)
               (summaries/summary-changed! ret))))

-
-
+(defn get-inner-sp [ts]
+  (->> (summaries/node-ordinary-children ts)
+       (remove tree-summarizer?)
+       util/safe-singleton))

 (defn ts-str [sp])
 (defmethod print-method angelic.search.implicit.fah_astar_eval2.TreeSummarizer [ts o]
@@ -220,49 +226,42 @@
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;  Subproblem Impl  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

 (defn set-stub-output! [stub sp]
+  (assert (empty? (get-outputs stub)))
   (summaries/summary-changed-local! stub)
   (add-output! stub sp))

-;; Would be nice to assert consistency, but hard to get before-summary...
-;; This version keeps children with same input inside.
-;; Actually makes things worse sometimes (more evaluations?!) -- with first, better with last.
-;; TODO: this solution does not work with decomposition -- infinite loops
-;; TODO: the check commented out below works, but adds 50% overhead.
-;; TODO: also, it doesn't seem to work... -- see dm 2-3
-;;  (Since we don't keep only first solution)
 (defn add-sp-child! [sp child-sp]
   (assert (not (terminal? sp)))
   (summaries/summary-changed-local! sp)
   (add-output! sp child-sp))

-;; Note: All nonterminal subproblems use or-summary for ri-fn
-(defn make-simple-subproblem
-  [stub subsuming-sp out-set terminal? summary-fn ri-fn init-bound]
-  (let [ts-atom (atom nil)
-        ret (traits/reify-traits [simple-cached-node simple-watched]
-             summaries/Summarizable (summarize       [s] (summary-fn s (top-down-bound @ts-atom)))
-             Subproblem             (stub            [s] stub)
-                                    (output-set      [s] out-set)
-                                    (tree-summarizer [s] @ts-atom)
-                                    (terminal?       [s] terminal?)
-                                    (refine-input    [s ni] ;; Note ni may have different context.
-                                      (if (= ni (input-set stub)) stub (ri-fn s ni))))]
-    (reset! ts-atom (make-tree-summarizer ret init-bound))
-    (when subsuming-sp (summaries/connect! @ts-atom (tree-summarizer subsuming-sp) true))
-    ret))
-
-;; TODO: better grouping -- allow adding etc?
-;; I lie about my stub ...
+(traits/deftrait simple-subproblem
+  [stb out-set ts term? ri-fn] []
+  [simple-cached-node simple-watched]
+  Subproblem (stub            [s] stb)
+             (output-set      [s] out-set)
+             (tree-summarizer [s] ts)
+             (terminal?       [s] term?)
+             (refine-input    [s ni] (ri-fn s ni)))
+
+
+(defn make-simple-subproblem [stub subsuming-sp out-set terminal? summary-fn ri-fn init-bound]
+  (let [ts  (make-tree-summarizer init-bound)
+        ret (traits/reify-traits [(simple-subproblem stub out-set ts terminal? ;; Note ni may have different context.
+                                                     (fn [s ni] (if (= ni (input-set stub)) stub (ri-fn s ni))))]
+              summaries/Summarizable (summarize       [s] (summary-fn s (top-down-bound ts))))]
+    (init-tree-summarizer! ts ret subsuming-sp)
+    ret))
+
+;; TODO: collect children too ?

 (declare make-output-collecting-subproblem)
 (defn make-output-collecting-stub [inner-stub]
   (assert (not (= (first (stub-name inner-stub)) :OS)))
   (assert (not (= (first (stub-name inner-stub)) :SA)))
   (let [in-set (input-set inner-stub)
-        ret (traits/reify-traits
-             [simple-cached-node simple-watched or-summarizable
-              (simple-stub [:OS (stub-name inner-stub) in-set] in-set)])]
+        ret (traits/reify-traits [or-summarizable (simple-stub [:OS (stub-name inner-stub) in-set] in-set)])]
     (connect-and-watch! ret inner-stub #(set-stub-output! ret (make-output-collecting-subproblem ret %)))
     ret))

@@ -272,25 +271,20 @@
                      (state/current-context s2)) "%s" [s1 s2])
   (= s1 s2))

-;; TODO: check out set equality issues...
-;; TODO: remove extra layers here ?  Don't actually seem to help.
+;; TODO: is refine-input right ?
 (defn make-output-collecting-subproblem [stb inner-sp]
   (let [ts  (tree-summarizer inner-sp)
-        ret (traits/reify-traits [simple-cached-node simple-watched ]
-             summaries/Summarizable (summarize       [s] (or-summary s (top-down-bound ts)))
-             Subproblem             (stub            [s] stb)
-                                    (output-set      [s] (output-set inner-sp))
-                                    (tree-summarizer [s] ts)
-                                    (terminal?       [s] false)
-                                    (refine-input    [s ni] (refine-input inner-sp ni)))
-        child-watch (fn child-watch [o]
-                      (if (=-state-sets (output-set inner-sp) (output-set o))
-                        (do (connect-and-watch! ret o child-watch)
-                            (summaries/summary-changed! ret))
-                        (do (if (#{:SA :OS} (first (stub-name (stub o))))
-                              (add-sp-child! ret o)
-                              (connect-and-watch! ret (make-output-collecting-stub (stub o)) #(add-sp-child! ret %))))))]
-    (connect-and-watch! ret inner-sp child-watch)
+        ret (traits/reify-traits ;; TODO: RI correct?
+             [(simple-subproblem stb (output-set inner-sp) ts false #(refine-input inner-sp %2))]
+             summaries/Summarizable (summarize [s] (or-summary s (top-down-bound ts))))]
+    (connect-and-watch! ret inner-sp
+      (fn child-watch [o]
+        (if (=-state-sets (output-set inner-sp) (output-set o))
+          (do (connect-and-watch! ret o child-watch)
+              (summaries/summary-changed! ret))
+          (do (if (#{:SA :OS} (first (stub-name (stub o))))
+                (add-sp-child! ret o)
+                (connect-and-watch! ret (make-output-collecting-stub (stub o)) #(add-sp-child! ret %)))))))
     ret))

@@ -298,28 +292,20 @@

 (declare make-state-abstracted-subproblem)
 (defn make-state-abstracted-stub [inner-stub in-set]
- ; (println "MSAS" inner-stub in-set)
-  (let [ret (traits/reify-traits
-             [simple-cached-node simple-watched or-summarizable
-              (simple-stub [:SA (stub-name inner-stub) in-set] in-set)])]
+  (let [ret (traits/reify-traits [or-summarizable (simple-stub [:SA (stub-name inner-stub) in-set] in-set)])]
     (connect-and-watch! ret inner-stub #(set-stub-output! ret (make-state-abstracted-subproblem ret %)))
     ret))

 ;; Note: subsumed subproblems can have different irrelevant vars
 (defn make-state-abstracted-subproblem [stb inner-sp]
-;  (println "MSASP" inner-sp )
   (let [ts  (tree-summarizer inner-sp)
         in  (input-set stb)
         out (state/transfer-effects in (output-set inner-sp))
-        ret (traits/reify-traits [simple-cached-node simple-watched or-summarizable]
-             Subproblem             (stub            [s] stb)
-                                    (output-set      [s] out)
-                                    (tree-summarizer [s] ts)
-                                    (terminal?       [s] (terminal? inner-sp))
-                                    (refine-input    [s ni] (if (=-state-sets ni in) stb (refine-input inner-sp ni))))]
+        ri-fn #(if (=-state-sets %2 in) stb (refine-input inner-sp %2))
+        ret (traits/reify-traits
+             [or-summarizable (simple-subproblem stb out ts (terminal? inner-sp) ri-fn)])]
     (connect-and-watch! ret inner-sp
-      (fn [o] (connect-and-watch! ret (make-state-abstracted-stub (stub o) in) #(add-sp-child! ret %))))
-
+      (fn [o] (connect-and-watch! ret (make-state-abstracted-stub (stub o) in) #(add-sp-child! ret %))))
     ret))

@@ -367,9 +353,7 @@
 (defn- make-atomic-stub [name subsuming-sp inp-set function-set]
   (let [state (atom :ready) ;; set to [out-set reward] after first eval, then :go after second.
         ret
-        (traits/reify-traits
-         [(simple-stub name inp-set)
-          simple-watched simple-cached-node]
+        (traits/reify-traits [(simple-stub name inp-set)]
          summaries/Summarizable
          (summarize [s]
            (cond (= :ready @state) (summary/make-live-simple-summary (subsuming-bound s) s)
@@ -473,9 +457,9 @@
 ;; TODO: remove children as they are no longer needed ?
 (defn- make-pair-stub2 [subsuming-sp left-sp right-stub]
   (let [ret (traits/reify-traits
-             [simple-cached-node simple-watched sum-summarizable
+             [sum-summarizable
               (simple-stub [:Pair (subproblem-name left-sp) (stub-name right-stub)]
-                            (input-set (stub left-sp)))])]
+                           (input-set (stub left-sp)))])]
     (connect-subsuming! ret subsuming-sp)
     (summaries/connect! ret (tree-summarizer left-sp) false)
     (connect-and-watch! ret right-stub
@@ -483,7 +467,7 @@
     ret))

 (defn- make-pair-stub1 [subsuming-sp left-stub right-name right-stub-fn]
-  (let [ret (traits/reify-traits [simple-cached-node simple-watched or-summarizable
+  (let [ret (traits/reify-traits [or-summarizable
                                   (simple-stub [:Pair1 (stub-name left-stub) right-name]
                                                (input-set left-stub))])]
     (connect-subsuming! ret subsuming-sp)
@@ -579,26 +563,3 @@

-
-
-(comment (defn make-output-collecting-subproblem [inner-sp]
-  (let [ts  (tree-summarizer inner-sp)
-        ret (traits/reify-traits [simple-cached-node simple-watched ]
-             summaries/Summarizable (summarize       [s] (or-summary s (top-down-bound ts)))
-             Subproblem             (stub            [s] (stub inner-sp))
-                                    (output-set      [s] (output-set inner-sp))
-                                    (tree-summarizer [s] ts)
-                                    (terminal?       [s] false)
-                                    (refine-input    [s ni] (refine-input inner-sp ni)))
-        child-watch (fn child-watch [o]
-                      (if (= (output-set inner-sp) (output-set o))
-                        (do (connect-and-watch! ret o child-watch)
-                            (summaries/summary-changed! ret))
-                        (add-sp-child! ret o)))]
-    (connect-and-watch! ret inner-sp child-watch)
-    ret))
-
-(defn output-wrap [sp]
-  (if *no-identical-nonterminal-outputs*
-    (make-output-collecting-subproblem sp)
-    sp)))


DOOOOOOC STRAAAAAANGS

DOOOOOOC STRAAAAAANGS

--- src/doctopus/files/storage.clj
+++ src/doctopus/files/storage.clj
@@ -1,19 +1,46 @@
 (ns doctopus.files.storage
-  "Create a common interface to storage backends.
+  "Defines how Doctopus speaks to different places it can store generated HTML")

-  It shouldn't matter how a particular org wants to provide storage for
-  doctopus; the backend should be extensible, even if we provide very
-  few default implementations.
+;; ## Storage
+;; Doctopus shouldn't really care _where_ it puts generated HTML; it
+;; just needs a consistent interface. Thus, the Backend: a way of
+;; generalizing and controlling where Doctopus tries to get and put Stuff.
+;;
+;; As a first pass, the backend will be defined by an atom which
+;; contains the current Backend instance; functions in this NS will
+;; work against that atom. This means a Doctopus will have a single Backend; we
+;; can potentially expand this later.
+;;
+;; Initial backends:
+;; - Temporary filesystem (provides it's own directory)
+;; - Permanent filesystem (needs a directory provided)
+;; - Amazon S3
+;;
+;; At time of writing, I'm thinking of loading and saving one Tentacle worth of
+;; documents all at once.

-  Initial backends:
-  - Temporary filesystem (provides it's own directory)
-  - Permanent filesystem (needs a directory provided)
-  - Amazon S3")
-
+;; Control atom for Backend functions.
 (def *backend* (atom "temp-fs"))

-(defn set-backend!
-  [new-backend]
-  nil)
+(defn load-documents [k] (load-from-storage @*backend* k))
+(defn save-documents [k docs] (save-to-storage @*backend* k docs))

-(defrecord Backend)
+(defprotocol DoctopusBackend
+  (load-from-storage [this k])
+  (save-to-storage [this k v]))
+
+(defmulti set-backend! class)
+(defmethod set-backend! Backend
+  [])
+(defmethod set-backend! :default)
+
+;; A name, a configuration map, a get function
+(defrecord Backend
+    [name conf load-fn save-fn]
+  DoctopusBackend
+  (load-from-storage [this k]
+    (let [{:keys [conf load-fn]} this]
+      (load-fn conf k)))
+  (save-to-storage [this k v]
+    (let [{:keys [conf save-fn]} this]
+      (save-fn conf k))))


Fix fn name

Fix fn name

--- src/dungeon_crusade/combat.clj
+++ src/dungeon_crusade/combat.clj
@@ -90,104 +90,104 @@
 (defn calc-dmg
   [attacker-race attack defender-race defender-body-part]
   (condp vec-match? [attacker-race attack defender-race defender-body-part]
-    [:bat        :bite         :human      :abdomen]   (uniform-random 0.5 1.5)
-    [:bat        :bite         :human      :arm]       (uniform-random 0.5 1.5)
-    [:bat        :bite         :human      :face]      (uniform-random 0.5 1.5)
-    [:bat        :bite         :human      :foot]      (uniform-random 0.5 1.5)
-    [:bat        :bite         :human      :head]      (uniform-random 0.5 1.5)
-    [:bat        :bite         :human      :leg]       (uniform-random 0.5 1.5)
-    [:bat        :bite         :human      :neck]      (uniform-random 0.9 1.9)
-    [:bird       :bite         :human      :*]         (uniform-random 0.5 0.9)
-    [:bird       :claw         :human      :abdomen]   (uniform-random 0.5 1.5)
-    [:bird       :claw         :human      :face]      (uniform-random 0.8 1.8)
-    [:bird       :claw         :human      :neck]      (uniform-random 0.7 1.7)
-    [:bird       :claw         :human      :*]         (uniform-random 0.5 1.5)
-    [:boar       :bite         :human      :abdomen]   (uniform-random 0.5 2.5)
-    [:boar       :bite         :human      :arm]       (uniform-random 0.5 3.5)
-    [:boar       :bite         :human      :face]      (uniform-random 0.5 2.5)
-    [:boar       :bite         :human      :foot]      (uniform-random 0.5 1.5)
-    [:boar       :bite         :human      :head]      (uniform-random 1.5 3.5)
-    [:boar       :bite         :human      :leg]       (uniform-random 0.9 1.8)
-    [:boar       :bite         :human      :neck]      (uniform-random 1.5 2.5)
-    [:boar       :gore         :human      :abdomen]   (uniform-random 2.5 4.5)
-    [:boar       :gore         :human      :arm]       (uniform-random 1.5 2.5)
-    [:boar       :gore         :human      :face]      (uniform-random 3.5 4.5)
-    [:boar       :gore         :human      :foot]      (uniform-random 1.5 2.5)
-    [:boar       :gore         :human      :head]      (uniform-random 3.5 4.5)
-    [:boar       :gore         :human      :leg]       (uniform-random 2.5 3.5)
-    [:boar       :gore         :human      :neck]      (uniform-random 3.5 4.5)
-    [:centipede  :bite         :human      :*]         (uniform-random 0.5 0.9)
-    [:clam       :clamp        :human      :*]         (uniform-random 0.1 0.3)
-    [:fish       :bite         :human      :*]         (uniform-random 0.2 1.7)
-    [:frog       :claw         :human      :*]         (uniform-random 0.1 0.5)
-    [:gecko      :bite         :human      :*]         (uniform-random 0.1 0.3)
-    [:human      :punch        :bat        :body]      (uniform-random 0.5 1.5)
+    [:bat        :bite         :human      :abdomen]   (uniform-rand 0.5 1.5)
+    [:bat        :bite         :human      :arm]       (uniform-rand 0.5 1.5)
+    [:bat        :bite         :human      :face]      (uniform-rand 0.5 1.5)
+    [:bat        :bite         :human      :foot]      (uniform-rand 0.5 1.5)
+    [:bat        :bite         :human      :head]      (uniform-rand 0.5 1.5)
+    [:bat        :bite         :human      :leg]       (uniform-rand 0.5 1.5)
+    [:bat        :bite         :human      :neck]      (uniform-rand 0.9 1.9)
+    [:bird       :bite         :human      :*]         (uniform-rand 0.5 0.9)
+    [:bird       :claw         :human      :abdomen]   (uniform-rand 0.5 1.5)
+    [:bird       :claw         :human      :face]      (uniform-rand 0.8 1.8)
+    [:bird       :claw         :human      :neck]      (uniform-rand 0.7 1.7)
+    [:bird       :claw         :human      :*]         (uniform-rand 0.5 1.5)
+    [:boar       :bite         :human      :abdomen]   (uniform-rand 0.5 2.5)
+    [:boar       :bite         :human      :arm]       (uniform-rand 0.5 3.5)
+    [:boar       :bite         :human      :face]      (uniform-rand 0.5 2.5)
+    [:boar       :bite         :human      :foot]      (uniform-rand 0.5 1.5)
+    [:boar       :bite         :human      :head]      (uniform-rand 1.5 3.5)
+    [:boar       :bite         :human      :leg]       (uniform-rand 0.9 1.8)
+    [:boar       :bite         :human      :neck]      (uniform-rand 1.5 2.5)
+    [:boar       :gore         :human      :abdomen]   (uniform-rand 2.5 4.5)
+    [:boar       :gore         :human      :arm]       (uniform-rand 1.5 2.5)
+    [:boar       :gore         :human      :face]      (uniform-rand 3.5 4.5)
+    [:boar       :gore         :human      :foot]      (uniform-rand 1.5 2.5)
+    [:boar       :gore         :human      :head]      (uniform-rand 3.5 4.5)
+    [:boar       :gore         :human      :leg]       (uniform-rand 2.5 3.5)
+    [:boar       :gore         :human      :neck]      (uniform-rand 3.5 4.5)
+    [:centipede  :bite         :human      :*]         (uniform-rand 0.5 0.9)
+    [:clam       :clamp        :human      :*]         (uniform-rand 0.1 0.3)
+    [:fish       :bite         :human      :*]         (uniform-rand 0.2 1.7)
+    [:frog       :claw         :human      :*]         (uniform-rand 0.1 0.5)
+    [:gecko      :bite         :human      :*]         (uniform-rand 0.1 0.3)
+    [:human      :punch        :bat        :body]      (uniform-rand 0.5 1.5)
     [:human      :punch        :bat        #{:face
-                                             :head}]   (uniform-random 0.8 1.8)
-    [:human      :punch        :bat        :leg]       (uniform-random 0.2 0.5)
-    [:human      :punch        :bat        :wing]      (uniform-random 0.8 1.8)
-    [:human      :punch        :bird       :beak]      (uniform-random 0.5 1.5)
-    [:human      :punch        :bird       :body]      (uniform-random 0.5 1.5)
-    [:human      :punch        :bird       :head]      (uniform-random 0.5 1.5)
-    [:human      :punch        :bird       :leg]       (uniform-random 0.5 1.0)
-    [:human      :punch        :bird       :tail]      (uniform-random 0.5 1.5)
-    [:human      :punch        :bird       :wing]      (uniform-random 1.5 2.5)
-    [:human      :punch        :boar       :body]      (uniform-random 0.5 1.5)
-    [:human      :punch        :boar       :eye]       (uniform-random 2.5 3.5)
-    [:human      :punch        :boar       :face]      (uniform-random 0.9 1.9)
-    [:human      :punch        :boar       :head]      (uniform-random 0.3 1.3)
-    [:human      :punch        :boar       :leg]       (uniform-random 0.7 1.7)
-    [:human      :punch        :boar       :snout]     (uniform-random 0.7 1.7)
-    [:human      :punch        :boar       :tail]      (uniform-random 0.1 1.1)
+                                             :head}]   (uniform-rand 0.8 1.8)
+    [:human      :punch        :bat        :leg]       (uniform-rand 0.2 0.5)
+    [:human      :punch        :bat        :wing]      (uniform-rand 0.8 1.8)
+    [:human      :punch        :bird       :beak]      (uniform-rand 0.5 1.5)
+    [:human      :punch        :bird       :body]      (uniform-rand 0.5 1.5)
+    [:human      :punch        :bird       :head]      (uniform-rand 0.5 1.5)
+    [:human      :punch        :bird       :leg]       (uniform-rand 0.5 1.0)
+    [:human      :punch        :bird       :tail]      (uniform-rand 0.5 1.5)
+    [:human      :punch        :bird       :wing]      (uniform-rand 1.5 2.5)
+    [:human      :punch        :boar       :body]      (uniform-rand 0.5 1.5)
+    [:human      :punch        :boar       :eye]       (uniform-rand 2.5 3.5)
+    [:human      :punch        :boar       :face]      (uniform-rand 0.9 1.9)
+    [:human      :punch        :boar       :head]      (uniform-rand 0.3 1.3)
+    [:human      :punch        :boar       :leg]       (uniform-rand 0.7 1.7)
+    [:human      :punch        :boar       :snout]     (uniform-rand 0.7 1.7)
+    [:human      :punch        :boar       :tail]      (uniform-rand 0.1 1.1)
     [:human      :punch        :centipede  #{:body
-                                             :head}]   (uniform-random 0.9 1.9)
-    [:human      :punch        :centipede  :leg]       (uniform-random 0.1 0.5)
-    [:human      :punch        :clam       :shell]     (uniform-random 0.5 1.5)
+                                             :head}]   (uniform-rand 0.9 1.9)
+    [:human      :punch        :centipede  :leg]       (uniform-rand 0.1 0.5)
+    [:human      :punch        :clam       :shell]     (uniform-rand 0.5 1.5)
     [:human      :punch        :fish       #{:body
-                                             :head}]   (uniform-random 0.5 1.5)
+                                             :head}]   (uniform-rand 0.5 1.5)
     [:human      :punch        :fish       #{:fin
-                                             :tail}]   (uniform-random 0.5 1.1)
-    [:human      :punch        :frog       :*]         (uniform-random 0.5 1.5)
-    [:human      :punch        :gecko      :*]         (uniform-random 0.5 1.5)
+                                             :tail}]   (uniform-rand 0.5 1.1)
+    [:human      :punch        :frog       :*]         (uniform-rand 0.5 1.5)
+    [:human      :punch        :gecko      :*]         (uniform-rand 0.5 1.5)
     [:human      :punch        :monkey     #{:arm
-                                             :leg}]    (uniform-random 0.5 1.5)
+                                             :leg}]    (uniform-rand 0.5 1.5)
     [:human      :punch        :monkey     #{:body
                                              :face
                                              :head
-                                             :neck}]   (uniform-random 0.5 1.5)
-    [:human      :punch        :monkey     :tail]      (uniform-random 0.2 1.0)
+                                             :neck}]   (uniform-rand 0.5 1.5)
+    [:human      :punch        :monkey     :tail]      (uniform-rand 0.2 1.0)
     [:human      :punch        :octopus    #{:body
-                                             :head}]   (uniform-random 1.5 2.9)
-    [:human      :punch        :octopus    :tentacle]  (uniform-random 0.5 1.5)
+                                             :head}]   (uniform-rand 1.5 2.9)
+    [:human      :punch        :octopus    :tentacle]  (uniform-rand 0.5 1.5)
     [:human      :punch        :parrot     #{:body
                                              :face
-                                             :head}]   (uniform-random 0.5 1.5)
+                                             :head}]   (uniform-rand 0.5 1.5)
     [:human      :punch        :parrot     #{:leg
-                                             :tail}]   (uniform-random 0.5 1.3)
-    [:human      :punch        :parrot     :wing]      (uniform-random 0.8 1.8)
+                                             :tail}]   (uniform-rand 0.5 1.3)
+    [:human      :punch        :parrot     :wing]      (uniform-rand 0.8 1.8)
     [:human      :punch        :rat        #{:body
                                              :face
                                              :head
-                                             :neck}]   (uniform-random 0.5 1.5)
+                                             :neck}]   (uniform-rand 0.5 1.5)
     [:human      :punch        :rat        #{:leg
-                                             :tail}]   (uniform-random 0.5 1.2)
+                                             :tail}]   (uniform-rand 0.5 1.2)
     [:human      :punch        :scorpion   #{:abdomen
                                              :head
-                                             :tail}]   (uniform-random 0.9 1.9)
+                                             :tail}]   (uniform-rand 0.9 1.9)
     [:human      :punch        :scorpion   #{:claw
-                                             :leg}]    (uniform-random 0.5 1.5)
+                                             :leg}]    (uniform-rand 0.5 1.5)
     [:human      :punch        :sea-snake  #{:body
-                                             :head}]   (uniform-random 0.9 1.9)
+                                             :head}]   (uniform-rand 0.9 1.9)
     [:human      :punch        :shark      #{:body
                                              :head
-                                             :nose}]   (uniform-random 0.5 1.5)
+                                             :nose}]   (uniform-rand 0.5 1.5)
     [:human      :punch        :shark      #{:fin
-                                             :tail}]   (uniform-random 0.5 1.1)
+                                             :tail}]   (uniform-rand 0.5 1.1)
     [:human      :punch        :snake      #{:body
                                              :head
-                                             :tail}]   (uniform-random 0.5 1.5)
+                                             :tail}]   (uniform-rand 0.5 1.5)
     [:human      :punch        :spider     #{:abdomen
-                                             :face}]   (uniform-random 0.5 1.5)
+                                             :face}]   (uniform-rand 0.5 1.5)
     [:human      :punch        :spider     #{:leg}]    (uniform-rand 0.5 1.5)
     [:human      :punch        :squid      #{:body
                                              :head


Clear drop menu after drop

Clear drop menu after drop

--- src/dungeon_crusade/update.clj
+++ src/dungeon_crusade/update.clj
@@ -240,7 +240,9 @@
         (println "dropping")
         (case keyin
           \d (toggle-drop state-with-command)
-          (drop-item state-with-command keyin)))
+          (-> state-with-command
+              (drop-item keyin)
+              (assoc-in [:world :show-drop?] false))))
     ;; handle main game commands
     :else
       (do


Updated check task to reload project before and after; this should fix problem which was causing unreliable results based on whether a class was already aot compiled or not. In particular, this was causing the check task to fail on clojure-protobuf and unreliable results when run on projects where certain classes were already aot-compiled.

--- src/cake/tasks/check.clj
+++ src/cake/tasks/check.clj
@@ -3,11 +3,13 @@
   (:use cake
         cake.core
         [cake.file :only [file rmdir]]
+        [cake.project :only [reload!]]
         [cake.tasks.compile :only [source-dir]]))

 (deftask check #{compile-java}
   "Check syntax and warn on reflection."
   (let [source-path (source-dir)]
+    (reload!)
     (bake (:use [bake.core :only [log print-stacktrace]]
                 [bake.find-namespaces :only [find-clojure-sources-in-dir
                                              read-file-ns-decl]]
@@ -29,4 +31,5 @@
                           (print-stacktrace e))))
                   (do
                     (log "Skipping namespace " (second src-file-ns-decl))
-                    (log "  Reason: Dependency on cake.core")))))))))+                    (log "  Reason: Dependency on cake.core")))))))
+    (reload!)))


Ensure that :name and :namespace are set to not junk

Fixes clojure-grimoire/grimoire#264

--- src/grimoire/doc.clj
+++ src/grimoire/doc.clj
@@ -152,12 +152,14 @@
   (let [docs (-> (meta var)
                  (assoc  :src  (var->src var)
                          :type (var->type var))
-                 (update :name name-stringifier)
-                 (update :ns   ns-stringifier)
+                 (update :name #(name-stringifier (or %1 (t/thing->name var))))
+                 (update :ns   #(ns-stringifier (or %1 (t/thing->name (t/thing->namespace var)))))
                  (dissoc :inline
                          :protocol
                          :inline
                          :inline-arities))]
+    (assert (:name docs) "Var name was nil!")
+    (assert (:namespace docs) "Var namespace was nil!")
     (guarded-write-meta config
                         (var->thing config var)
                         docs)))


standardize service configs #180

standardize service configs
#180

--- src/clj/swarmpit/api.clj
+++ src/clj/swarmpit/api.clj
@@ -469,15 +469,18 @@
   ([service]
    (-> service
        (assoc-in [:secrets] (dmo/->service-secrets service (secrets)))
+       (assoc-in [:configs] (dmo/->service-configs service (configs)))
        (assoc-in [:repository :imageId] (service-image-id service false))))
   ([service force?]
    (if force?
      (-> service
          (assoc-in [:secrets] (dmo/->service-secrets service (secrets)))
+         (assoc-in [:configs] (dmo/->service-configs service (configs)))
          (assoc-in [:repository :imageId] (service-image-id service true))
          (update-in [:deployment :forceUpdate] inc))
      (-> service
-         (assoc-in [:secrets] (dmo/->service-secrets service (secrets)))))))
+         (assoc-in [:secrets] (dmo/->service-secrets service (secrets)))
+         (assoc-in [:configs] (dmo/->service-configs service (configs)))))))

 (defn create-service
   [service]


change dh api to use v2 tags flow

change dh api to use v2 tags flow

--- src/clj/swarmpit/api.clj
+++ src/clj/swarmpit/api.clj
@@ -4,6 +4,8 @@
             [swarmpit.docker.client :as dc]
             [swarmpit.docker.mapper.inbound :as dmi]
             [swarmpit.docker.mapper.outbound :as dmo]
+            [swarmpit.dockerauth.client :as dac]
+            [swarmpit.dockerregistry.client :as drc]
             [swarmpit.dockerhub.client :as dhc]
             [swarmpit.dockerhub.mapper.inbound :as dhmi]
             [swarmpit.registry.client :as rc]
@@ -242,10 +244,10 @@

 (defn dockerhub-tags
   [repository-name repository-user]
-  (let [user (dockeruser-by-username repository-user)]
-    (->> (dhc/tags repository-name user)
-         (map :name)
-         (into []))))
+  (let [user (dockeruser-by-username repository-user)
+        token (:token (dac/token user repository-name))]
+    (->> (drc/tags token repository-name)
+         :tags)))

 ;;; Repository V2 API


feat(card): allow user to pass his own set to styling params

--- src/cljs/omell/core.cljs
+++ src/cljs/omell/core.cljs
@@ -5,17 +5,17 @@

 (enable-console-print!)

-(defcomponent card [style :- {:style js/Object}  owner]
+(defcomponent card [sty :- {:style js/Object}  owner]
   (render-state [_ state]
     (dom/div
-      (dom/div {:style {
+      (dom/div {:style (merge {
         :marginBottom 20
         :padding 40
         :borderRadius 2
         :background "#fff"
         :boxShadow "0 1px 1px rgba(0, 0, 0, 0.2)"
         :boxSizing "border-box"
-      }} "This is going to be omell card !"))))
+      } (:style sty))} "This is going to be omell card !"))))

 (defn main []
   (om/root


Document neko.doc

Document neko.doc

Yeah, that sounds a bit recursive

--- src/clojure/neko/doc.clj
+++ src/clojure/neko/doc.clj
@@ -16,12 +16,16 @@
             [neko.ui.mapping :as mapping])
   (:use [clojure.string :only [join]]))

-(defn- get-trait-doc [trait]
+(defn- get-trait-doc
+  "Returns a docstring for the given trait keyword."
+  [trait]
   (when-let [doc (get-in (meta #'traits/transform-attributes)
                             [:trait-doc trait])]
     (str trait " - " doc)))

-(defn get-element-doc
+(defn- get-element-doc
+  "Returns a docsting generated from the element mapping. Verbose flag
+  switches the detailed description of element's traits."
   [el-type el-mapping verbose?]
   (let [{:keys [classname attributes values]} el-mapping
         traits (mapping/all-traits el-type)]
@@ -41,18 +45,23 @@
                (format "Special values: %s\n"
                        (pr-str values))))))

-(get-element-doc :button (get @@#'mapping/keyword-mapping :button) true)
-
 (defn describe
+  "Describes the given keyword. If it reprenents UI element's name
+  then describe the element. If optional second argument equals
+  `:verbose`, describe all its traits as well. If a trait keyword is
+  given, describes the trait. No-arguments version briefly describes
+  all available UI elements."
   ([]
      (let [all-elements @@#'mapping/keyword-mapping]
        (doseq [[el-type parameters] all-elements]
          (print (get-element-doc el-type parameters false)))))
   ([kw]
+     (describe kw nil))
+  ([kw modifier]
      (let [parameters (get @@#'mapping/keyword-mapping kw)
            trait-doc (get-trait-doc kw)]
        (cond
         parameters (print "Elements found:\n"
-                          (get-element-doc kw parameters true))
+                          (get-element-doc kw parameters (= modifier :verbose)))
         trait-doc (print "\nTraits found:\n" trait-doc)
         :else (print (str "No elements or traits were found for " kw))))))


Experiment more with meta-errors

Experiment more with meta-errors

--- src/clojush/evaluate.clj
+++ src/clojush/evaluate.clj
@@ -501,7 +501,7 @@
                 (vec (repeat (count (:errors ind)) 6)))
               ;
               (= cat :devolution)
-              (if (and (:parent1-errors ind)
+              #_(if (and (:parent1-errors ind)
                        (:parent2-errors ind)
                        (not= (:errors ind) (:parent1-errors ind))
                        (not= (:errors ind) (:parent2-errors ind)))
@@ -516,6 +516,23 @@
                          (< e (max p1e p2e)) 3
                          (= e (max p1e p2e)) 4
                          :else 5)))
+                (vec (repeat (count (:errors ind)) 6)))
+              (if (and (:parent1-errors ind)
+                       (:parent2-errors ind))
+                (if (or (= (:errors ind) (:parent1-errors ind))
+                        (= (:errors ind) (:parent2-errors ind)))
+                  (vec (repeat (count (:errors ind)) 7))
+                  (vec (for [[e p1e p2e] (mapv #(vector %1 %2 %3)
+                                               (:errors ind)
+                                               (:parent1-errors ind)
+                                               (:parent2-errors ind))]
+                         (cond
+                           (zero? e) 0
+                           (< e (min p1e p2e)) 1
+                           (and (not= p1e p2e) (= e (min p1e p2e))) 2
+                           (< e (max p1e p2e)) 3
+                           (= e (max p1e p2e)) 4
+                           :else 5))))
                 (vec (repeat (count (:errors ind)) 6)))
               ;
               (= cat :error-neglect)


Remove raw error from :discounted-case-improvements meta-error

--- src/clojush/evaluate.clj
+++ src/clojush/evaluate.clj
@@ -267,9 +267,10 @@
                                            1.0E100
                                            ;(* (first case-history) (/ 1.0 sum))
                                            ; arbitrating error ties with improvement
-                                           (+ (first case-history) (- 1.0 sum))
+                                           ;(+ (first case-history) (- 1.0 sum))
                                            ; (mostly) arbitrating improvement ties with error
                                            ;(+ (first case-history) (* 1000 (/ 1.0 sum)))
+                                           (- 1.0 sum)
                                            )))))))
                           (= cat :reproductive-fidelity)
                           (let [g (:genome ind)]
@@ -370,3 +371,4 @@

+


Experiment with :case-stagnation meta-error

--- src/clojush/evaluate.clj
+++ src/clojush/evaluate.clj
@@ -168,7 +168,7 @@
                       (- 1.0 sum)))))
               ;
               (= cat :case-stagnation) ;; formerly :discounted-case-improvements
-              (if (not (:print-history argmap))
+              #_(if (not (:print-history argmap))
                 (throw
                   (Exception.
                     ":print-history must be true for :case-stagnation"))
@@ -188,6 +188,47 @@
                                                (iterate (partial * (- 1 improvement-discount)) 1))
                                  sum (reduce + (mapv * improvements weights))]
                              (- sum)))))))
+              #_(if (not (:print-history argmap))
+                (throw
+                  (Exception.
+                    ":print-history must be true for :case-stagnation"))
+                (if (empty? (rest (:history ind)))
+                  (vec (repeat (count (:errors ind)) 1000000))
+                  (vec (for [case-history (apply map list (:history ind))]
+                         (if (zero? (first case-history))
+                           -100000  ;; solved, improvement doesn't matter
+                           (let [improvements (mapv (fn [[newer-error older-error]]
+                                                      (if (< newer-error older-error)
+                                                        1.0
+                                                        (if (= newer-error older-error)
+                                                          0.0
+                                                          -1.0)))
+                                                    (partition 2 1 case-history))
+                                 weights (take (count improvements)
+                                               (iterate (partial * (- 1 improvement-discount)) 1))
+                                 sum (reduce + (mapv * improvements weights))]
+                             (- sum)))))))
+              (if (not (:print-history argmap))
+                (throw
+                  (Exception.
+                    ":print-history must be true for :case-stagnation"))
+                (if (empty? (rest (:history ind)))
+                  (vec (repeat (count (:errors ind)) 1000000))
+                  (vec (for [case-history (apply map list (:history ind))]
+                         (if (zero? (first case-history))
+                           -100000  ;; solved, improvement doesn't matter
+                           (let [improvements (mapv (fn [[newer-error older-error]]
+                                                      (if (< newer-error older-error)
+                                                        1.0
+                                                        (if (= newer-error older-error)
+                                                          -1.0
+                                                          0.0)))
+                                                    (partition 2 1 case-history))
+                                 weights (take (count improvements)
+                                               (iterate (partial * (- 1 improvement-discount)) 1))
+                                 sum (reduce + (mapv * improvements weights))]
+                             (- sum)))))))
+
               ;
               (= cat :case-gens-since-improvement)
               (if (not (:print-history argmap))


Experiment more with meta-errors

Experiment more with meta-errors

--- src/clojush/evaluate.clj
+++ src/clojush/evaluate.clj
@@ -583,6 +583,20 @@
                            (< e (max p1e p2e)) 1
                            :else 2))))
                 (vec (repeat (count (:errors ind)) 4)))
+              #_(if (and (:parent1-errors ind)
+                       (:parent2-errors ind))
+                (vec (for [[e p1e p2e] (mapv #(vector %1 %2 %3)
+                                             (:errors ind)
+                                             (:parent1-errors ind)
+                                             (:parent2-errors ind))]
+                       (cond
+                         (zero? e) 0
+                         (< e (min p1e p2e)) 1
+                         (and (not= p1e p2e) (= e (min p1e p2e))) 2
+                         (< e (max p1e p2e)) 3
+                         (= e (max p1e p2e)) 4
+                         :else 5)))
+                (vec (repeat (count (:errors ind)) 6)))
               (if (and (:parent1-errors ind)
                        (:parent2-errors ind))
                 (vec (for [[e p1e p2e] (mapv #(vector %1 %2 %3)
@@ -590,7 +604,7 @@
                                              (:parent1-errors ind)
                                              (:parent2-errors ind))]
                        (cond
-                         (zero? e) 0
+                         (zero? e) 1
                          (< e (min p1e p2e)) 1
                          (and (not= p1e p2e) (= e (min p1e p2e))) 2
                          (< e (max p1e p2e)) 3


Reworking DL exploration interaction

Reworking DL exploration interaction

which now, finally, seems to work.

Signed-off-by: Daniel Borchmann <25857343a15bf1edafebc2912e82ecf775c585c1@mailbox.tu-dresden.de>

--- src/conexp/contrib/dl/languages/interaction.clj
+++ src/conexp/contrib/dl/languages/interaction.clj
@@ -40,18 +40,18 @@
   (let [language    (interpretation-language model),
         old-objects (interpretation-base-set model),

-        new-objects (ask "Please enter your new objects:"
-                         #(read-string (str "#{" (read-line) "}"))
-                         empty?
+        new-objects (ask "Please enter your new objects: "
+                         #(read-string (str "#{" (first (drop-while nil? (repeatedly read-line))) "}"))
+                         not-empty
                          "Please specify at least one new object.\n",
-                         #(not-empty (intersection old-objects %))
-                         #(str "The objects"
-                               (difference % old-objects)
-                               " are already defined. Please use other names."),
-                         #(some (fn [s]
-                                  (not (Character/isUpperCase ^Character (first (str s))))
-                                 %))
-                         (str "New objects need to start with a capital letter.")),
+                         #(empty? (intersection old-objects %))
+                         #(str "The objects "
+                               (intersection % old-objects)
+                               " are already defined. Please use other names.\n"),
+                         #(every? (fn [s]
+                                    (Character/isUpperCase ^Character (first (str s))))
+                                  %)
+                         (str "New objects need to start with a capital letter.\n")),

         interfun    (loop [objects    (seq new-objects),
                            attributes {}]


changed 1 instance of futuro to future

changed 1 instance of futuro to future

--- es.clj
+++ es.clj
@@ -44,7 +44,7 @@
                                                   :target-model es/small}
                                                  :count count}])))
                                   [{:synsem {:sem {:tense :conditional}}}
-                                   {:synsem {:sem {:tense :futuro}}}
+                                   {:synsem {:sem {:tense :future}}}
                                    {:synsem {:sem {:tense :present}}}
                                    {:synsem {:sem {:aspect :perfect
                                            :tense :past}}}


add {:aux true} to present-perfect default rule

--- src/babel/italiano/grammar.cljc
+++ src/babel/italiano/grammar.cljc
@@ -49,6 +49,14 @@
                        :cat :verb
                        :sem {:tense :present
                              :aspect :simple}
+                       :infl :present}})
+
+            (apply-default-if
+             verb-default?
+             {:synsem {:aux true
+                       :cat :verb
+                       :sem {:tense :present
+                             :aspect :perfect}
                        :infl :present}})

             (apply-default-if


disable lexeme key-modification via morphology, at least for now, but it remains an option

--- src/babel/italiano/lexicon.cljc
+++ src/babel/italiano/lexicon.cljc
@@ -20,6 +20,8 @@
                                pronoun-acc pronoun-reflexive sentential-adverb
                                transitive transitivize verb-aux verb-subjective]]
    [dag_unify.core :refer [fail? get-in merge]]))
+
+(def analyze-lexemes false)

 (def lexicon-source
   {"Luisa"
@@ -2235,16 +2237,22 @@
                   #(or (not (= :verb (get-in % [:synsem :cat])))
                        (not (= :none (get-in % [:synsem :infl] :none)))))

-                 ;; TODO: use italiano.morphology/preposition-plus-article regexp pairs.
-                 ;; rather than hard-wired rules here.
                  (rewrite-keys
                   (fn [k]
                     (cond
+                      (= false analyze-lexemes)
+                      k
+
+                      ;; TODO: only an example provided here:
+                      ;; if analyze-lexemes is true, replace this example with use of
+                      ;; italiano.morphology/preposition-plus-article regexp pairs
                       (= k "alla prossima")
                       "a la prossima"
-                      true k)))
-
-                 ))
+
+                      true k)))))
+
+
+


-(def lexicon); +(defn lexicon)

-(def lexicon); +(defn lexicon)

--- src/babel/italiano/lexicon.cljc
+++ src/babel/italiano/lexicon.cljc
@@ -288,5 +288,11 @@
      ;; end of language-specific grammar rules
 ))

-(def lexicon (future (edn2lexicon (clojure.java.io/resource "babel/italiano/lexicon.edn"))))
-
+(defn lexicon []
+  (->
+   (clojure.java.io/resource "babel/italiano/lexicon.edn")
+   edn2lexicon))
+
+
+
+


allow the user to run the program using parallel or sequential code

--- src/k_means/core.clj
+++ src/k_means/core.clj
@@ -47,5 +47,11 @@
 (defn -main
   "Main function for k-means"
   [& args]
-  (let [c (profile :info :Arithmetic (k-means (vector/make-list-rand 5000) 7 15)) => "Done"]
-    (spit "k-means.txt" (vec c))) (shutdown-agents))
+  (cond
+    (= (first args) "seq")
+      (let [c (profile :info :Arithmetic (k-means (vector/make-list-rand 500000) 5 100)) => "Done"]
+        (spit "k-means.txt" (vec c)))
+    (= (first args) "par")
+      (let [c (profile :info :Arithmetic (k-means-p (vector/make-list-rand 500000) 5 100)) => "Done"]
+        (spit "k-means.txt" (vec c))))
+  (shutdown-agents))


conn timeout too

conn timeout too

--- src/block_chain/peer_client.clj
+++ src/block_chain/peer_client.clj
@@ -52,6 +52,7 @@
   (-> (http/post (url peer "ping")
                  {:form-params {:ping time}
                   :socket-timeout 2000
+                  :conn-timeout 2000
                   :content-type :json})
       :body
       read-json))


Add location data to the returned urls

Add location data to the returned urls

--- src/clj/comic_reader/server.clj
+++ src/clj/comic_reader/server.clj
@@ -56,12 +56,18 @@
 (defn get-comic-urls [{{:keys [site comic chapter page]} :params
                        :as request}]
   (let [site (keyword site)
-        chapter-map (get-comic-chapter site comic
-                                       (safe-read-string chapter))
+        chapter (safe-read-string chapter)
+        page    (safe-read-string page)
+        add-location (fn [idx comic-info]
+                       (assoc comic-info
+                              :chapter chapter
+                              :page (+ page idx)))
+        chapter-map (get-comic-chapter site comic chapter)
         page-list (get-following-pages site comic
                                        chapter-map
-                                       (safe-read-string page))]
-    (if-let [comic-urls (map :url page-list)]
+                                       page)]
+    (if-let [comic-urls (map-indexed add-location
+                                     page-list)]
       (edn-response comic-urls)
       (edn-response (gen-error-data request) 404))))


Bikeshed nastiness.

Bikeshed nastiness.

--- src/clj/freefrog/governance.clj
+++ src/clj/freefrog/governance.clj
@@ -101,8 +101,9 @@
   (validate-not (role-missing? circle role-name)
                 (str "Role not found: " role-name)))

-(defn- validate-name [type role-name]
-  (validate-not (empty? role-name) (format "%s name may not be empty" type)))
+(defn- validate-name [thing-type thing-name]
+  (validate-not (empty? thing-name)
+                (format "%s name may not be empty" thing-type)))

 (defn- validate-role-updates [circle role-name]
   "Checks that the role name is not empty and that it exists in the circle."


Further cleans up resolve-ability function.

--- src/clj/game/core-abilities.clj
+++ src/clj/game/core-abilities.clj
@@ -1,8 +1,7 @@
 (in-ns 'game.core)
 (declare corp-trace-prompt optional-ability
          check-optional check-psi check-trace
-         can-trigger? do-choices do-ability do-effect
-         print-msg register-end-turn register-once
+         can-trigger? do-choices do-ability
          psi-game resolve-psi resolve-trace show-select)

 ; Functions for implementing card abilities and prompts
@@ -92,24 +91,25 @@

 (defn- check-optional
   "Checks if there is an optional ability to resolve"
-  [state side {:keys [optional] :as ability} {:keys [cid] :as card} targets]
-  (when (and optional
-             (not (get-in @state [(:once optional) (or (:once-key optional) cid)]))
-             (check-req state side card targets optional))
-    (optional-ability state (or (:player optional) side) card
-                      (:prompt optional) optional targets)))
+  [state side ability card targets]
+  (when-let [optional (:optional ability)]
+    (when (and (not (get-in @state [(:once optional) (or (:once-key optional) (:cid card))]))
+               (check-req state side card targets optional))
+      (optional-ability state (or (:player optional) side) card (:prompt optional) optional targets))))

 (defn- check-psi
   "Checks if a psi-game is to be resolved"
-  [state side {:keys [psi] :as ability} card targets]
-  (when (and psi (check-req state side card targets psi))
-    (psi-game state side card psi)))
+  [state side ability card targets]
+  (when-let [psi (:psi ability)]
+    (when (check-req state side card targets psi)
+      (psi-game state side card psi))))

 (defn- check-trace
   "Checks if there is a trace to resolve"
-  [state side {:keys [trace] :as ability} card targets]
-  (when (and trace (check-req state side card targets trace))
-    (corp-trace-prompt state card trace)))
+  [state side ability card targets]
+  (when-let [trace (:trace ability)]
+    (when (check-req state side card targets trace)
+      (corp-trace-prompt state card trace))))

 (defn- can-trigger?
   "Checks if ability can trigger. Checks that once-per-turn is not violated."
@@ -139,6 +139,8 @@
                 (let [cards (choices state side card targets)] ; a vector of cards or strings
                   (if not-distinct cards (distinct-by :title cards))))]
        (prompt! state s card prompt cs ab args)))))
+
+(declare print-msg do-effect register-end-turn register-once)

 (defn- do-ability
   "Perform the ability, checking all costs can be paid etc."


Revert distances to correctly large value


Work in progress - complete the 'update-player-search' function in core.cljs

--- src/cljs/farsight_orb/core.cljs
+++ src/cljs/farsight_orb/core.cljs
@@ -27,7 +27,8 @@
 (defonce app-state (atom {:text ""
                           :events []
                           :connected false
-                          :players []}))
+                          :players []
+                          :auto-complete-results []}))

 (defn submit-new-text [data owner]
   (let [new-text (-> (om/get-node owner "new-text") .-value)]
@@ -65,8 +66,8 @@
           nil)
         (recur (:event (<! ch-chsk))))))

-(defn update-player-search [something]
-  (println (type something)))
+(defn update-player-search [value]
+  (println value))

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

@@ -82,7 +83,8 @@
                   :url (str "data/players")
                   :on-complete
                    (fn [res]
-                     (om/update! app :players res))}))
+                     (om/update! app :players
+                                 res))}))
     om/IWillMount
     (will-mount [this]
                 (event-loop app owner))
@@ -94,9 +96,19 @@
                        (g/grid {}
                                (g/row {:class "player-search-input"}
                                       (dom/h2 "Search")
-                                      (dom/input {:type "text" :ref "new-text" :placeholder "Enter a player name or tag..." :style {:width "100%"} :onInput #(update-player-search %)}))
+                                      (dom/input {:type "text"
+                                                  :ref "new-text"
+                                                  :placeholder "Enter a player name or tag..."
+                                                  :style {:width "100%"}
+                                                  :onInput #(update-player-search (.. % -target -value))}))
                                (g/row {:class "player-search-results"}
-                                      (dom/h2 "Results"))))))))
+                                      (dom/h2 "Results")
+                                      (if (empty? (:auto-complete-results @app-state))
+                                        (dom/span "No results.")
+                                        (dom/ul
+                                         (map
+                                          #(dom/li %)
+                                          (:auto-complete-results @app-state)))))))))))

 (defn main []
   (om/root


Inject the handling function into the component.

--- src/cljs/leipzig_live/core.cljs
+++ src/cljs/leipzig_live/core.cljs
@@ -68,13 +68,13 @@
       (beep! hertz seconds 1))
     state))

-(defn handle! [action]
+(defn apply-action! [action]
   (swap! state (partial process action)))

 ;; -------------------------
 ;; Views

-(defn home-page [state]
+(defn home-page [handle! state]
   [:div [:h1 "Welcome to Leipzig Live!"]
    [:div [:input {:type "text"
                   :value (:text state)
@@ -90,7 +90,7 @@
 ;; Routes

 (defn app []
-  (home-page @state))
+  (home-page apply-action! @state))

 (secretary/defroute "/" []
   (session/put! :current-page #'app))


Transitioning to pure event-driven

Transitioning to pure event-driven

--- src/cljs/puertorico/client.cljs
+++ src/cljs/puertorico/client.cljs
@@ -5,6 +5,7 @@

 (enable-console-print!)

+(def estream (atom []))

 (defn create-player [name gold starting-field]
   {:name name
@@ -29,13 +30,12 @@
                         :trader "Goods for money"
                         :builder "Buy buildings"
                         :settler "Get quarry/field(s)"
-                        :mayor "Get colonists"
+                        :mayor "Get workers"
                         :craftsman "Produce goods"})

 (def common-state
   {:roles (set (keys role-descriptions))
-   :goods [:coffee 9 :tobacco 9 :corn 10 :sugar 11 :indigo 11]
    :buildings common/initial-buildings
    :trader []
    :governor 0
@@ -44,19 +44,116 @@
    :quarry 8
    :fields {:coffee 8 :tobacco 9 :corn 10 :sugar 11 :indigo 12}})

+(defn bank-buildings []
+  (into {}
+        (for [[bname bdesc] common/initial-buildings]
+          [bname (select-keys bdesc [:count :column])])))
+
+(swap! estream conj
+       [:good :bank :coffee 9]
+       [:good :bank :tobacco 9]
+       [:good :bank :corn 10]
+       [:good :bank :sugar 11]
+       [:good :bank :indigo 11]
+
+       [:field :bank :quarry 8]
+       [:field :bank :coffee 8]
+       [:field :bank :tobacco 9]
+       [:field :bank :corn 10]
+       [:field :bank :sugar 11]
+       [:field :bank :indigo 12]
+
+       [:building :bank (bank-buildings)]
+
+       )
+
+(defn next-player [current-picker cstate]
+  (mod (inc current-picker) (:nplayers cstate)))
+
+(defmulti transition identity)
+(defmethod transition :good [etype state [dest good-type amount]]
+  (update-in state [dest etype good-type] + amount))
+(defmethod transition :field [etype state [dest good-type amount]]
+  (update-in state [dest etype good-type] + amount))
+(defmethod transition :worker [etype state [dest amount]]
+  (update-in state [dest etype] + amount))
+(defmethod transition :vp [etype state [dest amount]]
+  (update-in state [dest etype] + amount))
+(defmethod transition :gold [etype state [dest amount]]
+  (update-in state [dest etype] + amount))
+(defmethod transition :building [etype state [dest buildings]]
+  (assoc-in state [dest] buildings))
+(defmethod transition :add-player [etype state [pname]]
+  (-> state
+      (update-in [:order] conj pname)
+      (update-in [:nplayers] inc)
+      (assoc-in [pname] {:name pname :worker 0 :gold 0 :vp 0 :field {} :building {}})))
+
+(defmethod transition :rolepick [etype state [role]]
+  (assoc state :current-role role))
+
+(defmethod transition :actiondone [etype state]
+  (update-in state [:action-picker] next-player state))
+
+(defmethod transition :default [etype state]
+  state)
+
+
+(defn calc-state []
+  (let [estream @estream]
+    (reduce
+      (fn [acc [etype & eargs]]
+        (transition etype acc eargs))
+      {:order []
+       :nplayers 0
+       :governor 0
+       :role-picker 0
+       :current-role nil
+       :action-picker 0
+       :bank {:vp 0
+              :field-count 0
+              :building nil}}
+        estream)))
+
+(defn get-players [state]
+  (into {}
+        (remove (fn [[k v]] (keyword? k)) state)))
+
 (defn create-game
   ([p1 p2 p3]
+   (swap! estream conj
+          [:vp :bank 75]
+          [:worker :bank 55]
+
+          [:worker :worker-ship 3]
+          [:worker :bank -3]
+
+          [:ship 0 4]
+          [:ship 1 5]
+          [:ship 2 6]
+
+          [:add-player p1]
+          [:gold p1 2]
+          [:field p1 :indigo 1]
+
+          [:add-player p2]
+          [:gold p2 2]
+          [:field p2 :indigo 1]
+
+          [:add-player p3]
+          [:gold p3 1]
+          [:field p3 :corn 1]
+          )
+
    (merge common-state
           {:n-player 3
-           :vp 75 :colonists 55 :ships [4 5 6]
-           :colonist-ship 3
            :players [(create-player p1 2 :indigo)
                      (create-player p2 2 :indigo)
                      (create-player p3 1 :corn)]})))

 (def game (atom (apply create-game ["Kanwei" "Lauren" "Ted"])))

-(defn randomize-fields []
+(defn randomize-fields [state]
   (->> (for [[field-type field-num] (:fields @game)]
          (repeat field-num field-type))
        flatten
@@ -80,9 +177,15 @@
 (defn add-to-turn [event]
   (swap! game update-in [:turns] add-event-to-turn event))

-(defn do-mayor []
-
+(defn do-mayor [cstate]
+  (swap! estream conj
+         [:rolepick :mayor]
+         [:worker :bank -1]
+         [:worker (nth (:order cstate) (:role-picker cstate)) 1])
   )
+
+(defn action-done []
+  (swap! estream conj [:actiondone]))

 (defn do-settler [field-type i]
   (when true
@@ -98,12 +201,10 @@
         (= :end (first current-turn)))))

 (defn player-pick-role [role]
-  (if (time-to-pick-role?)
-    (let [cstate @game
-          player-picked-role (:governor cstate)]
-      (swap! game update-in [:turns] conj [role player-picked-role])
-      (swap! game update-in [:log] conj [:rolestart role player-picked-role])
-      (swap! game update-in [:players player-picked-role] assoc :role role))))
+  (case role
+    :mayor (do-mayor (calc-state))
+    nil)
+  )

 (defn whose-turn []
   (let [current-turn (peek (:turns @game))
@@ -177,26 +278,28 @@
    [:div.box {:class type}]
    [:div.clearfix]])

-(defn player-board [player]
+(defn player-board [[pname player]]
   [:div
    (if (:role player)
      [:div.rolecard (name (:role player))])
    [:div.well
-    [:div.pull-left (:name player)]
+    [:div.pull-left pname]
     [:span.pull-right (gold (:gold player))]
     [:span.pull-right (vp (:vp player))]
     [:div.clearfix]
+    [:h5 "Workers: " (:worker player)]
     [:h5 "Buildings"]
-    (for [building (:buildings player)]
+    (for [building (:building player)]
       [:div (:name building)])
     [:h5 "Fields"]
-    (for [field (:fields player)]
-      [:div.field {:class (name field)} (name field)])
+    (for [[ftype fnum] (:field player)
+          i (range fnum)]
+      [:div.field {:class (name ftype)} (name ftype)])
     ]])

 (defn player-boards []
   [:div.row
-   (for [player (:players @game)]
+   (for [player (get-players (calc-state))]
      [:div.col-md-3
       (player-board player)])])

@@ -213,14 +316,15 @@
       [:span " - " (role role-descriptions)]])])

 (defn supply-board []
-  (let [current @game]
+  (let [current @game
+        cstate (calc-state)]
     [:div
-     [:i.fa.fa-trophy (:vp current)]
-     [:div "Colonist Supply: " (:colonists current)]
-     [:div "Colonist Ship: " (:colonist-ship current)]
+     [:i.fa.fa-trophy (get-in cstate [:bank :vp])]
+     [:div "Worker Supply: " (get-in cstate [:bank :worker])]
+     [:div "Worker Ship: " (get-in cstate [:worker-ship :worker])]
      [:h3 "Ships"]
      (for [ship (:ships current)]
-       (render-ship ship))
+       (render-ship ship nil))
      [:h3 "Trader"] (render-trader (:trader current))
      [:h3 "Fields"]
      [:div.quarry.field {:on-click #(do-settler :quarry nil)} (:quarry current) " Q"]
@@ -229,13 +333,17 @@
                                  :on-click #(do-settler field i)} (name field)]
                     )
                   (:available-fields current))
-     [:h3 "Current turn: " (pr-str (peek (:turns current)))]
-     [:h3 "Pick role? " (str (time-to-pick-role?))]
-     [:h3 "Whose turn? " (str (whose-turn))]
-     #_[:h3 "Current role: " (current-role)]]))
+     [:h3 "Governor: " (:governor cstate)]
+     [:h3 "Role picker: " (:role-picker cstate)]
+     [:h3 "Current role: " (str (:current-role cstate))]
+     [:h3 "Action picker: " (:action-picker cstate)]
+     [:button.btn.btn-success {:on-click action-done} "Done!"]
+     ]))

 (defn game-state []
-  [:blockquote (pr-str @game)])
+  [:div
+    [:blockquote (pr-str @estream)]
+    [:blockquote (pr-str (calc-state))]])

 (reagent/render-component [building-board] (.getElementById js/document "building-board"))


Add breadcrumbs for better navigation

Add breadcrumbs for better navigation

--- src/cljs/todogo_cljs/views.cljs
+++ src/cljs/todogo_cljs/views.cljs
@@ -19,6 +19,9 @@
       [:div {:class "base-container"}
        (c/nav-bar @main-menu-visible)
        [:div {:class "container"}
+        [:div {:class "col-12 "}
+         [:ul {:class "breadcrumb"}
+          [:li [:span "Home"]]]]
         [:div {:class "col-lg-4 col-md-4"}
          (c/create-todo-list-form @todo-list-title)
          (c/todo-lists @lists)]]
@@ -35,6 +38,10 @@
       [:div {:class "base-container"}
        (c/nav-bar @main-menu-visible)
        [:div {:class "container"}
+        [:div {:class "col-12 "}
+         [:ul {:class "breadcrumb"}
+          [:li [:a {:href "#/"} "Home"]]
+          [:li [:span (:title @todo-list)]]]]
         [:div {:class "col-lg-4 col-md-4 hidden-sm hidden-xs"}
          (c/create-todo-list-form @todo-list-title)
          (c/todo-lists @lists)]
@@ -57,6 +64,11 @@
       [:div {:class "base-container"}
        (c/nav-bar @main-menu-visible)
        [:div {:class "container"}
+        [:div {:class "col-12 "}
+         [:ul {:class "breadcrumb"}
+          [:li [:a {:href "#/"} "Home"]]
+          [:li [:a {:href (str "#/lists/" (:id @todo-list))} (:title @todo-list)]]
+          [:li [:span (:title @todo)]]]]
         [:div {:class "col-lg-4 col-md-4 hidden-sm hidden-xs"}
          (c/create-todo-list-form @todo-list-title)
          (c/todo-lists @lists)]


Add UI events for mouse entering and leaving a tile

--- src/cljs/zetawar/events/ui.cljs
+++ src/cljs/zetawar/events/ui.cljs
@@ -360,3 +360,18 @@
 (defmethod router/handle-event ::start-new-game
   [{:as handler-ctx :keys [ev-chan conn]} [_ scenario-id]]
   (app/start-new-game! handler-ctx scenario-id))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Tile coordinates
+
+(defmethod router/handle-event ::hover-hex-enter
+  [{:as handler-ctx :keys [ev-chan db]} [_ q r]]
+  (let [app (app/root db)]
+    {:tx [[:db/add (e app) :app/hover-q q]
+          [:db/add (e app) :app/hover-r r]]}))
+
+(defmethod router/handle-event ::hover-hex-leave
+  [{:as handler-ctx :keys [ev-chan db]} [_ q r]]
+  (let [app (app/root db)]
+      {:tx [[:db/retract (e app) :app/hover-q q]
+            [:db/retract (e app) :app/hover-r r]]}))


expose global CLJS_EVAL fn via shadow.remote

gives third-party libs/tools access to eval without having to
worry about self-hosted. assuming a shadow-cljs watch provides
it of course.

--- src/main/shadow/remote/runtime/cljs/common.cljs
+++ src/main/shadow/remote/runtime/cljs/common.cljs
@@ -1,5 +1,6 @@
 (ns shadow.remote.runtime.cljs.common
   (:require
+    [goog.object :as gobj]
     [cognitect.transit :as transit]
     [shadow.cljs.devtools.client.env :as env]
     [shadow.remote.runtime.api :as api]
@@ -148,6 +149,29 @@
           (socket-close)
           (swap! renv/runtime-ref dissoc :obj-support :tap-support :eval-support :stop))]

+    ;; test exporting this into the global so potential consumers
+    ;; don't have to worry about importing a namespace that shouldn't be in release builds
+    ;; can't bind cljs.core/eval since that expects a CLJ form not a string
+    ;; which we could technically also support but I don't want to assume the user
+    ;; knows how to read properly. just accepting a string and optional ns is much easier
+    (set! js/goog.global.CLJS_EVAL
+      (fn [input callback]
+        (let [input
+              (cond
+                ;; preferred when calling from CLJS
+                (map? input)
+                input
+
+                ;; just calling with code
+                (string? input)
+                {:code input :ns 'cljs.user}
+
+                ;; when calling from JS {code: "string", ns: "cljs.user"}
+                (object? input)
+                {:code (gobj/get input "code") :ns (symbol (gobj/get input "ns"))})]
+
+          (renv/eval-cljs runtime input callback))))
+
     (reset! renv/runtime-ref
       {:runtime runtime
        :obj-support obj-support
@@ -157,5 +181,6 @@

 (defn stop-runtime! []
   (when-some [runtime @renv/runtime-ref]
+    (reset! renv/runtime-ref nil)
     (let [{:keys [stop]} runtime]
       (stop))))


formatting

formatting

--- src/overtone/sc/machinery/server/connection.clj
+++ src/overtone/sc/machinery/server/connection.clj
@@ -78,11 +78,11 @@
            system-outs    (re-seq #"system:playback_[0-9]*" port-list)
            interface-ins  (re-seq #"system:AC[0-9]*_dev[0-9]*_.*In.*" port-list)
            interface-outs (re-seq #"system:AP[0-9]*_dev[0-9]*_LineOut.*" port-list)
-           connections (partition 2 (concat
-                                     (interleave sc-outs system-outs)
-                                     (interleave sc-outs interface-outs)
-                                     (interleave system-ins sc-ins)
-                                     (interleave interface-ins sc-ins)))]
+           connections    (partition 2 (concat
+                                        (interleave sc-outs system-outs)
+                                        (interleave sc-outs interface-outs)
+                                        (interleave system-ins sc-ins)
+                                        (interleave interface-ins sc-ins)))]
        (doseq [[src dest] connections]
          (logged-sh "jack_connect" src dest)
          (log/info "jack_connect " src " " dest)))))
@@ -116,7 +116,7 @@
   (log/debug "Connecting to internal SuperCollider server")
   (let [send-fn (fn [peer-obj buffer]
                   (scsynth-send @sc-world* buffer))
-        peer (assoc (osc-peer false false) :send-fn send-fn)]
+        peer    (assoc (osc-peer false false) :send-fn send-fn)]
     (dosync (ref-set server-osc-peer* peer))
     (setup-connect-handlers)
     (server-snd "/status")))
@@ -211,8 +211,8 @@
   "Pull audio server log data from a pipe and store for later printing."
   [stream read-buf]
   (while (pos? (.available stream))
-    (let [n (min (count read-buf) (.available stream))
-          _ (.read stream read-buf 0 n)
+    (let [n   (min (count read-buf) (.available stream))
+          _   (.read stream read-buf 0 n)
           msg (String. read-buf 0 n)]
       (swap! external-server-log* conj msg)
       (log/info (String. read-buf 0 n)))))
@@ -262,26 +262,26 @@
   [args]
   (when (not= 1 (:realtime? args))
     (throw (Exception. "Non-realtime server mode not currently supported. Patches accepted - please contact the mailing list.")))
-  (let [udp?             (:udp? args)
-        port             (:port args)
-        ugens-paths      (or (:ugens-paths args) [])
-        args             (select-keys args (keys SC-ARG-INFO))
-        args             (dissoc args :udp? :port :realtime? :nrt-cmd-filename :nrt-output-filename :nrt-output-header-format :nrt-output-sample-format)
-        port-arg         (if (= 1 udp?)
-                           ["-u" port]
-                           ["-t" port])
-        ugens-paths      (map resolve-tilde-path ugens-paths)
-        ugens-paths      (filter dir-exists? ugens-paths)
-        ugens-paths      (apply str (interpose ":" ugens-paths))
-        args             (if (empty? ugens-paths)
-                           (dissoc args :ugens-paths)
-                           (assoc args :ugens-paths ugens-paths))
-        arg-list         (reduce
-                          (fn [res [flag val]] (if val
-                                                (concat res [(find-sc-arg-flag! flag) val])
-                                                res))
-                          []
-                          args)]
+  (let [udp?        (:udp? args)
+        port        (:port args)
+        ugens-paths (or (:ugens-paths args) [])
+        args        (select-keys args (keys SC-ARG-INFO))
+        args        (dissoc args :udp? :port :realtime? :nrt-cmd-filename :nrt-output-filename :nrt-output-header-format :nrt-output-sample-format)
+        port-arg    (if (= 1 udp?)
+                      ["-u" port]
+                      ["-t" port])
+        ugens-paths (map resolve-tilde-path ugens-paths)
+        ugens-paths (filter dir-exists? ugens-paths)
+        ugens-paths (apply str (interpose ":" ugens-paths))
+        args        (if (empty? ugens-paths)
+                      (dissoc args :ugens-paths)
+                      (assoc args :ugens-paths ugens-paths))
+        arg-list    (reduce
+                     (fn [res [flag val]] (if val
+                                           (concat res [(find-sc-arg-flag! flag) val])
+                                           res))
+                     []
+                     args)]
     (map str (concat port-arg arg-list))))

 (defn- sc-command
@@ -380,9 +380,9 @@
      (unsatisfy-all-dependencies))))

 (defonce _shutdown-hook
-     (.addShutdownHook (Runtime/getRuntime)
-                       (Thread. (fn []
-                                  (log/info "Shutdown hook activated...")
-                                  (locking connection-info*
-                                    (when (= :connected @connection-status*)
-                                      (shutdown-server)))))))
+  (.addShutdownHook (Runtime/getRuntime)
+                    (Thread. (fn []
+                               (log/info "Shutdown hook activated...")
+                               (locking connection-info*
+                                 (when (= :connected @connection-status*)
+                                   (shutdown-server)))))))


No need to clean up for master archive

No need to clean up for master archive

as there are no temp files such as mp3 or iso files.

--- src/mdr2/archive.clj
+++ src/mdr2/archive.clj
@@ -144,8 +144,7 @@
   (-> production
       copy-files ; place all the files in the spool dir
       create-rdf ; create an rdf file
-      add-to-db ; add it to the db so that the agadir machinery will pick it up
-      clean-up-tmp-files))
+      add-to-db)) ; add it to the db so that the agadir machinery will pick it up

 (defn archive-distribution-master
   "Archive a distribution master .i.e. a DTB encoded with mp3 and packed up in one or more iso files"


Formatting and comments fixes.

Formatting and comments fixes.

--- src/measure/core.clj
+++ src/measure/core.clj
@@ -115,10 +115,6 @@
             (getRatio [] (RatioGauge$Ratio/of (n-fn) (d-fn))))]
     (register registry name r)))

-;; ### Derived Gauge
-;;
-;; A derived gauge yields the value of a source gauge, to which a
-;; transformation is applied.
 (defn derive-gauge
   "### Derived Gauge

@@ -164,8 +160,6 @@
   [^MetricRegistry registry ^String name]
   (.histogram registry name))

-
-
 (defn meter
   "## Meters

@@ -204,8 +198,6 @@
   "Wraps the given function such that each invocation is timed by the given timer."
   [^Timer t f]
   (fn [& args] (time! t #(apply f args))))
-
-

 (defn start-timing
   "Operations occasionally cross thread boundaries, and even more frequently
@@ -254,7 +246,6 @@

 (defprotocol SingleValuedMetric
   "The five metric types each expose a scalar value, which depending on the specific
-
    type of metric is more or less useful.  Gauges and counters are of course simply
    measures of one scalar value, and so their value is the entirety of their information.


Fix deref

Fix deref

--- src/onyx/peer/virtual_peer.clj
+++ src/onyx/peer/virtual_peer.clj
@@ -76,11 +76,11 @@
         high-water-ratio (/ high-water-pct 100)]
     (while (not (Thread/interrupted))
       (let [ratio (/ (count buf) (.n buf))
-            on-val @on]
+            on-val? @on?]
         (cond (and (not on-val) (> ratio high-water-ratio))
-              (do (reset! on? true)
+              (do (reset! on-val? true)
                   (>!! outbox-ch (create-log-entry :backpressure-on {:peer id})))
-              (and on-val (< ratio low-water-ratio))
+              (and on-val? (< ratio low-water-ratio))
               (do (reset! on? false)
                   (>!! outbox-ch (create-log-entry :backpressure-off {:peer id})))))
       (Thread/sleep check-interval))))


update debug

update debug

--- src/meta/server.cljs
+++ src/meta/server.cljs
@@ -8,7 +8,7 @@
 (enable-console-print!)

 (defn app []
-  (debug "Starting [meta] server")
+  (debug "Starting application server")
   (feathers/app))

 (defn with-defaults [app]


Added test for cdata in sexp-as-element that contains an embedded ]]> (DXML-12)

--- src/test/clojure/clojure/data/xml/test_sexp.clj
+++ src/test/clojure/clojure/data/xml/test_sexp.clj
@@ -34,15 +34,26 @@
            (sexp-as-element sexp-input)))))

 (deftest with-multiple-cdata
-  (let [xml-input (element :tag {:attr "value"}
-                           (element :body {}
-                                    (cdata "not parsed <stuff")
-                                    (cdata "more not parsed <stuff")))
-        sexp-input [:tag {:attr "value"} [:body {}
-                                          (list [:-cdata "not parsed <stuff"]
-                                                [:-cdata "more not parsed <stuff"])]]]
-    (is (= xml-input
-           (sexp-as-element sexp-input)))))
+  (testing "separate cdata"
+    (let [xml-input (element :tag {:attr "value"}
+                             (element :body {}
+                                      (cdata "not parsed <stuff")
+                                      (cdata "more not parsed <stuff")))
+          sexp-input [:tag {:attr "value"} [:body {}
+                                            (list [:-cdata "not parsed <stuff"]
+                                                  [:-cdata "more not parsed <stuff"])]]]
+      (is (= xml-input
+             (sexp-as-element sexp-input)))))
+  (testing "cdata with embedded ]]>"
+    (let [xml-input (element :tag {:attr "value"}
+                             (element :body {}
+                                      (cdata "not parsed <stuff")
+                                      (cdata "more not parsed <stuff")))
+          sexp-input [:tag {:attr "value"}
+                      [:body {}
+                       [:-cdata "not parsed <stuff]]>more not parsed <stuff"]]]]
+      (is (= (emit-str xml-input)
+             (emit-str (sexp-as-element sexp-input)))))))

 (deftest with-comment
   (let [xml-input (element :tag {:attr "value"}


When the sequencer isn't playing, play the instrument when the user enables a cell.

Combined with ns-instruments, this seems like a nice way to explore available instruments.

--- src/overtone/gui/sequencer.clj
+++ src/overtone/gui/sequencer.clj
@@ -95,7 +95,12 @@
         rows (count (:rows state))
         cols (:steps state)
         c    (int (/ x (/ (width grid) cols)))
-        r    (int (/ y (/ (height grid) rows)))]
+        r    (int (/ y (/ (height grid) rows)))
+        new-state (toggle-entry state r c)]
+    ; when they enable a cell, play the sample.
+    (if (and (get-in new-state [:rows r :value c])
+             (not (:playing? new-state)))
+      ((get-in new-state [:rows r :inst])))
     (toggle-entry state r c)))

 (defn- on-grid-drag [state e]


Be a bit more conservative with vertical whitespace in play#.

--- src/overtunes/songs/at_all.clj
+++ src/overtunes/songs/at_all.clj
@@ -96,10 +96,8 @@
 (defn play# [] (->
                  (bpm 160 (now))
                  (after 2)
-                 intro# intro#
-                 first-bit#
+                 intro# intro# first-bit#
                  (tempo 3/2)
-                 first-bit# variation#
-                 final-chord#))
+                 first-bit# variation# final-chord#))

 (play#)


Fix team notifications check.

Fix team notifications check.

--- src/oc/email/app.clj
+++ src/oc/email/app.clj
@@ -22,7 +22,7 @@
           :digest (mailer/send-digest msg-body)
           :sns (mailer/handle-data-change msg-body)
           :notify (mailer/send-entry-notification msg-body)
-          :team (when (= (:team-action msg-body) :team-add)
+          :team (when (-> msg-body :notification :team-action keyword (= :team-add))
                   (mailer/send-team-notification msg-body))
           :reminder-alert (mailer/send-reminder-alert msg-body)
           :reminder-notification (mailer/send-reminder-notification msg-body)


resolve conflicts

resolve conflicts

--- src/ophion/aleph.clj
+++ src/ophion/aleph.clj
@@ -107,12 +107,6 @@
    :headers {"content-type" "application/json"}
    :body "found"})

-(defn edge-query-handler
-  [graph request]
-  {:status 200
-   :headers {"content-type" "application/json"}
-   :body "found"})
-
 (defn parse-int
   ([n] (parse-int n 0))
   ([n default]


Removed global memoization from move modes

and changed the move-modes functions to return functions instead. This
allows us to create local, memoized functions.

Signed-off-by: Daniel Borchmann <25857343a15bf1edafebc2912e82ecf775c585c1@mailbox.tu-dresden.de>

--- src/conexp/graphics/draw.clj
+++ src/conexp/graphics/draw.clj
@@ -64,8 +64,8 @@

 ;; editor features

-(declare single-move, ideal-move, filter-move, chain-move,
-	 infimum-additive-move, supremum-additive-move)
+(declare single-move-mode, ideal-move-mode, filter-move-mode, chain-move-mode,
+	 infimum-additive-move-mode, supremum-additive-move-mode)

 (defn- change-parameters
   "Installs parameter list which influences lattice drawing."
@@ -109,14 +109,14 @@
 			       (layout-fn (lattice (get-layout-from-scene scn)))))))))

   ;; move mode (ideal, filter, chain, single)
-  (let [move-modes {"single" single-move,
-		    "ideal"  ideal-move,
-		    "filter" filter-move,
-		    "chain"  chain-move,
-		    "inf"    infimum-additive-move,
-		    "sup"    supremum-additive-move}
+  (let [move-modes {"single" (single-move-mode),
+		    "ideal"  (ideal-move-mode),
+		    "filter" (filter-move-mode),
+		    "chain"  (chain-move-mode),
+		    "inf"    (infimum-additive-move-mode),
+		    "sup"    (supremum-additive-move-mode)}
 	#^JComboBox combo-box (make-combo-box buttons (keys move-modes)),
-	current-move-mode (atom single-move)]
+	current-move-mode (atom (move-modes "single"))]
     (add-callback-for-hook scn :move-drag
 			   (fn [node dx dy]
 			     (@current-move-mode node dx dy)))
@@ -127,60 +127,58 @@
 			     (reset! current-move-mode move-mode)))))
   nil)

-(defn- single-move
+(defn- single-move-mode
   "Moves the single node only."
-  [node dx dy]
-  nil)
+  []
+  (fn [node dx dy]
+    nil))

 (defn- neighbor-move-mode
   "Moves nodes neighbored to node by [dx dy]."
-  [neighbors node dx dy]
-  (do-swing
-   (doseq [n (neighbors node)]
-     (move-node-by n dx dy))))
-
-(def all-nodes-above* (memoize all-nodes-above))
-
-(defn- ideal-move
+  [neighbors]
+  (fn [node dx dy]
+    (do-swing
+     (doseq [n (neighbors node)]
+       (move-node-by n dx dy)))))
+
+(defn- ideal-move-mode
   "Moves all nodes below the current node."
-  [node dx dy]
-  (neighbor-move-mode all-nodes-above* node dx dy))
-
-(def all-nodes-below* (memoize all-nodes-below))
-
-(defn- filter-move
+  []
+  (neighbor-move-mode (memoize all-nodes-above)))
+
+(defn- filter-move-mode
   "Moves all nodes above the current node."
-  [node dx dy]
-  (neighbor-move-mode all-nodes-below* node dx dy))
-
-(defn- chain-move
+  []
+  (neighbor-move-mode (memoize all-nodes-below)))
+
+(defn- chain-move-mode
   "Combined ideal and filter move mode."
-  [node dx dy]
-  (ideal-move node dx dy)
-  (filter-move node dx dy))
-
-(defn- additive-move
+  []
+  (let [ideal (ideal-move),
+	filter (filter-move)]
+    (fn [node dx dy]
+      (ideal node dx dy)
+      (filter node dx dy))))
+
+(defn- additive-move-mode
   "Abstract move mode for moving nodes according to additive
   influence."
-  [influenced-nodes dx dy]
-  (do-swing
-   (doseq [[n weight] influenced-nodes]
-     (with-doubles [dx dy weight]
-       (move-node-by n (* dx weight) (* dy weight))))))
-
-(def all-inf-add-influenced-nodes* all-inf-add-influenced-nodes)
-
-(defn- infimum-additive-move
+  [influenced-nodes]
+  (fn [node dx dy]
+    (do-swing
+     (doseq [[n weight] (influenced-nodes node)]
+       (with-doubles [dx dy weight]
+	 (move-node-by n (* dx weight) (* dy weight)))))))
+
+(defn- infimum-additive-move-mode
   "Moves all nodes infimum-additively with node."
-  [node dx dy]
-  (additive-move (all-inf-add-influenced-nodes* node) dx dy))
-
-(def all-sup-add-influenced-nodes* all-sup-add-influenced-nodes)
-
-(defn- supremum-additive-move
+  []
+  (additive-move (memoize all-inf-add-influenced-nodes)))
+
+(defn- supremum-additive-move-mode
   "Moves all nodes supremum-additively with node."
-  [node dx dy]
-  (additive-move (all-sup-add-influenced-nodes* node) dx dy))
+  []
+  (additive-move (memoize all-sup-add-influenced-nodes)))

 ;; improve with force layout


Fix bad merge which set window-width back to a value

Fixes #90

--- src/day8/re_frame/trace.cljs
+++ src/day8/re_frame/trace.cljs
@@ -305,7 +305,7 @@
         dragging?         (r/atom false)
         pin-to-bottom?    (r/atom true)
         selected-tab      (r/atom (localstorage/get "selected-tab" :traces))
-        window-width      js/window.innerWidth
+        window-width      (r/atom js/window.innerWidth)
         handle-window-resize (fn [e]
                                ;; N.B. I don't think this should be a perf bottleneck.
                                (reset! window-width js/window.innerWidth))


Fix docstrings

Fix docstrings

--- src/play_clj/core_graphics.clj
+++ src/play_clj/core_graphics.clj
@@ -245,9 +245,9 @@
   "Returns a map with the provided x,y,z values converted from screen to window
 coordinates.

-    (screen->window 10 10)
-    (screen->window 10 10 0)
-    (screen->window {:x 10 :y 10 :z 0})"
+    (screen->window screen 10 10)
+    (screen->window screen 10 10 0)
+    (screen->window screen {:x 10 :y 10 :z 0})"
   ([screen {:keys [x y z] :or {x 0 y 0 z 0} :as entity}]
     (let [^Camera camera (u/get-obj screen :camera)
           coords (m/vector-3 x y z)]
@@ -265,9 +265,9 @@
   "Returns a map with the provided x,y,z values converted from window to screen
 coordinates.

-    (window->screen 10 10)
-    (window->screen 10 10 0)
-    (window->screen {:x 10 :y 10 :z 0})"
+    (window->screen screen 10 10)
+    (window->screen screen 10 10 0)
+    (window->screen screen {:x 10 :y 10 :z 0})"
   ([screen {:keys [x y z] :or {x 0 y 0 z 0} :as entity}]
     (let [^Camera camera (u/get-obj screen :camera)
           coords (m/vector-3 x y z)]


New Problems added - "Greatest Common Divisor" and "Prime Numbers"

--- src/foreclojure/data_set.clj
+++ src/foreclojure/data_set.clj
@@ -685,7 +685,30 @@
                                    list? seq? map? set? getClass])})

       (insert! :problems
-           {:_id 66
+          {:_id 66
+           :title "Greatest Common Divisor"
+           :times-solved 0
+           :description "Given two integers, write a function which
+returns the greatest common divisor."
+           :tags ["easy"]
+           :tests ["(= (__ 2 4) 2)"
+                   "(= (__ 10 5) 5)"
+                   "(= (__ 5 7) 1)"
+                   "(= (__ 1023 858) 33)"]})
+
+      (insert! :problems
+          {:_id 67
+           :title "Prime Numbers"
+           :times-solved 0
+           :description "Write a function which returns the first x
+number of prime numbers."
+           :tags ["medium" "primes"]
+           :tests ["(= (__ 2) [2 3])"
+                   "(= (__ 5) [2 3 5 7 11])"
+                   "(= (last (__ 100)) 541)"]})
+
+      (insert! :problems
+           {:_id 68
             :title "Power Set"
             :times-solved 0
             :description "A power set is the set of all subsets of a given set. Given a list, produce a set of sublists while preserving the order of elements."


Renamed methods to make more sense.

Renamed methods to make more sense.

--- src/startrek/nav.clj
+++ src/startrek/nav.clj
@@ -81,7 +81,7 @@
          (get-in enterprise [:sector])
          (map #(* (* 8 factor) %) dir-vec))))

-(defn enter-sector [game-state]
+(defn enter-quadrant [game-state]
   ; ensure good sector/quadrant coords
   (let [sector (->> (get-in @game-state [:enterprise :sector])
                             (map #(max % 1))
@@ -97,7 +97,7 @@
     (w/init-sector game-state)))

-(defn- leave-sector [game-state factor coord dir-vec]
+(defn- leave-quadrant [game-state factor coord dir-vec]
   ; (println "leaving quadrant")
   (let [place (warp-travel-distance (get-in @game-state [:enterprise])
                                     factor
@@ -120,7 +120,7 @@
       (swap! game-state update-in [:enterprise] merge updates)
       (when (> factor 1)
         (swap! game-state update-in [:stardate :start] inc))))
-  (enter-sector game-state))
+  (enter-quadrant game-state))

 (defn move [game-state course factor]
   (let [n (int (* factor 8))
@@ -134,7 +134,7 @@
           dir-vec [(Math/cos polar) (Math/sin polar)]]
       (loop [p (map + coord dir-vec) i n]
         (cond
-          (leave-sector? p) (leave-sector game-state factor coord dir-vec)
+          (leave-sector? p) (leave-quadrant game-state factor coord dir-vec)
           (hit-item? (get-in @game-state [:current-sector]) p) (bad-nav game-state factor p dir-vec)
           (<= i 0 ) (set-sector-position game-state factor p)
           :else (recur (map + p dir-vec) (dec i))))


rename mutating functions with exclamation point

--- src/t3tr0s/core.cljs
+++ src/t3tr0s/core.cljs
@@ -70,44 +70,45 @@
   []
   (println (board-str (:board @state))))

-(defn write-to-board
+(defn write-to-board!
   "Writes a given value to the x,y position on the board."
   [ x y value ]
   (if (and (<= 0 x 9) (<= 0 y 21))
     (swap! state assoc-in [:board y x] value)))

-(defn write-coord-to-board
+(defn write-coord-to-board!
   [[cx cy] x y]
-    (write-to-board (+ cx x) (+ cy y) 1))
+    (write-to-board! (+ cx x) (+ cy y) 1))

-(defn write-piece-to-board
+(defn write-piece-to-board!
   "Writes a given piece to the board."
   [piece x y]
-  (doall (map #(write-coord-to-board % x y) piece)))
+  (doall (map #(write-coord-to-board! % x y) piece)))

-(defn clear-board
+(defn clear-board!
   "Clears the board."
   []
   (swap! state assoc :board empty-board))

-(defn rotate-piece [piece]
-  (doall (map (fn [[x y]] [(- y) x]) piece))
-  )
+(defn rotate-piece
+  "Create a new piece by rotating the given piece clockwise."
+  [piece]
+  (doall (map (fn [[x y]] [(- y) x]) piece)))

-(defn test-rotate-piece
+(defn test-rotate-piece!
   "Clear the board, write the piece at 5, 9, rotate the piece, write the piece at 5, 1,
     print the board."
   [piece-key]
-  (clear-board)
-  (write-piece-to-board (piece-key pieces) 5 9)
-  (write-piece-to-board (rotate-piece (piece-key pieces)) 5 1)
+  (clear-board!)
+  (write-piece-to-board! (piece-key pieces) 5 9)
+  (write-piece-to-board! (rotate-piece (piece-key pieces)) 5 1)
   (print-board))

-(defn test-piece
+(defn test-piece!
   "Clear the board, write a piece at 5,9, and print it."
   [piece-key]
-  (clear-board)
-  (write-piece-to-board (piece-key pieces) 5 9)
+  (clear-board!)
+  (write-piece-to-board! (piece-key pieces) 5 9)
   (print-board))

 (defn init []


better image scaling

better image scaling

--- src/unspun/core.cljs
+++ src/unspun/core.cljs
@@ -18,9 +18,9 @@

 (defonce app-state (atom {:brand "Winton Centre"}))

-(def page-style {:flex 1
+(def page-style {
                  :marginLeft      0
-                 :paddingLeft 10
+                 :padding 0
                  :alignItems      "center"
                  :justifyContent "space-around"
                  :backgroundColor (:primary app-palette)})
@@ -32,16 +32,16 @@

 (defc AppRoot < rum/reactive [state]
-  (view {:style page-style}
-        (text {:style (merge {:paddingTop 80} brand-style)}
+  (view {:fill 1 :style page-style}
+        (text {:style (merge {:paddingTop 40} brand-style)}
               (:brand @state))
-        (view {:justifyContent "center" :style {:flexDirection "row" }}
-              (view (:style {:flexDirection "column" :textAlign "center"})
-                    (image {:source logo-img
-                            :style  {:transform [{:scale 0.5}]
-                                     }
-                            })))
-        (touchable-highlight {:style   {:marginBottom 40
+        (image {:source logo-img
+
+                :style  {:transform [{:scale 0.3}]
+
+                         }
+                })
+        (touchable-highlight {:style   {
                                         :backgroundColor (:accent app-palette)
                                         :padding         10
                                         :borderRadius    30 :height 60 :width 60


Fomratting tweak

Fomratting tweak

--- fulcro-todo/src/dev/cljs/user.cljs
+++ fulcro-todo/src/dev/cljs/user.cljs
@@ -1,8 +1,7 @@
 (ns cljs.user
-  (:require
-   [app.ui :as ui]
-   [app.core :as core]
-   [fulcro.client.core :as fc]))
+  (:require [app.ui :as ui]
+            [app.core :as core]
+            [fulcro.client.core :as fc]))

 (defn refresh [] (swap! core/app fc/mount ui/App "app"))


remove dead option from args & call site

--- src-cljs/frontend/components/build_head.cljs
+++ src-cljs/frontend/components/build_head.cljs
@@ -274,7 +274,7 @@
                                     :ancestors-closed? (or (:ancestors-closed? opts) closed?))})]]))
            (sort-by first artifacts))])))))

-(defn build-artifacts-list [data owner {:keys [show-node-indices?] :as opts}]
+(defn build-artifacts-list [data owner]
   (reify
     om/IRender
     (render [_]
@@ -511,8 +511,7 @@

              :artifacts (om/build build-artifacts-list
                                   {:artifacts-data (get build-data :artifacts-data) :user user
-                                   :has-artifacts? (:has_artifacts build)}
-                                  {:opts {:show-node-indices? (< 1 (:parallel build))}})
+                                   :has-artifacts? (:has_artifacts build)})

              :config (om/build build-config {:config-string (get-in build [:circle_yml :string])})


bump transit to 0.8.225

bump transit to 0.8.225

--- cljs/project.clj
+++ cljs/project.clj
@@ -7,7 +7,7 @@
    [org.clojure/clojurescript "1.7.107"]
    [org.clojure/tools.reader "0.10.0-SNAPSHOT"]
    [org.clojure/core.async "0.1.346.0-17112a-alpha"]
-   [com.cognitect/transit-cljs "0.8.220"]
+   [com.cognitect/transit-cljs "0.8.225"]
    [re-frame "0.4.1"]
    [rewrite-cljs "0.3.1"]
    [binaryage/devtools "0.1.2"]                                                                                ; Electron 0.28.2 has old Blink, we have to stick with this old version of devtools for now