Added demo for cartesian polygon with holes.

--- src/cmr/demos/visual_spatial_search.clj
+++ src/cmr/demos/visual_spatial_search.clj
@@ -146,7 +146,13 @@
         wide-south-cart (polygon :cartesian -70 -30, 70 -30, 70 -20, -70 -20, -70 -30)
         very-wide-cart (polygon :cartesian -179 40, -179 35, 179 35, 179 40, -179 40)
         very-tall-cart (polygon :cartesian -160 90, -160 -90, -150 -90, -150 90, -160 90)
-        ;very-tall-cart (polygon :cartesian -160 89, -160 -89, -150 -89, -150 89, -160 89)
+
+        ;; Cartesian With holes
+        outer-cart (rr/ords->ring :cartesian -5.26 -22.59 11.56 -22.77 10.47 -11.29 -5.86 -11.37 -5.26 -22.59)
+        hole1-cart (rr/ords->ring :cartesian 6.95 -17.95 2.98 -17.94 3.92 -20.08 6.95 -17.95)
+        hole2-cart (rr/ords->ring :cartesian 5.18 -13.08 -1.79 -12.99 -2.65 -15 4.29 -14.95 5.18 -13.08)
+        polygon-with-holes-cart (poly/polygon :cartesian [outer-cart hole1-cart hole2-cart])
+

         ;; points
         north-pole (p/point 90 0)
@@ -162,26 +168,29 @@
         ;search-area (assoc (p/point 0 0) :options {:id "point"})

         ]
-    (visual-interactive-search [touches-sp
-                                across-am-br
-                                touches-np
-                                normal-br1
-                                normal-br2
-                                wide-north
-                                wide-south
-                                across-am-poly
-                                on-np
-                                on-sp
-                                normal-poly
-                                polygon-with-holes
-                                wide-north-cart
-                                wide-south-cart
-                                very-wide-cart
-                                very-tall-cart
-                                north-pole
-                                south-pole
-                                normal-point
-                                am-point] search-area))
+    (visual-interactive-search [
+                                ; touches-sp
+                                ; across-am-br
+                                ; touches-np
+                                ; normal-br1
+                                ; normal-br2
+                                ; wide-north
+                                ; wide-south
+                                ; across-am-poly
+                                ; on-np
+                                ; on-sp
+                                ; normal-poly
+                                ; polygon-with-holes
+                                ; wide-north-cart
+                                ; wide-south-cart
+                                ; very-wide-cart
+                                ; very-tall-cart
+                                polygon-with-holes-cart
+                                ; north-pole
+                                ; south-pole
+                                ; normal-point
+                                ; am-point
+                                ] search-area))


Update db-name to match new default

Update db-name to match new default

--- config.clj
+++ config.clj
@@ -1,6 +1,6 @@
 {:wrap-reload false
  :db-host "localhost"
- :db-name "mydb"
+ :db-name "4clojure"
  :db-user nil
  :db-pwd nil
  :jetty-port 8080


Don't mention "the Solo Plan".

Don't mention "the Solo Plan".

--- src-cljs/frontend/components/org_settings.cljs
+++ src-cljs/frontend/components/org_settings.cljs
@@ -192,8 +192,7 @@

        [:span "The " [:strong org-name] " organization has "
         (pm/pretty-trial-time plan) " left in its trial."])]
-    [:p
-     "The trial plan is equivalent to the Solo plan with 6 containers."]
+    [:p "Your trial is equivalent to a plan with" (pluralize (pm/trial-containers plan) "containers") "."]
     (when (and (not (:too_many_extensions plan))
                (> 3 (pm/days-left-in-trial plan)))
       [:p


getters

getters

--- stuf/src/sandbox/4clojure.clj
+++ stuf/src/sandbox/4clojure.clj
@@ -1437,3 +1437,10 @@

 ;;162 Logical falsity and truth
 1
+
+;;164 Language of a DFA
+(defn get-next [from dfa]
+  (from (:transitions dfa)))
+
+(defn accepted? [symb dfa]
+  (symb (:accepts dfa)))


Refactor batched pipeline in-fn creation.

--- src/dsbdp/main.clj
+++ src/dsbdp/main.clj
@@ -191,7 +191,7 @@
                             (doseq [data (pmap proc-fn (repeat in-data))]
                               (.inc out-cntr))))
                       (and
-                        in-data
+                        (not (nil? in-data))
                         (> batch-delay 0)
                         (> batch-size 0)) (let [in-fn (get-in-fn pipeline)]
                                             (fn []


Change thread name.

Change thread name.

--- src/dsbdp/main.clj
+++ src/dsbdp/main.clj
@@ -120,7 +120,7 @@
                                            sample-pcap-processing-definition-json))
                        out-fn))
           in-loop (ProcessingLoop.
-                    "InLoop"
+                    "DataGenerationLoop"
                     (cond
                       (.endsWith scenario "-direct")
                         (let [proc-fn (condp = scenario


62 comment updated

62 comment updated

--- src/etaoin/api.clj
+++ src/etaoin/api.clj
@@ -2448,8 +2448,9 @@
   browser's logs. Possible values are: `:off`, `:debug`, `:warn`, `:info`,
   `:error`, `:all`. When not passed, `:all` is set.

-  -- `:profile` a string path that points on profile folder.
-  See `Setting profile` section in `README.md` file for more information.
+  -- `:profile` is a string path that points on profile folder.
+  See the `Setting browser profile` section in `README.md` to know
+  how to do it properly.

   -- `headless` is a boolean flag to run the browser in headless mode
   (i.e. without GUI window). Useful when running tests on CI servers


Using a build-tarball method

Using a build-tarball method

--- src/fatty/core.clj
+++ src/fatty/core.clj
@@ -152,14 +152,15 @@
   (let [ohai-data (read-json (sh "ohai"))]
     {:os (get ohai-data :os), :machine (get-in ohai-data [:kernel :machine])}))

+(defn build-tarball
+  [project-name os-data]
+  (let [status (sh "tar" "czf" (file-str fatty-pkg-dir "/" project-name "-" (os-data :os) "-" (os-data :machine) ".tar.gz") (file-str "/opt/opscode"))]
+    (log-sh-result status
+                   (str "Created package for " project-name " on " (os-data :os) " machine arch " (os-data :machine))
+                   (str "Failed to create package for " project-name " on " (os-data :os) " machine arch " (os-data :machine)))))
+
 (defn build-fat-binary
   "Build a fat binary"
   [project-name]
   (dorun (for [software-pkg (project-map project-name)] (build (software-map software-pkg))))
-  (let [os-data (get-os-and-machine)]
-    (do
-      (let [status (sh "tar" "czf" (file-str fatty-pkg-dir "/" project-name "-" (os-data :os) "-" (os-data :machine) ".tar.gz") (file-str "/opt/opscode"))]
-        (log-sh-result status
-                       (str "Created package for " project-name " on " (os-data :os) " machine arch " (os-data :machine))
-                       (str "Failed to create package for " project-name " on " (os-data :os) " machine arch " (os-data :machine)))))))
-
+  (let [os-data (get-os-and-machine)] (build-tarball)))


removes colon from work-stealing codahale metrics (#1011)

--- waiter/src/waiter/work_stealing.clj
+++ waiter/src/waiter/work_stealing.clj
@@ -246,12 +246,12 @@
                   (async/>! response-chan :no-matching-instance-found)))))
           (release-instance-fn
             [{:keys [instance status] :as reservation-summary}]
-            (counters/inc! (metrics/waiter-counter "work-stealing" "offer" (str "response-" status)))
+            (counters/inc! (metrics/waiter-counter "work-stealing" "offer" (str "response-" (name status))))
             (meters/mark! (metrics/waiter-meter "work-stealing" "offer" "response-rate"))
             (service/release-instance-go
               instance-rpc-chan
               instance
-              (select-keys reservation-summary [:cid, :request-id, :status])))
+              (select-keys reservation-summary [:cid :request-id :status])))
           (offer-help-fn
             [{:keys [request-id target-router-id] :as reservation-parameters} cleanup-chan]
             (async/go


assigns unique metrics registry in unit tests (#913)

--- waiter/test/waiter/metrics_test.clj
+++ waiter/test/waiter/metrics_test.clj
@@ -122,17 +122,18 @@
                     {:name "non-empty-inputs-c", :input {:old [:a :b], :new [:b :c :d :e], :initial 3}, :expected 5}
                     {:name "non-empty-inputs-d", :input {:old [:a :b :c], :new [:d], :initial 3}, :expected 1}]]
     (doseq [test-case test-cases]
-      (let [{:keys [name input expected]} test-case
-            title ["waiter" "test" name]
-            counter (counters/counter title)]
-        (testing (str "Test " name)
-          (if (:initial input)
-            (do
-              (counters/clear! counter)
-              (counters/inc! counter (:initial input))))
-          (update-counter counter (:old input) (:new input))
-          (let [actual-value (counters/value counter)]
-            (is (= expected actual-value))))))))
+      (with-isolated-registry
+        (let [{:keys [name input expected]} test-case
+              title ["waiter" "test" name]
+              counter (counters/counter title)]
+          (testing (str "Test " name)
+            (if (:initial input)
+              (do
+                (counters/clear! counter)
+                (counters/inc! counter (:initial input))))
+            (update-counter counter (:old input) (:new input))
+            (let [actual-value (counters/value counter)]
+              (is (= expected actual-value)))))))))

 (deftest test-reset-counter
   (let [test-cases [{:name "nil-inputs", :initial nil, :input nil, :expected 0}
@@ -142,14 +143,15 @@
                     {:name "old-counter-nil-input", :initial 2, :input nil, :expected 0}]]
     (doseq [{:keys [name initial input expected]} test-cases]
       (testing (str "Test " name)
-        (let [title ["waiter" "test" name]
-              the-counter (counters/counter title)]
-          (when initial
-            (counters/clear! the-counter)
-            (counters/inc! the-counter initial))
-          (reset-counter the-counter input)
-          (let [actual-value (counters/value the-counter)]
-            (is (= expected actual-value))))))))
+        (with-isolated-registry
+          (let [title ["waiter" "test" name]
+                the-counter (counters/counter title)]
+            (when initial
+              (counters/clear! the-counter)
+              (counters/inc! the-counter initial))
+            (reset-counter the-counter input)
+            (let [actual-value (counters/value the-counter)]
+              (is (= expected actual-value)))))))))

 (deftest test-prefix-and-contains-metrics-filter
   (with-isolated-registry
@@ -187,19 +189,20 @@
                                                   ["nested" "test-throughput"]
                                                   ["foo" "bar"]
                                                   ["outstanding" "fum"]]))]
-    (testing "retrieving metrics for specified services"
-      (.removeMatching metrics-registry (reify MetricFilter (matches [_ _ _] true)))
-      (is (zero? (count (.getMetrics metrics-registry))))
-      (create-metrics "test-service-1")
-      (is (all-service-metrics-available? (retrieve-service-metrics "test-service-1")))
-      (is (zero? (count (retrieve-service-metrics "test-service-2"))))
-      (is (zero? (count (retrieve-service-metrics "test-service-3"))))
-      (create-metrics "test-service-2")
-      (create-metrics "test-service-3")
-      (is (all-service-metrics-available? (retrieve-service-metrics "test-service-1")))
-      (is (all-service-metrics-available? (retrieve-service-metrics "test-service-2")))
-      (is (all-service-metrics-available? (retrieve-service-metrics "test-service-3")))
-      (.removeMatching metrics-registry (reify MetricFilter (matches [_ _ _] true))))))
+    (with-isolated-registry
+      (testing "retrieving metrics for specified services"
+        (.removeMatching metrics-registry (reify MetricFilter (matches [_ _ _] true)))
+        (is (zero? (count (.getMetrics metrics-registry))))
+        (create-metrics "test-service-1")
+        (is (all-service-metrics-available? (retrieve-service-metrics "test-service-1")))
+        (is (zero? (count (retrieve-service-metrics "test-service-2"))))
+        (is (zero? (count (retrieve-service-metrics "test-service-3"))))
+        (create-metrics "test-service-2")
+        (create-metrics "test-service-3")
+        (is (all-service-metrics-available? (retrieve-service-metrics "test-service-1")))
+        (is (all-service-metrics-available? (retrieve-service-metrics "test-service-2")))
+        (is (all-service-metrics-available? (retrieve-service-metrics "test-service-3")))
+        (.removeMatching metrics-registry (reify MetricFilter (matches [_ _ _] true)))))))

 (deftest test-get-waiter-metrics
   (let [metrics-registry mc/default-registry
@@ -222,14 +225,15 @@
                                                  ["nested" "test-throughput"]
                                                  ["foo" "bar"]
                                                  ["outstanding" "fum"]]))]
