fixing some refactory bugs

fixing some refactory bugs

--- cartagena-web/src/cartagena_web/main.cljs
+++ cartagena-web/src/cartagena_web/main.cljs
@@ -120,21 +120,21 @@
   (reset! app-state response))

 (defn new-game [state]
+  (dissoc state :selected-players))
+
+(defn new-game! []
   (let [players (cond-> []
                         (get-name :black) (conj {:name (get-name :black) :color :black})
                         (get-name :blue) (conj {:name (get-name :blue) :color :blue})
                         (get-name :green) (conj {:name (get-name :green) :color :green})
                         (get-name :orange) (conj {:name (get-name :orange) :color :orange})
                         (get-name :red) (conj {:name (get-name :red) :color :red}))]
-    (dissoc state :selected-players)))
-
-(defn new-game! []
-  (swap! app-state new-game)
-  (swap! names empty-names)
-  (ajax/POST "http://localhost:3000/new-game"
-             {:params {:players (shuffle players)}
-              :handler on-new-game
-              :error-handler on-error}))
+    (swap! app-state new-game)
+    (swap! names empty-names)
+    (ajax/POST "http://localhost:3000/new-game"
+               {:params {:players (shuffle players)}
+                :handler on-new-game
+                :error-handler on-error})))

 (defn select-players [state]
   (assoc state :select-players true))
@@ -144,7 +144,7 @@

 (defn update-active-player [state response]
   (assoc state :actions-remaining (:actions-remaining response)
-         :current-player (:current-player response)))
+               :current-player (:current-player response)))

 (defn on-update-active-player [response]
   (swap! app-state update-active-player response))
@@ -196,7 +196,7 @@
               :handler on-play-card
               :error-handler on-error}))

-(defn move-back [state response]
+(defn move-back [state board response]
   (assoc state :board board
          :draw-pile (:draw-pile response)
          :discard-pile (:discard-pile response)
@@ -204,7 +204,7 @@

 (defn on-move-back [response]
   (when-let [board (:board response)]
-    (swap! app-state move-back response)
+    (swap! app-state move-back board response)
     (update-active-player! @app-state)))

 (defn move-back! [player from-space board draw-pile discard-pile]


UNNEC

UNNEC

--- src/onyx/peer/coordinator.clj
+++ src/onyx/peer/coordinator.clj
@@ -23,6 +23,8 @@
   (:import [org.apache.zookeeper KeeperException$BadVersionException]
            [java.util.concurrent.locks LockSupport]))

+(def coordinator-log (atom []))
+
 (defn input-publications [{:keys [peer-sites message-short-ids] :as replica} peer-id job-id]
   (let [allocations (get-in replica [:allocations job-id])
         input-tasks (get-in replica [:input-tasks job-id])
@@ -50,10 +52,11 @@

 (defn offer-heartbeats
   [{:keys [messenger] :as state}]
+  (swap! coordinator-log conj :offer-heartbeats)
   (run! pub/offer-heartbeat! (m/publishers messenger))
   (assoc state :last-heartbeat-time (System/nanoTime)))

-(def coordinator-backoff-ms 1)
+(def coordinator-backoff-ms 500)

 (defn offer-barriers [{:keys [messenger barrier] :as state}]
   (if (:offering? barrier)
@@ -79,10 +82,12 @@
          (throw (Exception. "Coordinator failed to write coordinates.
                              This is likely due to the coordinator being quarantined, and another coordinator taking over.")))))

+
 (defn next-replica
   [{:keys [log job-id peer-id messenger curr-replica tenancy-id] :as state}
    barrier-period-ns
    new-replica]
+  (swap! coordinator-log conj :next-replica)
   (let [curr-version (get-in curr-replica [:allocation-version job-id])
         new-version (get-in new-replica [:allocation-version job-id])
         job-reallocated? (not= curr-version new-version)]
@@ -108,6 +113,7 @@
 (defn complete-job
   [{:keys [tenancy-id log job-id messenger checkpoint group-ch] :as state}]
   (info (format "Job %s completed, and final checkpoint has finished. Writing checkpoint coordinates." job-id))
+  (swap! coordinator-log conj :complete-job)
   (let [replica-version (m/replica-version messenger)
         epoch (m/epoch messenger)]
     (let [coordinates {:tenancy-id tenancy-id
@@ -130,6 +136,7 @@

 (defn periodic-barrier
   [{:keys [tenancy-id workflow-depth log curr-replica job-id messenger barrier checkpoint] :as state}]
+  (swap! coordinator-log conj :periodic-barrier)
   (if (:offering? barrier)
     ;; No op because hasn't finished emitting last barrier, wait again
     state
@@ -162,6 +169,8 @@
            (>= (:min-epoch status) epoch))))

 (defn completed-checkpoint [{:keys [checkpoint messenger job-id tenancy-id log] :as state}]
+
+  (swap! coordinator-log conj :completed-checkpoint)
   (let [{:keys [epoch write-version]} checkpoint
         write-coordinate? (> epoch 0)
         coordinates {:tenancy-id tenancy-id
@@ -178,6 +187,7 @@
                                    :write-version next-write-version}))))

 (defn schedule-next-barrier [state barrier-period-ns]
+  (swap! coordinator-log conj :schedule-next-barrier)
   (update state :barrier merge {:scheduled? true
                                 :next-barrier-time (+ (System/nanoTime) barrier-period-ns)}))


Runs with CLJS, but has warnings.

Runs with CLJS, but has warnings.

--- test/cljc/tst/tupelo/core.cljc
+++ test/cljc/tst/tupelo/core.cljc
@@ -9,9 +9,12 @@
     [clojure.string :as str]
     [tupelo.string :as ts]

-    #?(:clj  [tupelo.core :as t :refer [spy spyx spyxx spyx-pretty  vals->map map-plain? forv glue
+    #?(:clj  [tupelo.core :as t
+              :refer [spy spyx spyxx spyx-pretty  vals->map map-plain? forv glue
                                         ]]
-       :cljs [tupelo.core :as t :include-macros true :refer [spy spyx spyxx spyx-pretty vals->map]])
+       :cljs [tupelo.core :as t :include-macros true
+              :refer [spy spyx spyxx spyx-pretty vals->map map-plain? forv glue
+                                                             ]])

     #?(:clj [clojure.test] :cljs [cljs.test])
     #?(:clj  [tupelo.test :refer [deftest testing is dotest dotest-focus isnt is= isnt= is-set= is-nonblank= throws? throws-not? define-fixture]]
@@ -175,30 +178,6 @@
      1 11
      2 12
      3 13}))
-
-(dotest ; #todo => tupelo.core
-  (is= (t/with-cum-vector
-         (dotimes [ii 5]
-           (t/cum-vector-append ii)))
-    [0 1 2 3 4])
-  (let [ff (fn ff-fn [n]
-             (when (t/nonneg? n)
-               (t/cum-vector-append n)
-               (ff-fn (dec n))))]
-    (is= (t/with-cum-vector (ff 5))
-      [5 4 3 2 1 0]))
-  ; It will even work across multiple futures:  https://clojure.org/reference/vars#conveyance
-  (let [N     10
-        randy (fn [n]
-                (Thread/sleep (int (+ 50 (* 50 (Math/random)))))
-                (t/cum-vector-append n)
-                n)
-        nums  (t/with-cum-vector
-                (let [futures     (forv [ii (range N)]
-                                    (future (randy ii)))
-                      future-vals (forv [future futures] @future)] ; wait for all futures to finish
-                  (is= future-vals (range N))))] ; in order of creation
-    (is-set= nums (range N)))) ; nums is in random order

 (dotest
@@ -2907,7 +2886,8 @@
 ;***************************************************************************************************
 ;***************************************************************************************************
 ;***************************************************************************************************
-#?(:clj (do
+#?(:clj
+   (do

           (dotest
             (binding [*clojure-version* {:major 1 :minor 7}]
@@ -3204,5 +3184,30 @@
             (isnt (t/macro? 'if)))

+          (dotest ; #todo => tupelo.core
+            (is= (t/with-cum-vector
+                   (dotimes [ii 5]
+                     (t/cum-vector-append ii)))
+              [0 1 2 3 4])
+            (let [ff (fn ff-fn [n]
+                       (when (t/nonneg? n)
+                         (t/cum-vector-append n)
+                         (ff-fn (dec n))))]
+              (is= (t/with-cum-vector (ff 5))
+                [5 4 3 2 1 0]))
+            ; It will even work across multiple futures:  https://clojure.org/reference/vars#conveyance
+            (let [N     10
+                  randy (fn [n]
+                          (Thread/sleep (int (+ 50 (* 50 (Math/random)))))
+                          (t/cum-vector-append n)
+                          n)
+                  nums  (t/with-cum-vector
+                          (let [futures     (forv [ii (range N)]
+                                              (future (randy ii)))
+                                future-vals (forv [future futures] @future)] ; wait for all futures to finish
+                            (is= future-vals (range N))))] ; in order of creation
+              (is-set= nums (range N)))) ; nums is in random order
+
+
           ))


Add tests for when all shotgun requests are rejeceted

--- test/clojure/patterns_test.clj
+++ test/clojure/patterns_test.clj
@@ -96,17 +96,17 @@
                                    :service3 service3}
                                   2
                                   {})
-        action-blocking-latch (CountDownLatch. 1)
-        test-blocking-latch (CountDownLatch. 1)
+        action-blocking-latch (atom (CountDownLatch. 1))
+        test-blocking-latch (atom (CountDownLatch. 1))
         counter (atom 0)
         inc-fn (fn [current]
                  (if (= 1 current)
-                   (do (.await action-blocking-latch)
+                   (do (.await ^CountDownLatch @action-blocking-latch)
                        (inc current))
                    (inc current)))
         action-fn (fn [] (let [result (swap! counter inc-fn)]
                            (when (= result 2)
-                             (.countDown test-blocking-latch))
+                             (.countDown ^CountDownLatch @test-blocking-latch))
                            result))]
     (testing "Actions submitted to multiple services"
       (is (= 1
@@ -115,35 +115,70 @@
                                            :service2 action-fn
                                            :service3 action-fn}
                                           Long/MAX_VALUE)))
-      (.countDown action-blocking-latch)
-      (.await test-blocking-latch)
+      (.countDown ^CountDownLatch @action-blocking-latch)
+      (.await ^CountDownLatch @test-blocking-latch)
       (is (= 2 @counter))

       (reset! counter 0)
+      (reset! action-blocking-latch (CountDownLatch. 1))
+      (reset! test-blocking-latch (CountDownLatch. 1))
       (is (= 1
              @(patterns/submit-action shotgun
                                       (fn [_] (action-fn))
                                       Long/MAX_VALUE)))
-      (.countDown action-blocking-latch)
-      (.await test-blocking-latch)
+      (.countDown ^CountDownLatch @action-blocking-latch)
+      (.await ^CountDownLatch @test-blocking-latch)
       (is (= 2 @counter)))
     (testing "Result is from the the first services to response"
       (reset! counter 0)
+      (reset! action-blocking-latch (CountDownLatch. 1))
+      (reset! test-blocking-latch (CountDownLatch. 1))
       (let [f (patterns/submit-action-map shotgun
                                           {:service1 action-fn
                                            :service2 action-fn
                                            :service3 action-fn}
                                           Long/MAX_VALUE)]
         @f
-        (.countDown action-blocking-latch)
-        (.await test-blocking-latch)
-        (is (= 1 @f))
+        (.countDown ^CountDownLatch @action-blocking-latch)
+        (.await ^CountDownLatch @test-blocking-latch)
+        (is (= 1 @f)))
+
+      (reset! counter 0)
+      (reset! action-blocking-latch (CountDownLatch. 1))
+      (reset! test-blocking-latch (CountDownLatch. 1))
+      (let [f (patterns/submit-action shotgun
+                                      (fn [_] (action-fn))
+                                      Long/MAX_VALUE)]
+        @f
+        (.countDown ^CountDownLatch @action-blocking-latch)
+        (.await ^CountDownLatch @test-blocking-latch)
+        (is (= 1 @f))))
+    (testing "Nil returned if all services reject action"
+      (reset! counter 0)
+      (reset! action-blocking-latch (CountDownLatch. 1))
+      (reset! test-blocking-latch (CountDownLatch. 1))
+      (let [shotgun (patterns/shotgun {:service1 service1
+                                       :service2 service2
+                                       :service3 service3}
+                                      3
+                                      {})
+            action-fn (fn [_] (.await ^CountDownLatch @action-blocking-latch))
+            action-map-fn (partial action-fn nil)]
+        (is (not (nil? (patterns/submit-action shotgun action-fn Long/MAX_VALUE))))
+        (is (nil? (patterns/submit-action shotgun action-fn Long/MAX_VALUE)))
+        (.countDown ^CountDownLatch @action-blocking-latch)

         (reset! counter 0)
-        (let [f (patterns/submit-action shotgun
-                                        (fn [_] (action-fn))
-                                        Long/MAX_VALUE)]
-          @f
-          (.countDown action-blocking-latch)
-          (.await test-blocking-latch)
-          (is (= 1 @f)))))))+        (reset! action-blocking-latch (CountDownLatch. 1))
+        (reset! test-blocking-latch (CountDownLatch. 1))
+        (is (not (nil? (patterns/submit-action-map shotgun
+                                                   {:service1 action-map-fn
+                                                    :service2 action-map-fn
+                                                    :service3 action-map-fn}
+                                                   Long/MAX_VALUE))))
+        (is (nil? (patterns/submit-action-map shotgun
+                                              {:service1 action-map-fn
+                                               :service2 action-map-fn
+                                               :service3 action-map-fn}
+                                              Long/MAX_VALUE)))
+        (.countDown ^CountDownLatch @action-blocking-latch)))))


maybe make use of specter

maybe make use of specter

--- clojure/src/dnd/core.cljs
+++ clojure/src/dnd/core.cljs
@@ -6,6 +6,9 @@
     [ dnd.character :as character]
     [ dnd.showScreen :as show ]
     [ dnd.keyboard :as keyboard ]
+    [com.rpl.specter :as s
+     :refer [FIRST]
+     :refer-macros [select transform setval]]
     )
   (:require-macros
     [cljs.core.async.macros :as m :refer [go-loop]]))


