Microoptimizations for description graphs

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

--- src/conexp/contrib/dl/languages/description_graphs.clj
+++ src/conexp/contrib/dl/languages/description_graphs.clj
@@ -76,12 +76,20 @@
   unique symbols. Returns a pair of the result and the transformation
   map used."
   [tbox-map]
-  (let [old->new  (into {} (for [A (keys tbox-map)]
-                             [A (make-dl-expression (expression-language A) (gensym))])),
-        old->new* (into {} (for [[A B] old->new]
-                             [(expression-term A) B]))]
-    [(into {} (for [[A def-A] tbox-map]
-                [(old->new A) (set (map #(substitute % old->new*) def-A))]))
+  (let [old->new  (map-by-fn (fn [A]
+                               (make-dl-expression (expression-language A) (gensym)))
+                             (keys tbox-map)),
+        old->new* (reduce! (fn [map [A B]]
+                             (assoc! map (expression-term A) B))
+                           {}
+                           old->new)]
+    [(reduce! (fn [map [A def-A]]
+                (assoc! map
+                        (old->new A)
+                        (set-of (substitute term old->new*)
+                                [term def-A])))
+              {}
+              tbox-map)
      old->new]))

 (defn- tbox->hash-map
@@ -89,16 +97,25 @@
   of concepts in the top-level conjunction."
   [tbox]
   (let [language (tbox-language tbox)]
-    (into {} (for [def (tbox-definitions tbox)]
-               [(make-dl-expression language (definition-target def))
-                (conjunctors (definition-expression def))]))))
+    (reduce! (fn [map def]
+               (assoc! map
+                       (make-dl-expression language (definition-target def))
+                       (conjunctors (definition-expression def))))
+             {}
+             (vals (tbox-definition-map tbox)))))

 (defn- hash-map->tbox
   "Transforms given hash-map to a TBox for the given language."
   [language tbox-map]
-  (let [definitions (into {} (for [[A def-A] tbox-map]
-                               [(expression-term A) (make-dl-definition language (expression-term A) (cons 'and def-A))]))]
-    (make-tbox language definitions)))
+  (make-tbox language
+             (reduce! (fn [map [A def-A]]
+                        (assoc! map
+                                (expression-term A)
+                                (make-dl-definition language
+                                                    (expression-term A)
+                                                    (cons 'and def-A))))
+                      {}
+                      tbox-map)))

 ;; storing names

@@ -131,14 +148,16 @@
   term. New definitions go into the atom new-names."
   [term goal new-names]
   (cond
-   (goal term) term
-   (tbox-target-pair? term) (let [[tbox target] (expression-term term),
-                                  [tbox-map trans] (uniquify-tbox-map (tbox->hash-map tbox))]
-                              (add-names new-names tbox-map)
-                              (trans (make-dl-expression (expression-language term) target)))
-   :else (let [new-sym (make-dl-expression (expression-language term) (gensym))]
-           (add-name new-names new-sym (conjunctors term))
-           new-sym)))
+   (goal term) term,
+   (tbox-target-pair? term)
+   (let [[tbox target] (expression-term term),
+         [tbox-map trans] (uniquify-tbox-map (tbox->hash-map tbox))]
+     (add-names new-names tbox-map)
+     (trans (make-dl-expression (expression-language term) target))),
+   :else
+   (let [new-sym (make-dl-expression (expression-language term) (gensym))]
+     (add-name new-names new-sym (conjunctors term))
+     new-sym)))

 (defn- normalize-term
   "Normalizes conjunctor term. New definitions go into the atom new-names."
@@ -146,11 +165,11 @@
   (if (and (compound? term)
            (= 'exists (operator term)))
     (let [[r B] (arguments term),
-          norm (normalize-for-goal B
-                                   #(and (atomic? %)
-                                         (not (tbox-target-pair? %))
-                                         (not (primitive? %)))
-                                   new-names)]
+          norm  (normalize-for-goal B
+                                    #(and (atomic? %)
+                                          (not (tbox-target-pair? %))
+                                          (not (primitive? %)))
+                                    new-names)]
       (make-dl-expression (expression-language term)
                           (list 'exists r norm)))
     (normalize-for-goal term
@@ -166,13 +185,13 @@
   [tbox-map]
   (if (empty? tbox-map)
     tbox-map
-    (let [new-names (new-names),
-          ;; doall needed to store new names in new-names!
-          normalized-map (doall
-                          (into {} (map (fn [[A def-A]]
-                                          [A (set (map #(normalize-term % new-names) def-A))])
-                                        tbox-map))),
-          new-names-map (introduce-auxiliary-definitions (get-names new-names))]
+    (let [new-names      (new-names),
+          normalized-map (reduce! (fn [map [A def-A]]
+                                    (assoc! map A (set-of (normalize-term t new-names)
+                                                          [t def-A])))
+                                  {}
+                                  tbox-map),
+          new-names-map  (introduce-auxiliary-definitions (get-names new-names))]
       (into normalized-map new-names-map))))

 ;; normalizing algorithm -- squeezing the concept graph
@@ -195,19 +214,28 @@
   by A."
   [tbox-map]
   (let [equivalent-concepts (scc (concept-graph tbox-map)),
-        rename-map (into {} (for [concepts equivalent-concepts
-                                  concept concepts]
-                              [concept (first concepts)])),
-        used-map (into {} (for [concepts equivalent-concepts]
-                            [(first concepts) concepts])),
-        new-tbox-map (into {} (map (fn [target]
-                                     [target
-                                      (disj (set (replace rename-map
-                                                          (mapcat tbox-map (used-map target))))
-                                            target)])
-                                   (vals rename-map)))]
-    (into {} (for [target (keys tbox-map)]
-               [target (-> target rename-map new-tbox-map)]))))
+        rename-map          (reduce! (fn [map concepts]
+                                       (let [new-concept (first concepts)]
+                                         (reduce (fn [map concept]
+                                                   (assoc! map concept new-concept))
+                                                 map
+                                                 concepts)))
+                                     {}
+                                     equivalent-concepts),
+        used-map            (reduce! (fn [map concepts]
+                                       (assoc! map (first concepts) concepts))
+                                     {}
+                                     equivalent-concepts),
+        new-tbox-map        (reduce! (fn [map target]
+                                       (assoc! map
+                                               target
+                                               (disj (set (replace rename-map
+                                                                   (mapcat tbox-map (used-map target))))
+                                                     target)))
+                                     {}
+                                     (vals rename-map))]
+    (map-by-fn (comp new-tbox-map rename-map)
+               (keys tbox-map))))

 (defn- replace-toplevel-concepts
   "Replaces any top-level defined concept in tbox-map by its definition."
@@ -217,13 +245,14 @@
     (if (empty? deps)
       new-tbox-map
       (let [next-concepts (first deps),
-            new-defs (into {} (for [target next-concepts]
-                                [target (reduce (fn [result next-thing]
-                                                  (if (set? next-thing)
-                                                    (into result next-thing)
-                                                    (conj result next-thing)))
+            new-defs      (map-by-fn (fn [target]
+                                       (reduce (fn [result next-thing]
+                                                 (if (set? next-thing)
+                                                   (into result next-thing)
+                                                   (conj result next-thing)))
                                                 #{}
-                                                (replace new-tbox-map (tbox-map target)))]))]
+                                                (replace new-tbox-map (tbox-map target))))
+                                     next-concepts)]
         (recur (rest deps)
                (merge new-tbox-map new-defs))))))

@@ -251,15 +280,13 @@
         language      (tbox-language tbox),
         vertices      (defined-concepts tbox),
         neighbours    (memo-fn _ [target]
-                        (let [def (find-definition tbox target)]
-                          (set (map #(vec (map expression-term (arguments %)))
-                                    (filter compound? ;i.e. existential restriction
-                                            (arguments (definition-expression def))))))),
+                        (set-of (vec (map expression-term (arguments t)))
+                                [t (arguments (definition-expression (find-definition tbox target)))
+                                 :when (compound? t)])),
         vertex-labels (memo-fn _ [target]
-                        (let [def (find-definition tbox target)]
-                          (set (map expression-term
-                                    (filter atomic?
-                                            (arguments (definition-expression def)))))))]
+                        (set-of (expression-term t)
+                                [t (arguments (definition-expression (find-definition tbox target)))
+                                 :when (atomic? t)]))]
     (make-description-graph language vertices neighbours vertex-labels)))

 (defn description-graph->tbox
@@ -269,13 +296,15 @@
         labels      (vertex-labels description-graph),
         neighbours  (neighbours description-graph),

-        definitions (into {} (for [A (vertices description-graph)
-                                   :let [def-exp (make-dl-expression language
-                                                                     (list* 'and
-                                                                            (concat (labels A)
-                                                                                (for [[r B] (neighbours A)]
-                                                                                (list 'exists r B)))))]]
-                               [A (make-dl-definition A def-exp)]))]
+        definitions (map-by-fn (fn [A]
+                                 (make-dl-definition
+                                  A
+                                  (make-dl-expression language
+                                                      (list* 'and
+                                                             (concat (labels A)
+                                                                     (for [[r B] (neighbours A)]
+                                                                       (list 'exists r B)))))))
+                               (vertices description-graph))]
     (make-tbox language definitions)))

 (defn model->description-graph
@@ -304,9 +333,8 @@
   "Returns the product of the two description graphs given."
   [graph-1 graph-2]
   (let [language      (graph-language graph-1),
-        vertices      (for [a (vertices graph-1),
-                            b (vertices graph-2)]
-                        [a b])
+        vertices      (cross-product (vertices graph-1)
+                                     (vertices graph-2)),
         neighbours    (fn [[A B]]
                         (set-of [r [C D]] [[r C] ((neighbours graph-1) A),
                                            [s D] ((neighbours graph-2) B),
@@ -321,10 +349,10 @@
 (defn- HashMap->hash-map
   "Converts a Java HashMap to a Clojure hash-map."
   [^HashMap map]
-  (reduce (fn [map, ^java.util.Map$Entry entry]
-            (conj map [(.getKey entry) (.getValue entry)]))
-          {}
-          (.entrySet map)))
+  (reduce! (fn [map, ^java.util.Map$Entry entry]
+             (assoc! map (.getKey entry) (.getValue entry)))
+           {}
+           (.entrySet map)))

 (defmacro- while-let
   "Runs body with binding in effect as long as x is non-nil.
@@ -343,11 +371,12 @@
   vertices (sim v) in G-2 such that there exists a simulation from v to
   every vertex in (sim v)."
   [G-1 G-2]
-  (let [label-1 (vertex-labels G-1),
-        label-2 (vertex-labels G-2),
+  (let [label-1      (vertex-labels G-1),
+        label-2      (vertex-labels G-2),
         neighbours-1 (neighbours G-1),
         neighbours-2 (neighbours G-2),
-        edge-2? (fn [v r w] (contains? (neighbours-2 v) [r w])),
+        edge-2?      (fn [v r w]
+                       (contains? (neighbours-2 v) [r w])),

         ^HashMap sim-sets (HashMap.)]

@@ -369,17 +398,17 @@

 ;; efficient simulator sets (by meng)

-(defn single-edge->double-edge-graph
+(defn- single-edge->double-edge-graph
   "Given a single-edged graph G (i.e. a graph with a neighbours
   function on it) returns a structure with a :pre and a :post function
   on it. This function is part of the implementation for
   efficient-simulator-sets."
   [G]
-  (loop [pre-map {},
+  (loop [pre-map    (transient {}),
          vertex-set (vertices G)]
-    (if-not (empty? vertex-set)
+    (if (not-empty vertex-set)
       (let [v (first vertex-set)]
-        (recur (reduce #(update-in %1 [%2] conj v)
+        (recur (reduce #(assoc! %1 %2 (conj (get %1 %2) v))
                        pre-map
                        ((neighbours G) v))
                (rest vertex-set)))
@@ -388,7 +417,7 @@
        :post     (memo-fn _ [v r]
                    (set-of w [[s w] ((neighbours G) v)
                               :when (= s r)])),
-       :pre      (fn [v r]
+       :pre      (memo-fn _ [v r]
                    (set (get pre-map [r v] nil)))})))

 (defn efficient-initialize
@@ -418,7 +447,7 @@
         (.put remove [v r]
               (set-of w [w base-set-2,
                          :let [post-w (post-2 w r)]
-                         :when (seq post-w) ;i.e. (not (empty? post-w))
+                         :when (not-empty post-w)
                          :let [sim-v (.get sim v)]
                          :when (forall [x post-w] (not (contains? sim-v x)))]))))
     (doseq [w base-set-2]
@@ -448,7 +477,7 @@
         pre-1      (:pre G-1)]
     (doseq [v base-set-1,
             r R,
-            :when (seq (.get remove [v r]))] ;i.e. (not (empty? (.get remove [v r])))
+            :when (not-empty (.get remove [v r]))]
       (.add non-empty-removes [v r]))
     (while-let [[v r] (first non-empty-removes)]
       (doseq [w (.get remove [v r]),


missing passing opts

missing passing opts

--- src/main/cljs/cljs/js.cljs
+++ src/main/cljs/cljs/js.cljs
@@ -88,7 +88,7 @@
              (*load-fn* name
                (fn [source]
                  (if-not (nil? source)
-                   (analyze* env bound-vars source
+                   (analyze* env bound-vars source opts
                      (fn []
                        (analyze-deps lib (next deps) env bound-vars opts cb)))
                    (throw


Add jvm-opts in a comment

Add jvm-opts in a comment

--- resources/leiningen/new/play_cljc/project.clj
+++ resources/leiningen/new/play_cljc/project.clj
@@ -21,6 +21,8 @@
                  [org.lwjgl/lwjgl-glfw "3.2.3" :classifier "natives-windows"]
                  [org.lwjgl/lwjgl-opengl "3.2.3" :classifier "natives-windows"]
                  [org.lwjgl/lwjgl-stb "3.2.3" :classifier "natives-windows"]]
+  ; on Mac OS, you need to uncomment this!
+  ;:jvm-opts ["-XstartOnFirstThread"]
   :profiles {:dev {:main {{name}}.start-dev
                    :dependencies [[paravim "RELEASE"]
                                   [orchestra "2018.12.06-2"]


slightly improve rn ws connect error

slightly improve rn ws connect error

--- src/main/shadow/cljs/devtools/client/react_native.cljs
+++ src/main/shadow/cljs/devtools/client/react_native.cljs
@@ -244,7 +244,8 @@

     (set! (.-onerror socket)
       (fn [e]
-        (js/console.error "websocket error" (.-message e) e)))
+        (js/console.error (str "WebSocket connect failed:" (.-message e) "\n"
+                               "It was trying to connect to: " (subs ws-url 0 (str/index-of ws-url "/" 6)) "\n"))))

     (js/setTimeout heartbeat! 30000)
     ))


fixed ns requires order

fixed ns requires order

--- src/metabase/api/pulse.clj
+++ src/metabase/api/pulse.clj
@@ -2,6 +2,7 @@
   "/api/pulse endpoints."
   (:require [compojure.core :refer [defroutes GET PUT POST DELETE]]
             [hiccup.core :refer [html]]
+            [schema.core :as s]
             [metabase.api.common :refer :all]
             [metabase.db :as db]
             [metabase.email :as email]
@@ -16,8 +17,7 @@
             [metabase.pulse :as p]
             [metabase.pulse.render :as render]
             [metabase.util :as u]
-            [metabase.util.schema :as su]
-            [schema.core :as s]))
+            [metabase.util.schema :as su]))

 (defendpoint GET "/"


Add Platform and date-picker-ios to mobile_patient/ui

--- src/mobile_patient/ui.cljs
+++ src/mobile_patient/ui.cljs
@@ -11,9 +11,11 @@

 (def ReactNative (js/require "react-native"))

+(def Dimensions (.-Dimensions ReactNative))
+(def Platform (.-Platform ReactNative))
+
 (def date-picker (.-DatePickerAndroid ReactNative))
-(def Dimensions (.-Dimensions ReactNative))
-
+(def date-picker-ios (r/adapt-react-class (.-DatePickerIOS ReactNative)))
 (def view (r/adapt-react-class (.-View ReactNative)))
 (def modal (r/adapt-react-class (.-Modal ReactNative)))
 (def image (r/adapt-react-class (.-Image ReactNative)))


Cleaned up slack notify

Cleaned up slack notify

--- src/mokkameister/slack.clj
+++ src/mokkameister/slack.clj
@@ -1,13 +1,26 @@
 (ns mokkameister.slack
   (:require [clj-http.client :as client]
-            [environ.core :refer [env]]))
+            [environ.core :refer [env]]
+            [clojure.core.async :as a :refer [go timeout <!]]))

-(def slack-url (env :slack-url))
+(def slack-url (or (env :slack-url)
+                   (throw (Exception. "Missing SLACK_URL environment variable"))))

-(defn notify [message]
+(defn notify
+  "Send message to slack. Optional arguments: channel, emoji, username."
+  [message & {:keys [channel username emoji]
+              :or {channel  "#testroompleaseignore"
+                   emoji    ":coffee:"
+                   username "Mokkameister 9000"}}]
   (let [payload {:text message
-                 :username "Mokkameister 9000"
-                 :icon_emoji ":coffee:"
-                 :channel "#testroompleaseignore"}]
-    (client/post slack-url {:form-params payload
-                            :content-type :json})))
+                 :username username
+                 :icon_emoji emoji
+                 :channel channel}]
+    (client/post slack-url {:content-type :json
+                            :form-params payload})))
+
+(defn delayed-notify
+  "Send a delayed (millisec) message to slack."
+  [delay-ms & args]
+  (go (<! (timeout delay-ms))
+      (apply notify args)))


update location hash only after typing finished

--- iwaswhere-web/src/cljs/iwaswhere_web/ui/search.cljs
+++ iwaswhere-web/src/cljs/iwaswhere_web/ui/search.cljs
@@ -50,9 +50,14 @@
   "Renders search component."
   [{:keys [observed local put-fn]}]
   (let [local-snapshot @local
+        location-timeout-fn (fn [search-text]
+                              (.setTimeout js/window
+                                           #(aset js/window "location" "hash" (js/encodeURIComponent search-text))
+                                           5000))
         on-change-fn #(let [new-search (h/parse-search (.. % -target -value))]
                        (swap! local assoc-in [:current-query] new-search)
-                       (aset js/window "location" "hash" (js/encodeURIComponent (:search-text new-search)))
+                       (swap! local update-in [:set-location] (fn [prev] (when prev (.clearTimeout js/window prev))
+                                                                (location-timeout-fn (:search-text new-search))))
                        (put-fn [:state/get (merge new-search {:sort-by-upvotes (:sort-by-upvotes @observed)})]))]
     [:div.l-box-lrg.pure-g.search-div
      [:div.pure-u-1


get-level!

get-level!

--- clojure/src/dnd/core.cljs
+++ clojure/src/dnd/core.cljs
@@ -150,14 +150,17 @@
         (swap! (:character new-client) assoc :name dat-name)))
     (kick-it new-client)))

+(defn get-level! []
+  (async
+    (-> (await (db/load))
+        (then (fn [blocks]
+                (reset! level (if (nil? blocks)
+                                (make-level)
+                                (transform [ALL ALL :color] clj->js blocks))))))))
+
 (defn -main []
   (async
-    (await
-      (-> (await (db/load))
-          (then (fn [blocks]
-                  (reset! level (if (nil? blocks)
-                                  (make-level)
-                                  (transform [ALL ALL :color] clj->js blocks)))))))
+    (await (get-level!))
     (if (-> (last process.argv)
             (= "server"))
       (create-server)


Don't consistently redraw buffers - this helps us not hit the memory error in scsynth-jna so soon (after enough calls to (buffer-data) scsynth-jna runs out of memory as it doesn't free it after use.)

--- src/overtone/viz/scope.clj
+++ src/overtone/viz/scope.clj
@@ -31,9 +31,15 @@
                                                         (ref-set scope-group* (group :tail ROOT-GROUP))
                                                         (satisfy-deps :scope-group-created)))

-(defn- update-scope-data [s]
+(defn- update-scope-data
+  "Updates the scope by reading the current status of the buffer and repainting.
+  Currently only updates bus scope as there's a bug in scsynth-jna which crashes
+  the server after too many calls to buffer-data for a large buffer. As buffers
+  tend to be large, updating the scope frequently will cause the crash to happen
+  sooner. Need to remove this limitation when scsynth-jna is fixed."
+  [s]
   (let [{:keys [buf size width height panel y-arrays x-array panel]} s
-        frames    (buffer-data buf)
+        frames    (if @(:update? s) (buffer-data buf) @(:frames s))
         step      (int (/ (buffer-size buf) width))
         y-scale   (- height (* 2 Y-PADDING))
         [y-a y-b] @y-arrays]
@@ -44,10 +50,15 @@
                       (aget ^floats frames (unchecked-multiply x step)))))))

     (reset! y-arrays [y-b y-a])
-    (.repaint panel)))
+    (.repaint panel)
+
+    (when (and (not (:bus-synth s))
+               @(:update? s))
+      (reset! (:frames s) frames)
+      (reset! (:update? s) false))))

 (defn- update-scopes []
-  (doall (map update-scope-data (vals @scopes*))))
+  (dorun (map update-scope-data (vals @scopes*))))

 (defn- paint-scope [^Graphics g id]
   (if-let [scope (get @scopes* id)]
@@ -176,7 +187,9 @@
                :width width
                :height height
                :x-array x-array
-               :y-arrays (atom [y-a y-b])}
+               :y-arrays (atom [y-a y-b])
+               :update? (atom true)
+               :frames (atom [])}

         _ (reset-data-arrays scope)]
     (.addWindowListener frame


use map in comment anim instead of vector, to show that it can't be recreated with the ignore #_ macro


Add additional tests for fact/resource subqueries

--- test/com/puppetlabs/puppetdb/test/http/v2/facts.clj
+++ test/com/puppetlabs/puppetdb/test/http/v2/facts.clj
@@ -221,6 +221,16 @@
                                 [{:node "bar" :fact "ipaddress" :value "192.168.1.101"}
                                  {:node "foo" :fact "ipaddress" :value "192.168.1.100"}]

+                                ;; "not" matching resources
+                                ["and"
+                                 ["=" ["fact" "name"] "ipaddress"]
+                                 ["not" ["subquery" "resource"
+                                         ["and"
+                                          ["=" "type" "Class"]
+                                          ["=" "title" "Apache"]]]]]
+
+                                [{:node "baz" :fact "ipaddress" :value "192.168.1.102"}]
+
                                 ;; Multiple matching resources
                                 ["and"
                                  ["=" ["fact" "name"] "ipaddress"]
@@ -246,6 +256,23 @@
                                  {:node "foo" :fact "ipaddress" :value "192.168.1.100"}
                                  {:node "foo" :fact "operatingsystem" :value "Debian"}]

+                                ;; Multiple subqueries
+                                ["and"
+                                 ["=" ["fact" "name"] "ipaddress"]
+                                 ["or"
+                                  ["subquery" "resource"
+                                   ["and"
+                                    ["=" "type" "Class"]
+                                    ["=" "title" "Apache"]]]
+                                  ["subquery" "resource"
+                                   ["and"
+                                    ["=" "type" "Class"]
+                                    ["=" "title" "Main"]]]]]
+
+                                [{:node "bar" :fact "ipaddress" :value "192.168.1.101"}
+                                 {:node "baz" :fact "ipaddress" :value "192.168.1.102"}
+                                 {:node "foo" :fact "ipaddress" :value "192.168.1.100"}]
+
                                 ;; No matching resources
                                 ["and"
                                  ["=" ["fact" "name"] "ipaddress"]


Make default nodes gray

Make default nodes gray

--- test/com/wsscode/pathom/connect/run_graph_test.cljc
+++ test/com/wsscode/pathom/connect/run_graph_test.cljc
@@ -41,25 +41,23 @@
                  :node->descriptor (fn [node-id]
                                      (let [node (get nodes node-id)]
                                        (cond-> {:id    (str node-id)
-                                                :color (if (= node-id root) "blue" "normal")
+                                                :style "filled"
+                                                :color (if (= node-id root) "blue" "#F3F3F3")
                                                 :label (str
                                                          (or (::pc/sym node)
                                                              (if (::pcrg/run-and node) "AND")
                                                              (if (::pcrg/run-or node) "OR")))}
                                          (get-in env [::pc/index-resolvers (::pc/sym node) ::pc/dynamic-resolver?])
                                          (assoc
-                                           :style "filled"
                                            :fontcolor "white"
                                            :fillcolor "black")

                                          (::pcrg/run-and node)
                                          (assoc
-                                           :style "filled"
                                            :fillcolor "yellow")

                                          (::pcrg/run-or node)
                                          (assoc
-                                           :style "filled"
                                            :fillcolor "cyan"))))})]
     (io/copy (tangle/dot->image dot "png") (io/file "out.png"))
     graph))


Updated fmap and fold tests for RealBlockVector and RealBlockVector.

--- test/uncomplicate/neanderthal/buffer_block_test.clj
+++ test/uncomplicate/neanderthal/buffer_block_test.clj
@@ -29,6 +29,7 @@
            (release sub-a) => true
            (release a) => true
            (release a) => true)))
+
 (defn test-ifn-vector [factory]
   (facts "IFn implementation for real block vector"
          (let [x (create-vector factory [1 2 3 4])]
@@ -42,25 +43,26 @@
   (let [fx (fn [] (create-vector factory [1 2 3 4]))
         fy (fn [] (create-vector factory [2 3 4 5 6]))
         x (fx)
-        pf1 (fn ^double [^double x] (+ x 1.0))
-        pf2 (fn ^double [^double x ^double y] (+ x y))
-        pf3 (fn ^double [^double x ^double y ^double z] (+ x y z))
-        pf4 (fn ^double [^double x ^double y ^double z ^double w]
-              (+ x y z w))]
+        f (fn
+            (^double [^double x] (+ x 1.0))
+            (^double [^double x ^double y] (+ x y))
+            (^double [^double x ^double y ^double z] (+ x y z))
+            (^double [^double x ^double y ^double z ^double w] (+ x y z w)))]
+
     (facts "Functor implementation for real block vector"
-           (instance? IFn$DD pf1) => true
+           (instance? IFn$DD f) => true

-           (fmap! pf1 (fx)) => (create-vector factory [2 3 4 5])
-           (fmap! pf1 x) => x
+           (fmap! f (fx)) => (create-vector factory [2 3 4 5])
+           (fmap! f x) => x

-           (fmap! pf2 (fx) (fy)) => (create-vector factory [3 5 7 9])
-           (fmap! pf2 x (fy)) => x
+           (fmap! f (fx) (fy)) => (create-vector factory [3 5 7 9])
+           (fmap! f x (fy)) => x

-           (fmap! pf3 (fx) (fy) (fy)) => (create-vector factory [5 8 11 14])
-           (fmap! pf3 x (fy) (fy)) => x
+           (fmap! f (fx) (fy) (fy)) => (create-vector factory [5 8 11 14])
+           (fmap! f x (fy) (fy)) => x

-           (fmap! pf4 (fx) (fy) (fy) (fy)) => (create-vector factory [7 11 15 19])
-           (fmap! pf4 x (fy) (fy) (fy)) => x
+           (fmap! f (fx) (fy) (fy) (fy)) => (create-vector factory [7 11 15 19])
+           (fmap! f x (fy) (fy) (fy)) => x

            (fmap! + (fx) (fy) (fy) (fy) [(fy)])
            => (throws UnsupportedOperationException))))
@@ -93,6 +95,9 @@
            (fold pf1 1.0 x y y) => 39.0
            (fold pf1o [] x y y) => [5.0 8.0 11.0 14.0]

+           (fold pf1 1.0 x y y y) => 53.0
+           (fold pf1o [] x y y y) => [7.0 11.0 15.0 19.0]
+
            (fold + 1.0 x y y y) => (throws IllegalArgumentException))))

 (defn test-seq-vector [factory]
@@ -113,28 +118,28 @@
   (let [fx (fn [] (create-ge-matrix factory 2 3 [1 2 3 4 5 6]))
         fy (fn [] (create-ge-matrix factory 2 3 [2 3 4 5 6 7]))
         x (fx)
-        pf1 (fn ^double [^double x] (double (+ x 1.0)))
-        pf2 (fn ^double [^double x ^double y] (double (+ x y)))
-        pf3 (fn ^double [^double x ^double y ^double z] (double (+ x y z)))
-        pf4 (fn ^double [^double x ^double y ^double z ^double v]
-              (double (+ x y z v)))]
+        f (fn
+            (^double [^double x] (+ x 1.0))
+            (^double [^double x ^double y] (+ x y))
+            (^double [^double x ^double y ^double z] (+ x y z))
+            (^double [^double x ^double y ^double z ^double w] (+ x y z w)))]
     (facts "Functor implementation for real general matrix"
-           (instance? clojure.lang.IFn$DD pf1) => true
+           (instance? clojure.lang.IFn$DD f) => true

-           (fmap! pf1 (fx)) => (fy)
-           (fmap! pf1 x) => x
+           (fmap! f (fx)) => (fy)
+           (fmap! f x) => x

-           (fmap! pf2 (fx) (fy))
+           (fmap! f (fx) (fy))
            => (create-ge-matrix factory 2 3 [3 5 7 9 11 13])
-           (fmap! pf2 x (fy)) => x
+           (fmap! f x (fy)) => x

-           (fmap! pf3 (fx) (fy) (fy))
+           (fmap! f (fx) (fy) (fy))
            => (create-ge-matrix factory 2 3 [5 8 11 14 17 20])
-           (fmap! pf3 x (fy) (fy)) => x
+           (fmap! f x (fy) (fy)) => x

-           (fmap! pf4 (fx) (fy) (fy) (fy))
+           (fmap! f (fx) (fy) (fy) (fy))
            => (create-ge-matrix factory 2 3 [7 11 15 19 23 27])
-           (fmap! pf4 x (fy) (fy) (fy)) => x
+           (fmap! f x (fy) (fy) (fy)) => x

            (fmap! + (fx) (fy) (fy) (fy) [(fy)])
            => (throws UnsupportedOperationException))))


add RPOPLPUSH

add RPOPLPUSH

--- src/redis.clj
+++ src/redis.clj
@@ -111,6 +111,7 @@
   (lrem        [key count value] :bulk)
   (lpop        [key] :inline)
   (rpop        [key] :inline)
+  (rpoplpush   [srckey dstkey] :inline)
   ;; Set commands
   (sadd        [key member] :bulk int-to-bool)
   (srem        [key member] :bulk int-to-bool)


Expanded testing.

Expanded testing.

--- spec/clinp/clinp-test.cljs
+++ spec/clinp/clinp-test.cljs
@@ -10,13 +10,23 @@
               (should-be-nil (clinp/get-key-code :unknowablekey))))

 (describe "Key handler execs"
-          (it "Exec on a non register key handler")
-          (it "Exec on a non resitered phase")
-          (it "Exec on a registered key handler and phase"))
+          (it "Exec on a non register key handler"
+              (should-be-nil
+               (clinp/exec-handler! {65 {:down #(-> "test")}} :down 66)))
+          (it "Exec on a non resitered phase"
+              (should-be-nil
+               (clinp/exec-handler! {65 {:down #(-> "test")}} :up 65)))
+          (it "Exec on a registered key handler and phase"
+              (should-not-be-nil
+               (clinp/exec-handler! {65 {:up #(-> "test")}} :up 65))))

 (describe "Key down checking"
-          (it "Check that a key not held down doesn't register as held")
-          (it "Check that a key held down does register as held"))
+          (it "Check that a key not held down doesn't register as held"
+              (should-not (clinp/keydown? :a)))
+          (it "Check that a key held down does register as held"
+              (with-redefs
+                [clinp/downkeys (atom #{65})]
+                (should (clinp/keydown? :A)))))

 (describe "System setup/teardown"
           (it "Check setup")


Took out unnecessary comp

Took out unnecessary comp

--- src/polismath/clusters.clj
+++ src/polismath/clusters.clj
@@ -569,7 +569,7 @@
   (->> data
        get-matrix
        columns
-       (map (comp comment-stats))
+       (map comment-stats)
        (map #(assoc %2 :tid %1) (range))))


WIP on more robust greedy agree first; erroring out on nils...

--- src/polismath/clusters.clj
+++ src/polismath/clusters.clj
@@ -346,7 +346,7 @@
              (mapv-rest add-comparitive-stats)))))})

-(defn beats-best-by-test?
+(defn- beats-best-by-test?
   "Returns true if a given comment/group stat hash-map has a more representative z score than
   current-best-z. Used for making sure we have at least _one_ representative comment for every group,
   even if none are left over after the more thorough filters."
@@ -355,12 +355,20 @@
       (> (max rat rdt) current-best-z)))

-(defn beats-best-agrr-by-test?
-  "Like beats-best-by-test?, but only considers agrees."
-  [{:keys [repful-for rat] :as comment-conv-stats} current-best-z]
-  (and (= :agree repful-for)
-       (or (nil? current-best-z)
-           (> rat current-best-z))))
+(defn- beats-best-agrr?
+  "Like beats-best-by-test?, but only considers agrees. Additionally, doesn't focus solely on repness,
+  but also on raw probability of agreement, so as to ensure that there is some representation of what
+  people in the group agree on. Also, note that this takes the current-best, instead of just current-best-z."
+  [{:keys [ra rat pa pat] :as comment-conv-stats} current-best]
+  (cond
+    (and current-best (> (:ra current-best) 1.0))
+        ; XXX - a litte messy, since we're basicaly reimplimenting the repness sort function
+        (> (* ra rat pa pat) (apply * (map current-best [:ra :rat :pa :pat])))
+    current-best
+        (> (* pa pat) (apply * (map current-best [:pa :pat])))
+    :else
+        (or (> ra 1.0)
+            (> pa 0.5))))

 (defn passes-by-test?
@@ -438,12 +446,12 @@
                 ; Keep track of what the best comment so far is, even if it doesn't pass, so we always have at
                 ; least one comment
                 (if (and (empty? (gr-get gr :sufficient))
-                         (beats-best-by-test? comment-conv-stats (gr-get gr :test)))
+                         (beats-best-by-test? comment-conv-stats (gr-get gr :best :repness-test)))
                   (gr-assoc gr :best (finalize-cmt-stats tid comment-conv-stats))
                   gr)
                 ; Also keep track of best agree comment is, so we can throw that the front preferentially
-                (if (beats-best-agrr-by-test? comment-conv-stats (gr-get gr :test))
-                  (gr-assoc gr :best-agree (finalize-cmt-stats tid comment-conv-stats))
+                (if (beats-best-agrr? comment-conv-stats (gr-get gr :best-agree))
+                  (gr-assoc gr :best-agree (assoc comment-conv-stats :tid tid))
                   gr))))
           result
           (zip ids comment-stats)))
@@ -452,19 +460,20 @@
     ; If no sufficient, use best; otherwise sort sufficient and take 5
     (map-vals
       (fn [{:keys [best best-agree sufficient]}]
-        (if (empty? sufficient)
-          ; If there weren't any matches of the criteria, just take the best match, and take the best agree if
-          ; possible, and if not just the best general
-          (if best-agree
-            [best-agree]
-            [best])
-          (->> sufficient
-               ; Remove best agree if in list, since we'll be putting it in manually
-               (remove #(= best-agree %))
-               (repness-sort) ; sort by our complicated repness metric
-               (concat [best-agree]) ; put best agree at front, regardless
-               (take 5) ; take the top 5
-               (agrees-before-disagrees))))))) ; put the agrees before the disagrees
+        (let [best-agree (finalize-cmt-stats (:tid best-agree) best-agree)]
+          (if (empty? sufficient)
+            ; If there weren't any matches of the criteria, just take the best match, and take the best agree if
+            ; possible, and if not just the best general
+            (if best-agree
+              [best-agree]
+              [best])
+            (->> sufficient
+                 ; Remove best agree if in list, since we'll be putting it in manually
+                 (remove #(= best-agree %))
+                 (repness-sort) ; sort by our complicated repness metric
+                 (concat [best-agree]) ; put best agree at front, regardless
+                 (take 5) ; take the top 5
+                 (agrees-before-disagrees))))))))

 (defn xy-clusters-to-nmat [clusters]


Built a function for grabbing DB users together with usage stats.

--- src/polismath/intercom.clj
+++ src/polismath/intercom.clj
@@ -74,6 +74,74 @@
     (client/post "https://api.intercom.io/users")))

+(declare users conversations votes participants)
+
+(ko/defentity users
+  (ko/pk :uid)
+  (ko/entity-fields :uid :hname :username :email :is_owner :created :plan)
+  (ko/has-many conversations)
+  (ko/has-many votes))
+
+(ko/defentity conversations
+  (ko/pk :zid)
+  (ko/entity-fields :zid :owner)
+  (ko/has-many votes)
+  (ko/belongs-to user (:fk :owner)))
+
+(ko/defentity votes
+  (ko/entity-fields :zid :pid :tid :vote :created)
+  (ko/belongs-to participants (:fk :pid))
+  (ko/belongs-to conversations (:fk :zid)))
+
+(ko/defentity participants
+  (ko/entity-fields :pid :uid :zid :created)
+  (ko/belongs-to user (:fk :uid))
+  (ko/belongs-to conversations (:fk :zid)))
+
+(defn get-db-users-with-stats-by-uid
+  [uids]
+  (kdb/with-db (poll/heroku-db-spec (env/env :database-url))
+    (ko/select
+      users
+      (ko/fields :uid
+                 :created
+                 :email
+                 :owned_convs.avg_n_ptpts
+                 :owned_convs.n_owned_convs
+                 :ptpt_summary.n_ptptd_convs)
+      ; Join summary stats of owned conversations
+      (ko/join :left
+        [(ko/subselect
+           conversations
+           (ko/fields :owner)
+           ; Join participant count summaries per conv
+           (ko/join
+             [(ko/subselect
+                participants
+                (ko/fields :zid)
+                (ko/aggregate (count (ko/raw "DISTINCT pid")) :n_ptpts :zid))
+              ; as conv_summary
+              :conv_summary]
+             (= :conv_summary.zid :zid))
+           ; Average participant counts, and count number of conversations
+           (ko/aggregate (avg :conv_summary.n_ptpts) :avg_n_ptpts)
+           (ko/aggregate (count (ko/raw "DISTINCT conversations.zid")) :n_owned_convs)
+           (ko/group :owner))
+         ; as owned_convs
+         :owned_convs]
+        (= :owned_convs.owner :uid))
+      ; Join summary stats on participation
+      (ko/join
+        :left
+        [(ko/subselect
+           participants
+           (ko/fields :uid)
+           (ko/aggregate (count (ko/raw "DISTINCT zid")) :n_ptptd_convs :uid))
+         :ptpt_summary]
+        (= :ptpt_summary.uid :uid))
+      (ko/where (in :uid uids)))))
+
+
 (defn update-icuser-from-dbuser
   [dbuser]
   (update-icuser


Spec out utils/normalize-uri.

Spec out utils/normalize-uri.

--- spec/incise/utils_spec.clj
+++ spec/incise/utils_spec.clj
@@ -27,4 +27,14 @@
               3 [@hash-3]}
              (slot-by :value @coll))))

+(describe "normalize-uri"
+  (context "the given uri terminates with a '/'"
+    (with uri "/hey/")
+    (it "prepends index.html"
+      (should= (str @uri "index.html") (normalize-uri @uri))))
+  (context "the given uri does not terminate with a '/'"
+    (with uri "/hey.html")
+    (it "does nothing"
+      (should= @uri (normalize-uri @uri)))))
+
 (run-specs)


- correct datepicker dropdown formatting to allow for no initial selection. This closes PR #38

--- src/re_com/datepicker.cljs
+++ src/re_com/datepicker.cljs
@@ -87,6 +87,7 @@
   "Answer 2 x rows showing month with nav buttons and days NOTE: not internationalized"
   [current {show-weeks? :show-weeks? minimum :minimum maximum :maximum}]
   (let [prev-date     (dec-month @current)
+        ;prev-enabled? (if minimum (after? prev-date (dec-month minimum)) true)
         prev-enabled? (if minimum (after? prev-date minimum) true)
         next-date     (inc-month @current)
         next-enabled? (if maximum (before? next-date maximum) true)
@@ -227,15 +228,16 @@
          :style    (flex-child-style "none")
          :on-click (handler-fn (swap! shown? not))}
    [h-box
-    :align :center
-    :class "noselect"
-    :children [[:label {:class "form-control dropdown-button"}
-                (unparse (if (seq format) (formatter format) date-format) @model)]
-               #_[:span  {:class "dropdown-button activator input-group-addon"} ;; TODO: Remove
-                [:i {:class "glyphicon glyphicon-th"}]]
-               [:span.dropdown-button.activator.input-group-addon
-                {:style {:padding "3px 0 0 0"}}
-                [:i.md-apps {:style {:font-size "24px"}}]]]]])
+    :align     :center
+    :class     "noselect"
+    :min-width "10em"
+    :children  [[:label {:class "form-control dropdown-button"}
+                 (if (instance? js/goog.date.Date @model)
+                   (unparse (if (seq format) (formatter format) date-format) @model)
+                   "")]
+                [:span.dropdown-button.activator.input-group-addon
+                 {:style {:padding "3px 0 0 0"}}
+                 [:i.md-apps {:style {:font-size "24px"}}]]]]])

 (def datepicker-dropdown-args-desc
   (conj datepicker-args-desc
@@ -265,10 +267,9 @@
                     (when shown? [backdrop :on-click cancel-popover])
                     [popover-border
                      :position     position
-                     :width        "auto"                       ;; TODO: Sort this mess out!
                      :arrow-length 0
                      :arrow-width  0
-                     :margin-left  (if show-weeks? "-26px" "-13px")
+                     :margin-left  (if show-weeks? "-50px" "-36px") ; Align right edge to activation button.
                      :margin-top   "3px"
                      :padding      "0px"
                      :children     [(into [datepicker] passthrough-args)]]]]))))


Fix typo

Fix typo

--- src/re_demo/dropdowns.cljs
+++ src/re_demo/dropdowns.cljs
@@ -320,7 +320,7 @@
                                              :label  "Chosen"
                                              :href   "http://harvesthq.github.io/chosen"
                                              :target "_blank"]