-    (testing "retrieving metrics for specified services"
-      (.removeMatching metrics-registry (reify MetricFilter (matches [_ _ _] true)))
-      (is (zero? (count (.getMetrics metrics-registry))))
-      (create-metrics "services.test-service-1")
-      (create-metrics "waiter")
-      (create-metrics "services.test-service-2")
-      (is (all-waiter-metrics-available? (get-waiter-metrics)))
-      (.removeMatching metrics-registry (reify MetricFilter (matches [_ _ _] true))))))
+    (with-isolated-registry
+      (testing "retrieving metrics for specified services"
+        (.removeMatching metrics-registry (reify MetricFilter (matches [_ _ _] true)))
+        (is (zero? (count (.getMetrics metrics-registry))))
+        (create-metrics "services.test-service-1")
+        (create-metrics "waiter")
+        (create-metrics "services.test-service-2")
+        (is (all-waiter-metrics-available? (get-waiter-metrics)))
+        (.removeMatching metrics-registry (reify MetricFilter (matches [_ _ _] true)))))))

 (deftest test-aggregate-router-codahale-metrics
   (let [router->metrics {"router-a" {"counters" {"instance-counts" {"a" 10, "b" 20 "in-use" 2 "my-instances" 1
@@ -290,51 +294,58 @@
     (is (= expected actual))))

 (deftest test-remove-and-check-metrics-except-outstanding
-  (let [metrics-registry mc/default-registry
-        create-metrics (fn [service-id]
-                         (histograms/update! (histograms/histogram ["services" service-id "test-histogram1"]) (hash service-id))
-                         (histograms/update! (histograms/histogram ["services" service-id "instance" "test-histogram2"]) (hash service-id))
-                         (timers/start-stop-time! (timers/timer ["services" service-id "test-response-duration"]))
-                         (timers/start-stop-time! (timers/timer ["services" service-id "nested" "test-response-duration"]))
-                         (meters/mark! (meters/meter ["services" service-id "test-throughput"]))
-                         (meters/mark! (meters/meter ["services" service-id "nested" "test-throughput"]))
-                         (counters/inc! (counters/counter ["services" service-id "foo" "bar"]))
-                         (counters/inc! (counters/counter ["services" service-id "outstanding" "fum"])))
-        metrics-per-service 8
-        has-metrics-except-outstanding? (fn has-metrics-except-outstanding? [service-id]
-                                          (let [metric-filter (reify MetricFilter
-                                                                (matches [_ name _]
-                                                                  (and (str/includes? name service-id)
-                                                                       (not (str/includes? name "outstanding")))))]
-                                            (or (not-empty (.getCounters metrics-registry metric-filter))
-                                                (not-empty (.getHistograms metrics-registry metric-filter))
-                                                (not-empty (.getMeters metrics-registry metric-filter))
-                                                (not-empty (.getTimers metrics-registry metric-filter)))))]
-    (testing "Delete metrics for specified services"
-      (.removeMatching metrics-registry (reify MetricFilter (matches [_ _ _] true)))
-      (is (zero? (count (.getMetrics metrics-registry))))
-      (create-metrics "test-service-1")
-      (create-metrics "test-service-2")
-      (create-metrics "test-service-3")
-      (is (= (* 3 metrics-per-service) (count (.getMetrics metrics-registry))))
-      (create-metrics "test-service-2")
-      (is (= (* 3 metrics-per-service) (count (.getMetrics metrics-registry))))
-      (create-metrics "test-service-1")
-      (is (= (* 3 metrics-per-service) (count (.getMetrics metrics-registry))))
-      (is (has-metrics-except-outstanding? "test-service-1"))
-      (is (has-metrics-except-outstanding? "test-service-2"))
-      (is (has-metrics-except-outstanding? "test-service-3"))
-      (remove-metrics-except-outstanding metrics-registry "test-service-1")
-      (is (= (+ (* 1 1) (* 2 metrics-per-service)) (count (.getMetrics metrics-registry))))
-      (is (not (has-metrics-except-outstanding? "test-service-1")))
-      (is (has-metrics-except-outstanding? "test-service-2"))
-      (is (has-metrics-except-outstanding? "test-service-3"))
-      (remove-metrics-except-outstanding metrics-registry "test-service-2")
-      (is (= (+ (* 2 1) (* 1 metrics-per-service)) (count (.getMetrics metrics-registry))))
-      (is (not (has-metrics-except-outstanding? "test-service-1")))
-      (is (not (has-metrics-except-outstanding? "test-service-2")))
-      (is (has-metrics-except-outstanding? "test-service-3"))
-      (.removeMatching metrics-registry (reify MetricFilter (matches [_ _ _] true))))))
+  (with-isolated-registry
+    (let [metrics-registry mc/default-registry
+          create-metrics (fn [service-id]
+                           (histograms/update! (histograms/histogram ["services" service-id "test-histogram1"]) (hash service-id))
+                           (histograms/update! (histograms/histogram ["services" service-id "instance" "test-histogram2"]) (hash service-id))
+                           (timers/start-stop-time! (timers/timer ["services" service-id "test-response-duration"]))
+                           (timers/start-stop-time! (timers/timer ["services" service-id "nested" "test-response-duration"]))
+                           (meters/mark! (meters/meter ["services" service-id "test-throughput"]))
+                           (meters/mark! (meters/meter ["services" service-id "nested" "test-throughput"]))
+                           (counters/inc! (counters/counter ["services" service-id "foo" "bar"]))
+                           (counters/inc! (counters/counter ["services" service-id "outstanding" "fum"])))
+          metrics-per-service 8
+          has-metrics-except-outstanding? (fn has-metrics-except-outstanding? [service-id]
+                                            (let [metric-filter (reify MetricFilter
+                                                                  (matches [_ name _]
+                                                                    (and (str/includes? name service-id)
+                                                                         (not (str/includes? name "outstanding")))))]
+                                              (or (not-empty (.getCounters metrics-registry metric-filter))
+                                                  (not-empty (.getHistograms metrics-registry metric-filter))
+                                                  (not-empty (.getMeters metrics-registry metric-filter))
+                                                  (not-empty (.getTimers metrics-registry metric-filter)))))]
+      (testing "Delete metrics for specified services"
+        (.removeMatching metrics-registry (reify MetricFilter (matches [_ _ _] true)))
+        (let [metrics-items (.getMetrics metrics-registry)]
+          (is (zero? (count metrics-items)) (str metrics-items)))
+        (create-metrics "test-service-1")
+        (create-metrics "test-service-2")
+        (create-metrics "test-service-3")
+        (let [metrics-items (.getMetrics metrics-registry)]
+          (is (= (* 3 metrics-per-service) (count metrics-items)) (str metrics-items)))
+        (create-metrics "test-service-2")
+        (let [metrics-items (.getMetrics metrics-registry)]
+          (is (= (* 3 metrics-per-service) (count metrics-items)) (str metrics-items)))
+        (create-metrics "test-service-1")
+        (let [metrics-items (.getMetrics metrics-registry)]
+          (is (= (* 3 metrics-per-service) (count metrics-items)) (str metrics-items)))
+        (is (has-metrics-except-outstanding? "test-service-1"))
+        (is (has-metrics-except-outstanding? "test-service-2"))
+        (is (has-metrics-except-outstanding? "test-service-3"))
+        (remove-metrics-except-outstanding metrics-registry "test-service-1")
+        (let [metrics-items (.getMetrics metrics-registry)]
+          (is (= (+ (* 1 1) (* 2 metrics-per-service)) (count metrics-items)) (str metrics-items)))
+        (is (not (has-metrics-except-outstanding? "test-service-1")))
+        (is (has-metrics-except-outstanding? "test-service-2"))
+        (is (has-metrics-except-outstanding? "test-service-3"))
+        (remove-metrics-except-outstanding metrics-registry "test-service-2")
+        (let [metrics-items (.getMetrics metrics-registry)]
+          (is (= (+ (* 2 1) (* 1 metrics-per-service)) (count metrics-items)) (str metrics-items)))
+        (is (not (has-metrics-except-outstanding? "test-service-1")))
+        (is (not (has-metrics-except-outstanding? "test-service-2")))
+        (is (has-metrics-except-outstanding? "test-service-3"))
+        (.removeMatching metrics-registry (reify MetricFilter (matches [_ _ _] true)))))))

 (deftest test-transient-metrics-data-producer
   (let [service-id->metrics-atom (atom {})


use clojure.string lower-case

use clojure.string lower-case

--- src/jasons_game/core.clj
+++ src/jasons_game/core.clj
@@ -1,5 +1,5 @@
 (ns jasons_game.core
-  (:require [clojure.string :refer [join split]]
+  (:require [clojure.string :refer [join lower-case split]]
             [clojure.walk :refer [postwalk postwalk-replace]]))

@@ -34,7 +34,7 @@
                                               pronoun-info (pronouns pronoun-type)]
                                           (let [pronoun (first pronoun-info)
                                                 pronoun-target (second pronoun-info)]
-                                            (when (= (.toLowerCase pronoun) (.toLowerCase word-text))
+                                            (when (= (lower-case pronoun) (lower-case word-text))
                                               {:target pronoun-target})))))))

 (defn create-phrase


Reformat code.

Reformat code.

--- src/dsbdp/local_dpp_self_adaptivity.clj
+++ src/dsbdp/local_dpp_self_adaptivity.clj
@@ -110,7 +110,12 @@
             orig-mapping
           (>= last-drop last-non-drop)
             (let [decremented-mapping (update orig-mapping last-drop dec)]
-              (if (= (inc last-drop) (- (count fn-drops) (count @limit-reached)))
+              (if
+                (=
+                  (inc last-drop)
+                  (-
+                    (count fn-drops)
+                    (count @limit-reached)))
                 (swap! limit-reached conj last-drop))
               (update decremented-mapping last-non-drop inc))
           (< last-drop last-non-drop)


add disconnect-all! & connected-vertices! to IVertex, add add-edge! to IGraph, update remove-vertex! to destroy all outgoing edges, add LoggedGraph

--- src/thi/ng/fabric/async.cljc
+++ src/thi/ng/fabric/async.cljc
@@ -10,8 +10,10 @@
 (defprotocol IVertex
   (connect-to! [_ v sig-fn edge-opts])
   (disconnect-vertex! [_ v])
+  (disconnect-all! [_])
   (close-input! [_])
   (input-channel [_])
+  (connected-vertices [_])
   (collect! [_])
   (score-collect [_])
   (signal! [_])
@@ -24,7 +26,8 @@
   (add-vertex! [_ vstate])
   (remove-vertex! [_ v])
   (vertex-for-id [_ id])
-  (vertices [_]))
+  (vertices [_])
+  (add-edge! [_ src dest f opts]))

 (defprotocol IGraphExecutor
   (execute! [_])
@@ -58,6 +61,14 @@

 (defn should-collect?
   [vertex thresh] (> (score-collect vertex) thresh))
+
+(def default-vertex-state
+  {::uncollected      []
+   ::signal-map       {}
+   ::score-collect-fn default-score-collect
+   ::score-signal-fn  default-score-signal
+   ::collect-fn       default-collect
+   ::input-channel-fn chan})

 (defrecord Vertex [id state last-sig-state in outs]
   clojure.lang.IDeref
@@ -79,11 +90,15 @@
     [_ v sig-fn opts]
     (debug (format "%d connecting to %d (%s)" id (:id v) (pr-str opts)))
     (swap! outs assoc v [sig-fn opts]) _)
+  (connected-vertices
+    [_] (keys @outs))
   (disconnect-vertex!
     [_ v]
     (debug (format "%d disconnecting from %d" id (:id v)))
     (swap! outs dissoc v)
     _)
+  (disconnect-all!
+    [_] (run! #(disconnect-vertex! _ %) (keys @outs)) _)
   (close-input! [_]
     (if @in
       (do #_(debug (str id " closing..."))
@@ -126,21 +141,6 @@
    (defmethod print-method Vertex
      [^Vertex o ^java.io.Writer w] (.write w (.toString (into {} o)))))

-(def default-vertex-state
-  {::uncollected      []
-   ::signal-map       {}
-   ::score-collect-fn default-score-collect
-   ::score-signal-fn  default-score-signal
-   ::collect-fn       default-collect
-   ::input-channel-fn chan})
-
-(def default-context-opts
-  {:collect-thresh 0
-   :signal-thresh  0
-   :bus-size       16
-   :timeout        25
-   :max-ops        1e6})
-
 (defn vertex
   [id state]
   (map->Vertex
@@ -165,14 +165,43 @@
                  (assoc  :curr-vertex v)))))
         :curr-vertex))
   (remove-vertex!
-    [_ v] (swap! state update :vertices dissoc (:id v)))
+    [_ v]
+    (when (get-in @state [:vertices (:id v)])
+      (swap! state update :vertices dissoc (:id v))
+      (disconnect-all! v)
+      true))
   (vertex-for-id
     [_ id] (get-in @state [:vertices id]))
   (vertices
-    [_] (-> @state :vertices vals)))
+    [_] (-> @state :vertices vals))
+  (add-edge!
+    [_ src dest sig-fn opts]
+    (connect-to! src dest sig-fn opts)))
+
+(defrecord LoggedGraph [g logger]
+  IComputeGraph
+  (add-vertex! [_ v]
+    (let [v (add-vertex! g v)]
+      (go (>! logger [:add-vertex (:id v) @v]))
+      v))
+  (remove-vertex! [_ v]
+    (when (remove-vertex! g v)
+      (go (>! logger [:remove-vertex (:id v)]))
+      true))
+  (vertex-for-id
+    [_ id] (vertex-for-id g id))
+  (vertices
+    [_] (vertices g))
+  (add-edge!
+    [_ src dest f opts]
+    (connect-to! src dest f opts)
+    (go (>! logger [:add-edge (:id src) (:id dest) f opts]))))

 (defn compute-graph
   [] (Graph. (atom {:vertices {} :next-id 0})))
+
+(defn logged-compute-graph
+  [logger] (LoggedGraph. (compute-graph) logger))

 (defn eager-vertex-processor
   [{:keys [id] :as vertex} ctx]
@@ -207,6 +236,14 @@
   [bus vertices]
   (run! close! bus)
   (run! close-input! vertices))
+
+(def default-context-opts
+  {:collect-thresh 0
+   :signal-thresh  0
+   :processor      eager-vertex-processor
+   :bus-size       16
+   :timeout        25
+   :max-ops        1e6})

 (defn async-context
   [opts]
@@ -294,13 +331,6 @@
 %s}")
        (spit path)))