Remove file-attribute tests specific to OS X

--- planck-cljs/test/planck/io_test.cljs
+++ planck-cljs/test/planck/io_test.cljs
@@ -19,12 +19,7 @@
     (is (string? (:gname (planck.io/file-attributes "/tmp"))))
     (is (= js/Date (type (:created (planck.io/file-attributes "/tmp")))))
     (is (= js/Date (type (:modified (planck.io/file-attributes "/tmp")))))
-    (is (number? (:creator-code (planck.io/file-attributes "/tmp"))))
-    (is (number? (:type-code (planck.io/file-attributes "/tmp"))))
-    (is (number? (:file-size (planck.io/file-attributes "/tmp"))))
-    (let [extension-hidden (:extension-hidden (planck.io/file-attributes "/tmp"))]
-      (is (or (true? extension-hidden)
-              (false? extension-hidden))))))
+    (is (number? (:file-size (planck.io/file-attributes "/tmp"))))))

 (deftest coercions
   (testing "as-file coerceions"


shorthand inline functions

shorthand inline functions

--- cljx/plongeur-cljs/src/plongeur/view.cljs
+++ cljx/plongeur-cljs/src/plongeur/view.cljs
@@ -1,10 +1,14 @@
 (ns plongeur.view
   (:require [cljs.core.async :as a :refer [>! chan pipe]]
             [quiescent.core :as q :include-macros true :refer-macros [defcomponent]]
+            [cljsjs.material-ui]
             [sablono.core :refer-macros [html]]
             [plongeur.model :as m]
             [plongeur.sigma-driver :as s])
   (:require-macros [cljs.core.async.macros :refer [go]]))
+
+#_(def ^:dynamic *mui-theme*
+  (.getMuiTheme js/MaterialUI.Styles.ThemeManager))

 (def node-1 {:id "n1"
              :label "hello"
@@ -29,8 +33,8 @@
   [state {:keys [add-graph debug] :as intent-chans}]
   (html [:div {:id "plongeur-main"}
          [:h1 {} "Bonjour, ici Plongeur"]
-         [:button {:on-click (fn [_] (go (>! debug :click)))} "print state"]
-         [:button {:on-click (fn [_] (go (>! add-graph :click)))} "add graph"]
+         [:button {:on-click #(go (>! debug :click))} "print state"]
+         [:button {:on-click #(go (>! add-graph :click))} "add graph"]
          (for [graph-state (m/graphs state)]
            (Sigma graph-state intent-chans))]))


azulenoids.clj: first shot of a Clojure version of the traversal function.

--- clojure/org/gavrog/clojure/azulenoids.clj
+++ clojure/org/gavrog/clojure/azulenoids.clj
@@ -58,6 +58,29 @@
   ([ds]
     (curvature ds 0)))

+(defn traversal [ds indices seeds]
+  (let [stacks (map (fn [i] [i ()]) (take 2 indices))
+        queues (map (fn [i] [i []]) (drop 2 indices))
+        op (fn [i D] (if D (.op ds i D) nil))]
+    ((fn collect [seeds-left next seen]
+       (let [tmp (map (fn [[k d]] [k (drop-while #(seen [% k]) d)]) next)
+             r (first (filter (comp seq second) tmp))]
+         (if r
+           (let [[i [D & s]] r
+                 new-next (map (fn [[k x]]
+                                 [k (if (= k i) s (conj x (op k D)))])
+                               tmp)
+                 new-seen (into seen [[D] [D i] [(op i D) i]])]
+             (lazy-seq
+               (conj (collect seeds-left new-next new-seen) [D i])))
+           (if-let [D (first (filter (comp not seen) seeds-left))]
+             (let [new-next (map (fn [[k x]] [k (conj x (op k D))]) tmp)
+                   new-seen (conj seen D)]
+               (lazy-seq
+                 (conj (collect (rest seeds-left) new-next new-seen) [D])))
+             ()))))
+      (seq seeds) (doall (concat stacks queues)) #{})))
+
 ;; Azulenoid-specific functions

 (def template


Remove unused refer.

Remove unused refer.

--- src/re_frame/interceptor.cljc
+++ src/re_frame/interceptor.cljc
@@ -1,7 +1,7 @@
 (ns re-frame.interceptor
   (:require
     [re-frame.loggers :refer [console]]
-    [re-frame.interop :refer [ratom? empty-queue debug-enabled?]]))
+    [re-frame.interop :refer [empty-queue debug-enabled?]]))

 (def mandatory-interceptor-keys #{:id :after :before})


adjust ServiceEquiv so riemann will reload udp-server if so-rcvbuf changes

--- src/riemann/transport/udp.clj
+++ src/riemann/transport/udp.clj
@@ -67,12 +67,14 @@
   ; TODO compare pipeline-factory!
   (equiv? [this other]
           (and (instance? UDPServer other)
+               (= so-rcvbuf (:so-rcvbuf other))
                (= host (:host other))
                (= port (:port other))))

   Service
   (conflict? [this other]
              (and (instance? UDPServer other)
+                  (= so-rcvbuf (:so-rcvbuf other))
                   (= host (:host other))
                   (= port (:port other))))


Ensure fixtures run appropriately

Ensure fixtures run appropriately

As noted in a leiningen issue[1], overriding test-var isn't an
appropriate filtering approach, as it doesn't stop fixtures from
running for the filtered-out tests. They pointed to a Clojure
issue[2] that added the test-vars fn, which runs the fixtures
only for the vars you pass in. However, they indicated later in
that thread that while they waited for that issue to be resolved
(which it is now), they would just remove the :test metadata from
the vars. I haven't looked to confirm which approach they took,
so not sure if I'm being consistent. The only drawback seems to
be the lack of support fo the :test-ns-hook feature that allows
you to control order. This doesn't seem like that great of a
feature anyway, so I'm not too bothered.

[1] https://github.com/technomancy/leiningen/issues/1269
[2] http://dev.clojure.org/jira/browse/CLJ-866

--- jupiter-engine-clojure.test/src/main/resources/org/ajoberstar/jupiter/engine/clojure_test/execution.clj
+++ jupiter-engine-clojure.test/src/main/resources/org/ajoberstar/jupiter/engine/clojure_test/execution.clj
@@ -52,15 +52,10 @@

 (defmethod listener-report :default [_] nil)

-(defn filtering-test-var [real-test-var]
-  (fn [v]
-    (if (contains? *descs* v)
-      (real-test-var v))))
-
 (defn execute-tests [^EngineDescriptor descriptor ^EngineExecutionListener listener]
   (binding [*listener* listener
             *descs* (descriptors descriptor)
             *current-desc* (atom nil)
-            test/test-var (filtering-test-var test/test-var)
             test/report listener-report]
-    (test/run-all-tests)))
+    (let [selected-vars (keys *descs*)]
+      (test/test-vars selected-vars))))


verify handler case as well

verify handler case as well

--- test/transit/integer/test.cljs
+++ test/transit/integer/test.cljs
@@ -11,4 +11,17 @@
 (let [arr (.read r "[\"~i1\"]")]
   (assert (= (.toString (.shiftLeft (aget arr 0) 16)) "65536")))

+(deftype IntegerHandler []
+  Object
+  (tag [_ v] "i")
+  (rep [_ v] (.toString v))
+  (stringRep [_ v] (.toString v)))
+
+(def w (t/writer "json"
+         #js {"handlers"
+              #js [Long (IntegerHandler.)]}))
+
+(let [arr (.read r "[\"~i1\"]")]
+  (assert (= (.write w (.shiftLeft (aget arr 0) 16)) "{\"~#'\":\"~i65536\"}")))
+
 (println "ok")


cake tasks cleanup

cake tasks cleanup

--- tasks.clj
+++ tasks.clj
@@ -1,13 +1,12 @@
 (ns tasks
   (:use [cake.core :only [deftask]]
         [cake.file :only [file rm rmdir]]
-        [bake.core :only [log]]
-        [uncle.core :only [ant args env add-zipfileset]]
-        [cake.utils :only [os-name os-arch]])
+        [bake.core :only [log os-name os-arch]]
+        [uncle.core :only [ant args env add-zipfileset]])
   (:import [org.apache.tools.ant.taskdefs Copy ExecTask Replace]))

-(def tokyocabinet      "tokyocabinet-1.4.45")
-(def tokyocabinet-java "tokyocabinet-java-1.23")
+(def tokyocabinet      "tokyocabinet")
+(def tokyocabinet-java "tokyocabinet-java")

 (defn clean [srcdir]
   (when (.exists (file srcdir "Makefile"))
@@ -29,32 +28,35 @@
           (ant Replace {:file (file src "Makefile") :token token :value (str token " " rpath)}))))

 (deftask compile-native
-  (when-not (.exists (file "build" "native"))
-    (log (format "Compiling tokyocabinet for %s/%s" (os-name) (os-arch)))
-    (let [dest    (.getPath (file "build" "native"))
-          prefix  (str "--prefix=" dest)
-          classes (file "classes")
-          arch    (case (os-arch) "x86_64" "-m64" "x86" "-m32" "")]
-      (let [src (file "src" tokyocabinet)]
-        (ant ExecTask {:executable "./configure" :dir src :failonerror true}
-             (args prefix)
-             (env {"CFLAGS" arch "LDFLAGS" arch}))
-        (fix-install-path src "tokyocabinet")
-        (ant ExecTask {:executable "make" :dir src :failonerror true})
-        (ant ExecTask {:executable "make" :dir src :failonerror true}
-             (args "install")))
-      (let [cflags (format " %s -I%s/include -L%s/lib " arch dest dest)
-            src    (file "src" tokyocabinet-java)]
-        (ant ExecTask {:executable "./configure" :dir src :failonerror true}
-             (args prefix)
-             (env {"JAVA_HOME" (System/getProperty "java.home") "CFLAGS" cflags}))
-        (let [token "\nCFLAGS ="]  ; hack because configure doesn't set CFLAGS correctly in Makefile
-          (ant Replace {:file (file src "Makefile") :token token :value (str token " " cflags)}))
-        (fix-install-path src "jtokyocabinet")
-        (ant ExecTask {:executable "make" :dir src :failonerror true})
-        (ant ExecTask {:executable "make" :dir src :failonerror true}
-             (args "install")))
-      (ant Copy {:todir classes}
-           (add-zipfileset {:src (str dest "/lib/tokyocabinet.jar") :includes "**/*.class"}))
-      (rm (file dest "lib/tokyocabinet.jar"))
-      (rmdir (file dest "lib/pkgconfig")))))
+  (let [os-name (os-name)
+        os-arch (os-arch)
+        dest    (file "build" "native" os-name os-arch)]
+    (when-not (.exists dest)
+      (log (format "Compiling tokyocabinet for %s/%s" os-name os-arch))
+      (let [dest    (.getPath dest)
+            prefix  (str "--prefix=" dest)
+            classes (file "classes")
+            arch    (case os-arch "x86_64" "-m64" "x86" "-m32" "")]
+        (let [src (file "src" tokyocabinet)]
+          (ant ExecTask {:executable "./configure" :dir src :failonerror true}
+               (args prefix)
+               (env {"CFLAGS" arch "LDFLAGS" arch}))
+          (fix-install-path src "tokyocabinet")
+          (ant ExecTask {:executable "make" :dir src :failonerror true})
+          (ant ExecTask {:executable "make" :dir src :failonerror true}
+               (args "install")))
+        (let [cflags (format " %s -I%s/include -L%s/lib " arch dest dest)
+              src    (file "src" tokyocabinet-java)]
+          (ant ExecTask {:executable "./configure" :dir src :failonerror true}
+               (args prefix)
+               (env {"JAVA_HOME" (System/getProperty "java.home") "CFLAGS" cflags}))
+          (let [token "\nCFLAGS ="] ; hack because configure doesn't set CFLAGS correctly in Makefile
+            (ant Replace {:file (file src "Makefile") :token token :value (str token " " cflags)}))
+          (fix-install-path src "jtokyocabinet")
+          (ant ExecTask {:executable "make" :dir src :failonerror true})
+          (ant ExecTask {:executable "make" :dir src :failonerror true}
+               (args "install")))
+        (ant Copy {:todir classes}
+             (add-zipfileset {:src (str dest "/lib/tokyocabinet.jar") :includes "**/*.class"}))
+        (rm (file dest "lib/tokyocabinet.jar"))
+        (rmdir (file dest "lib/pkgconfig"))))))


fix replay for doc names

fix replay for doc names

--- src-cljs/frontend/controllers/navigation.cljs
+++ src-cljs/frontend/controllers/navigation.cljs
@@ -146,7 +146,8 @@
                                                              (doc-model/all @db))))))))))

 (defn maybe-replace-doc-token [current-state]
-  (let [path (.getPath (goog.Uri. js/window.location))
+  (let [url (goog.Uri. js/window.location)
+        path (.getPath url)
         ;; duplicated in controls/replace-token-with-new-name
         current-url-name (second (re-find #"^/document/([A-Za-z0-9_-]*?)-{0,1}\d+(/.*$|$)" path))
         doc (doc-model/find-by-id @(:db current-state)
@@ -162,7 +163,9 @@
       (let [[_ before-name after-name] (re-find #"^(/document/)[A-Za-z0-9_-]*?-{0,1}(\d+(/.*$|$))" path)
             new-path (str before-name new-url-name "-" after-name)]
         (put! (get-in current-state [:comms :nav]) [:navigate! {:replace-token? true
-                                                                :path new-path}])))))
+                                                                :path (str new-path
+                                                                           (when (seq (.getQuery url))
+                                                                             (str "?" (.getQuery url))))}])))))

 (defn handle-post-doc-navigation [navigation-point args previous-state current-state]
   (let [sente-state (:sente current-state)


Correct drop-handling before/after pages.

--- src-cljs/pepa/workflows/inbox2.cljs
+++ src-cljs/pepa/workflows/inbox2.cljs
@@ -27,7 +27,7 @@
   (remove-pages! [_ state page-ids]))

 (defprotocol ColumnDropTarget
-  (accept-drop!  [_ state pages target-idx]))
+  (accept-drop! [_ state pages target-idx]))

 (defrecord InboxColumnSource [id]
   ColumnSource
@@ -95,24 +95,32 @@
     (assert (number? document-id))
     (api/fetch-documents! [document-id])))

