Fix all tests.

Fix all tests.

--- test/cats/labs/channel_spec.cljc
+++ test/cats/labs/channel_spec.cljc
@@ -1,12 +1,15 @@
 (ns cats.labs.channel-spec
   #?(:cljs (:require-macros [cljs.core.async.macros :refer [go]]))
-  (:require #?@(:clj  [[clojure.core.async :as a :refer [go]]
-                       [clojure.test :as t]]
-                :cljs [
-                       [cljs.core.async :as a]
-                       [cljs.test :as t]])
-            [cats.core :as m]
-            [cats.labs.channel :as c]))
+  #?(:cljs (:require [cljs.core.async :as a]
+                     [cljs.test :as t]
+                     [cats.core :as m :include-macros true]
+                     [cats.labs.channel :as c]
+                     [cats.monad.either :as either])
+     :clj  (:require [clojure.core.async :as a :refer [go]]
+                     [clojure.test :as t]
+                     [cats.core :as m]
+                     [cats.labs.channel :as c]
+                     [cats.monad.either :as either])))

 (t/deftest channel-as-functor
   #?(:clj
@@ -29,9 +32,11 @@
      :cljs
      (t/async done
        (go
-         (let [ch (m/pure c/channel-monad 3)
-               rs (m/>>= ch (fn [x] (m/return (inc x))))]
-           (t/is (= 4 (a/<! rs)))
+         (let [ch (m/pure c/channel-monad 1)
+               result (m/>>= ch (fn [x] (m/return (inc x))))]
+           ;; (println 2222 @(a/<! result))
+
+           (t/is (= 2 (a/<! result)))
            (done))))))

@@ -98,7 +103,6 @@
            (t/is (= (a/<! ch1) (a/<! rs)))
            (done))))))

-
 (t/deftest third-monad-law-associativity
   #?(:clj
      (let [rs1 (m/>>= (m/mlet [x  (c/with-value 2)
@@ -125,59 +129,68 @@

 (defn async-call
   [wait]
-  (a/go
+  (go
     (a/<! (a/timeout wait))
     wait))

-#?(:clj
-   (t/deftest applicative-do
+(t/deftest applicative-do
+  #?(:clj
      (let [result (m/alet [x (async-call 100)
                            y (async-call 100)]
                     (+ x y))]
        (t/is (c/channel? result))
-       (t/is (a/<!! result) 200))))
+       (t/is (= (a/<!! result) 200)))
+     :cljs
+     (t/async done
+       (go
+         (let [result (m/alet [x (async-call 100)
+                               y (async-call 100)]
+                        (+ x y))]
+           (t/is (c/channel? result))
+           (t/is (= (a/<! result) 200))
+           (done))))))

-;; (def chaneither-m (either/either-transformer c/channel-monad))
+(def chaneither-m (either/either-transformer c/channel-monad))

-;; #?(:clj
-;;    (t/deftest channel-transformer-tests
-;;      (t/testing "channel combination with either"
-;;        (let [funcright (fn [x] (go (either/right x)))
-;;              funcleft (fn [x] (go (either/left x)))
-;;              r1 (m/with-monad chaneither-m
-;;                   (m/mlet [x (funcright 1)
-;;                            y (funcright 2)]
-;;                     (m/return (+ x y))))
+#?(:clj
+   (t/deftest channel-transformer-tests
+     (t/testing "channel combination with either"
+       (let [funcright (fn [x] (go (either/right x)))
+             funcleft (fn [x] (go (either/left x)))
+             r1 (m/with-monad chaneither-m
+                  (m/mlet [x (funcright 1)
+                           y (funcright 2)]
+                    (m/return (+ x y))))

-;;              r2 (m/with-monad chaneither-m
-;;                   (m/mlet [x (funcright 1)
-;;                            y (funcleft :foo)
-;;                            z (funcright 2)]
-;;                     (m/return (+ x y))))]
+             r2 (m/with-monad chaneither-m
+                  (m/mlet [x (funcright 1)
+                           y (funcleft :foo)
+                           z (funcright 2)]
+                    (m/return (+ x y))))]

-;;          (t/is (= (either/right 3) (a/<!! r1)))
-;;          (t/is (= (either/left :foo) (a/<!! r2))))))
+         (t/is (= (either/right 3) (a/<!! r1)))
+         (t/is (= (either/left :foo) (a/<!! r2))))))

-;;    :cljs
-;;    (t/deftest channel-transformer-tests
-;;      (t/async done
-;;               (let [funcright #(c/with-value (either/right %))
-;;                     funcleft #(c/with-value (either/left %))
-;;                     r1 (m/with-monad chaneither-m
-;;                          (m/mlet [x (funcright 1)
-;;                                   y (funcright 2)]
-;;                            (m/return (+ x y))))
+   :cljs
+   (t/deftest channel-transformer-tests
+     (t/async done
+              (let [funcright #(c/with-value (either/right %))
+                    funcleft #(c/with-value (either/left %))
+                    r1 (m/with-monad chaneither-m
+                         (m/mlet [x (funcright 1)
+                                  y (funcright 2)]
+                           (m/return (+ x y))))

-;;                     r2 (m/with-monad chaneither-m
-;;                          (m/mlet [x (funcright 1)
-;;                                   y (funcleft :foo)
-;;                                   z (funcright 2)]
-;;                            (m/return (+ x y))))]
-;;                 (go
-;;                   (t/is (= (either/right 3) (a/<! r1)))
-;;                   (t/is (= (either/left :foo) (a/<! r2)))
-;;                   (done))))))
+                    r2 (m/with-monad chaneither-m
+                         (m/mlet [x (funcright 1)
+                                  y (funcleft :foo)
+                                  z (funcright 2)]
+                           (m/return (+ x y))))]
+                (go
+                  (t/is (= (either/right 3) (a/<! r1)))
+                  (t/is (= (either/left :foo) (a/<! r2)))
+                  (done))))))

 ;; #?(:cljs (defn main [] (node/run-tests)))


Completion ch handling appears to require thread.

--- src/onyx/peer/task_lifecycle.clj
+++ src/onyx/peer/task_lifecycle.clj
@@ -277,7 +277,7 @@

 (defn launch-aux-threads!
   [messenger event outbox-ch seal-ch completion-ch task-kill-ch]
-  (go
+  (thread
    (loop []
      (when-let [[v ch] (alts!! [task-kill-ch
                                 completion-ch


Get server-test breaking same way post-merge (WIP)

i.e. it has the same problems as it did before I merged in my bottom-up
changes. But at least I fixed the new problems I introduced.

Client tests are probably a bigger deal, but (despite the branch name)
I'm not all that worried about them at the moment. They're pretty
horribly broken from any angle you care to look.

--- test/frereth_cp/test_factory.clj
+++ test/frereth_cp/test_factory.clj
@@ -78,7 +78,6 @@
    (let [server-extension (byte-array srvr-xtn-vec)
          server-name (shared/encode-server-name "hypothet.i.cal")
          long-pair (crypto/random-key-pair)
-         log-state (log/init message-loop-name)
          result (clnt/ctor {::msg-specs/->child (strm/stream)
                             ::client-state/chan->server (strm/stream)
                             ::log/logger logger
@@ -88,7 +87,7 @@
                                               ::K/server-name server-name}
                             ::client-state/server-extension server-extension
                             ::client-state/server-security {::K/server-name server-name
-                                                            ::shared-specs/public-long srvr-pk-long}
-                            ::log/state log-state})]
+                                                            ::shared-specs/public-long srvr-pk-long}}
+                           #(log/init message-loop-name))]
      (clnt/start! result)
      result)))


Oops - we can only cache stations every minute

--- src/org/gensym/viddy/storage.clj
+++ src/org/gensym/viddy/storage.clj
@@ -74,7 +74,7 @@

 (defn make-divvy-data [db-spec]
   (let [current-stations
-        (memo/ttl current-stations :ttl/threshold (* 60 60 1000))]
+        (memo/ttl current-stations :ttl/threshold (* 60 1000))]
     (reify data/DivvyData
       (clear-caches [this]
         (memo/memo-clear! current-stations))


Some refinements

Some refinements

--- src/degasolv/cli.clj
+++ src/degasolv/cli.clj
@@ -113,10 +113,12 @@
                            "Must be an executable file which exists on the file system."]
                 :required true]
                ["-u" "--subproc-out-format"
-               "Whether to read `edn` or `json` from the exe's output"
-               :validate [#(or (= "json" %)
-                               (= "edn" %))
-                       "Subproc output format may be either be 'edn' or 'json'"]]
+                "Whether to read `edn` or `json` from the exe's output"
+                :default nil
+                :default-desc "json"
+                :validate [#(or (= "json" %)
+                                (= "edn" %))
+                           "Subproc output format may be either be 'edn' or 'json'"]]
                ]
               }})

@@ -256,7 +258,7 @@
          options))
        genrepo
        (if (get-in package-systems [package-system :cli])
-         ((get-in package-systems [:constructor])
+         ((get-in package-systems [package-system :constructor])
           (:pkgsys-config all-options))
          (get-in package-systems [package-system :genrepo]))
        version-comparator
@@ -456,6 +458,7 @@
    :resolve-strat "thorough"
    :search-directory "."
    :search-strat "breadth-first"
+   :subproc-out-format "json"
    })

 (def available-option-packs
@@ -640,11 +643,13 @@
             :validate [#(or (= "priority" %) (= "global" %))
                        "Strategy must either be 'priority' or 'global'."]]
            ["-t" "--package-system SYS"
-            "May be 'degasolv' or 'apt'."
+            "May be 'degasolv', 'apt', or 'subproc'."
             :default nil
             :default-desc (str (:package-system subcommand-option-defaults))
-            :validate [#(or (= "degasolv" %) (= "apt" %))
-                       "Package system must be either 'degasolv' or 'apt'."]]
+            :validate [#(or (= "degasolv" %)
+                            (= "apt" %)
+                            (= "subproc" %))
+                       "Package system must be either 'degasolv', 'apt', or 'subproc'."]]
            ["-V" "--version-comparison CMP"
             "May be 'debian', 'maven', 'naive', 'python', 'rpm', 'rubygem', or 'semver'."
             :default nil


better

better

--- src/epicea/utils.clj
+++ src/epicea/utils.clj
@@ -5,8 +5,8 @@
     (every? (fn [v] (contains? ks v)) (keys x))))

 (defn compute-matrix-index [sizes indices]
-  (assert (count sizes)
-          (count indices))
+  (assert (= (count sizes)
+             (count indices)))
   (loop [S (vec sizes)
          I (vec indices)
          i 0]


Correct function call missing parameter

Correct function call missing parameter

--- src/exploud/deployments.clj
+++ src/exploud/deployments.clj
@@ -107,8 +107,8 @@
                                                                        :environment environment}))))

 (defn pause
-  [{:keys [application environment region]}]
-  (redis/pause application environment region))
+  [{:keys [application environment id region]}]
+  (redis/pause application environment id region))

 (defn resume
   [{:keys [application environment region]}]


Enable SPARQL Update

Enable SPARQL Update

--- src/rdf_path_examples/sparql.clj
+++ src/rdf_path_examples/sparql.clj
@@ -1,8 +1,9 @@
 (ns rdf-path-examples.sparql
   (:require [clojure.tools.logging :as log])
-  (:import [org.apache.jena.rdf.model Literal Resource]
+  (:import [org.apache.jena.rdf.model Literal Model Resource]
            [org.apache.jena.query QueryExecutionFactory QueryFactory]
-           [org.apache.jena.query Dataset]))
+           [org.apache.jena.query Dataset]
+           [org.apache.jena.update UpdateAction UpdateFactory]))

 ; ----- Protocols -----