-#_(def g (compute-graph))
-#_(def ctx
-  (async-context
-   {:graph     g
-    :bus-size  64
-    :processor eager-vertex-processor}))
-
 (defn signal-sssp
   [vertex dist] (if-let [v @vertex] (+ dist v)))

@@ -332,20 +362,26 @@
     (dotimes [i num-edges]
       (->> (make-strand verts e-length)
            (partition 2 1)
-           (map (fn [[a b]] (connect-to! (verts a) (verts b) signal-sssp 1)))
+           (map (fn [[a b]] (add-edge! g (verts a) (verts b) signal-sssp 1)))
            (doall)))
     nil))

 (comment
+  (def g (compute-graph))
+  (def ctx
+    (async-context
+     {:graph     g
+      :bus-size  64
+      :processor eager-vertex-processor}))
   (def a (add-vertex! g {:val 0   ::collect-fn collect-sssp}))
   (def b (add-vertex! g {:val nil ::collect-fn collect-sssp}))
   (def c (add-vertex! g {:val nil ::collect-fn collect-sssp}))
   (def d (add-vertex! g {:val nil ::collect-fn collect-sssp}))

-  (connect-to! a b signal-sssp 1)
-  (connect-to! a c signal-sssp 3)
-  (connect-to! b c signal-sssp 1)
-  (connect-to! c d signal-sssp 1)
+  (add-edge! g a b signal-sssp 1)
+  (add-edge! g a c signal-sssp 3)
+  (add-edge! g b c signal-sssp 1)
+  (add-edge! g c d signal-sssp 1)

   (prn @(execute! ctx))

@@ -389,7 +425,7 @@
                  (fn [acc v] (assoc acc v (add-vertex! g (assoc vspec :val #{v}))))
                  {} types)]
       (doseq [[a b] hierarchy]
-        (connect-to! (verts a) (verts b) signal-forward nil))
+        (add-edge! g (verts a) (verts b) signal-forward nil))
       verts)))

 ;;(warn :free-ram (.freeMemory (Runtime/getRuntime)))


Small formatting tweak.

Small formatting tweak.

--- test/ahnentafel/main_test.clj
+++ test/ahnentafel/main_test.clj
@@ -7,7 +7,8 @@
   (testing "redirect to index"
     (let [response (app (mock/request :get "/"))]
       (is (= (:status response) 302))
-      (is (= (get-in response [:headers "Location"]) "http://localhost/index.html"))))
+      (is (= (get-in response [:headers "Location"])
+             "http://localhost/index.html"))))

   (testing "static file redirect"
     (let [response (app (mock/request :get "/index.html"))]


Add requires-retrieval, requires-already-installed, and requires-conflicts tests

--- test/dependable/core_test.clj
+++ test/dependable/core_test.clj
@@ -13,25 +13,25 @@
 (let  [package-a30
       {:name "a"
        :version 30
-       :url "a_loc30"
+       :location "a_loc30"
        :conflicts {"c" nil}
        }
       package-a20
       {:name "a"
        :version 20
-       :url "a_loc20"}
+       :location "a_loc20"}
       package-c10
       {:name "c"
        :version 10
-       :url "c_loc10"}
+       :location "c_loc10"}
       package-d22
        {:name "d"
         :version 22
-        :url "d_loc22"}
+        :location "d_loc22"}
       package-e18
        {:name "e"
         :version 18
-        :url "e_loc18"
+        :location "e_loc18"
         :conflicts {"d" nil}}
       repo-info
       {"a"
@@ -153,8 +153,91 @@
                              [{:name "d"}]
                              query
                              :conflicts {"d" #(< % 22)})
-                           [:successful package-d22]))))
+                           [:successful package-d22])))))
+
+(deftest requires
+         (let [package-a
+               {:name "a"
+                :version 30
+                :location "a_loc30"
+                :requires [{:name "b"}]}
+               package-b
+               {:name "b"
+                :version 20
+                :location "b_loc20"}
+               repo-info
+               {"a" [package-a]
+                "b" [package-b]}
+               query (map-query repo-info)]
+           (testing (str "One package should require another and both "
+                         "should be found.")
+                    (is (= (resolve-dependencies
+                             [{:name "a"}]
+                             query)
+                           [:successful package-a package-b])))
+           (testing (str "One package should be found when it requires "
+                         "another, but it's already installed.")
+                    (is (= (resolve-dependencies
+                             [{:name "a"}]
+                             query
+                             :already-installed {"b" 20})
+                           [:successful package-a]))))
+         (let [package-a
+               {:name "a"
+                :version 10
+                :location "a_loc30"}
+               package-b
+               {:name "b"
+                :version 20
+                :location "b_loc20"
+                :requires [{:name "c"}]}
+               package-c
+               {:name "c"
+                :version 10
+                :conflicts {"a" nil}}
+
+               repo-info
+               {"a" [package-a]
+                "b" [package-b]
+                "c" [package-c]}
+               query (map-query repo-info)]
+           (testing (str "A package having dependencies which conflicts with "
+                         "other packages downloaded should be rejected.")
+                    (is (= (resolve-dependencies
+                             [{:name "a"}
+                              {:name "b"}]
+                             query)
+                           [:unsatisfiable "b" "c"]))))
+           (let [package-a
+                 {:name "a"
+                  :version 10
+                  :location "a_loc10"}
+                 package-b
+                 {:name "b"
+                  :version 10
+                  :location "b_loc10"
+                  :requires [{:name "c"}]}
+                 package-c
+                 {:name "c"
+                  :version 10
+                  :local "c_loc10"}
+                 repo-info
+                 {"a" [package-a]
+                  "b" [package-b]
+                  "c" [package-c]}
+                 query (map-query repo-info)]
+           (testing (str "A package having dependencies rejected a priori "
+                         "also gets rejected")
+                    (is (= (resolve-dependencies
+                             [{:name "a"}
+                              {:name "b"}]
+                             query
+                             :conflicts {"c" nil})
+                           [:unsatisfiable "b" "c"])))))
+
+
 ;; *maybe*. I'll think about it.
+;; Also get other tests from notebook.
 #_(deftest no-locking
            (testing (str "Find two packages, even when the preferred version "
                          "of one package conflicts with the other")
@@ -162,6 +245,6 @@
                              [{:name "a"}
                               {:name "c"}]
                              query)
-                           [:successful package-a20 package-c10])))))
-
-
+                           [:successful package-a20 package-c10]))))
+
+


Add a test for commutative featurec

Add a test for commutative featurec


do not expect root in json. backbone does not do such things

--- src/kreeda/controllers/applications.clj
+++ src/kreeda/controllers/applications.clj
@@ -12,7 +12,7 @@

 (defn create-route [req]
   (let [current-user (auth/current-user req)
-        app-name (get-in req [:body-params :application :name])]
+        app-name (get-in req [:body-params :name])]
     (resp/json (app-model/create app-name (:id current-user)))))

 (defroutes applications-routes


Four new tests: parse-int-min-int, parse-int-max-int, parse-int-overflow, and parse-int-bad-input

--- test/hurvinek/config_test.clj
+++ test/hurvinek/config_test.clj
@@ -95,3 +95,25 @@
         -65536      (parse-int "-65536")
         -2147483647 (parse-int "-2147483647")))

+(deftest test-parse-int-min-int
+    "Check the behaviour of function emender-jenkins.config/parse-int."
+    (is (== Integer/MIN_VALUE (parse-int "-2147483648"))))
+
+(deftest test-parse-int-max-int
+    "Check the behaviour of function emender-jenkins.config/parse-int."
+    (is (== Integer/MAX_VALUE (parse-int "2147483647"))))
+
+(deftest test-parse-int-overflow
+    "Check the behaviour of function emender-jenkins.config/parse-int."
+    (are [x] (thrown? NumberFormatException x)
+        (parse-int "2147483648")
+        (parse-int "-2147483649")))
+
+(deftest test-parse-int-bad-input
+    "Check the behaviour of function emender-jenkins.config/parse-int."
+    (are [x] (thrown? NumberFormatException x)
+        (parse-int "")
+        (parse-int " ")
+        (parse-int "xyzzy")))
+       ; (parse-int "+1"))) ; removed, not compatible with all supported JDKs
+


rm old commented-out code

rm old commented-out code

--- test/kbilling/plans_test.cljs
+++ test/kbilling/plans_test.cljs
@@ -13,13 +13,5 @@
                 (get-in (p/load-plan "test/kbilling/plans/examples/basic") ["cycles" "$subscription" "$begin"]))))

-;should PASS
-;(deftest somewhat-less-wat
-;         (is (= "{}[]" (+ {} []))))
-
-;should PASS
-;(deftest javascript-allows-div0
-;         (is (= js/Infinity (/ 1 0) (/ (int 1) (int 0)))))
-
 (node/enable-util-print!)
 (set! *main-cli-fn* t/run-all-tests)


generalize get and add uri to error

generalize get and add uri to error

--- pedestal-app/app/src/semtag_web/services.cljs
+++ pedestal-app/app/src/semtag_web/services.cljs
@@ -15,23 +15,29 @@
   (p/put-message input-queue {msg/type :set-value
                               msg/topic [:search-results]
                               :value results}))