+(defn- inbox-page-drag-over [page owner store-idx! e]
+  ;; Calculcate the center position for this image and set idx to the
+  ;; current page or the page after, respectively
+  (let [rect (.getBoundingClientRect (.-currentTarget e))
+        top (.-top rect)
+        height (.-height rect)
+        local (Math/abs (- (.-clientY e) top))
+        idx (if (>= (/ height 2) local)
+              (:idx page)
+              (inc (:idx page)))]
+    (store-idx! idx)))
+
 ;;; NOTE: We need on-drag-start in `inbox-column' and in
 ;;; `inbox-column-page' (the latter to handle selection-updates when
 ;;; dragging). We bubble it from `inbox-column-page', adding its own
 ;;; `:id' and use that id to update the selection information.
 (ui/defcomponent inbox-column-page [page owner {:keys [page-click! store-idx!]}]
-  (render-state [_ {:keys [dragover?]}]
+  (render [_]
     [:li.page {:draggable true
                :class (let [selected? (:selected? page)]
                         [(when selected? "selected")
-                         (when (and (not selected?) dragover?) "dragover")])
+                         (when (and (not selected?) (:dragover? page)) "dragover")])
                :on-drag-start (fn [e]
                                 (println "inbox-column-page")
                                 (.setData e.dataTransfer "application/x-pepa-page" (:id page)))
-               :on-drag-over (fn [e]
-                                (store-idx! (:idx page))
-                                (om/set-state! owner :dragover? true))
-               :on-drag-leave #(om/set-state! owner :dragover? false)
-               :on-drop #(om/set-state! owner :dragover? false)
+               :on-drag-over (partial inbox-page-drag-over page owner store-idx!)
                :on-click (fn [e]
                            (page-click!
                             (selection/event->click (:id page) e))
@@ -179,6 +187,8 @@
                                  (.preventDefault e)))
                :on-drag-start (partial column-drag-start state column owner)
                :on-drag-end (fn [_] (println "on-drag-end"))
+               ;; Reset this columns drop-idx to clear the marker
+               :on-drag-leave (fn [_] (om/set-state! owner :drop-idx nil))
                :on-drop (fn [e]
                           (println "on-drop")
                           (let [source-column (get-transfer-data e "application/x-pepa-column")
@@ -187,7 +197,9 @@
                             (handle-drop! (:id column)
                                           source-column
                                           page-ids
-                                          drop-idx)))}
+                                          drop-idx))
+                          ;; Remove drop-target
+                          (om/set-state! owner :drop-idx nil))}
      [:header (column-title column state)]
      [:ul.pages
       (let [pages (map-indexed (fn [idx page] (assoc page :idx idx))
@@ -199,7 +211,9 @@
                               :store-idx! (fn [idx]
                                             (om/set-state! owner :drop-idx idx))}
                        :fn (fn [page]
-                             (mark-page-selected page (:selected selection)))}))]]))
+                             (-> page
+                                 (assoc :dragover? (= drop-idx (:idx page) ))
+                                 (mark-page-selected (:selected selection))))}))]]))

 (defn ^:private inbox-handle-drop! [state owner page-cache target source page-ids target-idx]
   (let [columns (om/get-state owner :columns)
@@ -213,7 +227,8 @@
                           (map om/value))
                     page-ids)]
     ;; TODO: Assert?