-                                            ", style using "
+                                            ", styled using "
                                             [hyperlink-href
                                              :label  "Bootstrap"
                                              :href   "https://github.com/alxlit/bootstrap-chosen"


Check if the first argument to `reforms.validation/form` is a cursor.

--- src/reforms/validation.clj
+++ src/reforms/validation.clj
@@ -30,12 +30,16 @@
     [{} args]))

 (defmacro form
-  "Wrapper for [[reforms.core/form]]. **This is a macro.**"
+  "Wrapper for [[reforms.core/form]]. **This is a macro.**
+
+   It accepts the same args as [[reforms.core/form]] except there's an extra one in front: `cursor` to store validation results in."
   [cursor & args]
   (let [[attrs [& elems]] (parse-args args)]
-    `(reforms.core/form
-       ~attrs
-       (reforms.validation/validating-fields
-         (reforms.validation/validation-errors ~cursor)
-         ~@elems))))
+    `(do
+       (assert (om.core/cursor? ~cursor) "The first argument to reforms.validation/form before optional attributes must be a cursor.")
+       (reforms.core/form
+         ~attrs
+         (reforms.validation/validating-fields
+           (reforms.validation/validation-errors ~cursor)
+           ~@elems)))))


fixup! Project workflows actually paginate server-side

--- src-cljs/frontend/api.cljs
+++ src-cljs/frontend/api.cljs
@@ -85,15 +85,15 @@
               :params {:run/id run-id}}))

 (defn get-project-workflows [api-ch vcs-url opts]
-   (ajax/ajax :post
-              "/query-api"
-              :uncatchable-by-old-controller
-              api-ch
-              :format :transit
-              :params
-              {:type :get-project-workflows
-               :params {:vcs-url vcs-url
-                        :opts opts}}))
+  (ajax/ajax :post
+             "/query-api"
+             :uncatchable-by-old-controller
+             api-ch
+             :format :transit
+             :params
+             {:type :get-project-workflows
+              :params {:vcs-url vcs-url
+                       :opts opts}}))

 (defn get-branch-workflows [api-ch vcs-type org-name repo-name branch-name]
   (ajax/ajax :post


release 0.2.2

release 0.2.2

--- bigquery/project.clj
+++ bigquery/project.clj
@@ -1,4 +1,4 @@
-(defproject gclouj/bigquery "0.2.2-SNAPSHOT"
+(defproject gclouj/bigquery "0.2.2"
   :description "Google Cloud BigQuery"
   :url "https://github.com/pingles/gclouj"
   :license {:name "Eclipse Public License"


Basic describe for Oracle tables.

Basic describe for Oracle tables.

--- src/sqls/plugin/oracle.clj
+++ src/sqls/plugin/oracle.clj
@@ -1,11 +1,44 @@
 (ns sqls.plugin.oracle
-  "Oracle plugin for SQLs")
+  "Oracle plugin for SQLs"
+  (:require [clojure.string :as s]
+            [clojure.java.jdbc :as j]
+            [sqls.util :refer [format-tabular]])
+  (:import [java.sql Connection]))

 (defn classes
   []
   [["oracle.jdbc.OracleDriver" "Oracle"]])

+(defn orcl-describe-object!
+  [conn object-name]
+  {:pre [(instance? Connection conn)
+         (string? object-name)]}
+  (let [table-info (-> (j/query {:connection conn}
+                                ["select table_name, tablespace_name
+                                  from user_tables
+                                  where table_name = ?"
+                                 (s/upper-case object-name)])
+                       first)
+        columns (when table-info
+                  (j/query {:connection conn}
+                           ["select column_name, data_type
+                             from user_tab_columns
+                             where table_name = ?
+                             order by column_id"
+                            (:table_name table-info)]))]
+    (when table-info
+      (let [cols-desc (->> columns
+                           (map-indexed (fn [i c] [(str (inc i) ".")
+                                                   (:column_name c)
+                                                   (:data_type c)]))
+                           format-tabular
+                           (s/join "\n"))]
+        (str "Table: " (:table_name table-info) "\n"
+             "Columns:\n"
+             cols-desc)))))
+
 (def oracle-plugin
   {:name "Oracle"
    :classes classes
-   :jdbc-url-template "jdbc:oracle:thin:<username>/<password>@<host>:<port>:<db>"})
+   :jdbc-url-template "jdbc:oracle:thin:<username>/<password>@<host>:<port>:<db>"
+   :describe-object orcl-describe-object!})


trivial app

trivial app

--- webapp/src/webapp/core.clj
+++ webapp/src/webapp/core.clj
@@ -14,6 +14,7 @@
         [monger.query :refer :all]))

 (defroutes router*
-	(GET "/" (output "")))
+	(GET "/" request "Doug's Website")
+	(compojure.route/not-found "Link not found."))