-(defn- alert
-  "Creates an alert partial with correct type"
+(defn alert
+  "Creates an alert partial for given type"
   [msg alert-type]
   (dom/prepend! (dom/by-id "main")
                 (partials/alert msg (str "alert-" (name alert-type)))))

+(defn GET [uri success-fn]
+  (xhr/request (gensym)
+               uri
+               :request-method "GET"
+               :on-success success-fn
+               :on-error (fn [{:keys [xhr] :as msg}]
+                           (.log js/console "Request failed with:" (.getResponse xhr))
+                           (alert (format "Request '%s' failed with: %s"
+                                          uri
+                                          (.getResponse xhr)) :error))))
+
 (defn services-fn [message input-queue]
   (.log js/console (str "Sending query to server: " message))
   (put-search-title input-queue (:query message))
-  (xhr/request (gensym)
-               #_(str "http://localhost:3000/api/search?query=" (:query message) "&search_type=" (:search-type message))
-               "http://localhost:3000/api/search"
-               :request-method "GET"
-               :on-success (fn [args]
-                             (put-search-results
-                               input-queue
-                               (-> args :body read-string)))
-               :on-error (fn [{:keys [xhr] :as msg}]
-                           (.log js/console "Request failed with:" (.getResponse xhr))
-                           (alert (str "Request failed with: "(.getResponse xhr)) :error))))
+  (GET
+    (str "http://localhost:3000/api/search?query=" (:query message) "&search_type=" (:search-type message))
+    (fn [args]
+      (put-search-results
+        input-queue
+        (-> args :body read-string)))))


show-wishlist mutates state

show-wishlist mutates state

--- src/wishlistd/cljs/main.cljs
+++ src/wishlistd/cljs/main.cljs
@@ -40,7 +40,7 @@
   (.pop
     (.split js/window.location.pathname "/")))

-(defn show-wishlist [{:keys [wishes title] :as wishlist}]
+(defn show-wishlist! [{:keys [wishes title] :as wishlist}]
   (empty $content)
   (empty $header)
   (append $content (wish-ul wishes))
@@ -56,4 +56,4 @@

 (defn create-wishlist-rem []
   (letrem [wishlist (create-wishlist {:title "Default"})]
-    (show-wishlist wishlist)))
+    (show-wishlist! wishlist)))


wishlist-title-changer cljs delegate

wishlist-title-changer cljs delegate

--- src/wishlistd/cljs/main.cljs
+++ src/wishlistd/cljs/main.cljs
@@ -75,3 +75,9 @@
   (delegate $body "#create-wishlist" :click
     (fn [e]
       (create-wishlist-rem))))
+
+(defn wishlist-title-changer []
+  (delegate $header wishlist-title :change
+    (fn [e]
+      (let [wishlist (wishlist-from-html)]
+        (update-wishlist-rem wishlist)))))


remove stale comment

remove stale comment

--- src/main/cljs/clojure/browser/repl.cljs
+++ src/main/cljs/clojure/browser/repl.cljs
@@ -31,8 +31,6 @@
   (if-let [conn @xpc-connection]
     (net/transmit conn :print (pr-str data))))

-;; TODO: latest GCL interface for this is different
-;; see goog.userAgent.product
 (defn get-ua-product []
   (cond
     product/SAFARI :safari


truth table prints now from from relation and prints multi-character variables well

--- src/logic/truthtable.clj
+++ src/logic/truthtable.clj
@@ -1,23 +1,23 @@
 (ns logic.util)

-(defn ast-to-truth-table
+(defn code-to-truth-table
   "Takes clojure code and generates the truth table for it.
    Output format (truth table is a relation):
-   [:symbols [A B] \"vector of all formula variables, ex. \"A & B\"\"
+   {:symbols [A B] \"vector of all formula variables, ex. \"A & B\"\"
     :table [[true true true] [true false false]...] \"list of lists representing a row\"
-   ]"
+   }"
   [clj-code]
   (let [symbols (find-variables clj-code)
         allcomb (selections [true false] (count symbols))
         assign-map (for [comb allcomb]
                             (vec (interleave symbols comb)))]
-    [:symbols (vec symbols)
+    {:symbols (vec symbols)
      :table (vec (for [curr-valuation assign-map]
 					    (let [curr-val-map (apply hash-map curr-valuation)]
 						      (conj (vec (for [sym symbols]
                                (sym curr-val-map)))
                     (eval-formula clj-code curr-valuation))
-						   )))]))
+						   )))}))

 (defn abbrev-bool
   "Replaces 'true' with 'T' and 'false' with 'F' for better reading of a truth table."
@@ -25,32 +25,34 @@
   (cstr/replace (cstr/replace value "true" "T") "false" "F"))

 (defn- print-tt
-  "Prints a truth table in a nice format."
-  [symbols assign-map formula original-formula]
+  "Prints a truth table (given as relation) in a nice format."
+  [formula ttable]

-  ; print header
-  (println "Truth table for formula:" original-formula)
-  (doseq [sym symbols]
-    (print (cstr/replace sym ":" "") ""))
-  (print \u03A6 \newline )
+  (let [symbols (ttable :symbols)
+        table (ttable :table)
+        ;var-spaces (conj (vec (map (comp dec count name) symbols)) 0)]
+        var-spaces (-> (comp dec count name) (map symbols) vec (conj 0))]

-  ; print the combinations and results
-  (doseq [curr-valuation assign-map]
-    (let [curr-val-map (apply hash-map curr-valuation)]
-	    (doseq [sym symbols]
-	      (print (abbrev-bool (sym curr-val-map)) ""))
-	    (print (abbrev-bool (eval-formula formula curr-valuation)) \newline))))
+    ; print original formula
+    (println "Truth table for formula:" formula)
+    (println var-spaces)
+    ; print header
+	  (doseq [sym symbols]
+	    (print (name sym) ""))
+	  (print \u03A6 \newline )
+
+	  ; print the combinations and results
+    (doseq [row table]
+      (doseq [[elem spc] (map list row var-spaces)]
+        (print (abbrev-bool (str elem)) (if (> spc 0) (format (str "%" spc "s") " ") ""))
+      )
+      (print "\n")
+    )
+  ))

 (defn truth-table
   "Takes a human-readable formula, parses it and prints a truth table."
   [formula]
-  (let [ast (logic-parse formula)
-        clj-code (transform-ast ast)
-        symbols (find-variables clj-code)
-        allcomb (selections [true false] (count symbols))
-        assign-map (for [comb allcomb]
-                            (vec (interleave symbols comb)))
-        ]
-            (print-tt symbols assign-map clj-code formula)
-          ))
+  (print-tt formula (code-to-truth-table (transform-ast (logic-parse formula)))))
+


Set default log level to warn

Set default log level to warn