-    (when-not (<= 0 target-idx (dec (count existing-pages)))
+    ;; NOTE: We need to handle (= idx page-count) to be able to insert pages at the end
+    (when-not (<= 0 target-idx (count existing-pages))
       (throw (ex-info (str "Got invalid target-idx:" target-idx)
                       {:idx target-idx
                        :column-pages existing-pages


Cleaned up leftover Reagent test/sample code

--- src-cljs/tropefest/core.cljs
+++ src-cljs/tropefest/core.cljs
@@ -15,38 +15,6 @@
 (defn text-input [id label]
   (row label [:input.form-control {:field :text
                                    :id    id}]))
-
-
-
-; Some example functions from http://holmsand.github.io/reagent/
-; Currently using them to test reagent via figwheel
-;
-; For instance:
-;
-; (def e (aget (js/document.getElementsByTagName "main") 0))
-; (reagent/render [c/timer-component] e)
-; (reagent/render [c/counting-component] e)
-
-(def click-count (atom 0))
-(def seconds-elapsed (atom 0))
-
-(defn counting-component []
-  [:div
-   "The atom " [:code "click-count"] " has value: "
-   @click-count ". "
-   [:input {:type     "button" :value "Click me!"
-            :on-click #(swap! click-count inc)}]])
-
-(defn timer-component []
-  (let [seconds-elapsed (atom 0)]
-    (fn []
-      (js/setTimeout #(swap! seconds-elapsed inc) 1000)
-      [:div
-       "Seconds Elapsed: " @seconds-elapsed])))
-
-(defn set-html! [el content]
-  (set! (.-innerHTML el) content))
-

 ; Original code:


Add todo from edit

Add todo from edit

--- src/todomvc_reagent/core.cljs
+++ src/todomvc_reagent/core.cljs
@@ -17,24 +17,40 @@
    (let [id (swap! counter inc)]
      (swap! todos assoc id {:id id :title title :done done}))))

-(add-todo "Taste JavaScript" true)
-(add-todo "Buy a unicorn")
+(defn init []
+  (add-todo "Taste JavaScript" true)
+  (add-todo "Buy a unicorn"))
+
+(init)

 ;; -------------------------
 ;; Helper
+
 (defn toggle [id]
   (swap! todos update-in [id :done] not))
 (defn delete [id]
   (swap! todos dissoc id))
+(defn save [title]
+  (when (not-empty title) (add-todo title)))

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

 (defn todo-header [title placeholder]
-  [:header.header
-   [:h1 title]
-   [:input.new-todo
-    {:autofocus true, :placeholder placeholder}]])
+  (let [val (r/atom "")
+        stop #(reset! val "")]
+    (fn []
+      [:header.header
+       [:h1 title]
+       [:input.new-todo
+        {:value @val
+         :autoFocus true
+         :placeholder placeholder
+         :on-change #(reset! val (-> % .-target .-value))
+         :on-key-down #(case (.-which %)
+                         13 (do (save @val) (stop))
+                         27 (stop)
+                         nil)}]])))

 (defn todo-item [todo]
     (fn [{:keys [id title done]}]


Remove unused code.

Remove unused code.

--- src/tryclojure/views/home.clj
+++ src/tryclojure/views/home.clj
@@ -3,10 +3,6 @@
             [noir.response :refer [redirect]]
             [hiccup.element :refer [javascript-tag link-to unordered-list]]
             [hiccup.page :refer [include-css include-js html5]]))
-
-(defpartial home-html []
-  [:p.bottom
-   ""])

 (defn root-html [mode title]
   (html5
@@ -24,15 +20,6 @@
       [:div#container
        [:div#console.console]]
       (javascript-tag
-       "var _gaq = _gaq || [];
-        _gaq.push(['_setAccount', 'UA-27340918-1']);
-        _gaq.push(['_trackPageview']);
-
-        (function() {
-          var ga = document.createElement('script'); ga.type = 'text/javascript'; ga.async = true;
-          ga.src = ('https:' == document.location.protocol ? 'https://ssl' : 'http://www') + '.google-analytics.com/ga.js';
-          var s = document.getElementsByTagName('script')[0]; s.parentNode.insertBefore(ga, s);
-        })();")]]]))
        (str "mode = '" mode "';"))]]]))

 (defpage "/" []


Type hints for context-editor.context-editor-control

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

--- src/conexp/contrib/gui/editors/context_editor/context_editor_control.clj
+++ src/conexp/contrib/gui/editors/context_editor/context_editor_control.clj
@@ -17,7 +17,7 @@
         conexp.contrib.gui.editors.context-editor.table-control
         conexp.contrib.gui.editors.context-editor.editable-contexts)
   (:import [java.awt Color Font]
-    [javax.swing JLabel SwingConstants]))
+           [javax.swing JLabel SwingConstants JTable JComponent]))

 ;;; Context editor control
@@ -56,7 +56,7 @@
   (assert (instance? context-editor-widget widget))
   (let [table (get-table widget),
         view  (get-row-index-permutator table),
-        sel   (seq (.getSelectedRows (get-control table))),
+        sel   (seq (.getSelectedRows ^JTable (get-control table))),
         ectx  (get-ectx widget),
         names (deref (:obj-rows ectx)),
         fltr  #(filter (fn [x]
@@ -71,7 +71,7 @@
   (assert (instance? context-editor-widget widget))
   (let [table (get-table widget),
         view  (get-column-index-permutator table),
-        sel   (seq (.getSelectedColumns (get-control table))),
+        sel   (seq (.getSelectedColumns ^JTable (get-control table))),
         ectx  (get-ectx widget),
         names (deref (:attr-cols ectx)),
         fltr  #(filter (fn [x]
@@ -118,7 +118,7 @@
   (defn- context-cell-renderer-hook
     "Returns the component given as first parameter, optionally changes
      attributes of it depending on the cell"
-    [table component view-row view-col is-selected has-focus value]
+    [^JTable table, ^JComponent component, view-row view-col is-selected has-focus value]
     (let [row (get-row-index table view-row),
           col (get-column-index table view-col) ]
       (cond
@@ -151,7 +151,7 @@
           (.setForeground selected-foreground)
           (.setBackground selected-background)))
       (if (instance? JLabel component)
-        (.setHorizontalAlignment component SwingConstants/CENTER))
+        (.setHorizontalAlignment ^JLabel component SwingConstants/CENTER))
       component)))

@@ -219,11 +219,8 @@

 (defn- string-to-cross
   "Takes a string and decides, whether it should be a cross or not."
-  [s]
-  (let [trimmed (.trim s)]
-    (if (re-matches #"0*[,.]?0*" trimmed)
-      false
-      true)))
+  [^String s]
+  (boolean (re-matches #"0*[,.]?0*" (.trim s))))

 (defn- ectx-cell-value-hook
   [ectx row column contents]


Use default key-fn when writing json

Use default key-fn when writing json

--- src/video_server/metadata.clj
+++ src/video_server/metadata.clj
@@ -57,11 +57,6 @@
   [k]
   (if (re-find #"^-?\d+$" k) (parse-long k) (keyword k)))

-(defn- json-key
-  "Returns a string, suitable as a JSON key."
-  [k]
-  (if (keyword? k) (name k) (str k)))
-
 (defn read-metadata
   "Reads the stored metadata for the video."
   [title]
@@ -76,7 +71,7 @@
   (let [file (metadata-file title)]
     (log/debug "saving metadata" (str file))
     (with-open [w (io/writer file)]
-      (.write w (with-out-str (json/pprint info :key-fn json-key))))))
+      (.write w (with-out-str (json/pprint info))))))

 (defn save-poster
   "Downloads the poster for the specified video."


initial attempt at drawing big dungeon on a canvas

--- src/voke/world/visualize.cljs
+++ src/voke/world/visualize.cljs
@@ -132,9 +132,11 @@
    [:p "Algorithm:"]
    [:div.btn-group
     [tab :drunkard "Drunkard's Walk"]
-    [tab :cellular "Cellular Automata"]]
-
-   (common-visualization-sliders)
+    [tab :cellular "Cellular Automata"]
+    [tab :final "Voke algorithm"]]
+
+   (when (not= @selected-tab :final)
+     (common-visualization-sliders))

    (when (= @selected-tab :drunkard)
      [:div.drunkard-specific
@@ -162,12 +164,46 @@
      {:href     "#"
       :on-click (fn [e]
                   (.preventDefault e)
-                  (if (= @selected-tab :drunkard)
-                    (animate-dungeon-history
-                      (generate/drunkards-walk @grid-width @grid-height @num-empty-cells))
-                    (draw-automata-grid!)))}
+                  (condp = @selected-tab
+                    :drunkard (animate-dungeon-history
+                                (generate/drunkards-walk @grid-width @grid-height @num-empty-cells))
+                    :automata (draw-automata-grid!)
+                    :final (let [canvas (js/document.getElementById "visualization-canvas")
+                                 ctx (.getContext canvas "2d")
+                                 side-length 400
+                                 grid ((generate/automata side-length side-length 0.45 4 5 40000 0)
+                                        ::generate/grid)]
+                             ; TODO fill in the canvas
+                             (set! (.-fillStyle ctx) "#CCC")
+
+                             (loop [x 0
+                                    y 0]
+
+                               (when (< y side-length)
+                                 (when (= (-> grid
+                                              (get y)
+                                              (get x))
+                                          :empty)
+
+                                   (doto ctx
+                                     (.beginPath)
+                                     (.rect (* x 2) (* y 2) 2 2)
+                                     (.fill)))
+
+                                 (recur (if (= (dec x) side-length) 0 (inc x))
+                                        (if (= (dec x) side-length) (inc y) y)))))))}
      "generate"]]
-   [grid visualization-state]])
+
+   ; full #333, empty #ccc
+
+   (if (= @selected-tab :final)
+     [:canvas {:id     "visualization-canvas"
+               :width  800
+               :height 800
+               :style  {:border           "none"
+                        :background-color "#333"}
+               }]
+     [grid visualization-state])])

 ;; Main


reset the canvas when the generate button is clicked

--- src/voke/world/visualize.cljs
+++ src/voke/world/visualize.cljs
@@ -171,9 +171,11 @@
                     :final (let [canvas (js/document.getElementById "visualization-canvas")
                                  ctx (.getContext canvas "2d")
                                  side-length 400
-                                 grid ((generate/automata side-length side-length 0.45 4 5 40000 0)
+                                 cell-size 2
+                                 grid ((generate/automata side-length side-length 0.45 4 5 40000 8)
                                         ::generate/grid)]
-                             ; TODO fill in the canvas
+                             (.clearRect ctx 0 0 (* side-length cell-size) (* side-length cell-size))
+
                              (set! (.-fillStyle ctx) "#CCC")

                              (loop [x 0
@@ -187,7 +189,7 @@

                                    (doto ctx
                                      (.beginPath)
-                                     (.rect (* x 2) (* y 2) 2 2)
+                                     (.rect (* x cell-size) (* y cell-size) cell-size cell-size)
                                      (.fill)))

                                  (recur (if (= (dec x) side-length) 0 (inc x))


change: enhance dev-db bootstrap, #443

change: enhance dev-db bootstrap, #443

--- ssclj/jar/src/test/clojure/com/sixsq/slipstream/ssclj/api/dev_server.clj
+++ ssclj/jar/src/test/clojure/com/sixsq/slipstream/ssclj/api/dev_server.clj
@@ -1,5 +1,6 @@
 (ns com.sixsq.slipstream.ssclj.api.dev-server
   (:require
+    [korma.core                                       :as kc]
     [com.sixsq.slipstream.ssclj.app.server            :as server]
     [com.sixsq.slipstream.ssclj.resources.seeds.event :as es]
     [com.sixsq.slipstream.ssclj.usage.seeds.usages    :as us]))
@@ -11,18 +12,41 @@
     (println (str "Server started at localhost:" *server-port*))
     (server/start *server-port*)))

+(kc/defentity resources)
+(kc/defentity usage_summaries)
+
+(defn db-content
+  []
+  {:resource  (->> (kc/select resources)
+                   (map :id)
+                   (map (partial re-find #"(.*)/.*"))
+                   (map second)
+                   frequencies)
+   :summaries (->> (kc/select usage_summaries)
+                   (map :user)
+                   frequencies)})
+
+(defn empty-db?
+  []
+  (->> (db-content) vals (every? #{{}})))
+
 (defn bootstrap
-  [& {:keys [port events summaries user summaries clouds]
+  [& {:keys [port events summaries user summaries clouds clean]
       :or {port       8201
            events     45
            summaries  45
            clouds     ["aws" "exo"]
-           user       :bob}}]
+           user       :bob
+           clean      true}}]
     (binding [*server-port* port] @server)
     (println (str "Seeding " events " events for user '" (name user) "'..." ))
-    (es/seed! events user)
+    (when clean
+      (println "All DB entries will be deleted. Use (bootstrap :clean false) to avoid it."))
+    (es/seed! events user :clean clean)
     (println (str "Seeding " summaries " summaries for clouds '" clouds "' for user '" (name user) "'..."))
-    (us/seed-summaries! summaries user clouds))
+    (us/seed-summaries! summaries user clouds :clean clean)
+    (println "The current state of the DB is:")
+    (clojure.pprint/pprint (db-content)))

 (println)
 (println "Type (api/bootstrap) to start a server with 45 events and 45 summaries for user 'bob'")


Peg FireCloud at an older Leo image version (#1465)

--- src/cljs/main/broadfcui/page/workspace/notebooks/create_cluster.cljs
+++ src/cljs/main/broadfcui/page/workspace/notebooks/create_cluster.cljs
@@ -40,6 +40,10 @@
                    "n1-highmem-32"
                    "n1-highmem-64"
                    "n1-highmem-96"])
+
+; TODO: FireCloud temporarily pegged at an older Jupyter image with Hail 0.1
+; See https://github.com/DataBiosphere/leonardo/issues/699
+(def jupyterDockerImage "us.gcr.io/broad-dsp-gcr-public/leonardo-notebooks:hail0.1")

 (react/defc ClusterCreator
   {:refresh
@@ -178,7 +182,8 @@
                :payload (merge payload
                                {:machineConfig machineConfig}
                                (when-not (string/blank? extensionURI) {:jupyterExtensionUri extensionURI})
-                               (when-not (string/blank? userScriptURI) {:jupyterUserScriptUri userScriptURI}))
+                               (when-not (string/blank? userScriptURI) {:jupyterUserScriptUri userScriptURI})
+                               {:jupyterDockerImage jupyterDockerImage})
                :headers ajax/content-type=json
                :on-done (fn [{:keys [success? get-parsed-response]}]
                           (swap! state dissoc :creating?)


bug/49: database migration test should be CI-compatible now

--- src/integration/clojure/com/xebia/visualreview/itest/database_migration_test.clj
+++ src/integration/clojure/com/xebia/visualreview/itest/database_migration_test.clj
@@ -12,10 +12,10 @@

 (def ^:dynamic *conn* {:classname      "org.h2.Driver"
                        :subprotocol    "h2"
-                       :subname        "tcp://localhost/./target/temp/vr-db-migration-test.db;TRACE_LEVEL_FILE=2"
+                       :subname        "file:./target/temp/vr-db-migration-test.db;TRACE_LEVEL_FILE=2"
                        :user           ""
-                       :init-pool-size 2
-                       :max-pool-size  2})
+                       :init-pool-size 1
+                       :max-pool-size  1})

 (defn- run-db-script! [conn script]
   (j/execute! conn [script]))
@@ -34,6 +34,12 @@
                         (log/info "Creating initial v1 data")
                         (run-db-script! conn (read-db-script "dbmigration/dump-1.sql"))
                         (db/update-db-schema! conn)))
+
+(defn- setup-db-fixture [f]
+  (let [_ (setup-db)]
+    (f)))
+
+(use-fixtures :each setup-db-fixture)

 (deftest database-migration


remove session, flash, and double cookie handling from server

--- ssclj/jar/src/main/clojure/com/sixsq/slipstream/ssclj/app/server.clj
+++ ssclj/jar/src/main/clojure/com/sixsq/slipstream/ssclj/app/server.clj
@@ -5,6 +5,8 @@

     [ring.middleware.json :refer [wrap-json-body wrap-json-response]]
     [ring.middleware.params :refer [wrap-params]]
+    [ring.middleware.keyword-params :refer [wrap-keyword-params]]
+    [ring.middleware.nested-params :refer [wrap-nested-params]]
     [ring.middleware.cookies :refer [wrap-cookies]]

     [metrics.core :refer [default-registry]]
@@ -49,10 +51,12 @@

   (-> (routes/get-main-routes)

-      handler/site
+      ;;handler/site
       wrap-exceptions
       wrap-cimi-params
       wrap-base-uri
+      wrap-keyword-params
+      wrap-nested-params
       wrap-params
       wrap-authn-info-header
       (expose-metrics-as-json (str p/service-context "metrics") default-registry {:pretty-print? true})


remove mansonry

remove mansonry

--- src/cljs/material/component/grid/masonry.cljs
+++ src/cljs/material/component/grid/masonry.cljs
@@ -1,44 +0,0 @@
-(ns material.component.grid.masonry
-  (:require [material.components :as comp]
-            [sablono.core :refer-macros [html]]))
-
-(enable-console-print!)
-
-(defn grid
-  [{:keys [:first-col-pred] :or {first-col-pred even?} :as opts} & body]
-  {:pre [(map? opts)]}
-  (let [body' (remove nil? body)
-        colls (reduce
-                (fn [acc val]
-                  (-> (if (first-col-pred (:idx acc))
-                        (update acc :first-col conj val)
-                        (update acc :second-col conj val))
-                      (update :idx inc)))
-                {:idx 0 :first-col [] :second-col []}
-                body')
-        col-grid (fn [col-content]
-                   (comp/grid
-                     {:item true
-                      :key  (str "mgchi-" (hash col-content))
-                      :xs   12
-                      :md   6}
-                     (comp/grid
-                       {:container true
-                        :key       (str "mgchic-" (hash col-content))
-                        :spacing   40}
-                       (map-indexed
-                         (fn [index item]
-                           (let [h (hash item)]
-                             (comp/grid
-                               {:item true
-                                :key  (str "mgchics-" index "-" h)
-                                :xs   12}
-                               (html
-                                 [:div {:key (str "mgchicsi-" index "-" h)}
-                                  item])))) col-content))))]
-    (comp/grid
-      {:container true
-       :key       "mgpc"
-       :spacing   40}
-      (col-grid (:first-col colls))
-      (col-grid (:second-col colls)))))


fix multi-line indent

fix multi-line indent

--- src/com/billpiel/mem_tracer/string_output.clj
+++ src/com/billpiel/mem_tracer/string_output.clj
@@ -105,7 +105,7 @@
       (if mline
         ["\n"
           (indent-line-breaks (str s "\n")
-                              indent-base
+                              (+ 2 indent-base) ;; Why does this need to be 2?
                               :end
                               (apply str
                                      (repeat indent-offset
@@ -132,7 +132,7 @@
       (mapv #(multi-line-indent-MZ :label (str (first %) " => ")
                                    :value  (second %)
                                    :indent-base (:depth tree)
-                                   :indent-offset  2)
+                                   :indent-offset  3)
             arg-map))))

 (defn args-str


Added define-constructor

Added define-constructor

and defined and, or, exists, forall and inverse.

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

--- src/conexp/contrib/dl/framework/semantics.clj
+++ src/conexp/contrib/dl/framework/semantics.clj
@@ -80,22 +80,7 @@
 	  ((base-semantics dl-expression) model))
 	result))))

-(defmethod compile-expression 'and [dl-expression]
-  (fn [model]
-    (reduce intersection (model-base-set model)
-	    (map #(interpret model %) (arguments dl-expression)))))
-
-(add-common-constructor! 'and)
-
-(defmethod compile-expression 'exists [dl-expression]
-  (fn [model]
-    (let [r-I (interpret model (first (arguments dl-expression))),
-	  C-I (interpret model (second (arguments dl-expression)))]
-      (set-of x [x (model-base-set model),
-		 :when (exists [y C-I]
-			 (contains? r-I [x y]))]))))
-
-(add-common-constructor! 'exists)
+;;; base semantics (i.e. what to do if nothing else applies)

 (defmacro define-base-semantics
   "Define how to interpret an expression which is neither compound nor
@@ -104,6 +89,46 @@
   `(defmethod compile-expression [(language-name ~language) ::base-semantics] [~dl-expression]
      (fn [~model]
        ~@body)))
+
+
+;;; defining new constructors
+
+(defmacro define-constructor
+  "Defines a new constructor for description logics. Captures the
+  variables «model» and «dl-exp» for representing the model and the
+  dl-expression used."
+  [name & body]
+  `(do
+     (defmethod compile-expression '~name [~'dl-exp]
+       (fn [~'model]
+         ~@body))
+     (add-common-constructor! '~name)))
+
+(define-constructor and
+  (reduce intersection (model-base-set model)
+          (map #(interpret model %) (arguments dl-exp))))
+
+(define-constructor or
+  (reduce union #{}
+          (map #(interpret model %) (arguments dl-exp))))
+
+(define-constructor exists
+  (let [r-I (interpret model (first (arguments dl-exp))),
+        C-I (interpret model (second (arguments dl-exp)))]
+    (set-of x [x (model-base-set model),
+               :when (exists [y C-I]
+                       (contains? r-I [x y]))])))
+
+(define-constructor forall
+  (let [r-I (interpret model (first (arguments dl-exp))),
+        C-I (interpret model (second (arguments dl-exp)))]
+    (set-of x [x (model-base-set model),
+               :when (forall [y C-I]
+                       (contains? r-I [x y]))])))
+
+(define-constructor inverse
+  (let [r-I (interpret model (first (arguments dl-exp)))]
+    (set-of [y x] [[x y] r-I])))

 ;;; Model Syntax


Comment out visualize-hb-state for how

Comment out visualize-hb-state for how

--- src/edu/berkeley/ai/domains/hybrid_blocks.clj
+++ src/edu/berkeley/ai/domains/hybrid_blocks.clj
@@ -117,6 +117,9 @@
 	   (hs/get-hs-action env 'right-holding '{?b a ?ngx 5})
 	   (hs/get-hs-action env 'put '{?b a ?c b})])
        (envs/get-goal env)))))
+
+
+(comment

 (set! *warn-on-reflection* true)

@@ -179,6 +182,8 @@

 (set! *warn-on-reflection* false)

+)
+
 (defn animate-hb-seq [env action-names delay-ms]
   (visualize-hb-state
   (reduce (fn [s a]


Minor changes on tests.

Minor changes on tests.

--- test/catacumba/core_tests.clj
+++ test/catacumba/core_tests.clj
@@ -27,7 +27,7 @@
 ;; Tests
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

-(deftest public-address
+(deftest public-address-test
   (let [p (promise)
         handler (fn [context]
                   (deliver p (ct/public-address context))
@@ -37,7 +37,7 @@
             uri (deref p 1000 nil)]
         (is (= (str uri) "http://localhost:5050"))))))

-(deftest cookies
+(deftest cookies-test
   (testing "Setting new cookie."
     (letfn [(handler [context]
               (ct/set-cookies! context {:foo {:value "bar" :secure true :http-only true}})
@@ -49,7 +49,7 @@
           (is (= (get-in response [:cookies "foo" :value]) "bar"))
           (is (= (get-in response [:cookies "foo" :secure]) true)))))))

-(deftest request-response-handling
+(deftest request-response-handling-test
   (testing "Using send! with context"
     (let [handler (fn [ctx] (ct/send! ctx "hello world"))]
       (with-server {:handler handler}
@@ -181,23 +181,9 @@
         (let [response (client/get base-url)]
           (is (= (:body response) "Hello world!"))
           (is (= (:status response) 200))))))
-
-  #_(testing "Read body as text"
-    (let [p (promise)
-          handler (fn [ctx]
-                    (let [body (:body ctx)]
-                      (deliver p (slurp body)))
-                    "hello world")]
-      (with-server {:handler handler}
-        (let [response (client/post base-url {:body "Hello world"
-                                              :content-type "text/plain"})]
-          (is (= (:body response) "hello world"))
-          (is (= (:status response) 200))
-          (let [bodydata (deref p 1000 nil)]
-            (is (= bodydata "Hello world")))))))
-)
-
-(deftest routing
+  )
+
+(deftest routing-test
   (testing "Routing with parameter."
     (let [handler (fn [ctx]
                     (let [params (:route-params ctx)]
@@ -354,9 +340,7 @@
             (catch clojure.lang.ExceptionInfo e
               (let [data (ex-data e)]
                 (is (= (:status data) 404)))))))))
-)
-
-(deftest routing-1
+
   (testing "Serving authenticated assets in root."
     (letfn [(handler1 [state context]
               (reset! state 1)
@@ -375,10 +359,10 @@
           (let [response (client/get (str base-url "/test.txt"))]
             (is (= (:body response) "hello world from test.txt\n"))
             (is (= (:status response) 200))
-            (is (= 2 @state))))))))
-
-
-(deftest context-data-forwarding
+            (is (= 2 @state)))))))
+  )
+
+(deftest context-data-forwarding-test
   (letfn [(handler1 [context]
             (ct/delegate {:foo 1}))
           (handler2 [context]
@@ -401,7 +385,7 @@
                {:foo 1 :bar 2 :baz 3})))))))

-(deftest basic-request-handler
+(deftest basic-request-handler-test
   (testing "Simple cors request"
     (let [p (promise)
           handler (fn [ctx] (deliver p ctx) "hello world")
@@ -421,7 +405,7 @@
           (is (= (:body response) "hello world"))
           (is (= (:status response) 200)))))))

-(deftest async-context-delegation
+(deftest async-context-delegation-test
   (letfn [(handler1 [context]
             (md/future
               (ct/delegate)))


remove redundant part from session id

remove redundant part from session id

--- src/clj/closerve/session_manager.clj
+++ src/clj/closerve/session_manager.clj
@@ -19,7 +19,7 @@
   (init-session-manager [this]
     (reset! session-counter (long (/ (.getTime (java.util.Date.)) 1000))))
   ;; make the session-id more random
-  (make-new-session [this] (str (make-random-uuid) (swap! session-counter inc)))
+  (make-new-session [this] (make-random-uuid) )
   (get-session-var [this session-id k] (get-in @session-store [session-id k]))
   (set-session-var [this session-id k v] (swap! session-store assoc-in [session-id k] v))
   (get-cookie-key [this] cookie-key)


[REFACTOR] Rename a binding

[REFACTOR] Rename a binding

Signed-off-by: Pang Yan Han <22594c345857f664c61cd411f607c4d40a9d4af9@gmail.com>

--- src/cljs/cljs_nusmods/timetable.cljs
+++ src/cljs/cljs_nusmods/timetable.cljs
@@ -674,18 +674,18 @@
    If such a `TimetableLessonInfo` object does not exist, returns nil."
   [day rowNum timeIdx]
   (let [ttRow (timetable-get-day-row day rowNum)]
-    (reduce (fn [ttLessonInfoAfter [ttLessonInfo _]]
+    (reduce (fn [selectedTTLessonInfo [ttLessonInfo _]]
               (let [startTime (:startTime ttLessonInfo)]
-                (cond (and (nil? ttLessonInfoAfter)
+                (cond (and (nil? selectedTTLessonInfo)
                            (>= startTime timeIdx))
                       ttLessonInfo

-                      (and (not (nil? ttLessonInfoAfter))
+                      (and (not (nil? selectedTTLessonInfo))
                            (>= startTime timeIdx)
-                           (< startTime (:startTime ttLessonInfoAfter)))
+                           (< startTime (:startTime selectedTTLessonInfo)))
                       ttLessonInfo

-                      :else ttLessonInfoAfter)))
+                      :else selectedTTLessonInfo)))
             nil
             ttRow)))


[RENAME] Add `!` suffix to `select2-box-update-modules` function

Signed-off-by: Pang Yan Han <22594c345857f664c61cd411f607c4d40a9d4af9@gmail.com>

--- src/cljs/cljs_nusmods/timetable.cljs
+++ src/cljs/cljs_nusmods/timetable.cljs
@@ -284,7 +284,7 @@
   []
   (set! ModulesSelectedOrder []))

-(defn- select2-box-update-modules
+(defn- select2-box-update-modules!
   "Update the select2 box with the currently selected modules"
   []
   ; NOTE: Internally, this does a quadratic amount of work but I do not
@@ -1075,7 +1075,7 @@
                     ; Micro optimization for modules added via url hash
                     ; during initialization
                     (if (not addedViaUrlHashInit?)
-                        (select2-box-update-modules))))
+                        (select2-box-update-modules!))))

               ; Only lesson types with more than 1 option of lesson group
               ; will be draggable
@@ -1261,7 +1261,7 @@

     ; Update Select2 box, since this is not done in `add-module-lesson-group!`.
     ; Repeated work will be done there if we did so
-    (select2-box-update-modules)
+    (select2-box-update-modules!)
     ; Update url hash
     (set-document-location-hash-based-on-modules-order!)))

@@ -1557,7 +1557,7 @@
         (remove-from-ModulesSelectedOrder! moduleCode)
         (.log js/console "I hear and obey!")
         ; Update Select2 box
-        (select2-box-update-modules))))
+        (select2-box-update-modules!))))

 (defn remove-all-modules!
   "Removes all modules from the timetable"
@@ -1566,5 +1566,5 @@
   (timetable-create!)
   (reset-ModulesSelected!)
   (reset-ModulesSelectedOrder!)
-  (select2-box-update-modules)
+  (select2-box-update-modules!)
   (document-location-hash-reset!))