@@ -32,21 +33,21 @@
 ; ----- Public functions -----

 (defn ^Boolean ask-query
-  "Execute SPARQL ASK `query` on RDF `dataset`."
-  [^Dataset dataset
+  "Execute SPARQL ASK `query` on RDF `model`."
+  [^Model model
    ^String query]
-  (with-open [qexec (QueryExecutionFactory/create query dataset)]
+  (with-open [qexec (QueryExecutionFactory/create query model)]
     (.execAsk qexec)))

 (defmulti construct-query
   "Execute SPARQL CONSTRUCT `query` on `datasource`."
   (fn [datasource query] (type datasource)))

-(defmethod ^Model construct-query Dataset
-  ; Execute SPARQL CONSTRUCT `query` on local RDF `dataset`.
-  [^Dataset dataset
+(defmethod ^Model construct-query Model
+  ; Execute SPARQL CONSTRUCT `query` on local RDF `model`.
+  [^Model model
    ^String query]
-  (with-open [qexec (QueryExecutionFactory/create query dataset)]
+  (with-open [qexec (QueryExecutionFactory/create query model)]
     (.execConstruct qexec)))

 (defmethod ^Model construct-query String
@@ -60,12 +61,19 @@
   "Execute SPARQL SELECT `query` on `datasource`."
   (fn [datasource query] (type datasource)))

-(defmethod select-query Dataset
-  ; Execute SPARQL SELECT `query` on local RDF `dataset`.
-  [^Dataset dataset
+(defmethod select-query Model
+  ; Execute SPARQL SELECT `query` on local RDF `model`.
+  [^Model model
    ^String query]
-  (with-open [qexec (QueryExecutionFactory/create query dataset)]
+  (with-open [qexec (QueryExecutionFactory/create query model)]
     (let [results (.execSelect qexec)
           result-vars (.getResultVars results)]
       (mapv (partial process-select-solution result-vars)
             (iterator-seq results)))))
+
+(defn ^Model update-operation
+  "Execute SPARQL Update `operation` on `model`."
+  [^Model model
+   ^String operation]
+  (UpdateAction/execute (UpdateFactory/create operation) model)
+  model)


allow scaling of individual axes

allow scaling of individual axes

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

--- plugins/SlideExplorer2/src/slide_explorer/canvas.clj
+++ plugins/SlideExplorer2/src/slide_explorer/canvas.clj
@@ -73,7 +73,8 @@

 (def degrees-to-radians (/ Math/PI 180))

-(defn set-g2d-state [g2d {:keys [alpha color stroke rotate x y scale]}]
+(defn set-g2d-state [g2d {:keys [alpha color stroke rotate x y
+                                 scale scale-x scale-y]}]
   (doto g2d
     (.setColor (color-object (or color :black)))
     (.setComposite (if (or (not alpha)
@@ -91,11 +92,11 @@
                     (BasicStroke. width cap-code join-code miter-limit
                                   dashes-array dash-phase)
                     (BasicStroke. width cap-code join-code miter-limit)))))
-    (when (and x y (or rotate scale))
+    (when (and x y (or rotate scale scale-x scale-y))
       (doto g2d
         (.translate x y)
         (.rotate (* degrees-to-radians (or rotate 0.0)))
-        (.scale (or scale 1.0) (or scale 1.0))
+        (.scale (or scale-x scale 1.0) (or scale-y scale 1.0))
         (.translate (- x) (- y)))))

 (defn- with-g2d-state-fn [g2d params body-fn]


Made mark-as-completed function

Made mark-as-completed function

--- src/kmg/domain.clj
+++ src/kmg/domain.clj
@@ -39,13 +39,13 @@
          [?id :recommendation/id ?rid]
          [?fid :feedback/user ?uid]
          [?fid :feedback/recommendation ?id]
-         [?fid :feedback.comment/text ?comment]
          [?fid :feedback/complete true]]
        db [:user/name user])
        (sort-by-second)
        (every-first)
        ))

+;; (recommendations-comleted-by-user (db) "user2")
 (defn recommendations-for-user [db user]
   (->> (d/q '[:find ?id ?priority
          :in $ ?uid
@@ -87,9 +87,40 @@

 (defn recommendations [user]
   (let [db (db)
-        recommend-ids (take 5 (recommendation-ids db user))]
+        recommend-ids (take 6 (recommendation-ids db user))]
     (map (fn [rid] {:user user :recommendation (entity db rid) :media (entity db (media-id-by-recommendation-id db rid))}) recommend-ids)))

 ;;(recommendations "user1")
 ;;(recommendations "user2")
+
+(defn- get-feedback
+  [user recommendation]
+  (->> (d/q '[:find ?fid
+              :in $ ?user ?recommend
+              :where
+              [?uid :user/name ?user]
+              [?rid :recommendation/id ?recommend]
+              [?fid :feedback/user ?uid]
+              [?fid :feedback/recommendation ?rid]]
+            (db) user recommendation)
+       ffirst
+       (entity (db))))
+
+;; (get-feedback "user2" "spec1_book6")
+
+(defn create-feedback
+  [user recommendation]
+  [{:feedback/user [:user/name user]
+   :feedback/recommendation [:recommendation/id recommendation]
+   :feedback/complete true
+   :db/id (d/tempid :db.part/user)}])
+
+;; (create-feedback "user1" "spec1_book2")
+
+(defn mark-as-completed [user recommendation]
+  (let [db (db)
+        feedback (create-feedback user recommendation)]
+    @(d/transact (conn) feedback)))
+
+;; (mark-as-completed "user2" "spec1_book5")


lib.ktoa - Add Demensions module Use defonce for all js/require as otherwise hot reload gives an error

--- src/ktoa/core.cljs
+++ src/ktoa/core.cljs
@@ -1,10 +1,10 @@
 (ns ktoa.core)

-(def react-native
+(defonce react-native
   (when (exists? js/require)
     (js/require "react-native")))

-(def react
+(defonce react
   (when (exists? js/require)
     (js/require "react")))

@@ -12,7 +12,8 @@
   (when react-native
     {:create-element (.-createElement react)
      :platform (.-Platform react-native)
-     :registry (.-AppRegistry react-native)}))
+     :registry (.-AppRegistry react-native)
+     :dimensions (.-Dimensions react-native)}))

 (def os
   "Returns nil for non react-native environments or :ios or :android


Provide a default :draw fn which does nothing - but allows the looping constructs to work (required for handling keypress events)

--- src/rosado/processing/applet.clj
+++ src/rosado/processing/applet.clj
@@ -19,6 +19,7 @@
   [app-name & opts]
   (let [options (assoc (apply hash-map opts) :name (str app-name))
         fns (dissoc options :name :title :size)
+        fns (merge {:draw (fn [] nil)} fns)
         methods (into {} (map fix-mname fns))]
     `(def ~app-name
        (let [frame# (atom nil)


Adds example to docstring

Adds example to docstring

--- umm-spec-lib/src/cmr/umm_spec/test/expected_conversion.clj
+++ umm-spec-lib/src/cmr/umm_spec/test/expected_conversion.clj
@@ -369,7 +369,9 @@
 ;; ISO 19115-2

 (defn propagate-first
-  "Returns coll with the first element's value under k assoc'ed to each element in coll."
+  "Returns coll with the first element's value under k assoc'ed to each element in coll.
+
+  Example: (propagate-first :x [{:x 1} {:y 2}]) => [{:x 1} {:x 1 :y 2}]"
   [k coll]
   (let [v (get (first coll) k)]
     (for [x coll]


Use map instead of entity during reconciliation (#423)

--- scheduler/src/cook/mesos/scheduler.clj
+++ scheduler/src/cook/mesos/scheduler.clj
@@ -997,7 +997,7 @@
       (doseq [[task-id] running-tasks
               :let [task-ent (d/entity db [:instance/task-id task-id])
                     hostname (:instance/hostname task-ent)
-                    job (:job/_instance task-ent)
+                    job (util/entity->map (:job/_instance task-ent))
                     task-request (make-task-request job :task-id task-id)]]
         ;; Need to lock on fenzo when accessing taskAssigner because taskAssigner and
         ;; scheduleOnce can not be called at the same time.


indent + examples

indent + examples

--- src/sandbox/nullobjects/null.clj
+++ src/sandbox/nullobjects/null.clj
@@ -1,4 +1,9 @@
 (ns sandbox.nullobjects.null)

-(defn build-person [first-name last-name] (if (and first-name last-name)
-                                            {:first-name first-name :last-name last-name} {:first-name "John" :last-name "Doe"}))
+(defn build-person [first-name last-name]
+  (if (and first-name last-name)
+    {:first-name first-name :last-name last-name}
+    {:first-name "John" :last-name "Doe"}))
+
+(def p1 (build-person "Fname" "Sname"))
+(def nullperson (build-person "Fname" nil))


fix missing transform-header kw-arg in process fn

--- src/semantic_csv/transducers.clj
+++ src/semantic_csv/transducers.clj
@@ -232,7 +232,7 @@
     `colname, value`, and the result used as the parse value.
   * `:cast-only` - Only cast the specified column(s); can be either a single column name, or a vector of them."
   ([] (process {}))
-  ([{:keys [mappify keyify header remove-comments comment-re comment-char structs cast-fns cast-exception-handler cast-only]
+  ([{:keys [mappify keyify header transform-header remove-comments comment-re comment-char structs cast-fns cast-exception-handler cast-only]
      :or   {mappify         true
             keyify          true
             remove-comments true


Add shapes-by-id common lense to workspace.base ns.


Using interpose for better comma rendering.

--- src/cbfg/core.cljs
+++ src/cbfg/core.cljs
@@ -150,15 +150,19 @@
     "nil"))

 (defn vis-html-loop-state
-  ([vis loop-state] (mapv (fn [nv] [(vis-html-loop-state vis
-                                                         (first nv) (second nv)) ", "])
-                          loop-state))
-  ([vis name val] (let [name-parts (string/split (str name) #"-")]
-                    (cond (= "ch" (last name-parts)) [name " " (vis-html-ch vis val)]
-                          (= "chs" (last name-parts)) [name " ["
-                                                       (map #(vis-html-ch vis %) val)
-                                                       "]"]
-                          :default [name " " (if val val "nil")]))))
+  ([vis loop-state]
+     (interpose ", "
+                (mapv (fn [nv] [(vis-html-loop-state vis
+                                                     (first nv) (second nv))])
+                      loop-state)))
+  ([vis name val]
+     (let [name-parts (string/split (str name) #"-")]
+       (cond (= "ch" (last name-parts)) [name " " (vis-html-ch vis val)]
+             (= "chs" (last name-parts)) [name " ["
+                                          (interpose ", "
+                                                     (map #(vis-html-ch vis %) val))
+                                          "]"]
+             :default [name " " (if val val "nil")]))))

 ;; ------------------------------------------------


working freq only - ready to add regex

working freq only - ready to add regex

--- src/hangman/core.clj
+++ src/hangman/core.clj
@@ -282,7 +282,6 @@
   (let [keep-chars      (for [clue-char clue :when (not(nil? clue-char))] clue-char)
         fail-chars      (set/difference guessed-chars keep-chars)
         keep-flag       (map #(guess-matches? % clue ) word-array )
-
         fail-flag       (map #(guess-matches? % clue ) word-array )
     keep-words      (filter-with keep-flag word-array) ] )
 )


formatting

formatting

--- serpent-talk/src/serpent_talk/core.clj
+++ serpent-talk/src/serpent_talk/core.clj
@@ -1,18 +1,11 @@
 (ns serpent-talk.core
   (:require [camel-snake-kebab.core :refer :all :as csk]))
-
-(defn foo
-  "I don't do a whole lot."
-  [x]
-  (println x "Hello, World!"))

 (defn serpent-talk [s]
   (str "Serpent! You said: " (csk/->snake_case s)))

-
 (defn -main [& args]
   (println (serpent-talk (first args))))
-

 ; v -> [a,b,c,d] representing two points (a, b) and (c, d)
 (defn slope [v]


Add convenience dsl functions for build select-from, select-one and select-distinct.

--- src/cljooq/dsl.clj
+++ src/cljooq/dsl.clj
@@ -67,6 +67,32 @@
        (into-array org.jooq.Field)
        (DSL/select)))

+(defn select-distinct
+  "Start select statement."
+  [& fields]
+  (->> (map field fields)
+       (into-array org.jooq.Field)
+       (DSL/selectDistinct)))
+
+(defn select-from
+  "Helper for create select * from <table>
+  statement directly (without specify fields)"
+  [table']
+  (-> (table table')
+      (DSL/selectFrom)))
+
+(defn select-count
+  []
+  (DSL/selectCount))
+
+(defn select-one
+  []
+  (DSL/selectOne))
+
+(defn select-zero
+  []
+  (DSL/selectZero))
+
 (defn from
   "Creates from clause."
   [q & tables]


start watch process after server init

start watch process after server init

--- src/mirror/cli.clj
+++ src/mirror/cli.clj
@@ -26,15 +26,18 @@
         static-path (or (some-> (second args) str) "static")]
     (check-if-flags-valid flags)
     (check-if-files-exists pages-path static-path)
-    (when watch?
-      (println "watching for changes in" pages-path)
-      (core/watch-reload pages-path static-path))
     (let [port (or (System/getenv "PORT") 3000)]
       (println "starting server on port" port)
       (http/start-server
         (make-handler pages-path static-path)
-        {:port port}))))
+        {:port port}))
+    ;; this blocks
+    (when watch?
+      (println "watching for changes in" pages-path)
+      (core/watch-reload pages-path static-path))))

 (defn -main [& args]
   (cli-start args))

+
+


Fix merge issue in last commit.

Fix merge issue in last commit.

--- src/onyx/types.clj
+++ src/onyx/types.clj
@@ -1,16 +1,6 @@
 (ns onyx.types)

-<<<<<<< HEAD
-(defrecord Message [id payload])
-
 (defrecord Leaf [message id acker-id completion-id ack-val hash-group route])
-=======
-(defrecord Leaf [message id acker-id completion-id ack-val ack-vals route routes hash-group])
-
-(defn leaf
-  ([message]
-     (->Leaf message nil nil nil nil nil nil nil nil)))
->>>>>>> ba78b0e... Read vpeer-id separately to rest of buffer so that

 (defrecord Route [flow exclusions post-transformation action])


don't include duplicate project.clj and LICENSE files in uberjar

--- src/cake/tasks/jar.clj
+++ src/cake/tasks/jar.clj
@@ -121,7 +121,7 @@

 (defn add-jar-contents [task jars]
   (doseq [jar jars :let [name (.replace (.getName jar) ".jar" "")]]
-    (add-zipfileset task {:src jar :excludes "META-INF/**/*"})
+    (add-zipfileset task {:src jar :excludes "META-INF/**/*, project.clj, LICENSE"})
     (add-zipfileset task {:src jar :includes "META-INF/**/*" :prefix (str "META-INF/" name)})))

 (defn build-uberjar [jarfile jars]


Simplified initial-lane-state.

Simplified initial-lane-state.

--- src/cbfg/world/t2.cljs
+++ src/cbfg/world/t2.cljs
@@ -8,16 +8,11 @@
             [cbfg.world.net]))

 (def initial-server-state
-  {:default-realm "_lobby"
-   :realms {"_system" {:default-user nil
-                       :users {"admin" {:pswd "password"}}}
-            "_lobby" {:default-user "_anon"
-                      :users {"_anon" {:pswd ""}}}}})
+  {:realms {"_system" {:users {"admin" {:pswd "password"}}}
+            "_lobby" {:users {"_anon" {:pswd ""}}}}})

 (def initial-lane-state
-  (let [realm (:default-realm initial-server-state)]
-    {:realm realm
-     :user (get-in initial-server-state [:realms realm :default-user])}))
+  {:realm "_lobby" :user "_anon"})

 (defn rq-authenticate [actx m]
   (act rq-authenticate actx


No need to coerce to string for comparison

--- src/cheshire/parse.clj
+++ src/cheshire/parse.clj
@@ -55,15 +55,17 @@
             (Object.))]
     (if (= x eof)
       eof
-      (case (.toString (.getCurrentToken jp))
-            "START_OBJECT" (parse-object jp fst? keywords? eof array-coerce-fn)
-            "START_ARRAY" (parse-array jp fst? keywords? eof array-coerce-fn)
-            "VALUE_STRING" (.getText jp)
-            "VALUE_NUMBER_INT" (.getNumberValue jp)
-            "VALUE_NUMBER_FLOAT" (.getDoubleValue jp)
-            "VALUE_TRUE" true
-            "VALUE_FALSE" false
-            "VALUE_NULL" nil
-            (throw
-             (Exception.
-              (str "Cannot parse " (pr-str (.getCurrentToken jp)))))))))
+      (condp = (.getCurrentToken jp)
+        JsonToken/START_OBJECT (parse-object jp fst? keywords?
+                                             eof array-coerce-fn)
+        JsonToken/START_ARRAY (parse-array jp fst? keywords?
+                                           eof array-coerce-fn)
+        JsonToken/VALUE_STRING (.getText jp)
+        JsonToken/VALUE_NUMBER_INT (.getNumberValue jp)
+        JsonToken/VALUE_NUMBER_FLOAT (.getDoubleValue jp)
+        JsonToken/VALUE_TRUE true
+        JsonToken/VALUE_FALSE false
+        JsonToken/VALUE_NULL nil
+        (throw
+         (Exception.
+          (str "Cannot parse " (pr-str (.getCurrentToken jp)))))))))


RAIN documentation is finished!

RAIN documentation is finished!

--- src/clj/forma/rain.clj
+++ src/clj/forma/rain.clj
@@ -2,7 +2,7 @@
 ;; NOAA PRECL data at 0.5 degree resolution, and processing them into
 ;; tuples suitable for machine learning against MODIS data.
 ;;
-;; As with modis.clj, the overall goal here is to process an NOAA
+;; As in `forma.hdf`, the overall goal here is to process an NOAA
 ;; PREC/L dataset into tuples of the form
 ;;
 ;;     [?dataset ?res ?tileid ?tperiod ?chunkid ?chunk-pix]
@@ -152,26 +152,38 @@
   (let [bytes (get-bytes stream)]
     (rain-tuples ll-res (input-stream bytes))))

-;; TODO -- update this. We need m-res because we need to act properly
-;; on the datetime->period function, which currently depends on
-;; resolution. We should probably change this to work on the time
-;; period, like sixteens, days, etc.
-
 ;; Each PRECL filename contains the year from which the data is
-;; sourced.
+;; sourced. We currently decide time period based on spatial
+;; resolution -- this will cause problems later, when we start
+;; interacting with datasets at the same spatial resolution and
+;; different temporal resolution. A rework of `datetime->period` will
+;; fix this.

 (defmapop [extract-period [m-res]]
-  ^{:doc "Extracts the year from a NOAA PREC/L filename, assuming that
-  the year is the only group of 4 digits. pairs it with the supplied
-  month, and converts both into a time period, with units in months
-  from the reference start date as defined in conversion.clj."}
+  ^{:doc "Extracts the year from a NOAA PREC/L filename (assuming that
+  the year is the only group of 4 digits), pairs it with the supplied
+  month, and returns an integerized time period based on the supplied
+  spatial resolution value."}
   [filename month]
   (let [year (Integer/parseInt (first (re-find #"(\d{4})" filename)))]
     [m-res (datetime->period m-res year month)]))

+;; The following functions bring everything together, making heavy use
+;; of the functionality supplied by `forma.reproject`. Rather than
+;; sampling PRECL data at the positions of every possible MODIS tile,
+;; we allow the user to supply a seq of TileIDs for processing. (No
+;; MODIS product covers every possible tile. The terra products only
+;; cover land, for example.)
+;;
+;; These functions are designed to be able to map between WGS84 and
+;; MODIS datasets at arbitrary resolution. This explains the
+;; resolution parameters seen in the functions below.
+
 (defn index-seqs
-  "Takes a tile sequence and a couple of resolution parameters --
-  returns translation indices for chunks within a tile, given the chunk size."
+  "Cascalog subquery to generate translation indices for chunks within
+  each tile referenced in the supplied sequence of MODIS
+  TileIDs. Requires MODIS and WGS84 spatial resolutions, and a chunk
+  size."
   [m-res ll-res c-size tile-seq]
   (let [source (memory-source-tap tile-seq)]
     (<- [?mod-h ?mod-v ?chunkid ?idx-seq]
@@ -179,24 +191,33 @@
         (chunk-samples [m-res ll-res c-size]
                        ?mod-h ?mod-v :> ?chunkid ?idx-seq))))

-;; TODO -- explain in docstring why ll-res, etc is important!
 (defn rain-months
-  "Returns all months from a directory of PREC/L datasets at the
-  supplied resolution, paired with their time periods."
+  "Cascalog subquery to extract all months from a directory of PREC/L
+  datasets at the supplied WGS84 spatial resolution, paired with time
+  periods appropriate for the supplied MODIS spatial
+  resolution. Source can be any tap that supplies files like
+  precl_mon_v1.0.lnx.2010.gri0.5m(.gz, optionally)."
   [m-res ll-res source]
   (<- [?dataset ?m-res ?period ?raindata]
-        (source ?filename ?file)
-        (unpack-rain [ll-res] ?file :> ?dataset ?month ?raindata)
-        (extract-period [m-res] ?filename ?month :> ?m-res ?period)))
-
-;; TODO -- update documentation
-(defmapop fancyindex [f coll]
-  [(apply vector (map (vec f) coll))])
-
-;; TODO -- update documentation
+      (source ?filename ?file)
+      (unpack-rain [ll-res] ?file :> ?dataset ?month ?raindata)
+      (extract-period [m-res] ?filename ?month :> ?m-res ?period)))
+
+(defmapop fancyindex [coll indices]
+  ^{:doc "Samples the supplied collection, returning the values at the
+  supplied indices within coll. Analogous to NumPy's [fancy
+  indexing](http://goo.gl/rZ4ri)."}
+  [(apply vector (map (vec coll) indices))])
+
+;; And, finally, the chunker. This subquery is analogous to the
+;; chunker found in `forma.hdf`. This is the only function that needs
+;; to be called, when processing new PRECL data.
+
 (defn rain-chunks
-  "Generates rain chunks for the given tiles, at the supplied
-  resolutions on each end of the chain."
+  "Cascalog subquery to fully process a WGS84 float array at the
+  supplied resolution (`ll-res`) into tuples suitable for comparison
+  to any MODIS dataset at the supplied modis resolution (`m-res`),
+  partitioned by the supplied chunk size."
   [m-res ll-res c-size tile-seq source]
   (let [indices (index-seqs m-res ll-res c-size tile-seq)
         precl (rain-months m-res ll-res source)]


Shorten command-line help to 80 columns

Shorten command-line help to 80 columns

--- src/clj/reply/main.clj
+++ src/clj/reply/main.clj
@@ -85,12 +85,14 @@
   "Launches a REPL. Customizations available:
   -h/--help:           Show this help screen
   -i/--init:           Provide a Clojure file to evaluate in the user ns
-  -e/--eval:           Provide a custom form on the command line to evaluate in the user ns
+  -e/--eval:           Provide a custom form on the command line to evaluate in
+                         the user ns
   --prompt:            Provide a custom prompt function
   --skip-default-init: Skip the default initialization code
   --standalone:        Launch standalone mode instead of the default nREPL
-  --attach:            Attach to an existing nREPL session on this port or host:port, when used with nREPL
-  --port:              Start a new nREPL session on this port, when used with nREPL
+  --attach:            Attach to an existing nREPL session on this port or
+                         host:port, when used with nREPL
+  --port:              Start new nREPL server on this port
   --color:             Use color; currently only available with nREPL
   --timeout:           Specify the network timeout in ms, when used with nREPL"


Changed random-plush-genome-with-size to return genome as vector.

--- src/clojush/random.clj
+++ src/clojush/random.clj
@@ -70,10 +70,10 @@
 (defn random-plush-genome-with-size
   "Returns a random Plush genome containing the given number of points."
   [genome-size atom-generators argmap]
-  (repeatedly genome-size
-              #(random-plush-instruction-map
-                 atom-generators
-                 argmap)))
+  (vec (repeatedly genome-size
+                   #(random-plush-instruction-map
+                      atom-generators
+                      argmap))))

 (defn random-plush-genome
   "Returns a random Plush genome with size limited by max-genome-size."


Changed defservice prefix behaviour according to discussion on Compojure group

--- src/compojure/http.clj
+++ src/compojure/http.clj
@@ -346,9 +346,16 @@
          (update-servlet ~name ~doc ~@handlers))))

 (defmacro defservice
-  "Defines a 'MyClass-service' method suitable for being called by a
-  HttpServlet class created by genclass."
-  [cname & handlers]
-  `(defn ~(symbol (str cname "-service"))
-   ~'[this request response]
-     (http-service ~'this ~'request ~'response (list ~@handlers))))
+  "Defines a service method with an optional prefix suitable for being used by
+  genclass to compile a HttpServlet class.
+  e.g. (defservice
+         (GET \"/\" \"Hello World\"))
+       (defservice \"myprefix-\"
+         (GET \"/\" \"Hello World\"))"
+  [prefix & handlers]
+  (let [[prefix handlers] (if (string? prefix)
+                           [prefix handlers]
+                           ["-"   (cons prefix handlers)])]
+    `(defn ~(symbol (str prefix "service"))
+     ~'[this request response]
+       (http-service ~'this ~'request ~'response (list ~@handlers)))))


Fix character moving and add checks for invalid and sobokan moves


Guard against concurrently executing jobs

--- slackbot/src/org/teamweek/slackbot.clj
+++ slackbot/src/org/teamweek/slackbot.clj
@@ -186,38 +186,40 @@

 (defjob QuestionnaireJob [job-data]
   (try
-    (let [{:strs [domain db-conn]} (conversion/from-job-data job-data)
-        _ (log/info "Scheduled job started for" domain)
-        db (d/db db-conn)
-        token (:team/token (d/entity db [:team/domain domain]))
-        users (d/q '[:find [?name ...]
-                     :in $ ?domain
-                     :where
-                     [?team :team/domain ?domain]
-                     [?team :team/members ?member]
-                     [?member :member/name ?name]]
-                   db domain)
-        questions (d/q '[:find [(pull ?question [:db/id :question/text :question/order]) ...]
-                         :in $ ?domain
-                         :where
-                         [?team :team/domain ?domain]
-                         [?team :team/questions ?question]]
-                       db domain)
-        conn (when (and token
-                        (not-empty users)
-                        (not-empty questions))
-               (connect token))]
-    (if conn
-      (do
-        (log/infof "Sending quesitonnaire for %s (%s users and %s questions)" domain users questions)
-        (dorun
-         (pmap (fn [user]
-                 (let [answers (send-questionnaire conn token user (sort-by :question/order questions))]
-                   (submit-answers db-conn domain user answers)))
-               users))
-        ((:shutdown-fn conn)))
-      (do (log/infof "Skipping questionnaire for %s (%s users, %s questions and the token is %s"
-                     domain (count users) (count questions) token))))
+    (let [{:strs [domain db-conn scheduler]} (conversion/from-job-data job-data)
+          _ (when (scheduler/currently-executing-job? scheduler (jobs/key (str "jobs." domain)))
+              (throw (ex-info "Job is still running" {:domain domain})))
+          _ (log/info "Scheduled job started for" domain)
+          db (d/db db-conn)
+          token (:team/token (d/entity db [:team/domain domain]))
+          users (d/q '[:find [?name ...]
+                       :in $ ?domain
+                       :where
+                       [?team :team/domain ?domain]
+                       [?team :team/members ?member]
+                       [?member :member/name ?name]]
+                     db domain)
+          questions (d/q '[:find [(pull ?question [:db/id :question/text :question/order]) ...]
+                           :in $ ?domain
+                           :where
+                           [?team :team/domain ?domain]
+                           [?team :team/questions ?question]]
+                         db domain)
+          conn (when (and token
+                          (not-empty users)
+                          (not-empty questions))
+                 (connect token))]
+      (if conn
+        (do
+          (log/infof "Sending quesitonnaire for %s (%s users and %s questions)" domain users questions)
+          (dorun
+           (pmap (fn [user]
+                   (let [answers (send-questionnaire conn token user (sort-by :question/order questions))]
+                     (submit-answers db-conn domain user answers)))
+                 users))
+          ((:shutdown-fn conn)))
+        (do (log/infof "Skipping questionnaire for %s (%s users, %s questions and the token is %s"
+                       domain (count users) (count questions) token))))
     (catch Exception e
       (log/errorf e "Questionnaire job failed")
       (throw e))))
@@ -226,7 +228,8 @@
   (let [job (jobs/build
              (jobs/of-type QuestionnaireJob)
              (jobs/using-job-data {:domain domain
-                                   :db-conn db-conn})
+                                   :db-conn db-conn
+                                   :scheduler scheduler})
              (jobs/with-identity (jobs/key (str "jobs." domain))))
         trigger (triggers/build
                  (triggers/with-identity (triggers/key (str "triggers." domain)))


removed query button

removed query button

--- src/tango/cljs/client.cljs
+++ src/tango/cljs/client.cljs
@@ -618,9 +618,10 @@
                                                           this
                                                           `[(app/select-page {:page :competitions})])}
                                           (dom/a #js {:href "#"} "Tävlingar"))
-                                         (dom/li
-                                          #js {:onClick (fn [e] (test-query-click this))}
-                                          (dom/a #js {:href "#"} "Query")))
+                                         ;; (dom/li
+                                         ;;  #js {:onClick (fn [e] (test-query-click this))}
+                                         ;;  (dom/a #js {:href "#"} "Query"))
+                                         )
                                  (dom/form #js {:className "navbar-form navbar-right"}
                                            (dom/input #js {:type "text"
                                                            :className "form-control"


Fixed det function's internals.

Fixed det function's internals.

--- src/clojure/uncomplicate/neanderthal/real.clj
+++ src/clojure/uncomplicate/neanderthal/real.clj
@@ -103,7 +103,7 @@
 (def ^:private f* (double-fn *))

 (defn det ^double [^RealMatrix lu ^Vector ipiv]
-  (with-release [res (double (fold f* 1.0 (.dia lu)))]
+  (let [res (double (fold f* 1.0 (.dia lu)))]
     (if (even? (.dim ipiv))
       res
       (- res))))


First end-to-end run with dest=ora-test-1

--- src/pg_demo/core.clj
+++ src/pg_demo/core.clj
@@ -129,20 +129,20 @@
     (jdbc/with-db-connection [pg-conn dest-spec]
       (doseq [ [table-name creation-sql-str] tables/table-name->creation-sql ]
         (print ".")
-        (println " " table-name)
+;       (println " " table-name)
         (flush)

         ; Stupid Oracle does not allow "drop table if exists <tablename>".  We need to use
         ; try/catch to find the exception and ignore the harmless ones
         (let [drop-cmd (format "drop table %s" table-name)]
           (try
-            (println "running:" drop-cmd)
+;           (println "running:" drop-cmd)
             (jdbc/execute! pg-conn [drop-cmd] )
             (catch Exception ex
               (let [ex-str (.toString ex) ]
                 (when-not (re-find #"table or view does not exist" ex-str)
                   (throw (Exception. (str "Command failed: " drop-cmd "  Exception: " ex))))))))
-        (println "running:" creation-sql-str)
+;       (println "running:" creation-sql-str)
         (jdbc/execute! pg-conn [creation-sql-str] ))
       (newline)
     )))
@@ -211,10 +211,10 @@
 (defn -main []
   (oracle-init-src)
   (oracle-init-dest)
-
-  (println "-----------------------------------------------------------------------------")
   (drop-create-tables)
-; (count-tables)
-; (transfer-data)
+  (count-tables)
+
+  (println "-----------------------------------------------------------------------------")
+  (transfer-data)
 )


add duration? utility fn

add duration? utility fn

--- src/preflex/util.clj
+++ src/preflex/util.clj
@@ -108,6 +108,13 @@

 ;; ----- Duration handling -----
+
+
+(defn duration?
+  "Return true if argument is a valid duration, false otherwise."
+  [x]
+  (and (satisfies? t/IDuration x)
+    (t/duration? x)))

 (defn resolve-time-unit


Convert keywords to strings before splitting.

--- samples/twitterbuzz/src/twitterbuzz/dom-helpers.cljs
+++ samples/twitterbuzz/src/twitterbuzz/dom-helpers.cljs
@@ -31,7 +31,7 @@
     (doto e (dom/setTextContent s))))

 (defn normalize-args [tag args]
-  (let [parts (string/split tag #"(\.|#)")
+  (let [parts (string/split (name tag) #"(\.|#)")
         [tag attrs] [(first parts)
                      (apply hash-map (map #(cond (= % ".") :class
                                                  (= % "#") :id


Stop trying to be too clever in render

Stop trying to be too clever in render

There's no reliable way of making React forget a mounted tree
completely, and the old solution sometimes makes things worse.

--- src/reagent/dom.cljs
+++ src/reagent/dom.cljs
@@ -17,28 +17,14 @@
   (swap! roots dissoc container)
   (.' react-dom unmountComponentAtNode container))

-(defn- clear-container [node]
-  ;; If render throws, React may get confused, and throw on
-  ;; unmount as well, so try to force React to start over.
-  (try (unmount-comp node)
-       (catch :default e))
-  (some-> node
-          (.! :innerHTML "")))
-
 (defn- render-comp [comp container callback]
-  (let [rendered (volatile! nil)]
-    (try
-      (binding [util/*always-update* true]
-        (->> (.' react-dom render (comp) container
-                 (fn []
-                   (binding [util/*always-update* false]
-                     (swap! roots assoc container [comp container])
-                     (if (some? callback)
-                       (callback)))))
-             (vreset! rendered)))
-      (finally
-        (when-not @rendered
-          (clear-container container))))))
+  (binding [util/*always-update* true]
+    (->> (.' react-dom render (comp) container
+             (fn []
+               (binding [util/*always-update* false]
+                 (swap! roots assoc container [comp container])
+                 (if (some? callback)
+                   (callback))))))))

 (defn- re-render-component [comp container]
   (render-comp comp container nil))


removing session id

removing session id

--- src/mount/core.clj
+++ src/mount/core.clj
@@ -1,7 +1,6 @@
 (ns mount.core
   (:require [clojure.tools.macro :as macro]))

-;; (defonce ^:private session-id (System/currentTimeMillis))
 (defonce ^:private mount-state 42)
 (defonce ^:private -args (atom :no-args))                  ;; mostly for command line args and external files
 (defonce ^:private state-seq (atom 0))


[fix] parse-int. One more fix.

[fix] parse-int. One more fix.

--- src/ombs/funcs.clj
+++ src/ombs/funcs.clj
@@ -15,7 +15,9 @@
 (defn parse-int [s]
   (if (nil? s)
     0
-    (when-let [r (re-find  #"\d+" s )] (Integer. r))))
+    (if-let [r (re-find  #"\d+" s)]
+      (Integer. r)
+      0)))

 (defn nil-fix
  "Replace nil value to 0"


[fix] debug func.

[fix] debug func.

--- src/ombs/funcs.clj
+++ src/ombs/funcs.clj
@@ -30,5 +30,5 @@
 (defn part-price [event-price parts] (/ event-price parts))

 (defn with-log [f]
-  (print f)
+  (println (f))
   (f))


Update routes

Update routes

--- src/ombs/route.clj
+++ src/ombs/route.clj
@@ -41,16 +41,10 @@

   (GET  "/user" [_] (pages/user))

-  (POST "/act" {params :params}
-        (case (:action params)
-          "pay" (pay params)
-          "participate" (participate params)
-          "start" (start params)))
-
-  (GET "/start" {params :params} (start (:fid params)))
-  (GET "/participate" {params :params} (participate (:fid params)))
-  (GET "/pay" {params :params} (pay (:fid params)))
-  (GET "/affirm" {params :params} (affirm (:fid params)))
+  (GET "/start" {params :params} (start params))
+  (GET "/participate" {params :params} (participate params))
+  (GET "/pay" {params :params} (pay params))
+  (GET "/affirm" {{fid :fid} :params} (affirm fid))

   (resources "/") ;Should be after pages. Search all css, js, etc. in dir 'resources' in root of project


Added medioid function

Added medioid function

--- src/pscan/core.clj
+++ src/pscan/core.clj
@@ -8,17 +8,25 @@

 (declare region-query-s)
 (declare region-query-p)
-
-;; TODO; find optimal subdivision for r/fold; memoize
-
-;region-query-m memoized
-
-;region-query-mp memoized, parallel
-
-;; alias the appropriate region-query variant
-(def region-query region-query-p)
-
-(def memoized nil)
+(declare memoized-metric)
+
+;; TODO: find optimal subdivision for r/fold
+
+(def memoized-dbscan
+  "If true, calls to the metric passed to dbscan will be memoized"
+  true)
+
+(def memoized-mediods
+  "If true, calls to the metric passed to mediod-protein will be memoized"
+  true)
+
+(def region-query
+  "Select region-query-s (serial) or region-query-p (parallel)"
+  region-query-p)
+
+(def partition-size
+  "Approximate subdivision size for clojure.core.reducers/fold"
+  16)

 ;;;

@@ -32,8 +40,8 @@
   "Parallel region query; returns all pts at least eps similar to pt."
   [pt pts metric eps]
   (letfn [(is-local? [x] (>= (metric pt x) eps))]
-    (r/fold 5 (r/monoid into vector) conj (r/filter is-local? pts))))
-
+    (r/fold partition-size
+            (r/monoid into vector) conj (r/filter is-local? pts))))

 (defn expand-cluster
@@ -69,24 +77,27 @@
 (defn dbscan
   "Run dbscan"
   [pts metric eps min-pts]
-
-  (loop [points pts
-         visited #{}
-         clusters #{}]
-    (let [pt (first points)]
-      (cond
-        (empty? points)
-          clusters
-        (visited pt)
-          (recur (rest points)
-                 (conj visited pt)
-                 clusters)
-        :else
-          (let [{new-cluster :core, new-visited :visited}
-                (expand-cluster pt pts metric eps min-pts visited)]
+  (let [mem-metric (if memoized-dbscan
+                     (memoize-metric metric)
+                      metric)]
+
+    (loop [points pts
+           visited #{}
+           clusters #{}]
+      (let [pt (first points)]
+        (cond
+          (empty? points)
+            clusters
+          (visited pt)
             (recur (rest points)
-                   new-visited
-                   (conj clusters new-cluster)))))))
+                   (conj visited pt)
+                   clusters)
+          :else
+            (let [{new-cluster :core, new-visited :visited}
+                  (expand-cluster pt pts mem-metric eps min-pts visited)]
+              (recur (rest points)
+                     new-visited
+                     (conj clusters new-cluster))))))))

 (defn parse-float
   "Parse string s as float"
@@ -130,6 +141,20 @@
           (swap! mem assoc (hash-set a b) ret)
           ret)))))

+(defn medioid
+  "Return element of cluster that maximizes sum of similarity scores"
+  [cluster metric]
+  (let [mem-metric (if memoized-mediods
+                     (memoize-metric metric)
+                      metric)]
+    (second
+      (reduce (fn [x y]
+                (if (> (first x) (first y))
+                  x
+                  y))
+        (for [protein cluster]
+          [(reduce + (map #(mem-metric protein %) cluster)), protein])))))
+
 ;;;

 (def files
@@ -143,12 +168,26 @@

 (def sample-proteins
   (reduce into
-          (map read-fasta (take 3 prefixed-files))))
+          (map read-fasta (take 4 prefixed-files))))

 (time (def trial (dbscan sample-proteins protein-metric 100 4)))

 (comment
+
+(def memoized-dbscan
+  "If true, calls to the metric passed to dbscan will be memoized"
+  true)
+
+(def partition-size
+  "Approximate subdivision size for clojure.core.reducers/fold"
+  8)
+
+(def region-query
+  "Select region-query-s (serial) or region-query-p (parallel)"
+  region-query-p)
+
+

 (read-fasta "resources/simple.fasta")


non-recursive diff-revpairs

non-recursive diff-revpairs

--- src/revdiff/core.clj
+++ src/revdiff/core.clj
@@ -1,5 +1,3 @@
-;; TODO make diff-revpairs non-recursive?
-
 (ns revdiff.core
   (:gen-class)
   (:import [java.io.StringBufferInputStream])
@@ -45,18 +43,17 @@
     (if show (show-cmd cmd-components))
     (apply sh cmd-components)))

-;; Given a list of revision pairs, diff those for which the given filter term
-;; (if any) is present on a changed line in that pair. If no filter term is
-;; given, diff all changed files from all revision pairs.
+;; Show diffs for files that changed (modulo the optional filtering regexp)
+;; between each revision pair in the given list.

 (defn diff-revpairs [object filt revpairs show insens]
-  (when (seq revpairs)
-    (let [r1 (first revpairs)
-          r2 (first (rest revpairs))
+  (loop [x revpairs]
+    (let [r1 (first x)
+          r2 (second x)
           mf (matching-files r1 r2 object filt show insens)]
       (println (str "Checking: r" r1 " vs r" r2))
       (doseq [filename mf] (svndiff r1 r2 filename object show))
-      (diff-revpairs object filt (rest (rest revpairs)) show insens))))
+      (recur (drop 2 x)))))

 ;; Try to explain why this has failed.


Wrap om/allow-reads around every react lifecycle method.

--- src/quiescent.cljs
+++ src/quiescent.cljs
@@ -1,5 +1,6 @@
 (ns quiescent
-  [:require-macros [quiescent :as q]])
+  (:require-macros [quiescent :as q]
+                   [om.core :as om]))

 (def ^:dynamic *component*
   "Within a component render function, will be bound to the raw
@@ -22,46 +23,49 @@
          react-map
          (cond-> #js {:shouldComponentUpdate
                        (fn [next-props next-state]
-                         (this-as this
-                                  (or
-                                    (not= (aget (.-props this) "value")
-                                          (aget next-props "value"))
-                                    (let [this-state (or (.-state this) (js-obj))
-                                          next-state (or next-state (js-obj))]
-                                      (not= (aget this-state "value")
-                                            (aget next-state "value"))))))
+                         (om/allow-reads
+                           (this-as this
+                                    (or
+                                      (not= (aget (.-props this) "value")
+                                            (aget next-props "value"))
+                                      (let [this-state (or (.-state this) (js-obj))
+                                            next-state (or next-state (js-obj))]
+                                        (not= (aget this-state "value")
+                                              (aget next-state "value")))))))
                       :render
                        (fn []
-                         (this-as this
-                                  (binding [*component* this]
-                                    (apply renderer
-                                           (aget (.-props this) "value")
-                                           (aget (.-props this) "statics")))))}
+                         (om/allow-reads
+                           (this-as this
+                                    (binding [*component* this]
+                                      (apply renderer
+                                             (aget (.-props this) "value")
+                                             (aget (.-props this) "statics"))))))}
                  (or (:displayName m) (not-empty (.-name renderer)))
                  (q/set-prop! -displayName (or (:displayName m)
                                                (not-empty (.-name renderer))))
                  (:getInitialState m)
                  (q/set-prop! -getInitialState
                               (fn []
-                                (this-as this
-                                         (binding [*component* this]
-                                           #js {:value (get-initial-state)}))))
+                                (om/allow-reads
+                                  (this-as this
+                                           (binding [*component* this]
+                                             #js {:value (get-initial-state)})))))
                  (:getDefaultProps m)
-                 (q/set-prop! -getDefaultProps (:getDefaultProps m))
+                 (q/set-prop! -getDefaultProps (fn [] (.apply (:getDefaultProps m) (js-this) (js-arguments))))
                  (:componentWillMount m)
-                 (q/set-prop! -componentWillMount (:componentWillMount m))
+                 (q/set-prop! -componentWillMount (fn [] (.apply (:componentWillMount m) (js-this) (js-arguments))))
                  (:componentDidMount m)
-                 (q/set-prop! -componentDidMount (:componentDidMount m))
+                 (q/set-prop! -componentDidMount (fn [] (.apply (:componentDidMount m) (js-this) (js-arguments))))
                  (:componentWillReceiveProps m)
-                 (q/set-prop! -componentWillReceiveProps (:componentWillReceiveProps m))
+                 (q/set-prop! -componentWillReceiveProps (fn [] (.apply (:componentWillReceiveProps m) (js-this) (js-arguments))))
                  (:shouldComponentUpdate m)
-                 (q/set-prop! -shouldComponentUpdate (:shouldComponentUpdate m))
+                 (q/set-prop! -shouldComponentUpdate (fn [] (.apply (:shouldComponentUpdate m) (js-this) (js-arguments))))
                  (:componentWillUpdate m)
-                 (q/set-prop! -componentWillUpdate (:componentWillUpdate m))
+                 (q/set-prop! -componentWillUpdate (fn [] (.apply (:componentWillUpdate m) (js-this) (js-arguments))))
                  (:componentDidUpdate m)
-                 (q/set-prop! -componentDidUpdate (:componentDidUpdate m))
+                 (q/set-prop! -componentDidUpdate (fn [] (.apply (:componentDidUpdate m) (js-this) (js-arguments))))
                  (:componentWillUnmount m)
-                 (q/set-prop! -componentWillUnmount (:componentWillUnmount m)))
+                 (q/set-prop! -componentWillUnmount (fn [] (.apply (:componentWillUnmount m) (js-this) (js-arguments)))))
         react-component (.createClass js/React react-map)
         q-wrapper (fn [value & static-args]
                     (let [props #js {:value value :statics static-args}]


no longer have to wait a frame here

no longer have to wait a frame here

--- src/splash/core.cljs
+++ src/splash/core.cljs
@@ -144,8 +144,6 @@
       (.addChild (-> canvas :layer :ui) scroll-text)
       (sprite/set-pos! scroll-text 10000 10000)

-      ;; we have to wait a frame or the font is wrong? huh?
-      (<! (events/next-frame))
       (let [w (.-width scroll-text)
             hw (/ w 2 5)
             buff 300


Prevent multiple calls to install-devtools

--- src/devtools/core.cljs
+++ src/devtools/core.cljs
@@ -9,6 +9,7 @@
 (def formatter-key "devtoolsFormatter")

 (def ^:dynamic *devtools-enabled* true)
+(def ^:dynamic *devtools-installed* false)
 (def ^:dynamic *original-formatter* nil)

 (declare inlined-value-template)
@@ -200,13 +201,18 @@
       "body" (wrapper "body" body-hook))))

 (defn install-devtools! []
-  (set! *original-formatter* (aget js/window formatter-key))
-  (aset js/window formatter-key (cljs-formatter *original-formatter*)))
+  (if *devtools-installed*
+    (debug/log-info "devtools already installed - nothing to do")
+    (do
+      (set! *devtools-installed* true)
+      (set! *original-formatter* (aget js/window formatter-key))
+      (aset js/window formatter-key (cljs-formatter *original-formatter*)))))

 ; NOT SAFE
 (defn uninstall-devtools! []
   (aset js/window formatter-key *original-formatter*)
-  (set! *original-formatter* nil))
+  (set! *original-formatter* nil)
+  (set! *devtools-installed* false))

 (defn disable-devtools! []
   (set! *devtools-enabled* false))


Minor issue

Minor issue

--- test/civs/acceptance_test.clj
+++ test/civs/acceptance_test.clj
@@ -123,9 +123,8 @@
       (println "scenario-w77-100tribes-30turns sedentary" nsocieties-sedentary)
       (println "scenario-w77-100tribes-30turns bands" nsocieties-bands)
       (println "scenario-w77-100tribes-30turns tribes" nsocieties-tribes)
-      (println "scenario-w77-100tribes-30turns chiefdoms" nsocieties-chiefdoms)))
-    (is (and (>= nsocieties-still-nomadic 10) (<= nsocieties-still-nomadic 60)))
-    ))
+      (println "scenario-w77-100tribes-30turns chiefdoms" nsocieties-chiefdoms))
+    (is (and (>= nsocieties-still-nomadic 10) (<= nsocieties-still-nomadic 60)))))

 (deftest ^:acceptance test-some-societies-become-semi-sedentary
   (let [ g game-scenario-w77-100tribes-30turns


Remove unused defn

Remove unused defn

--- test/expound/test_runner.cljs
+++ test/expound/test_runner.cljs
@@ -13,7 +13,7 @@

 ;; runs all tests in all namespaces
 ;; This is what runs by default
-(defn ^:export run-all [karma]
+#_(defn ^:export run-all [karma]
   (jx.reporter.karma/run-all-tests karma))

 ;; runs all tests in all namespaces - only namespaces with names matching


added test replace-price-in-dom-should-leave-text-not-containing-prices-untouched

--- test-cljs/complico/test/dom.cljs
+++ test-cljs/complico/test/dom.cljs
@@ -26,24 +26,6 @@
 (defn confirm-text-remains [actual-text expected-text]
   (is (= actual-text expected-text)))

-
-(deftest setting-text-on-elem-changes-text
-    (-> (node
-          [:div#parent "original text"
-            [:div#child "original text"]])
-      (complico/replace-text-on-node! "modified text")
-      (complico/get-text-from-node)
-      (confirm-text-was-set-to "modified text")))
-
-(deftest setting-text-on-elem-does-not-alter-child-elem-text
-    (-> (node
-          [:div#parent "original text"
-            [:div#child "original text"]])
-      (complico/replace-text-on-node! "modified text")
-      (.-lastChild)
-      (complico/get-text-from-node)
-      (confirm-text-remains "original text")))
-
 (deftest convert-price-case-1
   (is (= (complico/convert-price-in-text "£3") "£XXX")))

@@ -53,11 +35,11 @@
 (deftest convert-price-should-not-change-text-without-price
   (is (= (complico/convert-price-in-text "text without price") "text without price")))

-(deftest replace-price-in-dom
+(deftest replace-price-in-dom-should-correctly-replace-price
   (let [root-elem (node
           [:body
             [:div
-              [:div#price "£300"]]])]
+              [:div "£300"]]])]
     (complico/replace-prices-in-dom! root-elem)
     (-> root-elem
         (.-lastChild)
@@ -65,3 +47,14 @@
         (complico/get-text-from-node)
         (confirm-text-was-set-to "£XXX"))))

+(deftest replace-price-in-dom-should-leave-text-not-containing-prices-untouched
+  (let [root-elem (node
+          [:body
+            [:div "£300"
+              [:div "donttouchme"]]])]
+    (complico/replace-prices-in-dom! root-elem)
+    (-> root-elem
+        (.-lastChild)
+        (.-lastChild)
+        (complico/get-text-from-node)
+        (confirm-text-remains "donttouchme"))))


Cleanup test code formatting a bit

Cleanup test code formatting a bit

--- test/cljs/zetawar/game_test.cljs
+++ test/cljs/zetawar/game_test.cljs
@@ -4,8 +4,8 @@
    [datascript.core :as d]
    [devcards.core :as dc :refer-macros [defcard deftest]]
    [zetawar.app :as app]
+   [zetawar.data :as data]
    [zetawar.db :as db :refer [e qe]]
-   [zetawar.data :as data]
    [zetawar.game :as game]
    [zetawar.test-helper :as helper]
    [zetawar.util :refer [breakpoint inspect]]))
@@ -159,8 +159,6 @@
     (d/transact conn (game/teleport-tx @conn game 2 1 7 6))
     (is (game/on-capturable-base? @conn game (game/unit-at @conn game 7 6)))))

-;; TODO: test unit-ex (?)
-
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; Movement

@@ -203,7 +201,9 @@
   (let [db @(helper/create-scenario-conn :sterlings-aruba-multiplayer)
         game (app/current-game db)
         unit (game/unit-at db game 2 2)]
+
     ;; TODO: update for state machine changes
+
     #_(testing "units that have not yet performed any actions can move"
         (is (= nil (game/check-can-move db game unit)))
         (is (= true (game/can-move? db game unit))))
@@ -231,7 +231,9 @@
         (let [db' (d/db-with db [[:db/add (e unit) :unit/repaired true]])
               unit' (game/unit-at db' game 2 2)]
           (is (thrown? ExceptionInfo (game/check-can-move db' game unit')))
-          (is (= false (game/can-move? db' game unit')))))))
+          (is (= false (game/can-move? db' game unit')))))
+
+    ))

 (deftest test-teleport-tx
   (let [db @(helper/create-scenario-conn :sterlings-aruba-multiplayer)
@@ -276,7 +278,9 @@
   (let [db @(helper/create-scenario-conn :sterlings-aruba-multiplayer)
         game (app/current-game db)
         unit (game/unit-at db game 2 2)]
+
     ;; TODO: update for state machine changes
+
     #_(testing "units that have not yet performed any actions can attack"
         (is (= nil (game/check-can-attack db game unit)))
         (is (= true (game/can-attack? db game unit))))
@@ -304,7 +308,9 @@
         (let [db' (d/db-with db [[:db/add (e unit) :unit/repaired true]])
               unit' (game/unit-at db' game 2 2)]
           (is (thrown? ExceptionInfo (game/check-can-attack db' game unit')))
-          (is (= false (game/can-attack? db' game unit')))))))
+          (is (= false (game/can-attack? db' game unit')))))
+
+    ))

 (deftest test-in-range-fns
   (let [db @(helper/create-scenario-conn :sterlings-aruba-multiplayer)
@@ -346,7 +352,9 @@
     (testing "undamaged units cannot be repaired"
       (is (thrown? ExceptionInfo (game/check-can-repair db game unit)))
       (is (= false (game/can-repair? db game unit))))
+
     ;; TODO: update for state machine changes
+
     #_(testing "damaged units that have not performed any actions can be repaired"
         (let [db' (d/db-with db [[:db/add (e unit) :unit/count 9]])
               unit' (game/unit-at db' game 2 2)]
@@ -376,7 +384,9 @@
         (let [db' (d/db-with db [[:db/add (e unit) :unit/repaired true]])
               unit' (game/unit-at db' game 2 2)]
           (is (thrown? ExceptionInfo (game/check-can-repair db' game unit')))
-          (is (= false (game/can-repair? db' game unit')))))))
+          (is (= false (game/can-repair? db' game unit')))))
+
+    ))

 (deftest test-repair-tx
   (let [conn (helper/create-scenario-conn :sterlings-aruba-multiplayer)
@@ -409,7 +419,9 @@
             terrain' (game/terrain-at db game 1 2)]
         (is (thrown? ExceptionInfo (game/check-capturable db' game unit' terrain')))
         (is (= false (game/can-capture? db' game unit' terrain')))))
+
     ;; TODO: update for state machine changes
+
     #_(testing "unit on unowned base can capture"
         (let [db' (d/db-with db (game/teleport-tx db game 2 2 2 1))
               unit' (game/unit-at db' game 2 1)
@@ -436,6 +448,7 @@
               terrain' (game/terrain-at db' game 2 1)]
           (is (thrown? ExceptionInfo (game/check-capturable db' game unit' terrain')))
           (is (= false (game/can-capture? db' game unit' terrain')))))
+
     (testing "already capturing units cannot capture"
       (let [db' (d/db-with db (concat (game/teleport-tx db game 2 2 2 1)
                                       [[:db/add (e unit) :unit/capturing true]]))


Add function arithmetic tests

Add function arithmetic tests

--- test/jest/arithmetic_test.clj
+++ test/jest/arithmetic_test.clj
@@ -12,7 +12,6 @@
   (test-code
    "val x = 1 + 2 + 3;"
    ["(def x (+ (+ 1 2) 3))"]))
-

 (deftest product-test-1
   (test-code
@@ -34,8 +33,23 @@
    "val x = 1 / 2 / 3;"
    ["(def x (/ (/ 1 2) 3))"]))

-
 (deftest multiply-divide-test
   (test-code
    "val x = 1 * 2 / 3;"
    ["(def x (/ (* 1 2) 3))"]))
+
+(deftest add-multiply-test
+  (test-code
+   "val x = 1 + 2 / 3;"
+   ["(def x (+ 1 (/ 2 3)))"]))
+
+
+(deftest func-test-1
+  (test-code
+   "val x = f(a, b, c) + 5;"
+   ["(def x (+ (f a b c) 5))"]))
+
+(deftest func-test-2
+  (test-code
+   "val x = f(a+b, b, c) + 5;"
+   ["(def x (+ (f (+ a b) b c) 5))"]))


Squash - rule tuning

Squash - rule tuning

--- resources/rules/_1_post_identifier_merge/step_h_ice_to_bio/step_hd_bioentity_linking/instance_based_kr/bioplex/step_a/bioplex_interactions_instance_based.clj
+++ resources/rules/_1_post_identifier_merge/step_h_ice_to_bio/step_hd_bioentity_linking/instance_based_kr/bioplex/step_a/bioplex_interactions_instance_based.clj
@@ -26,7 +26,7 @@
     PREFIX obo: <http://purl.obolibrary.org/obo/>
     PREFIX rdf: <http://www.w3.org/1999/02/22-rdf-syntax-ns#>
     PREFIX rdfs: <http://www.w3.org/2000/01/rdf-schema#>
-    select ?record ?bioentity1 ?bioentity2 ?physical_association {
+    select ?record ?bioentity1 ?bioentity2 ?physical_association ?has_participant {

      {
       select ?physical_association {


Refactor signalling code

Refactor signalling code

The signallers (used by sync-graph! to emit events to streams about
animation, etc.) are now placed in the state rather than being passed
around as arguments. This is justifiable because we can interpret the
state as containing exactly what is needed to render the graph.

--- src/graphito/core.cljs
+++ src/graphito/core.cljs
@@ -159,8 +159,15 @@

 ;; D3 magic

-(defn sync-graph! [state & {:keys [animation-signaller]}]
-  (let [{:keys [svg nodes links camera-pos view-size]} state
+(defn sync-graph! [state & {:keys [animate?]}]
+  (let [{:keys [svg
+                nodes
+                links
+                camera-pos
+                view-size
+                animation-signaller
+                node-tap-signaller
+                link-tap-signaller]} state
         {:keys [project-displacement
                 project-radius
                 project-opacity]} (projectors-for-state state)
@@ -170,7 +177,7 @@
                          .transition
                          (.duration 500)
                          (.each "end" #(animation-signaller false))))
-        maybe-transition (if animation-signaller transition identity)
+        maybe-transition (if animate? transition identity)
         positions (mapv (fn [node]
                           (view-position state
                                          (:pos node)
@@ -204,23 +211,26 @@

 ;; State management

-(defn initial-state [svg width height]
+(defn initial-state [svg width height
+                     animation-signaller node-tap-signaller link-tap-signaller]
   {:svg svg
    :view-size (math-vec width height)
    :camera-pos (math-vec 0 0)
    :nodes []
    :edges []
-   :projection :fisheye}) ; Can be :fisheye or :zoom-out
+   :projection :fisheye ; Can be :fisheye or :zoom-out
+   ; Signallers are part of state because they are needed to render the graph.
+   :animation-signaller animation-signaller
+   :node-tap-signaller node-tap-signaller
+   :linke-tap-signaller link-tap-signaller})

 (defn swap-state! [current-state f & args]
   (apply swap! current-state f args)
   (sync-graph! @current-state))

-(defn swap-state-animated! [animation-signaller current-state f & args]
-  ; There's no way to arrange the arguments that isn't awkward. Luckily all the
-  ; uses will probably be right here.
+(defn swap-state-animated! [current-state f & args]
   (apply swap! current-state f args)
-  (sync-graph! @current-state :animation-signaller animation-signaller))
+  (sync-graph! @current-state :animate? true))

 (defn update-state! [current-state k f & args]
   (apply swap! current-state update k f args)
@@ -230,19 +240,17 @@
   (update-state! current-state :camera-pos add-vec
                  (scalar-multiply d (/ (scroll-scale-for-state @current-state)))))

-(defn set-projection! [current-state projection animation-signaller]
-  (swap-state-animated! animation-signaller
-                        current-state assoc :projection projection))
-
-(defn toggle-projection! [current-state animation-signaller]
+(defn set-projection! [current-state projection]
+  (swap-state-animated! current-state assoc :projection projection))
+
+(defn toggle-projection! [current-state]
   (let [projection (if (= (:projection @current-state) :fisheye)
                      :zoom-out
                      :fisheye)]
-    (set-projection! current-state projection animation-signaller)))
-
-(defn zoom-in-to-pos! [current-state pos animation-signaller]
-  (swap-state-animated! animation-signaller
-                        current-state assoc
+    (set-projection! current-state projection)))
+
+(defn zoom-in-to-pos! [current-state pos]
+  (swap-state-animated! current-state assoc
                         :projection :fisheye
                         :camera-pos pos))

@@ -373,11 +381,11 @@
             (move-camera! current-state (math-vec dx dy)))))))

 (defn switch-zoom-on-spacebar!
-  [current-state animation-observable animation-signaller]
+  [current-state animation-observable]
   (-> key-up-observable
       (.filter #(= 32 (.-keyCode %)))
       (suppress-while-animating animation-observable)
-      (.subscribe #(toggle-projection! current-state animation-signaller))))
+      (.subscribe #(toggle-projection! current-state))))

 ;; Gestures

@@ -466,8 +474,7 @@

 (defn zoom-on-pinch! [manager
                       current-state
-                      animation-observable
-                      animation-signaller]
+                      animation-observable]
   (let [pinches (pinch-observable manager (:svg @current-state))
         pinch-ins (-> pinches (.filter #(< (:scale %) 0.8))
                       (suppress-while-animating animation-observable))
@@ -476,13 +483,12 @@
     (.subscribe
       pinch-ins
       #(if (= (:projection @current-state) :fisheye)
-         (set-projection! current-state :zoom-out animation-signaller)))
+         (set-projection! current-state :zoom-out)))
     (.subscribe
       pinch-outs
       #(if (= (:projection @current-state) :zoom-out)
          (zoom-in-to-pos! current-state
-                          (zoom-out->world-pos @current-state (:center %))
-                          animation-signaller)))))
+                          (zoom-out->world-pos @current-state (:center %)))))))

 ;; Gestures - tap

@@ -494,15 +500,29 @@

 (defn zoom-in-on-tap! [manager
                        current-state
-                       animation-observable
-                       animation-signaller]
+                       animation-observable]
   (let [taps (tap-observable manager (:svg @current-state))]
     (.subscribe
       taps
       #(if (= (:projection @current-state) :zoom-out)
          (zoom-in-to-pos! current-state
-                          (zoom-out->world-pos @current-state %)
-                          animation-signaller)))))
+                          (zoom-out->world-pos @current-state %))))))
+
+;; Gestures - tap on node
+
+(defn observable-and-signaller
+  []
+  (let [observers (atom [])
+        observable (.create rx-observable #(swap! observers conj %))
+        signaller (fn [node] (doseq [o @observers] (.onNext o node)))]
+    [observable signaller]))
+
+(defn focus-node-on-tap! [current-state
+                          node-tap-observable
+                          animation-observable]
+  (-> node-tap-observable
+      (suppress-while-animating animation-observable)
+      (.subscribe #(js/alert "FOO"))))

 ;; Exported function to do magic

@@ -511,10 +531,19 @@
         width (.-clientWidth element)
         height (.-clientHeight element)
         svg (setup-svg! selector width height)
-        current-state (atom (initial-state svg width height))
         gesture-manager (hammer-manager svg)
         [animation-observable
-         animation-signaller] (animation-observable-and-signaller)]
+         animation-signaller] (animation-observable-and-signaller)
+        [node-tap-observable
+         node-tap-signaller] (observable-and-signaller)
+        [link-tap-observable
+         link-tap-signaller] (observable-and-signaller)
+        current-state (atom (initial-state svg
+                                           width
+                                           height
+                                           animation-signaller
+                                           node-tap-signaller
+                                           link-tap-signaller))]
     (sync-graph! @current-state)
     (load-graph "miserables.json"
                 (fn [graph]
@@ -523,9 +552,7 @@
     (move-camera-on-arrow-keys! current-state animation-observable)
     (move-camera-on-pan! gesture-manager current-state animation-observable)
     (move-camera-on-swipe! gesture-manager current-state animation-observable)
-    (switch-zoom-on-spacebar!
-      current-state animation-observable animation-signaller)
-    (zoom-on-pinch!
-      gesture-manager current-state animation-observable animation-signaller)
-    (zoom-in-on-tap!
-      gesture-manager current-state animation-observable animation-signaller)))
+    (switch-zoom-on-spacebar! current-state animation-observable)
+    (zoom-on-pinch! gesture-manager current-state animation-observable)
+    (zoom-in-on-tap! gesture-manager current-state animation-observable)
+    (focus-node-on-tap! current-state node-tap-observable animation-observable)))


Actually fix weather unit tests

Actually fix weather unit tests

--- test/env_logger/weather_test.clj
+++ test/env_logger/weather_test.clj
@@ -8,6 +8,7 @@
             [next.jdbc :as jdbc]
             [env-logger
              [config :refer [get-conf-value]]
+             [db :refer [get-tz-offset]]
              [weather :refer [-convert-to-iso8601-str
                               -convert-to-tz-iso8601-str
                               calculate-start-time
@@ -33,7 +34,9 @@
     (is (= "2022-06-06T15:33:50Z"
            (-convert-to-iso8601-str
             (ZonedDateTime/of 2022 6 6
-                              18 33 50 0
+                              (+ 15 (get-tz-offset
+                                     (get-conf-value :weather-timezone)))
+                              33 50 0
                               (t/zone-id
                                (get-conf-value :weather-timezone))))))))

@@ -42,7 +45,9 @@
     (is (= "2022-06-06T15:33:50Z"
            (-convert-to-tz-iso8601-str
             (ZonedDateTime/of 2022 6 6
-                              18 33 50 0
+                              (+ 15 (get-tz-offset
+                                     (get-conf-value :weather-timezone)))
+                              33 50 0
                               (t/zone-id
                                (get-conf-value
                                 :weather-timezone))))))))


Add alias generation.

Add alias generation.

--- test/smallex/test/generators.clj
+++ test/smallex/test/generators.clj
@@ -1,4 +1,5 @@
 (ns smallex.test.generators
+  (:refer-clojure :exclude [alias])
   (:require [simple-check.generators :as gen]
             [clojure.test :refer :all]
             [clojure.pprint :as pprint :refer [pprint]]))
@@ -25,24 +26,28 @@
 (defn use-alias [aliases]
   (gen/elements aliases))

-(def collection-generators [string char-set])
+(def collection-generators
+  (map #(gen/resize 20 %) [string char-set]))

 (declare operation)

 (defn- operation-generator
   [{:keys [op max-args type-fn such-that]
     :or {max-args 4 such-that (constantly true)}}]
-  (gen/sized
-   (fn [size]
-     (let [smaller-ops (gen/resize (dec size) operation)
-           arg-gen (cond-> (map #(gen/resize 20 %) collection-generators)
-                           (pos? size) (conj smaller-ops))]
-       (->> (gen/vector (gen/one-of arg-gen) 1 max-args)
-            (gen/fmap
-             (fn [args]
-               (with-meta {:type :op, :value op, :args args}
-                 {:result (type-fn (map #(-> % meta :result) args))})))
-            (gen/such-that such-that))))))
+  (fn [alias-gen]
+    (gen/sized
+     (fn [size]
+       (let [smaller-ops (gen/resize (dec size) (operation alias-gen))
+             arg-gen (cond-> (conj collection-generators alias-gen)
+                             (pos? size)
+                             ;; v- hack to get more nested ops
+                             (conj smaller-ops smaller-ops smaller-ops))]
+         (->> (gen/vector (gen/one-of arg-gen) 1 max-args)
+              (gen/fmap
+               (fn [args]
+                 (with-meta {:type :op, :value op, :args args}
+                   {:result (type-fn (map #(-> % meta :result) args))})))
+              (gen/such-that such-that)))))))

 (def or-op
   (operation-generator
@@ -80,10 +85,18 @@
   [or-op cat-op star-op plus-op opt-op not-op])

 (def operation
-  (gen/sized
-   (fn [size]
-     (let [op-generators (map #(gen/resize size %) all-op-generators)]
-       (gen/one-of op-generators)))))
+  (fn [alias-gen]
+    (gen/sized
+     (fn [size]
+       (let [op-generators (map #(gen/resize size (% alias-gen))
+                                all-op-generators)]
+         (gen/one-of op-generators))))))
+
+(defn expression
+  [alias-gen]
+  (gen/frequency [[8 (operation alias-gen)]
+                  [4 (gen/one-of collection-generators)]
+                  [1 alias-gen]]))

 (defn ppm [obj]
   (let [orig-dispatch pprint/*print-pprint-dispatch*]
@@ -96,5 +109,31 @@
         (orig-dispatch o))
       (pprint obj))))

-(deftest ^:examples print-op-result
-  (ppm (gen/sample operation)))
+(defn alias
+  [prev-aliases]
+  (let [alias-gen (if (seq prev-aliases)
+                    (gen/elements prev-aliases)
+                    string) ;; avoid throwing when empty
+        alias-name (gen/such-that #(and (seq %)
+                                        (Character/isLetter (first %))
+                                        (not-any? (fn [e] (= % (:value e)))
+                                                  prev-aliases))
+                                  (gen/resize 20 gen/string-alpha-numeric))
+        expr (expression alias-gen)]
+    (->> (gen/tuple alias-name expr)
+         (gen/fmap (fn [[alias-name expr]]
+                     {(with-meta {:type :symbol :value alias-name}
+                        {:result (-> expr meta :result)})
+                      expr})))))
+
+(defn aliases
+  [size]
+  (if (zero? size)
+    (alias nil)
+    (gen/bind (gen/resize (dec size)
+                          (gen/sized aliases))
+              (fn [alias-map]
+                (gen/fmap
+                 (fn [generated-alias]
+                   (merge alias-map generated-alias))
+                 (alias (-> alias-map keys)))))))


use-earliest false

use-earliest false

--- kafka-clj/src/kafka_clj/fetch.clj
+++ kafka-clj/src/kafka_clj/fetch.clj
@@ -259,7 +259,7 @@
      ))

-(defn write-offset-request-message [^ByteBuf buff {:keys [topics max-offsets use-earliest] :or {use-earliest true max-offsets 10}}]
+(defn write-offset-request-message [^ByteBuf buff {:keys [topics max-offsets use-earliest] :or {use-earliest false max-offsets 10}}]
   "
 	OffsetRequest => ReplicaId [TopicName [Partition Time MaxNumberOfOffsets]]
 	  ReplicaId => int32
@@ -268,6 +268,7 @@
 	  Time => int64
 	  MaxNumberOfOffsets => int32
 	"
+  (info "write-offset-requests use-earliest " use-earliest)
   (.writeInt buff (int -1)) ;replica id
   (.writeInt buff (int (count topics))) ;write topic array count
   (doseq [[topic partitions] topics]


list repository contents

list repository contents

--- src/atom_finder/questions/code_age.clj
+++ src/atom_finder/questions/code_age.clj
@@ -15,6 +15,7 @@
    [clojure.pprint :refer [pprint]]
    [clojure.string :as string]
    [swiss.arrows :refer :all]
+   [schema.core :as s]
    )
   (:import
    [org.eclipse.jgit.api Git]
@@ -40,14 +41,35 @@
   [sec]
   (java.time.LocalDateTime/ofEpochSecond sec 0 (java.time.ZoneOffset/ofHours 0)))

+(def year-month (juxt (memfn getYear) (memfn getMonthValue)))
+
+(defn first-monthly-commits
+  [repo]
+  (->> repo gitq/rev-list
+       (partition-by #(-<> % .getCommitTime long sec->java-time year-month))
+       (map last)))
+
+;; https://stackoverflow.com/questions/19941597/use-jgit-treewalk-to-list-files-and-folders
+(s/defn list-repository-contents [git-repo :- Git commit]
+  (let [repository (.getRepository git-repo)
+        ;head (.getRef repository "HEAD") ;TODO NOT HEAD
+        walk (org.eclipse.jgit.revwalk.RevWalk. repository) ; probably can be the commit
+        ;commit (.parseCommit walk (.getObjectId head))
+        tree   (.getTree commit)
+        treeWalk (org.eclipse.jgit.treewalk.TreeWalk. repository)
+        ]
+
+    (.addTree treeWalk tree)
+    (.setRecursive treeWalk true)
+
+    (take-while identity (repeatedly #(and (.next treeWalk) (.getPathString treeWalk))))))
+
 (-<>>
  gcc-repo
- gitq/rev-list
- (take 10000)
- (map #(-<> % .getCommitTime long sec->java-time))
- (distinct-by (juxt (memfn getYear) (memfn getMonthValue)))
- ;(distinct-by #(-<> % .getCommitTime long sec->java-time ((juxt (memfn getYear) (memfn getMonthValue)))))
- (map prn)
- dorun
+ first-monthly-commits
+ first
+ (list-repository-contents gcc-repo)
+ (take 10)
+ pprint
  time-mins
  )


Fix user-from-session fn

Fix user-from-session fn

--- src/braid/server/routes/api/public.clj
+++ src/braid/server/routes/api/public.clj
@@ -21,8 +21,8 @@

 (defn user-from-session [req]
   (when-let [user-id (get-in req [:session :user-id])]
-    (when-let [user (user/user-id-exists? user-id)]
-      user)))
+    (when (user/user-id-exists? user-id)
+      (user/user-by-id user-id))))

 (defn edn-response [clj-body]
   {:headers {"Content-Type" "application/edn; charset=utf-8"}


type hint topology context to avoid reflection

--- src/clj/backtype/storm/daemon/task.clj
+++ src/clj/backtype/storm/daemon/task.clj
@@ -157,7 +157,7 @@
                          (.getThisTaskId topology-context)
                          stream))))

-(defn mk-task [worker topology-context user-context]
+(defn mk-task [worker ^TopologyContext topology-context ^TopologyContext user-context]
   (let [task-id (.getThisTaskId topology-context)

         ;; TODO refactor...


formatting

formatting

--- src/clj/backtype/storm/daemon/task.clj
+++ src/clj/backtype/storm/daemon/task.clj
@@ -478,7 +478,7 @@
              (when (sampler)
                (.put tuple-start-times tuple (System/currentTimeMillis)))

-             (.execute bolt tuple)
+             (.execute bolt tuple)
              ))))]
     ))


Catch log application error and print

Catch log application error and print

In the future we should stop return completely, send freshness message
and deadness message.

--- src/clj/onyx_dashboard/http/server.clj
+++ src/clj/onyx_dashboard/http/server.clj
@@ -60,7 +60,10 @@
     (loop [replica (:replica subscription)]
       (if-let [position (first (alts!! (vector ch (timeout 50))))]
         (let [entry (extensions/read-log-entry log position)
-              new-replica (extensions/apply-log-entry entry replica)
+              new-replica (try (extensions/apply-log-entry entry replica)
+                               (catch Throwable t
+                                 (error (str "Could not apply log entry: " entry) t)
+                                 (throw t)))
               diff (extensions/replica-diff entry replica new-replica)
               job-id (:job (:args entry))
               ;complete-tasks (get (:completions new-replica) job-id)


Make give freshness timeout a name

Make give freshness timeout a name

--- src/clj/onyx_dashboard/http/server.clj
+++ src/clj/onyx_dashboard/http/server.clj
@@ -50,6 +50,8 @@
                  {:job job-id :task task}))
              (keys allocations))))

+(def freshness-timeout 50)
+
 ; May want to track events in a deployment atom
 ; including chunks that are read e.g. catalog. Then if we end up
 ; with multiple clients viewing the same deployment we can only subscribe once.
@@ -58,7 +60,7 @@
   (let [log (:log (:env subscription))
         up-to-date? (atom false)]
     (loop [replica (:replica subscription)]
-      (if-let [position (first (alts!! (vector ch (timeout 50))))]
+      (if-let [position (first (alts!! (vector ch (timeout freshness-timeout))))]
         (let [entry (extensions/read-log-entry log position)
               new-replica (try (extensions/apply-log-entry entry replica)
                                (catch Throwable t


fixed empty log npe

fixed empty log npe

--- src/clj/swarmpit/docker/engine/log.clj
+++ src/clj/swarmpit/docker/engine/log.clj
@@ -25,9 +25,10 @@

 (defn parse-log
   [service-log]
-  (->> (split-lines service-log)
-       (map (fn [x] {:line      (parse-log-line x)
-                     :timestamp (parse-log-timestamp x)
-                     :task      (parse-log-task x)}))
-       (filter #(some? (:task %)))
-       (sort-by :timestamp)))+  (if (some? service-log)
+    (->> (split-lines service-log)
+         (map (fn [x] {:line      (parse-log-line x)
+                       :timestamp (parse-log-timestamp x)
+                       :task      (parse-log-task x)}))
+         (filter #(some? (:task %)))
+         (sort-by :timestamp))))


bringing multipdgmmod/handle-multimodplldisplay2 to branch valclmod

--- src/clj/webapp/routes/multipdgmmod.clj
+++ src/clj/webapp/routes/multipdgmmod.clj
@@ -261,19 +261,6 @@
      [:script {:type "text/javascript"}
       "goog.require('webapp.core');"])))

-(defn pstring2map
-  [pdgm]
-  (let [pdgm1 (clojure.string/replace pdgm #"^.*?\\r\\n" "") ;; header out
-        pdgmstring (clojure.string/replace pdgm1 #"\\r\\n" "%%")
-        pdgmstr (clojure.string/replace pdgmstring #",([^,]*%%)" "&$1")
-        pdgm2 (clojure.string/replace pdgmstr #"&" " ")
-        pdgm3  (clojure.string/replace pdgm2 #"%%" " ")
-        plist (split pdgm3 #" ")
-        pmap (apply hash-map plist)
-        ]
-    (clojure.walk/keywordize-keys pmap)
-    ))
-
 (defn handle-multimodplldisplay
   "This version relies on external npg.clj file for sort order; can be eliminated as soon as is clear that handle-multimodplldisplay2 is adequate"
   [pdgms headerset2 pdgmstr2]
@@ -326,6 +313,19 @@
       [:script {:type "text/javascript"}
        "goog.require('webapp.core');"]]])))

+(defn pstring2map
+  [pdgm]
+  (let [pdgm1 (clojure.string/replace pdgm #"^.*?\\r\\n" "") ;; header out
+        pdgmstring (clojure.string/replace pdgm1 #"\\r\\n" "%%")
+        pdgmstr (clojure.string/replace pdgmstring #",([^,]*%%)" "&$1")
+        pdgm2 (clojure.string/replace pdgmstr #"&" " ")
+        pdgm3  (clojure.string/replace pdgm2 #"%%" " ")
+        plist (split pdgm3 #" ")
+        pmap (apply hash-map plist)
+        ]
+    (clojure.walk/keywordize-keys pmap)
+    ))
+
 (defn handle-multimodplldisplay2
   "This version does not rely on external png file for sort order; keyset should be generalized beyond png to any sequence of cols between col-1 ('pivot', here limited to paradigms) and token column. Also need to 'presort' cols before initial display."
   [pdgms headerset2 pdgmstr2]


Add offline/online firebase methods

Add offline/online firebase methods

--- src/cljs/hacker_agent/hacker-base.cljs
+++ src/cljs/hacker_agent/hacker-base.cljs
@@ -8,6 +8,12 @@
 (defonce url "https://hacker-news.firebaseio.com/v0")

 (defonce root (js/Firebase. url))
+
+(defn goOffline []
+  (.goOffline js/Firebase))
+
+(defn goOnline []
+  (.goOnline js/Firebase))

 (defn- walk-root [r & keys]
   (let [[k & ks] keys]


reset-data-sync! can specify paths in data atom

--- src/cljs/hacker_agent/hacker-base.cljs
+++ src/cljs/hacker_agent/hacker-base.cljs
@@ -35,46 +35,40 @@
   created from item ID to update PATH in DATA.  Channels created to
   update DATA will be stored in atom CHANS as a hash-map of ID and
   chan."
-  ([data id]
-   (init-data-sync! [:item] data id))
-  ([path data id]
-   (init-data-sync! path data id [:channels]))
-  ([path data id chan-path]
+  ([data id] (init-data-sync! data id [:entry]))
+  ([data id path] (init-data-sync! data id (conj path :item) (conj path :channels)))
+  ([data id path chan-path]
    (let [fbc (id->fb-chan id)]
      (swap! data assoc-in (conj chan-path id) fbc)
      (letfn [(handle-kid [k v child-path]
                (let [items (doall (map #(hash-map % {}) v))]
                  (swap! data assoc-in child-path (into {} items))
                  (doseq [id v]
-                   (init-data-sync! (conj child-path id) data id chan-path))))]
+                   (init-data-sync! data id (conj child-path id) chan-path))))]
        (go-loop []
          (when-let [msg (<! fbc)]
            (let [[event key val] msg
                  child-path (conj path key)]
-             (cond
-              (= event :child_added)
-              (if (= key :kids)
-                (handle-kid key val child-path)
-                (swap! data assoc-in child-path val))
-
-              (= event :child_changed)
-              (if (= key :kids)
-                (handle-kid key val child-path)
-                (swap! data assoc-in child-path val))
-              ;; TODO: implement dissoc-in?
-              (= event :child_removed)
-              (swap! data assoc-in child-path nil)
-
-              :else (.log js/console (clj->js [event key val]))
-              ))
+             (case event
+               :child_added (if (= key :kids)
+                              (handle-kid key val child-path)
+                              (swap! data assoc-in child-path val))
+               :child_changed (if (= key :kids)
+                                (handle-kid key val child-path)
+                                (swap! data assoc-in child-path val))
+               ;; TODO: implement dissoc-in?
+               :child_removed (swap! data assoc-in child-path nil)
+               (.log js/console (clj->js [event key val]))))
            (recur)))))))

-(defn reset-data-sync! [data id]
+(defn reset-data-sync! [id data path]
   (swap! data
          #(do
-            (when-let [{id-chans :channels} %]
+            (when-let [id-chans (get-in % (conj path :channels))]
               (doseq [[id chan] (seq id-chans)]
                 (.log js/console (str "Closing channel " id "."))
                 (close! chan)))
-            (dissoc % :item :channels)))
-  (init-data-sync! data id))
+            (update-in %
+                       path
+                       dissoc :item :channels)))
+  (init-data-sync! data id path))


morph bug

morph bug

--- src/clojure/zensols/nlparse/config.clj
+++ src/clojure/zensols/nlparse/config.clj
@@ -92,6 +92,13 @@
    {:component :pos
     :pos-model-resource pos-model-resource
     :parser :stanford}))
+
+(defn morphology
+  "Create a morphology annotator, which adds the lemmatization of a word.  This
+  adds the `:lemma` keyword to each token.."
+  []
+  {:component :morph
+   :parser :stanford})

 (defn named-entity-recognizer
   "Create annotator to do named entity recognition.  All models in the
@@ -210,8 +217,6 @@
                    only-tokenize? [(tokenize) (sentence)]
                    :else (components-by-parsers parsers))})

-(create-parse-config :pipeline [(tokenize) (sentence)])
-
 (defn- registered-components
   "Return all registered component functions.  This is the `:component-fns` key
   in the registeration map provided by each parser."


Reformat code

Reformat code

--- src/tetris/core.cljs
+++ src/tetris/core.cljs
@@ -1,9 +1,9 @@
 (ns tetris.core
   (:require [reagent.core :as r]))

-(defonce ^:const initial-tick-frequency 500)
-(defonce ^:const width 10)
-(defonce ^:const height 20)
+(defonce initial-tick-frequency 500)
+(defonce width 10)
+(defonce height 20)

 (defonce empty-grid
   (vec (take height (repeat (vec (take width (repeat \ )))))))
@@ -69,27 +69,28 @@
           grid))

 (defn new-block [world]
-  (let [block (rand-nth blocks)
-        x (int (- (/ width 2) (/ (count (first block)) 2)))
+  (let [block        (rand-nth blocks)
+        x            (int (- (/ width 2) (/ (count (first block)) 2)))
         [score grid] (-> world render score)
-        new (-> world
-                (assoc :grid grid, :x x, :y 0, :rotations 0, :block block)
-                (update :score (fnil + 0) score))]
+        new          (-> world
+                         (assoc :grid grid, :x x, :y 0, :rotations 0, :block block)
+                         (update :score (fnil + 0) score))]
     (if (valid? new)
       new
       (assoc new :game-over? true))))

 (defn move [{:keys [game-over?] :as world} direction]
   (let [new (case direction
-              :up (update world :rotations inc)
-              :down (update world :y inc)
-              :left (update world :x dec)
+              :up    (update world :rotations inc)
+              :down  (update world :y inc)
+              :left  (update world :x dec)
               :right (update world :x inc)
               world)]
-    (cond game-over? world
-          (valid? new) new
-          (= direction :down) (new-block world)
-          :else world)))
+    (cond
+      game-over?          world
+      (valid? new)        new
+      (= direction :down) (new-block world)
+      :else               world)))

 (defn grid-component [grid]
   [:div.grid
@@ -98,7 +99,7 @@
       {:key (str "line-" y)}
       (for [[x cell] (map vector (iterate inc 0) line)]
         [:div.cell
-         {:key (str "cell-" x)
+         {:key   (str "cell-" x)
           :class (when-not (= cell \ )
                    (str "taken block-" cell))}])])])

@@ -106,11 +107,15 @@
   (swap! world-atom move direction))

 (defn main-component [world-atom]
-  (let [{:keys [game-over? grid score] :as world} @world-atom
-        button (fn [dir]
-                 (let [f #(do (move! world-atom dir)
-                              (.preventDefault %))]
-                   [:button {:class (name dir), :on-click f, :on-touch-start f} (name dir)]))]
+  (let [{:keys [game-over? grid score]
+         :as   world} @world-atom
+        button        (fn [dir]
+                        (let [f #(do (move! world-atom dir)
+                                     (.preventDefault %))]
+                          [:button {:class (name dir)
+                                    :on-click f
+                                    :on-touch-start f}
+                           (name dir)]))]
     [:div.main
      {:class (when game-over? "game-over")}

@@ -124,7 +129,7 @@

      (when game-over?
        [:a.title
-        {:href "#"
+        {:href     "#"
          :on-click #(reset! world-atom
                             (new-block {:grid empty-grid}))}
         "GAME OVER"])]))
@@ -149,4 +154,4 @@

 (defn ^:export run []
   (r/render-component [main-component world-atom]
-                    (.getElementById js/document "container")))
+                      (.getElementById js/document "container")))


Fix redirect

Fix redirect

--- lein-template/src/leiningen/new/modular/dashboard/website.clj
+++ lein-template/src/leiningen/new/modular/dashboard/website.clj
@@ -33,7 +33,9 @@
     {::dashboard (fn [req] (page this req))})

   ;; All paths lead to the dashboard
-  (routes [_] ["/" [[["dashboard/" [#".*" :path]] ::dashboard]
+  (routes [_] ["/" [["dashboard/" ::dashboard]
+                    ;; You cannot redirect to a target that requires a parameter
+                    [["dashboard/" [#".*" :path]] ::dashboard]
                     ["" (redirect ::dashboard)]]])

   ;; A WebService can be 'mounted' underneath a common uri context