-(def router (compojure.handler/api router*))
+(def router (compojure.handler/api router*))


figwheel.main: whitespace

figwheel.main: whitespace

--- figwheel-main/src/figwheel/main/schema/cljs_options.clj
+++ figwheel-main/src/figwheel/main/schema/cljs_options.clj
@@ -29,7 +29,7 @@
 (s/def ::output-to non-blank-string?)

 (def-spec-meta ::output-to
-  :doc
+  :doc
   "After your ClojureScript has been compiled to JavaScript, this
 specifies the name of the JavaScript output file.  The contents of
 this file will differ based on the :optimizations setting.
@@ -45,8 +45,8 @@

 (s/def ::output-dir non-blank-string?)

-(def-spec-meta ::output-dir
-  :doc
+(def-spec-meta ::output-dir
+  :doc
   "Sets the output directory for output files generated during
 compilation.

@@ -78,9 +78,10 @@

   :optimizations :none")

+;; TODO should exist!!
 (s/def ::main                      ::string-or-symbol)
 (def-spec-meta ::main
-  :doc
+  :doc
   "Specifies an entry point namespace. When combined with optimization
 level :none, :main will cause the compiler to emit a single JavaScript
 file that will import goog/base.js, the JavaScript file for the
@@ -93,7 +94,7 @@

 (s/def ::asset-path                string?)
 (def-spec-meta ::asset-path
-  :doc
+  :doc
   "When using :main it is often necessary to control where the entry
 point script attempts to load scripts from due to the configuration of
 the web server. :asset-path is a relative URL path not a file system
@@ -106,7 +107,7 @@

 (s/def ::source-map                (some-fn boolean? non-blank-string?))
 (def-spec-meta ::source-map
-  :doc
+  :doc
   "See https://github.com/clojure/clojurescript/wiki/Source-maps. Under
 optimizations :none the valid values are true and false, with the
 default being true. Under all other optimization settings must specify
@@ -117,7 +118,7 @@

 (s/def ::preloads                  (s/every symbol? :min-count 1 :into [] :kind sequential?))
 (def-spec-meta ::preloads
-  :doc
+  :doc
   "Developing ClojureScript commonly requires development time only
 side effects such as enabling printing, logging, spec instrumentation,
 and connecting REPLs. :preloads permits loading such side effect
@@ -140,14 +141,14 @@

 (s/def ::verbose                   boolean?)
 (def-spec-meta ::verbose
-  :doc
+  :doc
   "Emit details and measurements from compiler activity.

   :verbose true")

 (s/def ::pretty-print              boolean?)
 (def-spec-meta ::pretty-print
-  :doc
+  :doc
   "Determines whether the JavaScript output will be tabulated in a
 human-readable manner. Defaults to true.

@@ -155,7 +156,7 @@

 (s/def ::target                    #{:nodejs :webworker})
 (def-spec-meta ::target
-  :doc
+  :doc
   "If targeting nodejs add this line. Takes no other options at the
 moment. The default (no :target specified) implies browsers are being
 targeted. Have a look here for more information on how to run your
@@ -166,7 +167,7 @@

 (s/def ::infer-externs boolean?)
 (def-spec-meta ::infer-externs
-  :doc
+  :doc
   "Experimental externs inference.

   :infer-externs true


Minor clean-up.

Minor clean-up.

--- src/asid/trustee_agent.clj
+++ src/asid/trustee_agent.clj
@@ -18,7 +18,7 @@
 (defn challenge [agent]
   (-> agent agent-conn-req :pool-challenge set))

-(defn sample-conn-req
+(defn- sample-conn-req
   ([] (sample-conn-req {}))
   ([args]
      (let [defaults {:from "other identity"
@@ -31,4 +31,6 @@
        (cr/new-connection-request (merge defaults args)))))

 (fact
-  (-> (sample-conn-req) new-trustee-agent challenge) => #{:sample :challenge})
+  (-> (sample-conn-req)
+      new-trustee-agent
+      challenge) => #{:sample :challenge})


[#1232] Log failed transformations

[#1232] Log failed transformations

--- backend/src/akvo/lumen/transformation/engine.clj
+++ backend/src/akvo/lumen/transformation/engine.clj
@@ -141,7 +141,9 @@
                                                                             source-table
                                                                             previous-columns
                                                                             transformation)]
-      (when-not success? (throw (ex-info "Failed to transform" {})))
+      (when-not success?
+        (log/errorf "Failed to transform: %s, columns: %s, execution-log: %s" message columns execution-log)
+        (throw (ex-info "Failed to transform" {})))
       (let [new-dataset-version-id (str (util/squuid))]
         (clear-dataset-version-data-table tenant-conn {:id (:id dataset-version)})
         (let [next-dataset-version {:id new-dataset-version-id


Add debug import statement.

Add debug import statement.

--- src/uswitch/bifrost/s3.clj
+++ src/uswitch/bifrost/s3.clj
@@ -1,6 +1,6 @@
 (ns uswitch.bifrost.s3
   (:require [com.stuartsierra.component :refer (Lifecycle system-map using start stop)]
-            [clojure.tools.logging :refer (info warn error)]
+            [clojure.tools.logging :refer (info warn error debug)]
             [clojure.core.async :refer (<! >! go-loop chan close! alts! timeout >!!)]
             [clojure.java.io :refer (file)]
             [aws.sdk.s3 :refer (put-object bucket-exists? create-bucket)]


Include fn-args in help test.

Include fn-args in help test.

--- test/cli4clj/test/cli.clj
+++ test/cli4clj/test/cli.clj
@@ -82,10 +82,11 @@
     (is (= "Divide by zero" out-string))))

 (deftest help-cmd-cli-interaction-stdout-test
-  (let [cli-opts {:cmds {:add {:fn #(+ %1 %2)}}}
+  (let [cli-opts {:cmds {:add {:fn #(+ %1 %2)
+                               :fn-args "fn-args string"}}}
         test-cmd-input ["help"]
         out-string (test-cli-stdout #(start-cli cli-opts) test-cmd-input)]
-    (is (= "add\n\n\nhelp [? h]\n\tShow help.\n\tDisplay a help text that lists all available commands including further detailed information about these commands.\n\nquit [q]\n\tQuit the CLI.\n\tTerminate and close the command line interface."
+    (is (= "add\n\t Arguments: fn-args string\n\nhelp [? h]\n\tShow help.\n\tDisplay a help text that lists all available commands including further detailed information about these commands.\n\nquit [q]\n\tQuit the CLI.\n\tTerminate and close the command line interface."
            out-string))))

 (deftest allow-eval-cli-interaction-test


CMR-5107: Cleaned up test utility function.

--- umm-spec-lib/test/cmr/umm_spec/test/umm_json.clj
+++ umm-spec-lib/test/cmr/umm_spec/test/umm_json.clj
@@ -65,7 +65,7 @@
 (defn- remove-get-service-and-get-data-nils
   "Removes nil values in GetService and GetData added by json->umm to RelatedUrls,
   this is needed to prevent failures caused by json->umm parser. It will add in :GetService
-  and :GetData that shouldn't be there because it is calling the contructor for RelatedUrlType defrecord.
+  and :GetData that shouldn't be there because it is calling the constructor for RelatedUrlType defrecord.
   So we remove them because they should only be present when URLContentType = DistributionURL and
   Type = GET DATA or GET SERVICE."
   [umm]
@@ -83,12 +83,12 @@
                           (dissoc ru :GetService)
                           :else ru)))]
     (-> umm
-        (util/update-in-all [:RelatedUrls] remove-nils)
         (util/update-in-all [:ContactGroups :ContactInformation :RelatedUrls] remove-nils)
         (util/update-in-all [:ContactPersons :ContactInformation :RelatedUrls] remove-nils)
+        (util/update-in-all [:DataCenters :ContactGroups :ContactInformation :RelatedUrls] remove-nils)
         (util/update-in-all [:DataCenters :ContactInformation :RelatedUrls] remove-nils)
-        (util/update-in-all [:DataCenters :ContactGroups :ContactInformation :RelatedUrls] remove-nils)
-        (util/update-in-all [:DataCenters :ContactPersons :ContactInformation :RelatedUrls] remove-nils))))
+        (util/update-in-all [:DataCenters :ContactPersons :ContactInformation :RelatedUrls] remove-nils)
+        (util/update-in-all [:RelatedUrls] remove-nils))))

 ;; This only tests a minimum example record for now. We need to test with larger more complicated
 ;; records. We will do this as part of CMR-1929


issue was just a lack of cleaning

issue was just a lack of cleaning

--- src/bitsplit_cli/core.cljs
+++ src/bitsplit_cli/core.cljs
@@ -32,7 +32,6 @@
         (.get prompt message
             (fn [err input]
                 (when (-> input nil? not)
-                    (println "oh noes a read" input message)
                     (put! return
                         (aget input message)))))
         return))


input type for mobile login gives better keyboard

--- src/braid/mobile/core.cljs
+++ src/braid/mobile/core.cljs
@@ -80,6 +80,7 @@
              [:div.content.login.email
               "Email"
               [:input.email {:placeholder "you@awesome.com"
+                             :type "email"
                              :key "email"}]
               [:button.next {:on-click (fn [e]
                                          (swap! data assoc :email (.. e -target -value)))}]]


factor out match-uri CLJS impl into separate fn

--- src/calfpath/internal.cljc
+++ src/calfpath/internal.cljc
@@ -352,6 +352,47 @@
   [params FULL-MATCH-INDEX])

+(defn match-uri*
+  [uri ^long begin-index pattern-tokens attempt-partial-match?]
+  (when (not= begin-index FULL-MATCH-INDEX)  ; if already a full-match then no need to match any further
+    (let [actual-uri (subs uri begin-index)
+          actual-len (count actual-uri)]
+      (if (= 1 (count pattern-tokens))  ; if length==1, then token must be string (static URI path)
+        (let [static-path (first pattern-tokens)
+              static-size (count static-path)]
+          (when (string/starts-with? actual-uri static-path)  ; URI begins with path, so at least partial match exists
+            (if (= (count actual-uri) (count static-path))  ; if full match exists, then return as such
+              FULL-MATCH-NO-PARAMS
+              (when attempt-partial-match?
+                (partial-match static-size)))))
+        (loop [path-params  (transient {})
+               actual-index 0
+               next-tokens  (seq pattern-tokens)]
+          (if (and next-tokens (< actual-index actual-len))
+            (let [token (first next-tokens)]
+              (if (string? token)
+                ;; string token
+                (when (string/starts-with? (subs actual-uri actual-index) token)
+                  (recur path-params (unchecked-add actual-index (count token)) (next next-tokens)))
+                ;; must be a keyword
+                (let [[u-path-params
+                       u-actual-index] (loop [sb (transient [])  ; string buffer
+                                              j actual-index]
+                                         (if (>= j actual-len)  ; 'separator not found' implies URI has ended
+                                           [(assoc! path-params token (apply str (persistent! sb)))
+                                            actual-len]
+                                           (let [ch (get actual-uri j)]
+                                             (if (= \/ ch)
+                                               [(assoc! path-params token (apply str (persistent! sb)))
+                                                j]
+                                               (recur (conj! sb ch) (unchecked-inc j))))))]
+                  (recur u-path-params (long u-actual-index) (next next-tokens)))))
+            (if (< actual-index actual-len)
+              (when attempt-partial-match?
+                (partial-match (persistent! path-params) actual-index))
+              (full-match (persistent! path-params)))))))))
+
+
 (defn match-uri
   "Match given URI string against URI pattern, returning a vector `[params-map ^int end-index]` on success,
   and `nil` on no match.
@@ -363,41 +404,5 @@
   | pattern-tokens         | URI pattern tokens to match against               |
   | attempt-partial-match? | flag to indicate whether to attempt partial-match |"
   [uri ^long begin-index pattern-tokens attempt-partial-match?]
-  #?(:cljs (when (not= begin-index FULL-MATCH-INDEX)  ; if already a full-match then no need to match any further
-             (let [actual-uri (subs uri begin-index)
-                   actual-len (count actual-uri)]
-               (if (= 1 (count pattern-tokens))  ; if length==1, then token must be string (static URI path)
-                 (let [static-path (first pattern-tokens)
-                       static-size (count static-path)]
-                   (when (string/starts-with? actual-uri static-path)  ; URI begins with path, so at least partial match exists
-                     (if (= (count actual-uri) (count static-path))  ; if full match exists, then return as such
-                       FULL-MATCH-NO-PARAMS
-                       (when attempt-partial-match?
-                         (partial-match static-size)))))
-                 (loop [path-params  (transient {})
-                        actual-index 0
-                        next-tokens  (seq pattern-tokens)]
-                   (if (and next-tokens (< actual-index actual-len))
-                     (let [token (first next-tokens)]
-                       (if (string? token)
-                         ;; string token
-                         (when (string/starts-with? (subs actual-uri actual-index) token)
-                           (recur path-params (unchecked-add actual-index (count token)) (next next-tokens)))
-                         ;; must be a keyword
-                         (let [[u-path-params
-                                u-actual-index] (loop [sb (transient [])  ; string buffer
-                                                       j actual-index]
-                                                  (if (>= j actual-len)  ; 'separator not found' implies URI has ended
-                                                    [(assoc! path-params token (apply str (persistent! sb)))
-                                                     actual-len]
-                                                    (let [ch (get actual-uri j)]
-                                                      (if (= \/ ch)
-                                                        [(assoc! path-params token (apply str (persistent! sb)))
-                                                         j]
-                                                        (recur (conj! sb ch) (unchecked-inc j))))))]
-                           (recur u-path-params (long u-actual-index) (next next-tokens)))))
-                     (if (< actual-index actual-len)
-                       (when attempt-partial-match?
-                         (partial-match (persistent! path-params) actual-index))
-                       (full-match (persistent! path-params))))))))
+  #?(:cljs (match-uri* uri begin-index pattern-tokens attempt-partial-match?)
       :clj (Util/matchURI uri begin-index pattern-tokens attempt-partial-match?)))


update to the latest version of chrome driver

--- test/functional/setup.clj
+++ test/functional/setup.clj
@@ -14,7 +14,7 @@
   (case (browser-to-use)
     :firefox (do (.setup (WebDriverManager/firefoxdriver))
                  (FirefoxDriver.))
-    (do (.. (WebDriverManager/chromedriver) (version "2.37") (setup))
+    (do (.. (WebDriverManager/chromedriver) (version "2.43") (setup))
         (let [options (ChromeOptions.)
               loggingPrefs (LoggingPreferences.)]
           (do


adding tid to all requests

adding tid to all requests

--- src/celestial/security.clj
+++ src/celestial/security.clj
@@ -11,6 +11,8 @@

 (ns celestial.security
   (:use
+    [celestial.common :only (gen-uuid)]
+    [gelfino.timbre :only (set-tid)]
     [celestial.common :only (import-logging)])
   (:require
     [celestial.roles :as roles]
@@ -24,8 +26,9 @@
 (defn user-tracking [app]
   "A tiny middleware to track api access"
   (fn [{:keys [uri request-method] :as req}]
-    (debug request-method " on " uri "by" (friend/current-authentication) )
-    (app req)))
+    (set-tid (gen-uuid)
+      (debug request-method " on " uri "by" (friend/current-authentication))
+      (app req))))

 (defn secured-app [routes]
   (friend/authenticate


guard against non-existant user when setting status

--- src/chat/client/store.cljs
+++ src/chat/client/store.cljs
@@ -119,7 +119,8 @@
   (transact! [:users user-id :nickname] (constantly nick)))

 (defn update-user-status! [user-id status]
-  (transact! [:users user-id :status] (constantly status)))
+  (when (get-in @app-state [:users user-id])
+    (transact! [:users user-id :status] (constantly status))))

 (defn all-users []
   (vals (get-in @app-state [:users])))


use config for :hmac-secret in invite, not var

can't just (def hmac-secret (config :hmac-secret)), b/c config hasn't
been "started" by mount at def-time

--- src/chat/server/invite.clj
+++ src/chat/server/invite.clj
@@ -13,18 +13,17 @@
             [chat.server.cache :refer [cache-set! cache-get cache-del! random-nonce]]
             [chat.server.crypto :refer [hmac constant-comp]]
             [chat.server.db :as db]
+            [environ.core :refer [env]]
             [braid.server.conf :refer [config]]))

 (when (and (= (env :environment) "prod") (empty? (env :hmac-secret)))
   (println "WARNING: No :hmac-secret set, using an insecure default."))

-(def hmac-secret (config :hmac-secret))
-
 (defn verify-hmac
   [mac data]
   (constant-comp
     mac
-    (hmac hmac-secret data)))
+    (hmac (config :hmac-secret) data)))

 (defn verify-invite-nonce
   "Verify that the given nonce is valid for the invite"
@@ -71,7 +70,7 @@
 (defn register-page
   [invite token]
   (let [now (.getTime (java.util.Date.))
-        form-hmac (hmac hmac-secret
+        form-hmac (hmac (config :hmac-secret)
                         (str now token (invite :id) (invite :invitee-email)))
         api-domain (:api-domain config)]
     (clostache/render-resource "templates/register_page.html.mustache"
@@ -86,7 +85,7 @@
   [params]
   (constant-comp
     (params :hmac)
-    (hmac hmac-secret
+    (hmac (config :hmac-secret)
           (str (params :now) (params :token) (params :invite_id) (params :email)))))

 (def avatar-size [128 128])
@@ -124,7 +123,7 @@
                       :never (t/years 1000))
                     (t/plus (t/now))
                     (c/to-long))
-        mac (hmac hmac-secret (str nonce group-id expiry))]
+        mac (hmac (config :hmac-secret) (str nonce group-id expiry))]
     (str (config :site-url) "/invite?group-id=" group-id "&nonce=" nonce
          "&expiry=" expiry "&mac=" mac)))

@@ -132,7 +131,7 @@
   [group-id]
   (let [now (.getTime (java.util.Date.))
         group (db/get-group group-id)
-        form-hmac (hmac hmac-secret (str now group-id))
+        form-hmac (hmac (config :hmac-secret) (str now group-id))
         api-domain (:api-domain config)]
     (clostache/render-resource "templates/link_signup.html.mustache"
                                {:api-domain api-domain
@@ -190,7 +189,7 @@
 (defn reset-page
   [user token]
   (let [now (.getTime (java.util.Date.))
-        form-hmac (hmac hmac-secret (str now token (user :id)))
+        form-hmac (hmac (config :hmac-secret) (str now token (user :id)))
         api-domain (config :api-domain)]
     (clostache/render-resource "templates/reset_page.html.mustache"
                                {:api_domain api-domain


CMR-5806 CMR-5809 Updates doc string.

CMR-5806 CMR-5809 Updates doc string.

--- common-app-lib/src/cmr/common_app/api/routes.clj
+++ common-app-lib/src/cmr/common_app/api/routes.clj
@@ -227,7 +227,7 @@
       ((ring-json/wrap-json-response handler) request))))

 (defn add-security-header-response-handler
-  ""
+  "Adds a number of security related response headers."
   [handler]
   (fn [{context :request-context :as request}]
     (if-let [request-id (cxt/context->request-id context)]


rename :bodies to :points

rename :bodies to :points

--- src/clj/ephemeris/core.clj
+++ src/clj/ephemeris/core.clj
@@ -7,7 +7,7 @@
 (def ^:private
   defaults {:utc nil
             :geo {:lat nil :lon nil}
-            :bodies [:Sun :Moon :Mercury :Venus :Mars :Jupiter :Saturn
+            :points [:Sun :Moon :Mercury :Venus :Mars :Jupiter :Saturn
                      :TrueNode :Uranus :Neptune :Pluto]
             :angles [:Asc :MC]
             :houses "O"
@@ -73,9 +73,9 @@
         want (request stuff)
         flag (. SweConst SEFLG_SPEED)]
     (merge
-      {:bodies
+      {:points
         (into {}
-          (for [i (flatten [(:bodies want)])]
+          (for [i (flatten [(:points want)])]
             (let [what (if (known? i) (lookup i) i)
                   res (double-array 6)
                   err (StringBuffer.)


basic reagant support

basic reagant support

--- src/cljs/pynchon/core.cljs
+++ src/cljs/pynchon/core.cljs
@@ -8,12 +8,12 @@
 ;; Views

 (defn home-page []
-  [:div [:h2 "Welcome to mykproject"]
-   [:div [:a {:href "/about"} "go to about page"]]])
+  [:div [:h2 "Welcome to Pynchon"]
+   [:div [:a {:href "/app/about"} "go to about page"]]])

 (defn about-page []
-  [:div [:h2 "About myproject"]
-   [:div [:a {:href "/"} "go to the home page"]]])
+  [:div [:h2 "About Pynchon"]
+   [:div [:a {:href "/app"} "go to the home page"]]])

 (defn current-page []
   [:div [(session/get :current-page)]])
@@ -21,10 +21,10 @@
 ;; -------------------------
 ;; Routes

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

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

 ;; -------------------------
@@ -34,7 +34,6 @@
   (reagent/render [current-page] (.getElementById js/document "app")))

 (defn init! []
-  (js/console.log "HI")
   (accountant/configure-navigation!
     {:nav-handler
      (fn [path]
@@ -45,4 +44,6 @@
   (accountant/dispatch-current!)
   (mount-root))

+;---------------------------
+;; Run app
 (init!)


Using m.trust instead of config attribute works better

--- src/cljs/repodoc/core.cljs
+++ src/cljs/repodoc/core.cljs
@@ -181,9 +181,8 @@
                                            {:onclick #(set_serialize serialize-html)} "HTML")
                                        " Click the text area and select text"])
                             (if (= serializer serialize-html)
-                              (nm "div"
-                                  {"config" #(render-html (serialize-db serializer) %1 %2 %3)})
-                              (nm "textarea" (serialize-db serializer)))]))))
+                              (nm "div" (m/trust (serialize-db serializer)))
+                              (nm "textarea" {"key" "ser"} (serialize-db serializer)))]))))

 (defn reporender
   "Render repository trees"


Editing works!

Editing works!

Input field's change event updates db momently.

--- src/cljs/repodoc/core.cljs
+++ src/cljs/repodoc/core.cljs
@@ -23,7 +23,7 @@

 ;; Data

-(def db {:data REPO
+(def db {:data (get REPO "tree")
          :start 0
          :editing #{}})

@@ -38,16 +38,18 @@
   (let [editing (querydb [:editing])]
     (updatedb [:editing] (conj editing pos))))

-(defn update_field [pos key value]
-  (let [item (assoc (querydb [:data pos]) key value)]
-    (set! db (assoc-in db [:data pos] item))))
-
 (defn save [item pos]
   "Save item to db :data into position"
   (let [doc (assoc item "mtime" (str (new js/Date)))
         data (querydb [:data])]
     (updatedb [:data] (assoc data pos doc))
     (println "Saved!" (get doc "path"))))
+
+(defn update_field [pos key value]
+  (let [prev (querydb [:data pos])
+        item (assoc prev key value)]
+    (println "Editing: " pos key value)
+    (save item pos)))

 (defn close
   [pos]
@@ -76,7 +78,7 @@
 (defn annotate-editor
   [pos item]
   (let [title (get item "title")]
-    (nm "div" [(e/text "title" title 40 #(update_field "title" pos %))])))
+    (nm "div" [(e/text "title" title 40 #(update_field pos "title" %))])))

 (defn annotate-button
   [pos item]
@@ -106,7 +108,7 @@
 (defn reporender
   "Render repository trees"
   []
-  (let [tree (get (querydb [:data]) "tree")]
+  (let [tree (querydb [:data])]
     (map-indexed node tree)))


Document ready fix.

Document ready fix.

--- src/cljs/website/core.cljs
+++ src/cljs/website/core.cljs
@@ -8,6 +8,8 @@
             [website.ajax :refer [load-interceptors!]]
             [ajax.core :refer [GET POST]])
   (:import goog.History))
+
+(defn ready [f] (.ready (js/$ js/document) f))

 (defn nav-link [uri title page]
   [:li.nav-item
@@ -149,13 +151,11 @@
   })

 (defn nicescroll [id]
-  (js/jQuery (fn []
+  (ready (fn []
     (.niceScroll (js/jQuery id) nicescroll-config))))

-(defn jsDefer [f] (js/setTimeout f))
-
 (defn notebook-handler [data]
-  (jsDefer (fn[]
+  (ready (fn []
     (.appendChild
       (js/document.getElementById "notebook")
       (-> data js/JSON.parse js/nb.parse .render))


Use hyphens in multi-word unit keywords -More idiomatic in Clojure

--- src/cljs/zetawar/data.cljs
+++ src/cljs/zetawar/data.cljs
@@ -362,31 +362,31 @@
              :armored   10}
             :zoc
             [:personnel :armored]}
-     :heavytank {:description "Heavy Tank"
-                 :cost 500
-                 :movement 12
-                 :can-capture false
-                 :can-repair #{}
-                 :min-range 1
-                 :max-range 1
-                 :armor-type :armored
-                 :armor 15
-                 :repair 1
-                 :state-map :move-attack
-                 :image "tilesets/elite-command/units/heavytank-COLOR.png"
-                 :terrain-effects
-                 {:plains {:movement-cost 4 :armor-bonus  0 :attack-bonus 0}
-                  :woods  {:movement-cost 6 :armor-bonus -3 :attack-bonus 0}
-                  :desert {:movement-cost 5 :armor-bonus  0 :attack-bonus 0}
-                  :tundra {:movement-cost 7 :armor-bonus  0 :attack-bonus 0}
-                  :swamp  {:movement-cost 8 :armor-bonus -4 :attack-bonus 0}
-                  :ford   {:movement-cost 8 :armor-bonus -2 :attack-bonus 0}
-                  :base   {:movement-cost 3 :armor-bonus -2 :attack-bonus 0}}
-                 :attack-strengths
-                 {:personnel 15
-                  :armored   12}
-                 :zoc
-                 [:personnel :armored]}
+     :heavy-tank {:description "Heavy Tank"
+                  :cost 500
+                  :movement 12
+                  :can-capture false
+                  :can-repair #{}
+                  :min-range 1
+                  :max-range 1
+                  :armor-type :armored
+                  :armor 15
+                  :repair 1
+                  :state-map :move-attack
+                  :image "tilesets/elite-command/units/heavytank-COLOR.png"
+                  :terrain-effects
+                  {:plains {:movement-cost 4 :armor-bonus  0 :attack-bonus 0}
+                   :woods  {:movement-cost 6 :armor-bonus -3 :attack-bonus 0}
+                   :desert {:movement-cost 5 :armor-bonus  0 :attack-bonus 0}
+                   :tundra {:movement-cost 7 :armor-bonus  0 :attack-bonus 0}
+                   :swamp  {:movement-cost 8 :armor-bonus -4 :attack-bonus 0}
+                   :ford   {:movement-cost 8 :armor-bonus -2 :attack-bonus 0}
+                   :base   {:movement-cost 3 :armor-bonus -2 :attack-bonus 0}}
+                  :attack-strengths
+                  {:personnel 15
+                   :armored   12}
+                  :zoc
+                  [:personnel :armored]}
      :artillery {:description "Artillery"
                  :cost 400
                  :movement 8
@@ -410,29 +410,29 @@
                  :attack-strengths
                  {:personnel 12
                   :armored   13}}
-     :heavyartillery {:description "Heavy Artillery"
-                      :cost 1250
-                      :movement 2
-                      :can-capture false
-                      :can-repair #{}
-                      :min-range 4
-                      :max-range 6
-                      :armor-type :armored
-                      :armor 8
-                      :repair 1
-                      :state-map :move-or-attack
-                      :image "tilesets/elite-command/units/heavyartillery-COLOR.png"
-                      :terrain-effects
-                      {:plains {:movement-cost 2 :armor-bonus  0 :attack-bonus  0}
-                       :woods  {:movement-cost 2 :armor-bonus -3 :attack-bonus -5}
-                       :desert {:movement-cost 2 :armor-bonus  0 :attack-bonus  0}
-                       :tundra {:movement-cost 2 :armor-bonus  0 :attack-bonus  0}
-                       :swamp  {:movement-cost 2 :armor-bonus -3 :attack-bonus -5}
-                       :ford   {:movement-cost 2 :armor-bonus -2 :attack-bonus  0}
-                       :base   {:movement-cost 1 :armor-bonus  0 :attack-bonus  0}}
-                      :attack-strengths
-                      {:personnel 14
-                       :armored   15}}}}})
+     :heavy-artillery {:description "Heavy Artillery"
+                       :cost 1250
+                       :movement 2
+                       :can-capture false
+                       :can-repair #{}
+                       :min-range 4
+                       :max-range 6
+                       :armor-type :armored
+                       :armor 8
+                       :repair 1
+                       :state-map :move-or-attack
+                       :image "tilesets/elite-command/units/heavyartillery-COLOR.png"
+                       :terrain-effects
+                       {:plains {:movement-cost 2 :armor-bonus  0 :attack-bonus  0}
+                        :woods  {:movement-cost 2 :armor-bonus -3 :attack-bonus -5}
+                        :desert {:movement-cost 2 :armor-bonus  0 :attack-bonus  0}
+                        :tundra {:movement-cost 2 :armor-bonus  0 :attack-bonus  0}
+                        :swamp  {:movement-cost 2 :armor-bonus -3 :attack-bonus -5}
+                        :ford   {:movement-cost 2 :armor-bonus -2 :attack-bonus  0}
+                        :base   {:movement-cost 1 :armor-bonus  0 :attack-bonus  0}}
+                       :attack-strengths
+                       {:personnel 14
+                        :armored   15}}}}})

 ;; TODO: remove redundant id keys (?)
 (def maps


Support :on, :off deltas in unpack

Support :on, :off deltas in unpack

--- src/cljx/commos/delta.cljx
+++ src/cljx/commos/delta.cljx
@@ -7,44 +7,6 @@
   (if (coll? ks) ks [ks]))

 ;; Helpers on deltas
-(defn pack
-  "Wrap deltas in a :batch delta if necessary."
-  [deltas]
-  (if (> (count deltas) 1)
-    (apply vector :batch deltas)
-    (first deltas)))
-
-(defn unpack
-  "Return a seq of deltas from a delta."
-  [[op & maybe-deltas :as delta]]
-  (if (#+clj identical? #+cljs keyword-identical? op :batch)
-    maybe-deltas
-    [delta]))
-
-(defn prepend-ks
-  "Prepend ks to the keys in delta"
-  [ks delta]
-  (->> delta
-       unpack
-       (map (fn [[op korks-or-new-val new-val :as delta]]
-              (if (= 3 (count delta))
-                [op (into ks (collect korks-or-new-val)) new-val]
-                [op ks korks-or-new-val])))
-       pack))
-
-(defn diagnostic-delta
-  "Bring delta into diagnostic form [op ks (v | [v+])].  v is a
-  collection for :in and :ex ops.  This form is not applicable for add
-  as ks can be [], which is invalid.  See summable-delta.
-
-  Not suitable for :batch deltas (use unpack) beforehand."
-  [[op korks-or-new-val new-val :as delta]]
-  (cond-> (if (= 3 (count delta))
-            [op (collect korks-or-new-val) new-val]
-            [op [] korks-or-new-val])
-    (not (#+clj identical? #+cljs keyword-identical? op :is))
-    (update-in [2] collect)))
-
 (defn summable-delta
   "Make a diagnostic applicable for add again."
   [[op korks new-val :as delta]]
@@ -93,6 +55,67 @@
 (def ^{:arglists '([m])} positive-deltas
   "Convert a map to positive summable deltas."
   positive-diagnostic-deltas)
+
+;; Helpers on deltas
+(defn diagnostic-delta
+  "Bring delta into diagnostic form [op ks (v | [v+])].  v is a
+  collection for :in and :ex ops.  This form is not applicable for add
+  as ks can be [], which is invalid.  See summable-delta.
+
+  Not suitable for :batch - use unpack."
+  [[op korks-or-new-val new-val :as delta]]
+  (cond-> (if (= 3 (count delta))
+            [op (collect korks-or-new-val) new-val]
+            [op [] korks-or-new-val])
+    (not (#+clj identical? #+cljs keyword-identical? op :is))
+    (update-in [2] collect)))
+
+(defn- prepend-ks*
+  [ks [op korks-or-new-val new-val :as delta]]
+  (if (= 3 (count delta))
+    [op (into ks (collect korks-or-new-val)) new-val]
+    [op ks korks-or-new-val]))
+
+(defn pack
+  "Wrap deltas in a :batch delta if necessary."
+  [deltas]
+  (if (> (count deltas) 1)
+    (apply vector :batch deltas)
+    (first deltas)))
+
+(defn- unpack-batch
+  [[op & maybe-deltas :as delta]]
+  (if (#+clj identical? #+cljs keyword-identical? op :batch)
+    maybe-deltas
+    [delta]))
+
+(defn unpack
+  "Return a seq of deltas from a delta.  Returns a seq with
+  only :is, :in and :ex deltas."
+  [delta]
+  (let [transform (fn [delta f]
+                    (let [[_ ks v] (diagnostic-delta delta)]
+                      (->> v
+                           f
+                           (map (partial prepend-ks* ks))
+                           (map summable-delta))))]
+    (->> delta
+         unpack-batch
+         (mapcat (fn [[op :as delta]]
+                   (case op
+                     :on (transform delta
+                                    positive-diagnostic-deltas)
+                     :off (transform delta
+                                     negative-diagnostic-deltas)
+                     [delta]))))))
+
+(defn prepend-ks
+  "Prepend ks to the keys in delta"
+  [ks delta]
+  (->> delta
+       unpack
+       (map (partial prepend-ks* ks))
+       pack))

 ;; Transducers
 (defn nest


Wait for Hadoop 1.x FS cleanup hook to complete.

--- src/clojure/parkour/util/shutdown/hadoop1.clj
+++ src/clojure/parkour/util/shutdown/hadoop1.clj
@@ -41,6 +41,6 @@
         (returning t
           (.put m nil nil) ;; Prevent cache from ever being empty
           (when t'
-            (add-hook #(some-> t' .start))
+            (add-hook #(when t' (.start t') (.join t')))
             (.removeShutdownHook (Runtime/getRuntime) t'))
           (.addShutdownHook (Runtime/getRuntime) t))))))


Add :unsolved option for knock-off-chip-off-the-old-block

--- src/clojush/pushgp/selection/preselection.clj
+++ src/clojush/pushgp/selection/preselection.clj
@@ -81,42 +81,60 @@
   will be chosen randomly from the range of (int (* minfrac outof)) to outof.
   If the value is of the form [:random :random limit minfrac maxfrac] then diffs
   will be chosen randomly from the range of (int (* minfrac outof)) to
-  (int (* maxfrac outof))."
+  (int (* maxfrac outof)). If the first item in (:knock-off-chip-off-the-old-block argmap)
+  is :unsolved, then the remainder are interpreted as above, but only errors
+  that are not solved for a given individual are considered in the filtering."
   [pop argmap]
-  (if (not (:knock-off-chip-off-the-old-block argmap))
-    pop
-    (if (not (:print-history argmap))
-      (throw
-       (Exception.
-        ":print-history must be true for :knock-off-chip-off-the-old-block"))
-      (if (= true  (:knock-off-chip-off-the-old-block argmap))
-        (let [changed (vec (filter #(not= (first (:history %)) (second (:history %)))
-                                   pop))]
-          (if (empty? changed)
-            pop
-            changed))
-        (let [knock-spec (:knock-off-chip-off-the-old-block argmap)
-              diffs (first knock-spec)
-              outof (second knock-spec)
-              limit (if (= outof :random) (nth knock-spec 2) nil)
-              outof (if (= outof :random) (inc (lrand-int limit)) outof)
-              diffs  (if (= diffs :random)
-                       (inc (if (> (count knock-spec) 3)
-                              (let [mindiff (int (* (nth knock-spec 3) outof))
-                                    maxdiff (if (> (count knock-spec) 4)
-                                              (int (* (nth knock-spec 4) outof))
-                                              outof)]
-                                (+ mindiff (lrand-int (max 1 (- maxdiff mindiff)))))
-                              (lrand-int outof)))
-                       diffs)
-              changed (vec (filter #(or (< (count (:history %)) diffs)
-                                        (>= (count (distinct (take outof (:history %))))
-                                            diffs))
-                                   pop))]
-          (if (empty? changed)
-            (do (println "Universal violation of knock-off-chip-off-the-old-block constraint.")
-                pop)
-            changed))))))
+  (let [knock-spec (:knock-off-chip-off-the-old-block argmap)]
+    (if (not knock-spec)
+      pop
+      (if (not (:print-history argmap))
+        (throw
+         (Exception.
+          ":print-history must be true for :knock-off-chip-off-the-old-block"))
+        (let [knock-spec (if (= true knock-spec) [true] knock-spec)
+              unsolved? (= :unsolved (first knock-spec))
+              knock-spec (if unsolved? (rest knock-spec) knock-spec)
+              filtered-history (if unsolved?
+                                 (fn [ind]
+                                   (let [hist (:history ind)
+                                         keep? (map #(not (zero? %))
+                                                    (first hist))]
+                                     (map (fn [errs]
+                                            (filter identity
+                                                    (map (fn [e k?]
+                                                           (if k? e nil))
+                                                         errs
+                                                         keep?)))
+                                          hist)))
+                                 :history)]
+        (if (= true (first knock-spec))
+          (let [changed (vec (filter #(not= (first (:history %)) (second (:history %)))
+                                     pop))]
+            (if (empty? changed)
+              pop
+              changed))
+          (let [diffs (first knock-spec)
+                outof (second knock-spec)
+                limit (if (= outof :random) (nth knock-spec 2) nil)
+                outof (if (= outof :random) (inc (lrand-int limit)) outof)
+                diffs (if (= diffs :random)
+                        (inc (if (> (count knock-spec) 3)
+                               (let [mindiff (int (* (nth knock-spec 3) outof))
+                                     maxdiff (if (> (count knock-spec) 4)
+                                               (int (* (nth knock-spec 4) outof))
+                                               outof)]
+                                 (+ mindiff (lrand-int (max 1 (- maxdiff mindiff)))))
+                               (lrand-int outof)))
+                        diffs)
+                changed (vec (filter #(or (< (count (:history %)) diffs)
+                                          (>= (count (distinct (take outof (:history %))))
+                                              diffs))
+                                     pop))]
+            (if (empty? changed)
+              (do (println "Universal violation of knock-off-chip-off-the-old-block constraint.")
+                  pop)
+              changed))))))))

 (defn preselect
   "Returns the population pop reduced as appropriate considering the settings for


Logelei 2 works

Logelei 2 works

--- src/examples/logelei_2.clj
+++ src/examples/logelei_2.clj
@@ -63,22 +63,10 @@
         '(impl beutelaffen-oinken  ohrhörner-surren)
         ))

-fml
+(def solution
+  (let [tseit (transform-tseitin fml)
+        result (-> (:tseitin-formula tseit) generate-dimacs-clauses sat-solve)]
+    (retransform-tseitin result tseit)))

-(def fml '(or p (and (not p) q)))
-(truth-table fml)
-
-(def solution
-(let [tseit (transform-tseitin fml)
-      result (-> (:tseitin-formula tseit) generate-dimacs-clauses sat-solve)]
-  (retransform-tseitin result tseit)))
-
-(sort solution)
-; Ergebnis ist falsch
-
-(transform-tseitin fml)
-
-#_(-> fml
-     transform-tseitin
-     generate-dimacs-clauses
-    sat-solve)
+(filter literal? solution)
+; Ergebnis kontrollieren


tweak

tweak

--- src/flow_labeller/core.clj
+++ src/flow_labeller/core.clj
@@ -156,49 +156,51 @@
             "efs"
             (efs-prepper flowpath test-rat)
             ;; default
-            (println "Usage: java -jar flow-labeller.jar <-f path to flow file> <-o arff|efs> <-r ratio-to-separate-as-training-set> <-t 1|0 (1 to tidy up arff header>")))))
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+            (println "USAGE: java -jar flow-labeller.jar <-f path to flow file> \\"
+                     "\n<-o arff|efs> <-r ratio-to-separate-as-training-set> \\"
+                     "\n<-t 1|0 (1 to tidy up arff header>")))))
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+


forgot to import schema.core

forgot to import schema.core

--- src/gangway/validation.clj
+++ src/gangway/validation.clj
@@ -1,6 +1,7 @@
 (ns gangway.validation
   (:require [clojure.data.json :as json]
             [hatch]
+            [schema.core :as s]
             [navigator.validation :as nav-val]
             [oarlock.validation :as oar-val]))


attempting to move people to #cljsrn

attempting to move people to #cljsrn

--- src/leiningen/new/expo.clj
+++ src/leiningen/new/expo.clj
@@ -33,7 +33,7 @@
 (defn expo [name & lib]
   (main/info "Generating fresh Expo project.")
   (main/info "README.md contains instructions to get you started.")
-  (main/info "If you have any questions, you can ask us on Expo slack #clojurescript channel. https://slack.expo.io/")
+  (main/info "If you have any questions, you can ask us on Clojurians #cljsrn channel. http://clojurians.net")

   (let [data {:name name
               :sanitized (name-to-path name)}


Add test module to Containium.

Add test module to Containium.

--- dev-resources/spec.clj
+++ dev-resources/spec.clj
@@ -10,5 +10,5 @@
                   :log-dir "target/kafka-log"
                   :zk-connect "localhost:2181"}
           :http-kit {:port 8080}}
- :modules []
+ :modules ["dev-resources/test-module/target/test-module-0.1.jar"]
  :resolve-dependencies true}


Add some tools to make it easier to experiment

--- dev-resources/user.clj
+++ dev-resources/user.clj
@@ -1,11 +1,30 @@
 (ns user
   (:use io.aviso.repl
+        io.aviso.logging
+        io.aviso.tracker
         clojure.pprint)
   (:require [clojure.tools.logging :as l]))

 (install-pretty-exceptions)
+(io.aviso.logging/install-pretty-logging)
+(io.aviso.logging/install-uncaught-exception-handler)

 (defmacro other-thread
   [& body]
-  `(.start (Thread. (bound-fn [] ~@body))))
+  `(.start (Thread. (bound-fn []
+                      (checkpoint
+                        ~@body)))))

+
+(defn demo-1
+  []
+  (track "on main thread" (other-thread (throw (RuntimeException. "hello")))))
+
+(defn demo-2
+  []
+  (track "outer" (track "middle - a" (other-thread (try
+                                                     (track "inner - a" (throw (ex-info "blowed up - a" {})))
+                                                     (catch Throwable _))))
+         (track "middle - b" (other-thread (try
+                                             (track "inner - b" (throw (ex-info "blowed up - b" {})))
+                                             (catch Throwable _))))))


Fix log, print only entry uuid instead of the whole map.

--- src/oc/storage/async/storage_notification.clj
+++ src/oc/storage/async/storage_notification.clj
@@ -92,7 +92,7 @@
              {:old entry-data
               :new entry-result
               :inbox-action {:follow true}} user nil))))
-        (timbre/info "Handled inbox-action " (:sub-type body) " for entry:" entry-result))
+        (timbre/info "Handled inbox-action " (:sub-type body) " for entry:" (:uuid entry-result)))
       (timbre/error "Failed handling" (:sub-type body) "message for item:" (:item-id body) "and users:" (mapv :user-id (:users body))))))

   ([db-pool body :guard #(and (= (:type %) "inbox-action")