Create loading icon while uploading badge

--- src/cljs/salava/badge/ui/upload.cljs
+++ src/cljs/salava/badge/ui/upload.cljs
@@ -27,20 +27,23 @@
               :data-dismiss "modal"}
      "OK"]]])

-(defn send-file []
+(defn send-file [state]
   (let [file (-> (.querySelector js/document "input")
                  .-files
                  (.item 0))
         form-data (doto
                     (js/FormData.)
                     (.append "file" file (.-name file)))]
+    (swap! state assoc :status "loading")
     (ajax/POST
       (path-for "/obpv1/badge/upload")
       {:body    form-data
        :handler (fn [data]
-                  (m/modal! (upload-modal data)
-                            (if (= (:status data) "success")
-                              {:hide #(navigate-to "/badge")})))})))
+                  (do
+                    (swap! state assoc :status "form")
+                    (m/modal! (upload-modal data)
+                              (if (= (:status data) "success")
+                                {:hide #(navigate-to "/badge")}))))})))

 (defn upload-info []
   [:div
@@ -58,22 +61,33 @@
     [:a {:href (path-for "/badge/mybadges")} (t :badge/Mybadges)]
     " " (t :badge/Uploadbagesfromresult3) "."]])

-(defn content []
-  [:div {:class "badge-upload"}
-   [m/modal-window]
-   [:h1.uppercase-header (t :badge/Uploadbadgesfrom)]
-   [upload-info]
-   [:form {:id "form"}
-    [:input {:type "file"
-             :aria-label "Choose file"
-             :name "file"
-             :on-change #(send-file)
-             :accept "image/png, image/svg+xml"}]]])
+(defn content [state]
+  (let [status  (:status @state)]
+    [:div {:class "badge-upload"}
+     [m/modal-window]
+     [:h1.uppercase-header (t :badge/Uploadbadgesfrom)]
+     [upload-info]
+
+     (cond
+       (= "loading" status) [:div.ajax-message
+                             [:i {:class "fa fa-cog fa-spin fa-2x "}]
+                             [:span (str (t :core/Loading) "...")]]
+       :else [:form {:id "form"}
+              [:input {:type       "file"
+                       :aria-label "Choose file"
+                       :name       "file"
+                       :on-change  #(send-file state)
+                       :accept     "image/png, image/svg+xml"}]] )
+
+
+
+     ]))

 (defn init-data []
       (ajax/GET (path-for "/obpv1/user/test") {}))

 (defn handler [site-navi]
-  (fn []
-    (init-data)
-    (layout/default site-navi (content))))
+  (let [state (atom {:status "form"})]
+    (fn []
+      (init-data)
+      (layout/default site-navi (content state)))))


modified invalid-exclude-param-msg function

--- src/cmr/common/services/messages.clj
+++ src/cmr/common/services/messages.clj
@@ -50,7 +50,5 @@

 (defn invalid-exclude-param-msg
   "Creates a message saying supplied parameter(s) are not in exclude params set."
-  ([]
-   (format "Some or all of the supplied parameters can not be used with exclude."))
-  ([param]
-   (format "Parameter [%s] can not be used with exclude." param)))
+  [params-set]
+  (format "Parameter(s) [%s] can not be used with exclude." (str/join ", " (map name params-set))))


fix func order

fix func order

--- src/com/billpiel/mem_tracer/core.clj
+++ src/com/billpiel/mem_tracer/core.clj
@@ -153,12 +153,6 @@

 (def tree->string #'com.billpiel.mem-tracer.string-output/tree->string)

-(defn print-trees
-  [coll]
-  (-> coll
-      get-trees
-      so/print-trees))
-
 (defn get-trees
   [v]
   (let [mk (meta v)]
@@ -175,6 +169,12 @@
                                  (keys v)
                                  (meta v)))))))

+(defn print-trees
+  [coll]
+  (-> coll
+      get-trees
+      so/print-trees))
+
 (defn print-ws
   []
   (#'com.billpiel.mem-tracer.string-output/print-tree (deref-workspace!)))


don't leave the printer running

don't leave the printer running

--- src/bolth.clj
+++ src/bolth.clj
@@ -129,19 +129,22 @@

 (defn run-gathered-tests [^AbstractQueue tests-to-run pharrallelism]
   (let [results (ArrayBlockingQueue. 1024)
+        printer-running (atom true)
         finished (into [] (map (fn [_] (promise)) (range pharrallelism)))
         workers (map #(run-worker results tests-to-run % finished) (range pharrallelism))
         printer (future
-                  (while true
+                  (while @printer-running
                     (if-let [r (.poll results)]
                       (print r))))]
     (try
       (dorun workers)
       (doseq [n finished]
         (deref n))
+      (reset! printer-running false)
       (future-cancel printer)
       (apply merge-with + (map (comp deref deref) finished))
       (finally
+        (reset! printer-running false)
         (future-cancel printer)
         (doseq [worker workers]
           (future-cancel worker))))))


Added :_content key that contains all the map's content

--- src/clucy.clj
+++ src/clucy.clj
@@ -1,12 +1,13 @@
 (ns clucy
   (:use clojure.contrib.java-utils)
+  (:import java.io.File)
   (:import org.apache.lucene.document.Document)
   (:import (org.apache.lucene.document Field, Field$Store, Field$Index))
   (:import (org.apache.lucene.index IndexWriter, IndexWriter$MaxFieldLength))
   (:import org.apache.lucene.analysis.standard.StandardAnalyzer)
   (:import org.apache.lucene.queryParser.QueryParser)
   (:import org.apache.lucene.search.IndexSearcher)
-  (:import org.apache.lucene.store.RAMDirectory)
+  (:import (org.apache.lucene.store RAMDirectory, NIOFSDirectory))
   (:import org.apache.lucene.util.Version))

 (def *version*  Version/LUCENE_30)
@@ -16,6 +17,11 @@
   "Create a new index in RAM."
   []
   (RAMDirectory.))
+
+(defn disk-index
+  "Create a new index in a directory on disk."
+  [dir-path]
+  (NIOFSDirectory. (File. dir-path)))

 (defn- index-writer
   "Create an IndexWriter."
@@ -30,12 +36,18 @@
             Field$Store/YES
             Field$Index/ANALYZED)))

+(defn- concat-values
+  "Concatenate all the maps values into a single string."
+  [map]
+  (apply str (interpose " " (vals map))))
+
 (defn- map->document
   "Create a Document from a map."
   [map]
   (let [document (Document.)]
     (doseq [[key value] map]
       (add-field document key value))
+    (add-field document :_content (concat-values map))
     document))

 (defn add
@@ -48,17 +60,20 @@
 (defn- document->map
   "Turn a Document object into a map."
   [document]
-  (into {}
-    (for [f (.getFields document)]
-      [(keyword (.name f)) (.stringValue f)])))
+  (-> (into {}
+        (for [f (.getFields document)]
+          [(keyword (.name f)) (.stringValue f)]))
+      (dissoc :_content)))

 (defn search
   "Search the supplied index with a query string."
-  [index query max-results default-field]
-  (with-open [searcher (IndexSearcher. index)]
-    (let [parser (QueryParser. *version* (as-str default-field) *analyzer*)
-          query  (.parse parser query)
-          hits   (.search searcher query max-results)]
-      (doall
-        (for [hit (.scoreDocs hits)]
-          (document->map (.doc searcher (.doc hit))))))))
+  ([index query max-results]
+    (search index query max-results :_content))
+  ([index query max-results default-field]
+    (with-open [searcher (IndexSearcher. index)]
+      (let [parser (QueryParser. *version* (as-str default-field) *analyzer*)
+            query  (.parse parser query)
+            hits   (.search searcher query max-results)]
+        (doall
+          (for [hit (.scoreDocs hits)]
+            (document->map (.doc searcher (.doc hit)))))))))


replace cond with if

replace cond with if

--- src/hackerrank/lambda_calculi_jun14/mango.clj
+++ src/hackerrank/lambda_calculi_jun14/mango.clj
@@ -19,9 +19,7 @@
         (= mangos min-mangos-eaten) k
         (and (= k high) (> mangos min-mangos-eaten))  k
         (and (= k low) (< mangos min-mangos-eaten)) (dec k)
-        :else (let [[nl nh] (cond
-                              (> mangos min-mangos-eaten) [(inc k) high]
-                              :else [low k])]
+        :else (let [[nl nh] (if (> mangos min-mangos-eaten) [(inc k) high] [low k])]
                 (recur nl nh))))))

 (defn parse-vec [] (read-string (str "[" (read-line) "]")))


wait for all dispatched events to be processed before checking

--- test/re_frame/router_test.clj
+++ test/re_frame/router_test.clj
@@ -16,9 +16,23 @@
   (fn [db [_ i]]
     (update db ::test (fnil conj []) i)))

+(rf/reg-fx
+ ::promise
+ (fn [{:keys [p val]}]
+   (deliver p val)))
+
+(rf/reg-event-fx
+ ::sentinel
+ (fn [cofx [_ p val]]
+   {::promise {:p p :val val}}))
+
 (deftest dispatching-race-condition-469-test
   ;; Checks for Day8/re-frame#469
-  (is (nil? (dotimes [i 1000]
-              (rf/dispatch [::test i]))))
-  (is (= (::test @db/app-db)
-         (range 1000))))
+  (let [p (promise)]
+    (is (nil? (dotimes [i 1000]
+                (rf/dispatch [::test i]))))
+    (is (nil? (rf/dispatch [::sentinel p ::done])))
+    (let [val (deref p 1000 ::timed-out)]
+      (is (= ::done val)))
+    (is (= (::test @db/app-db)
+           (range 1000)))))


Also terminate context when receiving term from updates

--- server/src/patavi/server/service.clj
+++ server/src/patavi/server/service.clj
@@ -31,7 +31,8 @@
             (if (= update {id "terminate"})
               (do
                 (close! updates)
-                (.close socket))
+                (.close socket)
+                (.term context))
               (do
                 (>! updates update)
                 (recur (zmq/receive-all socket)))))))