--- src/yetibot/core/logging.clj
+++ src/yetibot/core/logging.clj
@@ -16,7 +16,7 @@
   (let [v (get-config config-schema [:log :level])]
     (if (:error v)
       ;; default config level
-      :warn
+      :info
       (keyword (:value v)))))

 (defn rolling-appender-enabled?


Provoke CLJS only bug to test Travis

Provoke CLJS only bug to test Travis

Signed-off-by: Tom Marble <b248307e886b80bf9cb4014595572a835b049bf4@info9.net>

--- test/testing/avenir/math.cljc
+++ test/testing/avenir/math.cljc
@@ -14,7 +14,8 @@
 ;; if selenium then test  else constant
 (deftest test-constants
   (testing "test constants"
-    (is (= "force a" "bug"))
+    (is #?(:clj true
+           :cljs (= "force a" "cljs bug")))
     (is (= m/js-max-int
           #?(:clj 9007199254740991
              :cljs (if phantomjs?


Guard against bad grp input

Guard against bad grp input

--- services/tnseq-aggregate.clj
+++ services/tnseq-aggregate.clj
@@ -10,29 +10,30 @@
                  refdir (cmn/get-exp-info eid :refs)]
              (mapcat
               (fn[grp]
-                (let [pairs (butlast grp)
-                      allins (mapv second pairs)
-                      allcsv (last grp)
-                      strain (-> pairs ffirst fs/basename
-                                 (str/split #"-") first)
-                      refnm  ((cmn/get-exp-info eid :ncbi-sample-xref) strain)
-                      gtf (fs/join refdir (str refnm ".gbk"))
-                      norm   (fs/join refdir "NormGenes" (str refnm ".txt"))]
-                  (coll/vfold
-                   (fn[oiv]
-                     (let [ret (apply
-                                pg/perl script
-                                (concat ["-m" norm "-w" "1" "-x" "10"
-                                         "-l" "50" "-b" "0" "-c" gtf "-o"]
-                                        oiv [{:verbose true :throw false}]))
-                           exit-code @(ret :exit-code)
-                           exit (if (= 0 exit-code) :success exit-code)
-                           err (-> (ret :stderr) (str/split #"\n") last)]
-                       {:name "tnseq-aggregate"
-                        :value oiv
-                        :exit exit
-                        :err err}))
-                   (conj pairs (coll/concatv [allcsv] allins)))))
+                (when (seq grp)
+                  (let [pairs (butlast grp)
+                        allins (mapv second pairs)
+                        allcsv (last grp)
+                        strain (-> pairs ffirst fs/basename
+                                   (str/split #"-") first)
+                        refnm  ((cmn/get-exp-info eid :ncbi-sample-xref) strain)
+                        gtf (fs/join refdir (str refnm ".gbk"))
+                        norm   (fs/join refdir "NormGenes" (str refnm ".txt"))]
+                    (coll/vfold
+                     (fn[oiv]
+                       (let [ret (apply
+                                  pg/perl script
+                                  (concat ["-m" norm "-w" "1" "-x" "10"
+                                           "-l" "50" "-b" "0" "-c" gtf "-o"]
+                                          oiv [{:verbose true :throw false}]))
+                             exit-code @(ret :exit-code)
+                             exit (if (= 0 exit-code) :success exit-code)
+                             err (-> (ret :stderr) (str/split #"\n") last)]
+                         {:name "tnseq-aggregate"
+                          :value oiv
+                          :exit exit
+                          :err err}))
+                     (conj pairs (coll/concatv [allcsv] allins))))))
               grps))))

  :description "Function wrapping calc_fitness.py taking cmp-quads [t1 t2 csv ef]."


Fix doc string

Fix doc string

--- services/tnseq-aggregate.clj
+++ services/tnseq-aggregate.clj
@@ -35,5 +35,5 @@
                    (conj pairs (coll/concatv [allcsv] allins)))))
               grps))))

- :description "Function wrapping calc_fitness.py taking cmp-quads [t1 t2 csv ef] and gtf. gtf is a gene-transfer-format reference annotation file for the strain."
+ :description "Function wrapping calc_fitness.py taking cmp-quads [t1 t2 csv ef]."
 }


Fix test to not rely on missing def

Fix test to not rely on missing def

--- test/tttclj/t_core.clj
+++ test/tttclj/t_core.clj
@@ -12,7 +12,7 @@

 (facts "about `successor'"
        (fact "should swap the player to :o"
-             (:player game1) => :o)
+             (:player (successor (create-game) 0)) => :o)
        (fact "one tile is taken now"
              (frequencies (:tiles (successor (create-game) 3))) => { :- 8 :x 1})
        (fact "cannot make same move again"


fix incorrect format string

fix incorrect format string

--- cimi/src/com/sixsq/slipstream/auth/external.clj
+++ cimi/src/com/sixsq/slipstream/auth/external.clj
@@ -29,7 +29,7 @@
      user-name))

   ([{:keys [authn-login] :as user-record}]
-   (log/infof "Creating new SlipStream user '%'" authn-login)
+   (log/infof "Creating new SlipStream user '%s'" authn-login)
    (let [user-name (db/create-user! user-record)]
      (when user-name
        (db/create-user-params! user-name))


Pass logo with and height to the org-logo function on invite.

--- src/oc/email/content.clj
+++ src/oc/email/content.clj
@@ -278,12 +278,17 @@

 (defn- invite-content [invite]
   (let [logo-url (:org-logo-url invite)
+        logo-width (:org-logo-width invite)
+        logo-height (:org-logo-height invite)
         logo? (not (s/blank? logo-url))
         org-name (:org-name invite)
         from (if (s/blank? (:from invite)) "Someone" (:from invite))]
     [:td
       (spacer 40)
-      (when logo? (org-logo invite))
+      (when logo? (org-logo {:org-name org-name
+                             :org-logo-url logo-url
+                             :org-logo-width logo-width
+                             :org-logo-height logo-height}))
       (when logo? (spacer 35))
       (h1 (str from " " invite-message))
       (spacer 31)


Fix verify copy.

Fix verify copy.

--- src/oc/email/content.clj
+++ src/oc/email/content.clj
@@ -60,9 +60,9 @@
 (def reset-instructions-2 "Please click the link below to reset your password:")
 (def reset-button-text "reset_password")

-(def verify-message "Please verify your email")
+(def verify-message "Please verify your identity")
 (def verify-instructions "Welcome to Carrot! Carrot is a personalized news feed for your team. With Carrot, it's easy to stay in sync with fewer interruptions.")
-(def verify-instructions-2 "Please click the link below to verify your account:")
+(def verify-instructions-2 "Please click the link below to verify your identity:")
 (def verify-button-text "verify_email")

 ;; Bot removed
@@ -234,7 +234,7 @@
       :accept_invitation
       "Accept invite"
       :verify_email
-      "Verify email"
+      "Verify identity"
       :view_section
       "View section"
       :view_comment


Increase timeout for CI GC

Increase timeout for CI GC

--- test/onyx/log/percentage_multi_job_test.clj
+++ test/onyx/log/percentage_multi_job_test.clj
@@ -129,7 +129,7 @@
 (def ch (chan 10000))

 (def replica
-  (playback-log (:log env) (extensions/subscribe-to-log (:log env) ch) ch 3000))
+  (playback-log (:log env) (extensions/subscribe-to-log (:log env) ch) ch 10000))

 (fact "70/30% split for percentage job scheduler succeeded"
       (map (partial apply +)
@@ -138,7 +138,7 @@
 (def v-peers-2 (onyx.api/start-peers n-peers peer-group))

 (def replica-2
-  (playback-log (:log env) replica ch 3000))
+  (playback-log (:log env) replica ch 10000))

 (fact "70/30% split for percentage job scheduler succeeded after rebalance"
       (map (partial apply +)


Sort metadata and minor style improvment

--- src/onix/persistence.clj
+++ src/onix/persistence.clj
@@ -67,9 +67,7 @@
   "Fetches the data for the application with the given name."
   [application-name]
   (when-let [application (far/get-item (create-creds) applications-table {:name application-name})]
-    (if-let [metadata (cheshire/parse-string (:metadata application) true)]
-      (assoc application :metadata metadata)
-      application)))
+    (update-in application [:metadata] #(into (sorted-map) (cheshire/parse-string % true)))))

 (defn create-application
   "Creates the given application in store, unless it already exists."


fix snapshot version string to correctly render patch number

--- src/overtone/version.clj
+++ src/overtone/version.clj
@@ -11,5 +11,5 @@
          (:major version)
          "."
          (:minor version)
-         (if-not (= 0 (:patch version)) (:patch version) "")
+         (if-not (= 0 (:patch version)) (str "." (:patch version)) "")
          (if (:snapshot version) "-dev" ""))))


:postbox: better port parsing

:postbox: better port parsing

--- src/moves_server/core.clj
+++ src/moves_server/core.clj
@@ -36,4 +36,4 @@
              wrap-params))

 (defn -main [& args]
-  (jetty/run-jetty app {:port (or (env :port) 3333)}))
+  (jetty/run-jetty app {:port (Integer. (or (env :port) "3333"))}))


better logging

better logging

--- src/ontrail/websocket.clj
+++ src/ontrail/websocket.clj
@@ -55,7 +55,7 @@

 (defn server-message [type user value]
   (condp = type
-    :comment-ex {:user user :action "kommentoi viestiä" :message (:title value) :link (ex-link value)}
+    :comment-ex {:user user :action (str "kommentoi käyttäjän " (:user value) " harjoitusta") :message (:title value) :link (ex-link value)}
     :create-ex {:user user
                 :action "kirjasi harjoituksen"
                 :message (:title value)


debut retry-segment

debut retry-segment

--- src/onyx/plugin/kafka.clj
+++ src/onyx/plugin/kafka.clj
@@ -202,13 +202,14 @@

   (ack-segment [_ _ segment-id]
     (when-let [offset (:offset (get @pending-messages segment-id))]
-      (clojure.pprint/pprint ["ACK" (get @pending-messages segment-id)])
+      ;; (clojure.pprint/pprint ["ACK" (get @pending-messages segment-id)])
       (swap! pending-commits conj offset))
     (swap! pending-messages dissoc segment-id))

   (retry-segment
     [_ _ segment-id]
     (when-let [msg (get @pending-messages segment-id)]
+      (clojure.pprint/pprint ["RETRY" (get @pending-messages segment-id)])
       (swap! pending-messages dissoc segment-id)
       (>!! read-ch (t/input (java.util.UUID/randomUUID)
                             (:message msg)))))


Make add! nicer to use directly

Make add! nicer to use directly

--- src/play_clj/ui.clj
+++ src/play_clj/ui.clj
@@ -104,16 +104,14 @@
       nil)))

 (defn add!
-  [group children]
+  [group & children]
   (doseq [child children]
     (add-to-group! [group child]))
   group)

 (defn ^:private create-group
   [^WidgetGroup group children]
-  (-> group
-      u/create-entity
-      (add! children)))
+  (apply add! (u/create-entity group) children))

 ; widgets


influxdb 0.9: only escape spaces and commas in the measurement name (thanks jwilder)

--- src/riemann/influxdb.clj
+++ src/riemann/influxdb.clj
@@ -30,7 +30,7 @@
         encoded_tags   (clojure.string/join "," (map
                          (fn [[tag value]] (str (replace-disallowed-9 tag) "=" (replace-disallowed-9 value)))
                          (get event "tags")))]
-    (str (replace-disallowed-9 (get event "measurement")) "," encoded_tags " " encoded_fields " " (get event "time"))))
+    (str (str/escape (get event "measurement") {\space "\\ ", \, "\\,"}) "," encoded_tags " " encoded_fields " " (get event "time"))))

 (defn event-tags
   "Generates a map of InfluxDB tags from a Riemann event. Any fields in the


code changes suggested by the maintainer

--- src/riemann/logstash.clj
+++ src/riemann/logstash.clj
@@ -96,26 +96,21 @@
   :key              A PKCS8-encoded private key file
   :cert             The corresponding public certificate
   :ca-cert          The certificate of the CA which signed this key"
-
   [opts]
-
   (let [opts (merge {:host "127.0.0.1"
                      :port 9999
                      :protocol :tcp
                      :claim-timeout 0.1
                      :pool-size 4} opts)
-
         pool (fixed-pool
                (fn []
                  (info "Connecting to " (select-keys opts [:host :port :protocol]))
-                 (let [
-                       host (:host opts)
+                 (let [host (:host opts)
                        port (:port opts)
                        client (open (condp = (:protocol opts)
                                       :tcp (LogStashTCPClient. host port)
                                       :udp (LogStashUDPClient. host port)
-                                      :tls (LogStashTLSClient. host port opts)
-                                      ))]
+                                      :tls (LogStashTLSClient. host port opts)))]
                    (info "Connected")
                    client))
                (fn [client]


Remove destructuring from process-route args and document methods

--- src/route_ccrs/routes.clj
+++ src/route_ccrs/routes.clj
@@ -15,7 +15,9 @@
 (defn route-id [r]
   (select-keys r route-id-keys))

-(defn sorted-operation-set []
+(defn sorted-operation-set
+  "Returns an empty set that will sort its elements by their `:operation_no`"
+  []
   (sorted-set-by
     (fn [x y]
       (compare (:operation_no x) (:operation_no y)))))
@@ -39,12 +41,27 @@
     transduce-routes
     {}))

-(defn process-route [db [route-id operations]]
+(defn process-route
+  "Compares the current CCR for a route, as returned from the database, to
+  that calculated for the given collection of operations and returns a tuple
+  of `[route-ccr database-update]`
+
+  The returned `route-ccr` is a map containing the `route-id` fields, the
+  new CCR information for the route, and the routes best end date.
+
+  The `database-update` is a variant of `[update-type update-fields]` where
+  the `update-type` will be one of: `:insert`, `:update`, or `:replace` and
+  `update-fields` is a map of the fields and their values that are required
+  to perform the update."
+  [db route-id operations]
   (let [c {:connection db}]
     (ccr/ccr-entry-updates
       route-id
       (ccr/get-last-known-ccr route-id c)
       (ccr/select-current-ccr operations c))))

-(defn process-routes [db routes]
-  (parallel-process (partial process-route db) routes))
+(defn process-routes
+  "Processes a collection of routes, passing each to `process-route`
+  and returning a collection of the results."
+  [db routes]
+  (parallel-process #(apply process-route db %) routes))


Use new Heroku icon.

Use new Heroku icon.

--- src-cljs/frontend/components/integrations.cljs
+++ src-cljs/frontend/components/integrations.cljs
@@ -96,7 +96,7 @@
                           :type "submit"}]]])))))

 (def integration-data
-  {:heroku {:hero {:icon [:img {:src (utils/cdn-path "/img/outer/integrations/heroku-icon.svg") :alt "Heroku"}]
+  {:heroku {:hero {:icon (utils/cdn-path "/img/outer/integrations/heroku-logo.svg")
                    :heading "Deploy to Heroku from CircleCI"
                    :text "Experience a simple, modern continuous delivery workflow now."}
             :features [{:type :text
@@ -141,7 +141,7 @@
                             "Or see our "
                             [:a {:href "/docs/continuous-deployment-with-heroku"}
                              "docs on deploying to Heroku."]]}
-   :saucelabs {:hero {:icon [:img {:src (utils/cdn-path "/img/outer/integrations/sauce.png") :alt "Sauce Labs"}]
+   :saucelabs {:hero {:icon nil
                       :heading "Test with Sauce Labs on CircleCI"
                       :text "Test against hundreds of mobile and desktop browsers."}
                :features [{:type :text
@@ -250,7 +250,8 @@
                  [:div.row
                   [:div.hero-title.center-block
                    [:div.text-center
-                    [:img.hero-logo (get-in data [:hero :icon])]]
+                    (if-let [icon-src (get-in data [:hero :icon])]
+                      [:img.hero-logo {:src icon-src}])]
                    [:h1.text-center (get-in data [:hero :heading])]]]]
                 [:div.row.text-center
                  (common/sign-up-cta owner (str "integrations/" (name integration)))]]


Fix errors in throw calls

Fix errors in throw calls

throw wants an execption instance

--- src/vip/data_processor/validation/xml/spec.clj
+++ src/vip/data_processor/validation/xml/spec.clj
@@ -13,14 +13,14 @@
       (case prefix
         XMLConstants/DEFAULT_NS_PREFIX XMLConstants/NULL_NS_URI
         "xs" "http://www.w3.org/2001/XMLSchema"
-        (throw IllegalArgumentException (str "Unknown prefix: " prefix))))
+        (throw (IllegalArgumentException. (str "Unknown prefix: " prefix)))))
     (getPrefix [this namespace-uri]
       (case namespace-uri
         XMLConstants/NULL_NS_URI XMLConstants/DEFAULT_NS_PREFIX
         XMLConstants/XML_NS_URI XMLConstants/XML_NS_PREFIX
         XMLConstants/XMLNS_ATTRIBUTE_NS_URI XMLConstants/XMLNS_ATTRIBUTE
         "http://www.w3.org/2001/XMLSchema" "xs"
-        (throw IllegalArgumentException (str "Unknown namespace-uri: " namespace-uri))))
+        (throw (IllegalArgumentException. (str "Unknown namespace-uri: " namespace-uri)))))
     (getPrefixes [this namespace-uri]
       ;; not implemented
       nil)))


iterative remove-all-parens

iterative remove-all-parens

--- src/atom_finder/questions/operator_spacing.clj
+++ src/atom_finder/questions/operator_spacing.clj
@@ -44,14 +44,15 @@
        parse-expr))

 (defn remove-all-parens [node]
-  (let [new-kids (into [] (map remove-all-parens (children node)))
-        new-mom (replace-all-exprs node new-kids)]
-    (->> new-mom
-         children
-         (filter paren-node?)
-         (reduce
-          (fn [mom paren-child] (replace-expr mom paren-child (child paren-child)))
-          new-mom))))
+  (let [old-kids (children node)
+        new-kids (into [] (map remove-all-parens old-kids))
+        new-mom (if (= old-kids new-kids) node (replace-all-exprs node new-kids))]
+
+    (loop [mom new-mom]
+      (let [paren-child (->> mom children (filter paren-node?) first)]
+           (if (nil? paren-child)
+             mom
+             (recur (replace-expr mom paren-child (child paren-child))))))))

 (defn operator-spacing-confusing? [node]
   (not (tree=by (juxt class expr-operator)
@@ -88,20 +89,3 @@
     (count-all-spaced-operators edn-file)
     ;(summarize-all-nodes edn-file csv-file)
   ))
-
-(s/defn replace-exprs2 :- IASTNode
-  "Update multiple children inside a parent node.
-   Returns an updated copy of the parent."
-  [parent :- IASTNode
-   old-kids ;;:- [IASTExpression] - These don't play nicely with java arrays
-   new-kids ;;:- [IASTExpression]
-   ]
-
-  (assert (=by count old-kids new-kids) (str "Old expressions must be replaced by the same number of new expressions. You tried to replace " (count old-kids) " with " (count new-kids)))
-
-  (let [{getters :getters setters :setters} (expr-getters-setters parent)
-        old-idxs (map (fn [old-child] (.indexOf (map #(%) getters) old-child)) old-kids)]
-
-    (reduce (fn [mom [old-idx new-kid]]
-              (let [setter (nth setters old-idx)]
-                (setter new-kid))) parent (map vector old-idxs new-kids))))


Remove working dirs via system commands

Remove working dirs via system commands

Deleting them via java methods turned out to be problematic because of
symlinks etc.

--- src/cider_ci/ex/trials/working_dir_sweeper.clj
+++ src/cider_ci/ex/trials/working_dir_sweeper.clj
@@ -5,21 +5,26 @@
 (ns cider-ci.ex.trials.working-dir-sweeper
   (:require
     [cider-ci.ex.trials.state]
+
     [cider-ci.utils.config :as config :refer [get-config]]
     [cider-ci.utils.daemon :as daemon :refer [defdaemon]]
+    [cider-ci.utils.system :as system]
+
+    [clj-time.core :as time]
+    [clojure.java.io :refer [file]]
+    [me.raynes.fs :as clj-fs]
+
+    [clojure.tools.logging :as logging]
     [logbug.debug :as debug]
     [logbug.catcher :as catcher]
     [clj-logging-config.log4j :as logging-config]
-    [clj-time.core :as time]
-    [clojure.java.io :refer [file]]
-    [clojure.tools.logging :as logging]
-    [me.raynes.fs :as clj-fs]
     )
   (:import
     [java.io File]
     [java.nio.file Files Paths]
     [java.nio.file.attribute BasicFileAttributes PosixFileAttributes]
     [org.apache.commons.io FilenameUtils]
+    [org.apache.commons.lang3 SystemUtils]
     ))

 (defn- get-working-dir []
@@ -29,29 +34,28 @@
   (->> (clj-fs/list-dir (get-working-dir))
        (filter clj-fs/directory?)))

-(defn- delete-recursively [file-or-string]
-  (catcher/snatch {}
-    (let [file (clojure.java.io/file file-or-string)]
-      (when (.exists file)
-        (when (and (.isDirectory file) (not (Files/isSymbolicLink (.toPath file))))
-          (doseq [file (.listFiles file)]
-            (delete-recursively file)))
-        (.delete file)))))
+(defn- remove-working-dir [working-dir]
+  (let [path (str working-dir)]
+    (assert (.exists (file path)))
+    (let [cmd (cond SystemUtils/IS_OS_UNIX ["rm" "-rf" path]
+                    SystemUtils/IS_OS_WINDOWS ["RMDIR" "/s" "/q" path])]
+      (system/exec-with-success-or-throw cmd {:timeout "1 Minute"}))))

 (defn- delete-orphans []
   (doseq [working-dir (get-trial-dirs)]
-    (when-not (.exists (file (clojure.string/join
-                               [(str working-dir)
-                                File/separator "_cider-ci_keep"])))
-      (when-let [base-name (clj-fs/base-name working-dir)]
-        (when-not (cider-ci.ex.trials.state/get-trial base-name)
-          (logging/info "deleting working-dir " working-dir)
-          (delete-recursively working-dir))))))
+    (when-let [base-name (clj-fs/base-name working-dir)]
+      (when-not (cider-ci.ex.trials.state/get-trial base-name)
+        (when-not (.exists (file (clojure.string/join
+                                   [(str working-dir)
+                                    File/separator "_cider-ci_keep"])))
+          (logging/debug "deleting working-dir " working-dir)
+          (catcher/snatch
+            {} (remove-working-dir working-dir)))))))

 (defdaemon "trial-working-dir-sweeper" 1 (delete-orphans))

 (defn initialize []
-  (start-trial-working-dir-sweeper))
+ (start-trial-working-dir-sweeper))

 ;### Debug ####################################################################


Cleanup, remove everything prepared-statement related.

Add Execute protocol that works for all kinds of statements

--- src/clojure/clojurewerkz/cassaforte/client.clj
+++ src/clojure/clojurewerkz/cassaforte/client.clj
@@ -25,7 +25,7 @@
             [clojurewerkz.cassaforte.conversion :as conv]
             [qbits.hayt.cql                     :as hayt])
   (:import [com.datastax.driver.core Statement ResultSet ResultSetFuture Host Session Cluster
-            Cluster$Builder SimpleStatement PreparedStatement HostDistance PoolingOptions
+            Cluster$Builder SimpleStatement PreparedStatement BoundStatement HostDistance PoolingOptions
             SSLOptions ProtocolOptions$Compression]
            [com.datastax.driver.auth DseAuthProvider]
            [com.google.common.util.concurrent Futures FutureCallback]
@@ -56,7 +56,7 @@
      * max-connections-per-host: maximum number of connections per host.
      * retry-policy: configures the retry policy to use for the new cluster.
      * load-balancing-policy: configures the load balancing policy to use for the new cluster.
-     * force-prepared-queries: forces all queries to be executed as prepared by default
+
      * consistency-level: default consistency level for all queires to be executed against this cluster
      * ssl: ssl options in the form {:keystore-path path :keystore-password password} Also accepts :cipher-suites with a Seq of cipher suite specs.
      * ssl-options: pre-built SSLOptions object (overrides :ssl)
@@ -70,16 +70,12 @@
            retry-policy
            reconnection-policy
            load-balancing-policy
-           force-prepared-queries
            ssl
            ssl-options
            kerberos
            protocol-version
            compression]
     :or {protocol-version 2}}]