Fixed the event hook structure to properly register verdicts from judgements

--- src/ctia/flows/hooks/event_hooks.clj
+++ src/ctia/flows/hooks/event_hooks.clj
@@ -79,6 +79,7 @@
                                 (store/calculate-verdict event)
                                 (vs/realize-verdict owner))]
         (store/create-verdict @verdict-store new-verdict)
+        (println "Created a verdict: " new-verdict)
         new-verdict)
       event)))


Minor change.

Minor change.

--- hr/nonvisualstudio/clojure/algorithms/implementation/Implementation/ForCodeReview/chocolate-feast.Spec.clj
+++ hr/nonvisualstudio/clojure/algorithms/implementation/Implementation/ForCodeReview/chocolate-feast.Spec.clj
@@ -1,4 +1,4 @@
-;(load-file "c:/GitHub/practice/hr/nonvisualstudio/clojure/algorithms/implementation/ForCodeReview/chocolate-feast.Spec.clj")
+;(load-file "c:/GitHub/practice/hr/nonvisualstudio/clojure/algorithms/implementation/Implementation/ForCodeReview/chocolate-feast.Spec.clj")

 (ns hr.clojure.algorithms.implementation.implementation.chocolate-feast.spec)


Added rule to assign root concept ids

Added rule to assign root concept ids

--- kabob-build/src/main/resources/edu/ucdenver/ccp/kabob/build/rules/bio_to_ice/ontology_ice_gen_rules.clj
+++ kabob-build/src/main/resources/edu/ucdenver/ccp/kabob/build/rules/bio_to_ice/ontology_ice_gen_rules.clj
@@ -1,189 +1,206 @@
 ;; -------------------------------------------
-;; --------- BRENDA Tissue Ontology ----------
-;; -------------------------------------------
-;; create ICE URI's for each term in the BRENDA Tissue Ontology
-`{:name "brenda-ontology-ice-gen"
-  :head ((?/ice obo/IAO_0000219 ?/subclass)) ; denotes
-  :body ((?/subclass [rdfs/subClassOf *] obo/BTO_0000000))
-  :reify ([?/ice {:ln (:localname ?/subclass)
-                  :ns "iaobto" :prefix "" :suffix "_ICE"}])}
-
-;; -------------------------------------------
-;; -------------- Cell Ontology --------------
-;; -------------------------------------------
-;; create ICE URI's for each term in the Cell Ontology
-`{:name "cell-ontology-ice-gen"
-  :head ((?/ice obo/IAO_0000219 ?/subclass)) ; denotes
-  :body ((?/subclass [rdfs/subClassOf *] obo/CL_0000000))
-  :reify ([?/ice {:ln (:localname ?/subclass)
-                  :ns "iaocl" :prefix "" :suffix "_ICE"}])}
-
-;; -------------------------------------------
-;; ------------- ChEBI Ontology --------------
-;; -------------------------------------------
-;; create ICE URI's for each term in the ChEBI:subatomic particle subontology
-`{:name "chebi-subatomic-particle-ice-gen"
-  :head ((?/ice obo/IAO_0000219 ?/subclass)) ; denotes
-  :body ((?/subclass [rdfs/subClassOf *] obo/CHEBI_36342))
-  :reify ([?/ice {:ln (:localname ?/subclass)
-                  :ns "iaochebi" :prefix "" :suffix "_ICE"}])}
-
-;; create ICE URI's for each term in the ChEBI:role subontology
-`{:name "chebi-role-ice-gen"
-  :head ((?/ice obo/IAO_0000219 ?/subclass)) ; denotes
-  :body ((?/subclass [rdfs/subClassOf *] obo/CHEBI_50906))
-  :reify ([?/ice {:ln (:localname ?/subclass)
-                  :ns "iaochebi" :prefix "" :suffix "_ICE"}])}
-
-;; create ICE URI's for each term in the ChEBI:chemical entity subontology
-`{:name "chebi-chemical-entity-ice-gen"
-  :head ((?/ice obo/IAO_0000219 ?/subclass)) ; denotes
-  :body ((?/subclass [rdfs/subClassOf *] obo/CHEBI_24431))
-  :reify ([?/ice {:ln (:localname ?/subclass)
-                  :ns "iaochebi" :prefix "" :suffix "_ICE"}])}
+;; --------- Root Concept Assignment ---------
+;; -------------------------------------------
+;; create ICE URI's for each term in the ontology
+`{:name "root-concept-ice-gen"
+  :head (;(?/id obo/IAO_0000219 ?/root) ; denotes
+         (?/id rdfs/subClassOf ccp/IAO_EXT_0000190)) ; ontology root concept identifer
+  :sparql-string "select ?root {
+								  ?root rdf:type owl:Class .
+								  minus{?root rdfs:subClassOf ?class}
+								  minus{?root owl:deprecated true}
+								         }"
+  :reify ([?/id {:ln (:localname ?/subclass)
+                 :ns "ccp" :prefix "" :suffix ""}])}

+;
+;; -------------------------------------------
+;; --------- BRENDA Tissue Ontology ----------
+;; -------------------------------------------
+;; create ICE URI's for each term in the BRENDA Tissue Ontology
+;`{:name "brenda-ontology-ice-gen"
+;  :head ((?/ice obo/IAO_0000219 ?/subclass)) ; denotes
+;  :body ((?/subclass [rdfs/subClassOf *] obo/BTO_0000000))
+;  :reify ([?/ice {:ln (:localname ?/subclass)
+;                  :ns "iaobto" :prefix "" :suffix "_ICE"}])}
+;
+;; -------------------------------------------
+;; -------------- Cell Ontology --------------
+;; -------------------------------------------
+;; create ICE URI's for each term in the Cell Ontology
+;`{:name "cell-ontology-ice-gen"
+;  :head ((?/ice obo/IAO_0000219 ?/subclass)) ; denotes
+;  :body ((?/subclass [rdfs/subClassOf *] obo/CL_0000000))
+;  :reify ([?/ice {:ln (:localname ?/subclass)
+;                  :ns "iaocl" :prefix "" :suffix "_ICE"}])}
+;
+;; -------------------------------------------
+;; ------------- ChEBI Ontology --------------
+;; -------------------------------------------
+;; create ICE URI's for each term in the ChEBI:subatomic particle subontology
+;`{:name "chebi-subatomic-particle-ice-gen"
+;  :head ((?/ice obo/IAO_0000219 ?/subclass)) ; denotes
+;  :body ((?/subclass [rdfs/subClassOf *] obo/CHEBI_36342))
+;  :reify ([?/ice {:ln (:localname ?/subclass)
+;                  :ns "iaochebi" :prefix "" :suffix "_ICE"}])}
+;
+;; create ICE URI's for each term in the ChEBI:role subontology
+;`{:name "chebi-role-ice-gen"
+;  :head ((?/ice obo/IAO_0000219 ?/subclass)) ; denotes
+;  :body ((?/subclass [rdfs/subClassOf *] obo/CHEBI_50906))
+;  :reify ([?/ice {:ln (:localname ?/subclass)
+;                  :ns "iaochebi" :prefix "" :suffix "_ICE"}])}
+;
+;; create ICE URI's for each term in the ChEBI:chemical entity subontology
+;`{:name "chebi-chemical-entity-ice-gen"
+;  :head ((?/ice obo/IAO_0000219 ?/subclass)) ; denotes
+;  :body ((?/subclass [rdfs/subClassOf *] obo/CHEBI_24431))
+;  :reify ([?/ice {:ln (:localname ?/subclass)
+;                  :ns "iaochebi" :prefix "" :suffix "_ICE"}])}
+;
+;
 ;; -------------------------------------------
 ;; --------------- GO Ontology ---------------
 ;; -------------------------------------------
 ;; create ICE URI's for each term in the GO BP subontology
-`{:name "go-bp-ice-gen"
-  :head ((?/ice obo/IAO_0000219 ?/subclass)) ; denotes
-  :body ((?/subclass [rdfs/subClassOf *] obo/GO_0008150))
-  :reify ([?/ice {:ln (:localname ?/subclass)
-                  :ns "iaogo" :prefix "" :suffix "_ICE"}])}
-
+;`{:name "go-bp-ice-gen"
+;  :head ((?/ice obo/IAO_0000219 ?/subclass)) ; denotes
+;  :body ((?/subclass [rdfs/subClassOf *] obo/GO_0008150))
+;  :reify ([?/ice {:ln (:localname ?/subclass)
+;                  :ns "iaogo" :prefix "" :suffix "_ICE"}])}
+;
 ;; create ICE URI's for each term in the GO MF subontology
-`{:name "go-mf-ice-gen"
-  :head ((?/ice obo/IAO_0000219 ?/subclass)) ; denotes
-  :body ((?/subclass [rdfs/subClassOf *] obo/GO_0003674))
-  :reify ([?/ice {:ln (:localname ?/subclass)
-                  :ns "iaogo" :prefix "" :suffix "_ICE"}])}
-
+;`{:name "go-mf-ice-gen"
+;  :head ((?/ice obo/IAO_0000219 ?/subclass)) ; denotes
+;  :body ((?/subclass [rdfs/subClassOf *] obo/GO_0003674))
+;  :reify ([?/ice {:ln (:localname ?/subclass)
+;                  :ns "iaogo" :prefix "" :suffix "_ICE"}])}
+;
 ;; create ICE URI's for each term in the GO CC subontology
-`{:name "go-cc-ice-gen"
-  :head ((?/ice obo/IAO_0000219 ?/subclass)) ; denotes
-  :body ((?/subclass [rdfs/subClassOf *] obo/GO_0005575))
-  :reify ([?/ice {:ln (:localname ?/subclass)
-                  :ns "iaogo" :prefix "" :suffix "_ICE"}])}
-
+;`{:name "go-cc-ice-gen"
+;  :head ((?/ice obo/IAO_0000219 ?/subclass)) ; denotes
+;  :body ((?/subclass [rdfs/subClassOf *] obo/GO_0005575))
+;  :reify ([?/ice {:ln (:localname ?/subclass)
+;                  :ns "iaogo" :prefix "" :suffix "_ICE"}])}
+;
 ;; -------------------------------------------
 ;; --------------- MI Ontology ---------------
 ;; -------------------------------------------
 ;; create ICE URI's for each term in the PSI Molecular Interaction Ontology
-`{:name "mi-ice-gen"
-  :head ((?/ice obo/IAO_0000219 ?/cls)) ; denotes
-  :body ((?/cls oboInOwl/hasOBONamespace ["PSI-MI"])
-         (?/cls rdf/type owl/Class))
-  :reify ([?/ice {:ln (:localname ?/cls)
-                  :ns "iaomi" :prefix "" :suffix "_ICE"}])}
-
+;`{:name "mi-ice-gen"
+;  :head ((?/ice obo/IAO_0000219 ?/cls)) ; denotes
+;  :body ((?/cls oboInOwl/hasOBONamespace ["PSI-MI"])
+;         (?/cls rdf/type owl/Class))
+;  :reify ([?/ice {:ln (:localname ?/cls)
+;                  :ns "iaomi" :prefix "" :suffix "_ICE"}])}
+;
 ;; -------------------------------------------
 ;; --------------- MP Ontology ---------------
 ;; -------------------------------------------
 ;; create ICE URI's for each term in the Mammalian Phenotype ontology
-`{:name "mpheno-ice-gen"
-  :head ((?/ice obo/IAO_0000219 ?/subclass)) ; denotes
-  :body ((?/subclass [rdfs/subClassOf *] obo/MP_0000001)
-         (:not (:isBlank ?/subclass)))
-  :reify ([?/ice {:ln (:localname ?/subclass)
-                  :ns "iaompheno" :prefix "" :suffix "_ICE"}])}
-
-
+;`{:name "mpheno-ice-gen"
+;  :head ((?/ice obo/IAO_0000219 ?/subclass)) ; denotes
+;  :body ((?/subclass [rdfs/subClassOf *] obo/MP_0000001)
+;         (:not (:isBlank ?/subclass)))
+;  :reify ([?/ice {:ln (:localname ?/subclass)
+;                  :ns "iaompheno" :prefix "" :suffix "_ICE"}])}
+;
+;
 ;; -------------------------------------------
 ;; ----------- NCBITaxon Ontology ------------
 ;; -------------------------------------------
-
+;
 ;;iao/ncbi_taxon/NCBI_TAXON_215158_ICE
-
-`{:name "ncbitaxon-ice-gen"
-  :head ((?/ice obo/IAO_0000219 ?/subclass)) ; denotes
-  :body ((?/subclass [rdfs/subClassOf *] obo/NCBITaxon_1))
-  :reify ([?/ice {:ln (:localname ?/subclass)
-                  :ns "iaoncbitaxon" :prefix "" :suffix "_ICE"}])}
-
-
+;
+;`{:name "ncbitaxon-ice-gen"
+;  :head ((?/ice obo/IAO_0000219 ?/subclass)) ; denotes
+;  :body ((?/subclass [rdfs/subClassOf *] obo/NCBITaxon_1))
+;  :reify ([?/ice {:ln (:localname ?/subclass)
+;                  :ns "iaoncbitaxon" :prefix "" :suffix "_ICE"}])}
+;
+;
 ;; `{:name "ncbitaxon-ice-gen"
 ;;   :head ((?/ice obo/IAO_0000219 ?/subclass))
 ;;   :body ((?/subclass [rdfs/subClassOf *] obo/NCBITaxon_1))
 ;;   :reify ([?/ice {:ln (:regex "NCBITaxon" "NCBI_TAXON" ?/subclass)
 ;;                   :ns "iaoncbitaxon" :prefix "" :suffix "_ICE"}])}
-
-
+;
+;
 ;; ;; create ICE URI's for each term in the NCBITaxon:archaea subontology
 ;; `{:name "b2i8-ncbitaxon-archaea-ice-gen"
 ;;   :head ((?/ice obo/IAO_0000219 ?/subclass))
 ;;   :body ((?/subclass [rdfs/subClassOf *] ncbitaxon/NCBITaxon_2157))
 ;;   :reify ([?/ice {:ln (:localname ?/subclass)
 ;;                   :ns "iaoncbitaxon" :prefix "" :suffix "_ICE"}])}
-
+;
 ;; ;; create ICE URI's for each term in the NCBITaxon:bacteria subontology
 ;; `{:name "b2i9-ncbitaxon-bacteria-ice-gen"
 ;;   :head ((?/ice obo/IAO_0000219 ?/subclass))
 ;;   :body ((?/subclass [rdfs/subClassOf *] ncbitaxon/NCBITaxon_2))
 ;;   :reify ([?/ice {:ln (:localname ?/subclass)
 ;;                   :ns "iaoncbitaxon" :prefix "" :suffix "_ICE"}])}
-
+;
 ;; ;; create ICE URI's for each term in the NCBITaxon:eukaryota subontology
 ;; `{:name "b2i10-ncbitaxon-eukaryota-ice-gen"
 ;;   :head ((?/ice obo/IAO_0000219 ?/subclass))
 ;;   :body ((?/subclass [rdfs/subClassOf *] ncbitaxon/NCBITaxon_2759))
 ;;   :reify ([?/ice {:ln (:localname ?/subclass)
 ;;                   :ns "iaoncbitaxon" :prefix "" :suffix "_ICE"}])}
-
+;
 ;; ;; create ICE URI's for each term in the NCBITaxon:viroids subontology
 ;; `{:name "b2i11-ncbitaxon-viroids-ice-gen"
 ;;   :head ((?/ice obo/IAO_0000219 ?/subclass))
 ;;   :body ((?/subclass [rdfs/subClassOf *] ncbitaxon/NCBITaxon_12884))
 ;;   :reify ([?/ice {:ln (:localname ?/subclass)
 ;;                   :ns "iaoncbitaxon" :prefix "" :suffix "_ICE"}])}
-
+;
 ;; ;; create ICE URI's for each term in the NCBITaxon:viruses subontology
 ;; `{:name "b2i12-ncbitaxon-viruses-ice-gen"
 ;;   :head ((?/ice obo/IAO_0000219 ?/subclass))
 ;;   :body ((?/subclass [rdfs/subClassOf *] ncbitaxon/NCBITaxon_10239))
 ;;   :reify ([?/ice {:ln (:localname ?/subclass)
 ;;                   :ns "iaoncbitaxon" :prefix "" :suffix "_ICE"}])}
-
+;
 ;; ;; create ICE URI's for each term in the NCBITaxon:other subontology
 ;; `{:name "b2i13-ncbitaxon-other-ice-gen"
 ;;   :head ((?/ice obo/IAO_0000219 ?/subclass))
 ;;   :body ((?/subclass [rdfs/subClassOf *] ncbitaxon/NCBITaxon_28384))
 ;;   :reify ([?/ice {:ln (:localname ?/subclass)
 ;;                   :ns "iaoncbitaxon" :prefix "" :suffix "_ICE"}])}