-  (when force-prepared-queries
-    (alter-var-root (var hayt/*prepared-statement*)
-                    (constantly true)))
   (when consistency-level
     (alter-var-root (var cp/*consistency-level*)
                     (constantly (cp/resolve-consistency-level consistency-level))))
@@ -190,13 +186,12 @@
   [^Cluster cluster]
   (.close cluster))

-(defmacro prepared
-  "Same as cassaforte.policies/forcing-prepared-statements. Kept for backwards
-   compatibility."
-  [& body]
+(defmacro prepare
+  "Prepare a single statement, return prepared statement"
+  [body]
   `(binding [hayt/*prepared-statement* true
              hayt/*param-stack*        (atom [])]
-     (do ~@body)))
+     (do ~body)))

 (defmacro with-fetch-size
   "Temporarily alters fetch size."
@@ -212,7 +207,7 @@
     (.setConsistencyLevel statement (cp/resolve-consistency-level cp/*consistency-level*)))
   statement)

-(defn- build-statement
+(defn ^:private build-statement-
   "Builds a Prepare or Simple statement out of given params.

    Arities:
@@ -224,41 +219,20 @@
   ([^String string-query]
      (set-statement-options- (SimpleStatement. string-query))))

-(defn ^PreparedStatement prepare
-  "Prepares the provided query on C* server for futher execution.
-
-   This assumes that query is valid. Returns the prepared statement corresponding to the query."
-  ([^Session session ^String query]
-     (.prepare ^Session session query)))
-
-(defn render-query
-  "Renders compiled query"
-  [query-params]
-  (let [renderer (if hayt/*prepared-statement*
-                   hayt/->prepared
-                   hayt/->raw)]
-    (renderer query-params)))
-
-(defn compile-query
-  "Compiles query from given `builder` and `query-params`"
-  [query-params builder]
-  (apply builder (flatten query-params)))
-
-(defn as-prepared
-  "Helper method to create prepared query from `query` string with `?` placeholders and values
-   to be bound to the query."
-  [query & values]
-  (vector query values))
-
-(defn- ^Statement statement-for
-  [^Session session query prepared?]
-  (if prepared?
-    (if (coll? query)
-      (build-statement (prepare session (first query))
-                       (second query))
-      (throw (IllegalArgumentException.
-              "Query is meant to be executed as prepared, but no values were supplied.")))
-    (build-statement query)))
+(defn bind
+  [^PreparedStatement statement values]
+  (.bind statement (to-array values)))
+
+(comment
+  (defn- ^Statement statement-for
+    [^Session session query prepared?]
+    (if prepared?
+      (if (coll? query)
+        (build-statement- (prepare session (first query))
+                          (second query))
+        (throw (IllegalArgumentException.
+                "Query is meant to be executed as prepared, but no values were supplied.")))
+      (build-statement- query))))

 (defn ^ResultSetFuture execute-async
   "Executes a pre-built query and returns a future.
@@ -273,21 +247,48 @@
            ^ResultSetFuture fut (.executeAsync session statement)]
        (future (conv/to-clj (.getUninterruptibly fut))))))

-(defn execute
-  "Executes a pre-built query.
+(defprotocol Execute
+  (execute [query session]))
+
+(extend-protocol Execute
+  String
+  (execute [query ^Session session]
+    (execute (SimpleStatement. query) session))
+
+  clojure.lang.PersistentVector
+  (execute [[^String query _] ^Session session]
+    ;; Works only in combination with (prepare ...)
+    (.prepare session query))
+
+  BoundStatement
+  (execute [bound-statement ^Session session]
+    (-> session
+        (.executeAsync bound-statement)
+        (.getUninterruptibly)
+        (conv/to-clj)))
+  SimpleStatement
+  (execute [simple-statement ^Session session]
+    (-> session
+        (.executeAsync simple-statement)
+        (.getUninterruptibly)
+        (conv/to-clj))))
+
+(comment
+  (defn execute
+    "Executes a pre-built query.

    Options
      * prepared - whether the query should or should not be executed as prepared, always passed
        explicitly, because `execute` is considered to be a low-level function."
-  ([^Session session query]
-     (execute session query {}))
-  ([^Session session query {:keys [prepared fetch-size]}]
-     (let [^Statement statement (statement-for session query prepared)
-           _                    (when fetch-size
-                                  (.setFetchSize statement fetch-size))
-           ^ResultSetFuture fut (.executeAsync session statement)
-           res                  (.getUninterruptibly fut)]
-       (conv/to-clj res))))
+    ([^Session session query]
+       (execute session query {}))
+    ([^Session session query {:keys [fetch-size]}]
+       (let [^Statement statement (statement-for session query prepared)
+             _                    (when fetch-size
+                                    (.setFetchSize statement fetch-size))
+             ^ResultSetFuture fut (.executeAsync session statement)
+             res                  (.getUninterruptibly fut)]
+         (conv/to-clj res)))))

 (defn ^String export-schema
   "Exports the schema as a string"


Exercise 2.33, 2.34, 2.35

Exercise 2.33, 2.34, 2.35

--- src/sicp/chapter2/2_3.clj
+++ src/sicp/chapter2/2_3.clj
@@ -4,14 +4,36 @@

 ;;; 2.2.3  Sequences as Conventional Interfaces

+(defn accumulate [op initial sequence]
+  (if (empty? sequence)
+    initial
+    (op (first sequence)
+        (accumulate op initial (rest sequence)))))
+
 ;; Exercise 2.33
-;; TODO
+(defn map' [p sequence]
+  (accumulate (fn [x y] (cons (p x) y)) nil sequence))
+
+(defn append [seq1 seq2]
+  (accumulate cons seq2 seq1))
+
+(defn length [sequence]
+  (accumulate (fn [_ acc] (inc acc))  0 sequence))

 ;; Exercise 2.34
-;; TODO
+(defn horner-eval [x coefficient-sequence]
+  (accumulate (fn [this-coeff higher-terms]
+                (+ this-coeff (* x higher-terms)))
+              0
+              coefficient-sequence))

 ;; Exercise 2.35
-;; TODO
+(defn count-leaves [t]
+  (accumulate + 0 (map (fn [x]
+                         (if (not (seq? x))
+                           1
+                           (count-leaves x)))
+                       t)))

 ;; Exercise 2.36
 ;; TODO


and actually apply that function

and actually apply that function

--- src/vigil/operations.clj
+++ src/vigil/operations.clj
@@ -22,9 +22,11 @@
              (partial (comp not sally/overdue?) (:sally-duration game))
              (partial sally/against-team? (:team-id player)))
             sallies))
-      {;; We need to load game again, because we may have changed it above.
-       :game (core/game-view (data/get-full-game-by-player-id player))
-       :current-player (data/get-player player)})))
+      ;; We need to load game again, because we may have changed it above.
+      (let [game (data/get-full-game-by-player-id player)]
+        {:game (core/game-view game)
+         :current-player (core/player-view game
+                                           (data/get-player player))}))))

 (defn new-game [player-name team-name sally-duration]
   "Set up a game for the player."


Updated HTML renderer: proper widget ID for 'Use it' drop down list

--- src/zg/html_renderer.clj
+++ src/zg/html_renderer.clj
@@ -311,7 +311,7 @@
                          [:td (form/drop-down "class" ["N/A" "Noun" "Verb" "Adjective" "Adverb" "Pronoun" "Preposition" "Conjunction" "Determiner" "Exclamation"])]]
                     [:tr [:td [:div {:class "_label _label-default"} "Use it"]]
                          [:td " "]
-                         [:td (form/drop-down "class" ["Yes" "No" "With caution"])]]
+                         [:td (form/drop-down "use_it" ["Yes" "No" "With caution"])]]
                     [:tr [:td [:div {:class "_label _label-default"} "Internal:"]]
                          [:td " "]
                          [:td (form/check-box "internal")]]
@@ -378,6 +378,7 @@
     (println title)
     (println mode)
     (println (first search-results))
+    (println sources-map)
     (page/xhtml
         (render-html-header word url-prefix title)
         [:body


fixed world-balance

fixed world-balance

--- src-clj/acha/achievement.clj
+++ src-clj/acha/achievement.clj
@@ -148,12 +148,17 @@
 (def world-balance
   (make-loc-scanner
     [:world-balance
-    (fn [loc] (and (= (:added loc 0) (:deleted loc 0)) (> (:added loc 0) 0)))]))
+    (fn [loc]
+      (and (= (:added loc 0) (:deleted loc 0))
+           (pos? (:added loc 0))))]))

 (def eraser
   (make-loc-scanner
     [:eraser
-    (fn [loc] (= 0 (:added loc 0)))]))
+    (fn [loc]
+      (and
+        (= 0 (:added loc 0))
+        (pos? (:deleted loc 0))))]))

 (def massive
   (make-loc-scanner


feat(ingraph-sre): create new config for it


fix typos.

fix typos.

git-svn-id: 03a8048b5ee8463be5048a3801110fb50f378627@5852 d0ab736e-dc22-4aeb-8dc9-08def0aa14fd

--- clojure/acq_engine.clj
+++ clojure/acq_engine.clj
@@ -1,6 +1,6 @@
 (ns acq-engine
   (:use [mm :only [mmc gui acq]])
-  (:import [org.micromanager.api AcquisitionEngine])
+  (:import [org.micromanager.api AcquisitionEngine]))

 ; engine
@@ -57,7 +57,7 @@
   (clock-ms))

 (defn wait-for-devices [event]
-  (. waitForDevice (. mmc getFocusDevice))
+  (. mmc waitForDevice (. mmc getFocusDevice))
   ;; more
   )

@@ -77,10 +77,11 @@
 (defn run-acquisition [params]
   (println params))

-(def compute-verbose-summary [params]
+(defn compute-verbose-summary [params]
    "meh")

 ;; AcquisitionEngine implementation
+

 (defn create-acq-eng []
@@ -166,4 +167,6 @@

+
+


adding lights & light-groups batch generators

--- src/thi/ng/luxor/core.clj
+++ src/thi/ng/luxor/core.clj
@@ -351,9 +351,9 @@
    scene :film "fleximage"
    (merge
     (get-in scene [:film "fleximage"])
-    {:xresolution [:int width]
+    {:__aspect (double (/ height width))
+     :xresolution [:int width]
      :yresolution [:int height]
-     :__aspect (double (/ height width))
      :gamma [:float gamma]
      :filename [:string suffix]
      :colorspace_white [:float-vec white]
@@ -454,7 +454,11 @@

 (defn light-group
   [scene id {:keys [gain] :or {gain 1.0}}]
-  (append scene :light-groups id {:__gain [:float gain]}))
+  (append scene :light-groups id {:__gain gain}))
+
+(defn light-groups
+  [scene groups]
+  (reduce #(apply light-group % %2) scene groups))

 (defn- light-common
   [scene {:keys [group color gain power efficacy importance tx material hidden?]
@@ -464,7 +468,7 @@
    :__material (or material (when hidden? "__hidden__"))
    :L [:color color]
    :gain [:float (if group
-                   (* (get-in scene [:light-groups group :__gain 1] 1.0) gain)
+                   (* (get-in scene [:light-groups group :__gain] 1.0) gain)
                    gain)]
    :power [:float power]
    :efficacy [:float efficacy]
@@ -488,6 +492,18 @@
        :__shape [(conf/mesh-types mesh-type) {:__mesh mesh :__basename (str "light-" id)}]
        :nsamples [:int samples]}))))

+(def light-types
+  {:area area-light})
+
+(defn lights
+  [scene lspecs]
+  (reduce
+   (fn [scene [id {ltype :type :as spec}]]
+     (if-let [lfn (light-types ltype)]
+       (lfn scene id spec)
+       (prn "WARN: unknown light type: " ltype)))
+   scene lspecs))
+
 (defn shape-disk
   [scene id {:keys [z radius inner-radius phi tx material]
              :or {z 0 radius 1 inner-radius 0 phi 360}}]


add user role to all new users

add user role to all new users

--- src/wombats/daos/user.clj
+++ src/wombats/daos/user.clj
@@ -71,7 +71,8 @@
                   :user/avatar-url avatar_url}]
       (if-not current-user-id
         (d/transact-async conn [(merge update {:db/id (d/tempid :db.part/user)
-                                               :user/id (gen-id)})])
+                                               :user/id (gen-id)
+                                               :user/roles [:user.roles/user]})])
         (d/transact-async conn [(merge update {:user/id current-user-id})])))))

 (defn remove-access-token


Remove speclj for now

Remove speclj for now

--- spec/robb1e/core_spec.clj
+++ spec/robb1e/core_spec.clj
@@ -1,8 +0,0 @@
-(ns robb1e.core-spec
-  (:require [speclj.core :refer :all]))
-
-(describe "truthiness"
-  (it "tests if true"
-    (should true)))
-
-(run-specs)


Revert "Adding failing test to test CI."

This reverts commit bf373ae68fce104646934b0e65c5b468775f3ccd.

--- test/cmr/umm/test/echo10/collection.clj
+++ test/cmr/umm/test/echo10/collection.clj
@@ -10,10 +10,6 @@
             ;; my code
             [cmr.umm.echo10.collection :as c]
             [cmr.umm.collection :as umm-c]))
-
-(deftest will-always-fail
-  (println "Failing to test CI")
-  (is (= 5 4)))

 (defspec generate-collection-is-valid-xml-test 100
   (for-all [collection umm-gen/collections]


Update etl to account for ElasticSearch.

--- dev/etl.clj
+++ dev/etl.clj
@@ -24,7 +24,7 @@

 (def custom-formatter (tf/formatter "yyyy-MM-dd'T'HH:mm:ss.SSSZ"))

-(defn update-reading-metadata [metadata]
+(defn update-reading-metadata [metadata]
   (when metadata
     (let [new-metadata (walk/stringify-keys (read-string metadata))]
       new-metadata)))
@@ -34,7 +34,6 @@
     [(:username cred) (:password cred)]))

 (defn post-resource [post-uri content-type data]
-  (pr-str "DATA:" data)
   (let [response
         @(http-request
           {:method :post
@@ -66,7 +65,7 @@
   (doseq [batch (partition-all 500 measurements)]
     (post-measurements batch url)))

-(defn post-contextual-data
+(defn post-contextual-data
   "Creates test programme, project and devices which are used to post measurements.
   Uses the API."
   [store]
@@ -77,13 +76,16 @@
   (post-resource (:device-1 urls) "application/json" (:device-1 resources))

   (db/with-session [session (:hecuba-session store)]
-    (db/execute session
+    (db/execute session
                 (hayt/insert :entities (hayt/values {:id "14366c761c74592b9926e851bae8a64ece7239ff"
                                                      :project_id "ba776928f94b3aaa1e444569276ee5b66d6b21f7"})))
-    (db/execute session
+    (db/execute session
                 (hayt/insert :entities (hayt/values {:id "9ac7f5635832d843dda594f58525239263ffdd37"
                                                      :project_id "ba776928f94b3aaa1e444569276ee5b66d6b21f7"}))))
-
+  ;; cos we're bypassing the api above need to refresh ES.
+  (kixi.hecuba.data.entities.search/refresh-search
+   (:hecuba-session store) (:search-session store))
+
   (post-resource (:device-2 urls) "application/json" (:device-2 resources))
   (post-resource (:device-3 urls) "application/json" (:device-3 resources))
   (post-resource (:device-3 urls) "application/json" (:device-4 resources))
@@ -97,12 +99,12 @@
     (let [measurements2 (map #(zipmap [:device_id :type :month :timestamp :error :reading_metadata :value] %)
                              (rest (csv/read-csv in-file)))]
       (batch-csv measurements2 (:measurement-2 urls))))
-
+
   (with-open [in-file2 (io/reader (io/resource "csv/b4f0c7e2b15ba9636f3fb08379cc4b3798a226bb-interpolatedHeatConsumption.csv"))]
     (let [measurements3 (map #(zipmap [:device_id :type :month :timestamp :error :reading_metadata :metadata :value] %)
                              (rest (csv/read-csv in-file2)))
           m3 (map #(update-in % [:timestamp] (fn [t] (let [d (tf/parse (tf/formatter  "yyyy-MM-dd HH:mm:ssZ") t)]
-                                                     (tf/unparse
+                                                     (tf/unparse
                                                       (tf/formatter "yyyy-MM-dd HH:mm:ssZ")
                                                       (t/minus (t/plus d (t/years 2)) (t/days 9))))))
                   measurements3)]
@@ -112,7 +114,7 @@
     (let [measurements4 (map #(zipmap [:device_id :type :month :timestamp :error :reading_metadata :metadata :value] %)
                              (rest (csv/read-csv in-file3)))
            m4 (map #(update-in % [:timestamp] (fn [t] (let [d (tf/parse (tf/formatter  "yyyy-MM-dd HH:mm:ssZ") t)]
-                                                      (tf/unparse
+                                                      (tf/unparse
                                                        (tf/formatter "yyyy-MM-dd HH:mm:ssZ")
                                                        (t/minus (t/plus d (t/years 2)) (t/days 9))))))
                    measurements4)]
@@ -122,14 +124,14 @@
     (let [measurements5 (map #(zipmap [:device_id :type :month :timestamp :error :reading_metadata :value] %)
                              (rest (csv/read-csv in-file4)))]
       (batch-csv measurements5 (:measurement-5 urls))))
-
+
   (with-open [in-file5 (io/reader (io/resource "csv/122b4bf8dfa66cbf8f321f2d03c4d73f924bb719-interpolatedElectricityConsumption.csv"))]
     (let [measurements6 (map #(zipmap [:device_id :type :month :timestamp :error :reading_metadata :value] %)
                              (rest (csv/read-csv in-file5)))]
       (batch-csv measurements6 (:measurement-6 urls)))))

-(defn post-generated-measurements
+(defn post-generated-measurements
   "Generates measurements (500) and posts them to Hecuba"
   []
   (let [generated-measurements (generators/measurements  {:type "electricityConsumption"
@@ -137,7 +139,7 @@
                                                           :resolution 60
                                                           :period "PULSE"})]
     (post-resource (:measurement-1 urls) "application/json" {:measurements
-                                                             (map (fn [x]
+                                                             (map (fn [x]
                                                                     (-> x
                                                                         (dissoc :reading_metadata :error)
                                                                         (update-in [:timestamp]
@@ -147,10 +149,9 @@

 (defn load-test-data [system]
   (let [store (:store system)]
-
+
     (post-contextual-data store)
     (post-readings)
     (post-generated-measurements)))

 ;; To load data (load-test-data system)
-


partition-by finded solution

partition-by finded solution

--- src/4clojure/pack-seq.clj
+++ src/4clojure/pack-seq.clj
@@ -7,9 +7,12 @@
 (defn pack [result x]
   (if (empty? result)
     (conj result [x])
-    (conj result [x])))
+    (if (list-contains? x (last result))
+      (assoc result (dec (count result)) (conj (last result) x)))))

-;; (reduce #(if (list-contains? 1 %
+;; (pack [1] 1)
+
+;; (reduce pack [] [1 1 2 1 1 1 3 3])
 ;; [[1] [1] [2] [1] [1] [1] [3] [3]]

 (set [[1] [1] [2] [1] [1] [1] [3] [3]])
@@ -34,7 +37,7 @@
 ;; so we must pack only neibours

 (defn __ [coll]
-  coll)
+  (partition-by identity coll))

 (= (__ [1 1 2 1 1 1 3 3]) '((1 1) (2) (1 1 1) (3 3)))

@@ -43,4 +46,18 @@
 (= (__ [[1 2] [1 2] [3 4]]) '(([1 2] [1 2]) ([3 4])))

-(list-contains? 10 '(100 101 102))+(list-contains? 10 '(100 101 102))
+
+(dec (count [0 1]))
+(assoc [0 1] 0 1)
+
+;; https://github.com/ptrv/4clojure-solutions/blob/master/solutions.clj
+(fn [coll] (partition-by identity coll))
+;; failed to do it by myself
+
+;; 4clojure solution
+#(partition-by identity %)
+
+;; could be shorter
+;; _pcl's solution:
+partition-by identity


Implement least squares through vectors

Implement least squares through vectors

--- src/clj/clojurewerkz/statistiker/functions.clj
+++ src/clj/clojurewerkz/statistiker/functions.clj
@@ -1,9 +1,11 @@
 (ns clojurewerkz.statistiker.functions
   (:require [clojurewerkz.statistiker.fast-math :as fm]
             [clojure.core.matrix                :as matrix]
-            [clojure.core.matrix.operators      :as ops])
+            [clojure.core.matrix.operators      :as ops]
+            [schema.core                        :as s])

-  (:import [org.apache.commons.math3.analysis MultivariateFunction MultivariateVectorFunction]
+  (:import [clojure.lang IFn]
+           [org.apache.commons.math3.analysis MultivariateFunction MultivariateVectorFunction]
            [org.apache.commons.math3.optim InitialGuess MaxEval SimpleBounds]
            [org.apache.commons.math3.optim.nonlinear.scalar ObjectiveFunction ObjectiveFunctionGradient GoalType]
            [org.apache.commons.math3.optim.nonlinear.scalar.noderiv BOBYQAOptimizer] ;; Use optim version, not that one
@@ -13,39 +15,50 @@
   "Simple linear funciton:

      f(y) = ax + b"
-  [intercept slope]
+  [^Number intercept ^Number slope]
   (fn [x]
     (+ intercept (* slope x))))

 (defn fn->multivariate-function
-  [f]
+  [^IFn f]
   (reify MultivariateFunction
     (value [_ v]
       (apply f (vec v)))))

 (defn fn->multivariate-vector-function
-  [f]
+  [^IFn f]
   (reify MultivariateVectorFunction
     (value [_ v]
       (double-array
        (apply f (vec v))))))

 (defn objective-function
-  [f]
+  [^IFn f]
   (ObjectiveFunction. (fn->multivariate-function f)))

 (defn objective-function-gradient
-  [f]
+  [^IFn f]
   (ObjectiveFunctionGradient. (fn->multivariate-vector-function f)))

 ;;
 ;; Functions
 ;;

-(defn linear-fn
+(s/defrecord GradientProblem
+    [^{:s ObjectiveFunction}         objective-fn
+     ^{:s ObjectiveFunctionGradient} objective-fn-gradient])
+
+(defn make-gradient-problem
+  [^IFn objective ^IFn gradient]
+  (s/validate GradientProblem
+              (GradientProblem. (objective-function objective)
+                                (objective-function-gradient))))
+
+
+(defn ^IFn linear-fn
   "Linear function for optimizing least squares for linear regression and so forth"
   [data]
-  (fn [intercept slope]
+  (fn [^Number intercept ^Number slope]
     (let [f   (line intercept slope)
           res (->> data
                    (map (fn [[x y]]
@@ -54,51 +67,74 @@
                    (reduce +))]
       res)))

-(defn linear-problem
+(defn ^GradientProblem linear-problem
   [factors target]
-  {:objective          (objective-function
-                        (fn [& point]
-                          (->> (matrix/e* factors point)
-                               (map (fn [target-i value]
-                                      (- value target-i))
-                                    target)
-                               (reduce +))))
+  (GradientProblem. (objective-function
+                     (fn [& point]
+                       (->> (matrix/e* factors point)
+                            (map (fn [target-i value]
+                                   (- value target-i))
+                                 target)
+                            (reduce +))))

-   :objective-gradient (objective-function-gradient
-                        (fn [& point]
-                          (let [r (ops/- (matrix/e* factors point)
-                                         target)]
-                            (matrix/e* (matrix/transpose target)
-                                       r
-                                       2))))})
+                    (objective-function-gradient
+                     (fn [& point]
+                       (let [r (ops/- (matrix/e* factors point)
+                                      target)]
+                         (matrix/e* (matrix/transpose target)
+                                    r
+                                    2))))))
+
+
+(defn two-var-least-squares-vector
+  [points]
+  (let [factors (->> points (map butlast) (map #(cons 1 %)))
+        target  (map last points)]
+    (GradientProblem. (objective-function
+                       (fn [intercept slope]
+                         (let [f   (line intercept slope)
+                               res (->> points
+                                        (map (fn [[x y]]
+                                               (fm/sqr (- y (f x)))))
+                                        (reduce +))]
+                           res)))
+
+                      (objective-function-gradient
+                       (fn [& point]
+                         (let [ft (matrix/transpose factors)
+                               m! (matrix/inverse (matrix/dot ft factors))
+                               b  (matrix/dot ft target)]
+
+                           (ops/- (matrix/mmul m! b)
+                                  point)))))))

 (defn two-var-least-squares
   [points]
-  {:objective          (objective-function
-                        (fn [intercept slope]
-                          (let [f   (line intercept slope)
-                                res (->> points
-                                         (map (fn [[x y]]
-                                                (fm/sqr (- y (f x)))))
-                                         (reduce +))]
-                            res)))
+  (GradientProblem. (objective-function
+                     (fn [intercept slope]
+                       (let [f   (line intercept slope)
+                             res (->> points
+                                      (map (fn [[x y]]
+                                             (fm/sqr (- y (f x)))))
+                                      (reduce +))]
+                         res)))

-   :objective-gradient (objective-function-gradient
-                        (fn [intercept slope]
-                          [ (* 2 (->> points
-                                      (map (fn [[x y]]
-                                             (*
-                                              (- y (+ intercept (* slope x)))
-                                              -1)))
-                                      (reduce +)))
+                    (objective-function-gradient
+                     (fn [intercept slope]
+                       [ (* 2 (->> points
+                                   (map (fn [[x y]]
+                                          (*
+                                           (- y (+ intercept (* slope x)))
+                                           -1)))
+                                   (reduce +)))

-                            (* 2 (->> points
-                                      (map (fn [[x y]]
-                                             (*
-                                              (- y (+ intercept (* slope x)))
-                                              -1
-                                              x)))
-                                      (reduce +)))
-                            ]
-                          ))})
+                         (* 2 (->> points
+                                   (map (fn [[x y]]
+                                          (*
+                                           (- y (+ intercept (* slope x)))
+                                           -1
+                                           x)))
+                                   (reduce +)))
+
+                         ]))))


fix bug: trans-view: wrong usage of moment.js in ch-sel

--- src/cljs/expense_tracker/transaction/view.cljs
+++ src/cljs/expense_tracker/transaction/view.cljs
@@ -51,14 +51,17 @@
                                  :from (m->long (.subtract now 90 "days"))})
       "cur-yr" (u/trans-view e {:href href :to today
                                 :from (m->long (.month (.date now 1) 0))})
-      "prev-mon" (let [prev (.subtract now 1 "months")]
+      ;; .subtract/.date mutates now/prev :((
+      "prev-mon" (let [prev-to (.subtract (u/now) 1 "months")
+                       prev-from (.subtract (u/now) 1 "months")]
                    (u/trans-view e {:href href
-                                    :to (m->long (.date prev 31))
-                                    :from (m->long (.date prev 1))}))
-      "prev-yr" (let [prev (.subtract now 1 "years")]
+                                    :to (m->long (.date prev-to (.daysInMonth prev-to)))
+                                    :from (m->long (.date prev-from 1))}))
+      "prev-yr" (let [prev-to (.subtract (u/now) 1 "years")
+                      prev-from (.subtract (u/now) 1 "years")]
                   (u/trans-view e {:href href
-                                   :to (m->long (.month (.date prev 31) 12))
-                                   :from (m->long (.month (.date prev 1) 0))}))
+                                   :to (m->long (.date (.month prev-to 11) 31))
+                                   :from (m->long (.date (.month prev-from 0) 1))}))
       "custom" (u/trans-view e {:href href}))))

 (defn trans-rm [e t]


Refactoring: job-url function etc.

Refactoring: job-url function etc.

--- src/cloverage_jenkins_reporter/jenkins_api.clj
+++ src/cloverage_jenkins_reporter/jenkins_api.clj
@@ -35,6 +35,12 @@
     [^String url]
     (clojure.string/replace url " " "%20"))

+(defn job-url
+    ( [jenkins-url jenkins-job-prefix-url job-name]
+      (str jenkins-url jenkins-job-prefix-url (encode-spaces job-name)))
+    ( [jenkins-url jenkins-job-prefix-url job-name postfix]
+      (str jenkins-url jenkins-job-prefix-url (encode-spaces job-name) postfix)))
+
 (defn list-of-all-jobs-url
     [jenkins-url jenkins-job-list-url]
     (str jenkins-url jenkins-job-list-url))
@@ -49,7 +55,7 @@
 (defn read-job-info-as-json
     "Fetch the timestamp and duration of the last build from Jenkins server."
     [jenkins-url jenkins-job-prefix-url job-name]
-    (let [full-json-url (str jenkins-url jenkins-job-prefix-url (encode-spaces job-name) "/lastBuild/api/json?pretty=true")
+    (let [full-json-url (job-url jenkins-url jenkins-job-prefix-url job-name "/lastBuild/api/json?pretty=true")
           inputstr (slurp full-json-url)]
         (if inputstr
             (let [parsed   (json/read-str inputstr)
@@ -62,7 +68,7 @@

 (defn read-build-number-for-job
     [jenkins-url jenkins-job-prefix-url job-name]
-    (let [full-json-url (str jenkins-url jenkins-job-prefix-url (encode-spaces job-name) "/api/json?pretty=true")
+    (let [full-json-url (job-url jenkins-url jenkins-job-prefix-url job-name "/api/json?pretty=true")
           inputstr (slurp full-json-url)]
         (if inputstr
             (-> (json/read-str inputstr)
@@ -72,11 +78,11 @@

 (defn url-to-file-from-last-build
     [jenkins-url jenkins-job-prefix-url job-name file-name]
-    (str jenkins-url jenkins-job-prefix-url (encode-spaces job-name) "/lastBuild/artifact/" file-name))
+    (str (job-url jenkins-url jenkins-job-prefix-url job-name "/lastBuild/artifact/") file-name))

 (defn url-to-job-configuration
     [jenkins-url jenkins-job-prefix-url job-name]
-    (str jenkins-url jenkins-job-prefix-url (encode-spaces job-name) "/config.xml"))
+    (str (job-url jenkins-url jenkins-job-prefix-url job-name "/config.xml")))

 (defn read-file-from-last-build
     [job-name file-name]


Fix imports

Fix imports

--- test/icecap/rest_test.clj
+++ test/icecap/rest_test.clj
@@ -4,7 +4,8 @@
             [icecap.crypto :as crypto]
             [icecap.rest :as rest]
             [icecap.store.mem :refer [mem-store]]
-            [ring.mock.request :as mock]))
+            [ring.mock.request :as mock]
+            [clojure.tools.reader.edn :as edn]))

 (def handler
   (let [[seed-key salt] (map crypto/nul-byte-array