-
+;
 ;; ;; create ICE URI's for each term in the NCBITaxon:unclassified subontology
 ;; `{:name "b2i14-ncbitaxon-unclassified-ice-gen"
 ;;   :head ((?/ice obo/IAO_0000219 ?/subclass))
 ;;   :body ((?/subclass [rdfs/subClassOf *] ncbitaxon/NCBITaxon_12908))
 ;;   :reify ([?/ice {:ln (:localname ?/subclass)
 ;;                   :ns "iaoncbitaxon" :prefix "" :suffix "_ICE"}])}
-
+;
 ;; -------------------------------------------
 ;; ------------ Protein Ontology -------------
 ;; -------------------------------------------
-
-
-`{:name "pr-macromolecular-complex-ice-gen"
-  :head ((?/ice obo/IAO_0000219 ?/subclass)) ; denotes
-  :body ((?/subclass [rdfs/subClassOf *] obo/GO_0032991)
-         (:regex (:str ?/subclass) "^http://purl.obolibrary.org/obo/PR"))
-  ;;         (:regex ?/subclass "^http://purl.obolibrary.org/obo/PR"))
-  ;;(= "pr" (:namespace ?/subclass))) ;; ensure only PR terms are processed
-  :reify ([?/ice {:ln (:localname ?/subclass)
-                  :ns "iaopr" :prefix "" :suffix "_ICE"}])}
-
-
-`{:name "pr-aa-chain-ice-gen"
-  :head ((?/ice obo/IAO_0000219 ?/subclass)) ; denotes
-  :body ((?/subclass [rdfs/subClassOf *] obo/PR_000018263)
-         (:regex (:str ?/subclass) "^http://purl.obolibrary.org/obo/PR"))
-         ;;(:regex ?/subclass "^http://purl.obolibrary.org/obo/PR"))
-  ;;(= "pr" (:namespace ?/subclass))) ;; ensure only PR terms are processed
-  :reify ([?/ice {:ln (:localname ?/subclass)
-                  :ns "iaopr" :prefix "" :suffix "_ICE"}])}
-
-
+;
+;
+;`{:name "pr-macromolecular-complex-ice-gen"
+;  :head ((?/ice obo/IAO_0000219 ?/subclass)) ; denotes
+;  :body ((?/subclass [rdfs/subClassOf *] obo/GO_0032991)
+;         (:regex (:str ?/subclass) "^http://purl.obolibrary.org/obo/PR"))
+;  ;;         (:regex ?/subclass "^http://purl.obolibrary.org/obo/PR"))
+;  ;;(= "pr" (:namespace ?/subclass))) ;; ensure only PR terms are processed
+;  :reify ([?/ice {:ln (:localname ?/subclass)
+;                  :ns "iaopr" :prefix "" :suffix "_ICE"}])}
+;
+;
+;`{:name "pr-aa-chain-ice-gen"
+;  :head ((?/ice obo/IAO_0000219 ?/subclass)) ; denotes
+;  :body ((?/subclass [rdfs/subClassOf *] obo/PR_000018263)
+;         (:regex (:str ?/subclass) "^http://purl.obolibrary.org/obo/PR"))
+;         ;;(:regex ?/subclass "^http://purl.obolibrary.org/obo/PR"))
+;  ;;(= "pr" (:namespace ?/subclass))) ;; ensure only PR terms are processed
+;  :reify ([?/ice {:ln (:localname ?/subclass)
+;                  :ns "iaopr" :prefix "" :suffix "_ICE"}])}
+;
+;
 ;; ;;NOTE QUOTE NOT BACKQUOTE
 ;; '{:name "pr-macromolecular-complex-ice-gen"
 ;;   :head ((?/ice obo/IAO_0000219 ?/subclass))
@@ -191,7 +208,7 @@
 ;;           (= "pr" (:namespace ?/subclass))) ;; ensure only PR terms are processed
 ;;   :reify ([?/ice {:ln (:localname ?/subclass)
 ;;                   :ns "iaopr" :prefix "" :suffix "_ICE"}])}
-
+;
 ;; ;;NOTE QUOTE NOT BACKQUOTE
 ;; '{:name "pr-aa-chain-ice-gen"
 ;;   :head ((?/ice obo/IAO_0000219 ?/subclass))
@@ -199,30 +216,30 @@
 ;;           (= "pr" (:namespace ?/subclass))) ;; ensure only PR terms are processed
 ;;   :reify ([?/ice {:ln (:localname ?/subclass)
 ;;                   :ns "iaopr" :prefix "" :suffix "_ICE"}])}
-
+;
 ;; -------------------------------------------
 ;; ----------- Sequence Ontology -------------
 ;; -------------------------------------------
-`{:name "so-sequence-attribute-ice-gen"
-  :head ((?/ice obo/IAO_0000219 ?/subclass)) ; denotes
-  :body ((?/subclass [rdfs/subClassOf *] obo/SO_0000400))
-  :reify ([?/ice {:ln (:localname ?/subclass)
-                  :ns "iaoso" :prefix "" :suffix "_ICE"}])}
-
-`{:name "so-sequence-collection-ice-gen"
-  :head ((?/ice obo/IAO_0000219 ?/subclass)) ; denotes
-  :body ((?/subclass [rdfs/subClassOf *] obo/SO_0001260))
-  :reify ([?/ice {:ln (:localname ?/subclass)
-                  :ns "iaoso" :prefix "" :suffix "_ICE"}])}
-
-`{:name "so-sequence-feature-ice-gen"
-  :head ((?/ice obo/IAO_0000219 ?/subclass)) ; denotes
-  :body ((?/subclass [rdfs/subClassOf *] obo/SO_0000110))
-  :reify ([?/ice {:ln (:localname ?/subclass)
-                  :ns "iaoso" :prefix "" :suffix "_ICE"}])}
-
-`{:name "so-sequence-variant-ice-gen"
-  :head ((?/ice obo/IAO_0000219 ?/subclass)) ; denotes
-  :body ((?/subclass [rdfs/subClassOf *] obo/SO_0001060))
-  :reify ([?/ice {:ln (:localname ?/subclass)
-                  :ns "iaoso" :prefix "" :suffix "_ICE"}])}
+;`{:name "so-sequence-attribute-ice-gen"
+;  :head ((?/ice obo/IAO_0000219 ?/subclass)) ; denotes
+;  :body ((?/subclass [rdfs/subClassOf *] obo/SO_0000400))
+;  :reify ([?/ice {:ln (:localname ?/subclass)
+;                  :ns "iaoso" :prefix "" :suffix "_ICE"}])}
+;
+;`{:name "so-sequence-collection-ice-gen"
+;  :head ((?/ice obo/IAO_0000219 ?/subclass)) ; denotes
+;  :body ((?/subclass [rdfs/subClassOf *] obo/SO_0001260))
+;  :reify ([?/ice {:ln (:localname ?/subclass)
+;                  :ns "iaoso" :prefix "" :suffix "_ICE"}])}
+;
+;`{:name "so-sequence-feature-ice-gen"
+;  :head ((?/ice obo/IAO_0000219 ?/subclass)) ; denotes
+;  :body ((?/subclass [rdfs/subClassOf *] obo/SO_0000110))
+;  :reify ([?/ice {:ln (:localname ?/subclass)
+;                  :ns "iaoso" :prefix "" :suffix "_ICE"}])}
+;
+;`{:name "so-sequence-variant-ice-gen"
+;  :head ((?/ice obo/IAO_0000219 ?/subclass)) ; denotes
+;  :body ((?/subclass [rdfs/subClassOf *] obo/SO_0001060))
+;  :reify ([?/ice {:ln (:localname ?/subclass)
+;                  :ns "iaoso" :prefix "" :suffix "_ICE"}])}


Add projection lens.

Add projection lens.

--- src/active/clojure/lens.cljc
+++ src/active/clojure/lens.cljc
@@ -377,28 +377,58 @@
                       (rest result))
                 (into (empty structs)))))))))

-(let [map-f (fn
-              ([mp outer]
-               (reduce-kv (fn [inner k lens]
-                            (assoc inner k (yank outer lens)))
-                          mp mp))
-              ([mp outer inner]
-               (reduce-kv (fn [outer k lens]
-                            (shove outer lens (get inner k)))
-                          outer
-                          mp)))
-      vec-f (fn
-              ([v outer]
-               (mapv (fn [lens]
-                       (yank outer lens))
-                     v))
-              ([v outer inner]
-               (reduce (fn [outer i]
-                         (shove outer (get v i) (get inner i)))
-                       outer
-                       (range (count v)))))]
-  (defn pattern [p]
-    (cond
-      (map? p) (f/partial map-f p)
-      (vector? p) (f/partial vec-f p)
-      :else (assert false "Pattern must be a map or a vector."))))
+(let [f (fn
+          ([empty fields in]
+           (reduce (fn [r [f lens]]
+                     (shove r f (yank in lens)))
+                   empty
+                   fields))
+          ([empty fields out v]
+           (reduce (fn [r [f lens]]
+                     (shove r lens (yank v f)))
+                   out
+                   fields)))]
+  (defn- projection
+    "A lens that projects multiple derived values into a new value,
+  with `empty` being an initial new value, and `fields` a map or
+  sequence of tuples, of a lens on the new value and lens over the
+  'outer' value the lens is used on.
+
+  As an example, this can be used to map between to record types like this:
+
+```
+  (projection (make-inner-record nil)
+              {inner-record-field outer-record-field})
+```
+
+  The returned lens can then be used on a value of type
+  'outer-record', to see it as a value of type 'inner-record'."
+    [empty fields]
+    (f/partial f empty fields)))
+
+(defn pattern
+  "A lens over any value yielding to a map or a vector, depending on the given pattern.
+
+  For example
+
+```
+  (pattern {:bar (at-index 0) :foo (at-index 2)})
+```
+
+  will focus on the first and third elements of a sequence, as a map with the given keys.
+
+  Similarly, you can create a lens that yield a vector, given some fields of a map:
+
+```
+  (pattern [:bar :foo])
+```
+
+"
+  [p]
+  (cond
+    ;; TODO: optimize projection by using transient ? (generally, make a :keyword use assoc! on trantients?
+    (map? p) (projection {} p)
+    (vector? p) (projection [] (map-indexed (fn [idx f]
+                                              [(at-index idx) f])
+                                            p))
+    :else (assert false "Pattern must be a map or a vector.")))


Recently updated copy

Recently updated copy

--- src/clj/clojuredocs/pages/intro.clj
+++ src/clj/clojuredocs/pages/intro.clj
@@ -17,7 +17,7 @@
    (util/$avatar author)
    [:span.content
     (:login author)
-    " authored a new example for "
+    " authored an example for "
     (util/$var-link (:ns var) (:name var)
       (-> var :ns util/html-encode)
       "/"


Simple function tests performance of regular and optimized trends

--- src/clj/forma/hadoop/jobs/forma.clj
+++ src/clj/forma/hadoop/jobs/forma.clj
@@ -146,6 +146,48 @@
               (a/long-stats ts short-rain)
               (a/hansen-stat ts)])))

+(defn new-trends
+  "Calculates all trend statistics for a timeseries, also returns the
+   period index of the last element of the series"
+  [window long-block start-idx ts rain-ts]
+  (let [end-idx (series-end ts start-idx)
+        short-rain (first (f/shorten-ts ts rain-ts))]
+    (flatten [end-idx
+    ;;          (a/short-stat long-block window ts)
+              (a/long-stats ts short-rain)
+              (a/hansen-stat ts)])))
+
+(defn test-trends-perf
+  "Rough performance stats:
+
+   hansen-stat - 40 ms
+   long-stats - 55 ms
+   short-stat - 95 ms (in current trends)
+   short-stat - 7 ms (optimized - run once)
+
+Usage:
+     (ts-trends {:est-start \"2005-12-19\" :est-end \"2013-03-06\" :t-res \"16\" :window 10 :long-block 30} 693)"
+  [{:keys [est-start est-end t-res window long-block]}
+   ts-start-period]
+  (let [val-ts (repeatedly 350 (partial rand-int 10000))
+        rain-ts (repeatedly 350 (partial rand-int 10000))
+        [start-idx end-idx] (date/relative-period t-res ts-start-period
+                                          [est-start est-end])
+        tele-start-idx (inc start-idx)
+        tele-end-idx (inc end-idx)
+        calculate #(calculate-trends window long-block
+                                     ts-start-period % rain-ts)
+        new-calculate #(new-trends window long-block
+                                   ts-start-period % rain-ts)]
+    (prn "Normal trends")
+    (time (dotimes [_ 10] (last (first (map (comp vec calculate) ;; force realization
+                                      (f/tele-ts tele-start-idx tele-end-idx val-ts))))))
+    (prn "Optimized trends")
+    (time (dotimes [_ 10]
+            (let [a (a/short-stat long-block window val-ts)
+                  b (last (first (map (comp vec new-calculate) ;; force realization
+                         (f/tele-ts tele-start-idx tele-end-idx val-ts))))])))))
+
 (defmapcatop telescoping-trends
   "Maps `calculate-trends` onto each part of an ever-lengthening subset
    of the input timeseries, from `est-start` to `est-end`. Returns


rename fn for resetting consumer's state, to reflect more general usage

--- src/clj/marceline/storm/metrics.clj
+++ src/clj/marceline/storm/metrics.clj
@@ -106,10 +106,10 @@

 ;; helper fns
-(defn conf-state!
-  "Sets a consumer's state to be the conf map."
-  [this-consumer conf]
-  (reset! (. this-consumer state) conf))
+(defn reset-state!
+  "Sets a consumer's state to val."
+  [this-consumer val]
+  (reset! (. this-consumer state) val))

 (defn metric-vals
   [metric-name data-points]


start adding metrics support with gen-class-based consumers

--- src/clj/marceline/storm/metrics.clj
+++ src/clj/marceline/storm/metrics.clj
@@ -1,38 +1,60 @@
 (ns marceline.storm.metrics
-  (:require [backtype.storm.clojure :refer (to-spec normalize-fns)])
-  (:import [marceline.storm.trident.clojure ClojureMetricsConsumer])
+  (:import [backtype.storm.metric.api IMetric CountMetric MultiCountMetric])
+  (:require [backtype.storm.clojure :refer (to-spec normalize-fns)]
+            [backtype.storm.config :refer (TOPOLOGY-METRICS-CONSUMER-REGISTER)])
   (:gen-class))

-;; ## metrics consumer
-(defn clojure-metrics-consumer* [fn-var args]
-  (ClojureMetricsConsumer. (to-spec fn-var) args))

-(defmacro clojure-metrics-consumer [fn-sym args]
-  `(clojure-metrics-consumer* (var ~fn-sym) ~args))

-(defmacro metrics-consumer [& body]
-  (let [[base-fns other-fns] (split-with #(not (symbol? %)) body)
-        fns (normalize-fns base-fns)]
-    `(reify backtype.storm.metric.api.IMetricsConsumer
-       ~@fns)))
+(defmacro defmetricsconsumer
+  [name prepare-impl handle-data-points-impl cleanup-impl]
+  (let [prefix (gensym)
+        classname (str *ns* ".consumer." name)]
+    `(do
+       (gen-class :name ~classname
+                  :implements [backtype.storm.metric.api.IMetricsConsumer]
+                  :prefix ~prefix)
+       (defn ~(symbol (str prefix "prepare"))
+         ~@prepare-impl)
+       (defn ~(symbol (str prefix "handleDataPoints"))
+         ~@handle-data-points-impl)
+       (defn ~(symbol (str prefix "cleanup"))
+         ~@cleanup-impl)
+       (def ~name {~TOPOLOGY-METRICS-CONSUMER-REGISTER
+                   [{"class" ~classname
+                     "parallelism.hint" 1
+                     "argument" nil}]}))))

-(defmacro defmetricsconsumer [name & [opts & impl :as all]]
-  (if-not (map? opts)
-    `(defmetricsconsumer ~name {} ~@all)
-    (let [params (:params opts)
-          fn-name (symbol (str name "__"))
-          fn-body (if (:prepare opts)
-                    (cons 'fn impl)
-                    (let [[args & impl-body] impl
-                          prepargs [(gensym "conf") (gensym "registation-argument") (gensym "context") (gensym "error-reporter")]]
-                      `(fn ~prepargs (metrics-consumer
-                                      (~'handleDataPoints ~(vec args) ~@impl-body)))))
-          definer (if params
-                    `(defn ~name [& args#]
-                       (clojure-metrics-consumer ~fn-name args#))
-                    `(def ~name
-                       (clojure-metrics-consumer ~fn-name [])))]
-      `(do
-         (defn ~fn-name ~(if params params [])
-           ~fn-body)
-         ~definer))))
+(defmacro defmetric
+  [get-value-and-reset-impl]
+  `(reify IMetric
+     (getValueAndReset [this]
+       (do ~@get-value-and-reset-impl))))
+
+
+;; TODO maybe change how to pass these around (metrics + curry fns)
+(defn count-metric
+  []
+  (let [cm (CountMetric.)]
+    {:fn (fn [] (.incr cm))
+     :m cm}))
+
+(defn multi-count-metric
+  []
+  (let [mcm (MultiCountMetric.)]
+    {:fn (fn [k] (.incr (.scope mcm k)))
+     :m mcm}))
+
+(defn register-metrics
+  [topology-context metrics]
+  (doseq [[name imetric periodicity] metrics]
+    (.registerMetric topology-context name imetric (int periodicity))))
+
+(defmacro with-multi-count
+  [topology-context nm & body]
+  `(let [m# (multi-count-metric)
+         ~nm (:fn m#)]
+     (register-metrics ~topology-context [[(str (quote ~nm)) (:m m#) 30]])
+     (do ~@body)))
+
+;; TODO more general with-metrics macro