enable multi-form reformatting

enable multi-form reformatting

--- src/clojure/paredit_widget/core.clj
+++ src/clojure/paredit_widget/core.clj
@@ -2,6 +2,10 @@
   (:use [seesaw.core]
         [paredit.core]
         [paredit.parser])
+  (:require
+        [net.cgrand.parsley :as p]
+        [net.cgrand.parsley.functional-trees :as f]
+        [net.cgrand.parsley.views :as v])
   (:import java.awt.event.KeyListener
            java.awt.event.InputMethodListener))

@@ -71,15 +75,55 @@
   ["M" "Left"] :paredit-expand-left
    })

+(declare sexp-dup)
+
+(defn reformat-all-forms [s]
+  (let [rvec (map (fn [[offs p]]
+                    (let [len (v/length p)]
+                      (vector (- offs len) len (with-out-str (clojure.pprint/pprint (read-string (v/text p)))))))
+                  (filter (fn [me] (= :list (v/tag (val me)))) (v/offsets (sexp-dup s))))
+          rvec-first (nth rvec 0)
+          rlist (first (partition 2 1 rvec))
+          ;_ (println "rlist: " rlist)
+          sb (StringBuffer. s)
+        ]
+          ; replace first form
+          #_(println "first offset: " (first rvec-first))
+          (.replace sb (first rvec-first) (+ (first rvec-first) (second rvec-first)) (last rvec-first))
+
+          ; replace from 2nd to last form
+          (loop [offsum 0
+                 rl rlist]
+            (if (or (empty? rl) (not (second rl)))
+              (.toString sb)
+              (let [ra (first rl)
+                    rb (second rl)
+                    ;_ (println "ra: " ra)
+                    ;_ (println "rb: " rb)
+                    diff-a (- (.length (last ra)) (second ra))
+                    offset-b (first rb)
+                    len-b (second rb)
+                    off-next (+ diff-a offset-b offsum)]
+
+                      ; replace next form
+                      (.replace sb off-next (+ off-next len-b) (last rb))
+                      (recur off-next (rest rl)))))))
+
 (def formatting-keymap
   {["M" "f"] :fmt-pprint})

-(defn exec-pprint [k widget]
-  (when (formatting-keymap k)
-    (when-let [text (.getSelectedText widget)]
-      (let [fs (with-out-str (clojure.pprint/pprint (read-string text)))]
+(defn exec-pprint-old [k widget]
+  (let [cmd (formatting-keymap k)]
+    (if cmd
+      (let [fs (with-out-str (clojure.pprint/pprint (read-string (.getSelectedText widget))))]
         (if *debug* (println "replacement: " fs " at: " (.getSelectionStart widget)))
         (if fs (.replaceRange widget fs (.getSelectionStart widget) (.getSelectionEnd widget)))))))
+
+(defn exec-pprint [k widget]
+  (let [cmd (formatting-keymap k)]
+    (if cmd
+      (let [sel (.getSelectedText widget)]
+        (if sel (.replaceRange widget (reformat-all-forms sel) (.getSelectionStart widget) (.getSelectionEnd widget)))))))

 (defn exec-paredit [k w]
   (let [cmd (keymap k)]
@@ -157,3 +201,89 @@
                             :size [300 :by 300]))
    pack!
    show!))
+
+(def sexp-dup
+  (p/parser {:root-tag :root
+           :main :expr*
+           :space (p/unspaced gspaces :*)
+           :make-node f/fnode
+           :make-leaf f/fleaf
+           }
+    :expr- #{
+             :list
+             :vector
+             :map
+             :set
+             :quote
+             :meta
+             :deprecated-meta
+             :deref
+             :syntax-quote
+             :var
+             :fn
+             :unquote-splicing
+             :unquote
+             :string
+             :regex
+             :symbol
+             :reader-literal
+             :keyword
+             :int
+             :float
+             :ratio
+             :anon-arg
+             :char
+             :chimera
+             }
+    :list [open-list :expr* ")"]
+    :chimera
+             #{
+               [open-list :expr* eof]
+               [open-vector :expr* eof]
+               [open-map :expr* eof]
+               [open-fn :expr* eof]
+               [open-set :expr* eof]
+               ;(p/unspaced open-string #"(?:\\.|[^\\\"])++(?!\")" :? eof)
+               ;(p/unspaced open-regex #"(?:\\.|[^\\\"])++(?!\")" :? eof)
+               [open-quote eof]
+               [open-deref eof]
+               [open-syntax-quote eof]
+               [open-var eof]
+               [open-discard eof]
+               [open-unquote-splicing eof]
+               [open-unquote eof]
+               (p/unspaced open-char eof)
+               }
+    :vector [open-vector :expr* "]"]
+    :map [open-map :expr* "}"]
+    :set [open-set :expr* "}"]
+    :quote [open-quote :expr]
+    :open-meta "^"             :open-deprecated-meta "#^"
+    :meta-prefix [:open-meta
+                  :expr]       :deprecated-meta-prefix [:open-deprecated-meta
+                                                        :expr]
+    :meta [:meta-prefix :expr] :deprecated-meta [:deprecated-meta-prefix
+                                                 :expr]
+    :deref [open-deref :expr]
+    :syntax-quote [open-syntax-quote :expr]
+    :var [open-var :expr]
+    :fn [open-fn :expr* ")"]
+    :unquote-splicing [open-unquote-splicing :expr]
+    :unquote [open-unquote :expr]
+    :string-body #"(?:\\.|[^\\\"])++(?=\")"
+    :string (p/unspaced open-string :string-body :? \")
+    :regex-body #"(?:\\.|[^\\\"])++(?=\")"
+    :regex (p/unspaced open-regex :regex-body :? \")
+    :reader-literal-prefix (p/unspaced open-reader-literal :symbol)
+    :reader-literal [:reader-literal-prefix :expr]
+    :symbol #"(?:(?:[\-\+](?![0-9])[^\^\(^\[^\#^\{^\\^\"^\~^\%^\:^\,^\s^\;^\@^\`^\)^\]^\}]*)|(?:[^\^\(\[^\#\{\\\"\~\%\:\,\s\;\'\@\`\)\]\}\-\+;0-9][^\^\(\[\#\{\\\"\~\%\:\,\s\;\@\`\)\]\}]*))#?"
+    :keyword (p/unspaced open-keyword #"[^\(\[\{\'\^\@\`\~\"\\\,\s\;\)\]\}]*"); factorize with symbol
+    :int #"(?:[-+]?(?:0(?!\.)|[1-9][0-9]*+(?!\.)|0[xX][0-9A-Fa-f]+(?!\.)|0[0-7]+(?!\.)|[1-9][0-9]?[rR][0-9A-Za-z]+(?!\.)|0[0-9]+(?!\.))(?!/))"
+    :ratio #"[-+]?[0-9]+/[0-9]*"
+    :float #"[-+]?[0-9]+\.[0-9]*+(?:[eE][-+]?+[0-9]+)?+M?"
+    :anon-arg (p/unspaced open-anon-arg #"(?:[0-9|\&])?+")
+    :char (p/unspaced open-char #"(?:newline|space|tab|backspace|formfeed|return|u[0-9|a-f|A-F]{4}|o[0-3]?+[0-7]{1,2}|.)")
+    :whitespace whitespace
+    :comment #{(p/unspaced open-comment #"[^\n]*\n?")}
+    :discard [open-discard :expr]
+    ))


delaney2d.clj: new function (orbifold-symbol)

--- clojure/org/gavrog/clojure/delaney2d.clj
+++ clojure/org/gavrog/clojure/delaney2d.clj
@@ -1,19 +1,22 @@
 (ns org.gavrog.clojure.delaney2d
   (:use (org.gavrog.clojure delaney)))
+
+(defn- index-pairs [ds]
+  (let [[i j k] (indices ds)]
+    [[i j] [i k] [j k]]))

 (defn curvature
   ([ds default-v]
     (do
       (assert (= 2 (dim ds)) (str "Expected 2d symbol, got " (dim ds) "d"))
       (assert (connected? ds) "Symbol must be connected")
-      (let [[i j k] (indices ds)]
-        (reduce +
-                (- (size ds))
-                (for [[i j] [[i j] [i k] [j k]]
-                      :let [s #(if (orbit-loopless? ds [i j] %) 2 1)
-                            v #(or (v ds i j %) default-v)]
-                      D (orbit-reps ds [i j])]
-                  (/ (s D) (v D)))))))
+      (reduce +
+              (- (size ds))
+              (for [[i j] (index-pairs ds)
+                    :let [s #(if (orbit-loopless? ds [i j] %) 2 1)
+                          v #(or (v ds i j %) default-v)]
+                    D (orbit-reps ds [i j])]
+                (/ (s D) (v D))))))
   ([ds]
     (curvature ds 0)))

@@ -26,8 +29,7 @@
 (defn spherical? [ds]
   (and (pos? (curvature ds 1))
        (let [ds (oriented-cover ds)
-             [i j k] (indices ds)
-             cones (for [[i j] [[i j] [i k] [j k]]
+             cones (for [[i j] (index-pairs ds)
                          D (orbit-reps ds [i j])
                          :when (< 1 (v ds i j D))]
                      (v ds i j D))
@@ -35,3 +37,24 @@
          (and (not= 1 n) (or (not= 2 n) (= (first cones) (second cones)))))))

 (defn proto-spherical? [ds] (pos? (curvature ds 1)))
+
+(defn orbifold-symbol [ds]
+  (let [curv (curvature ds)
+        [i j k] (indices ds)
+        types (for [[i j] (index-pairs ds)
+                    D (orbit-reps ds [i j])
+                    :when (< 1 (v ds i j D))]
+                [(v ds i j D) (orbit-loopless? ds [i j] D)])
+        cones (for [[v b] types, :when b] v)
+        corners (for [[v b] types, :when (not b)] v)
+        cost (- 2 (+ (/ curv 2)
+                     (reduce + (map #(/ (dec %) %) cones))
+                     (reduce + (map #(/ (dec %) (* 2 %)) corners))
+                     (if (loopless? ds) 0 1)))
+        tmp (concat (sort cones)
+                    (if (loopless? ds) [] ["*"])
+                    (sort corners)
+                    (if (weakly-oriented? ds)
+                      (repeat (/ cost 2) "o")
+                      (repeat cost "x")))]
+    (if (pos? (count tmp)) (apply str tmp) "1")))


Cosmetic change (unthread)

Cosmetic change (unthread)

--- src/fink_nottle/sqs/channeled.cljc
+++ src/fink_nottle/sqs/channeled.cljc
@@ -15,7 +15,7 @@
     (go-catching
       (loop []
         (let [messages (try
-                         (-> (sqs/receive-message! creds queue-url params) <?)
+                         (<? (sqs/receive-message! creds queue-url params))
                          (catch #? (:clj Exception :cljs js/Error) e
                            (>! chan e)
                            ::error))]


faster method to get tx-data

faster method to get tx-data

--- src/pc/replay.clj
+++ src/pc/replay.clj
@@ -10,11 +10,10 @@
   [[e a v tx added]]
   {:e e :a a :v v :tx tx :added added})

-(defn tx-data [transaction]
-  (->> (d/q '{:find [?e ?a ?v ?tx ?op]
-              :in [?log ?txid]
-              :where [[(tx-data ?log ?txid) [[?e ?a ?v ?tx ?op]]]]}
-            (d/log (pcd/conn)) (:db/id transaction))
+(defn tx-data [tx-id]
+  (->> (d/tx-range (d/log (pcd/conn)) tx-id (inc tx-id))
+    first
+    :data
     (map ->datom)
     set))

@@ -32,7 +31,7 @@

 (defn reproduce-transaction [db tx-id]
   (let [tx (d/entity db tx-id)]
-    {:tx-data (tx-data tx)
+    {:tx-data (tx-data tx-id)
      :tx tx
      :db-after db}))


shuffle->lshuffle in fast-lexicase-selection

--- src/clojush.clj
+++ src/clojush.clj
@@ -2128,7 +2128,7 @@
   "Returns an individual that does the best on a randomly selected set of fitness cases.
    Assumes that setup-fast-lexicase-selection has been run, setting up global-lexicase-case-cohorts."
   [pop]
-  (loop [cases (shuffle (range (count (:errors (first pop)))))
+  (loop [cases (lshuffle (range (count (:errors (first pop)))))
          survivors (first (nth @global-lexicase-case-cohorts (first cases)))]
     (if (or (empty? (rest survivors))
             (empty? (rest cases)))


Adds full circular ref support

Adds full circular ref support

--- src/overcode/introvert.cljs
+++ src/overcode/introvert.cljs
@@ -1,47 +1,56 @@
 (ns overcode.introvert)
-
-(defn in?
-  "true if seq contains elm"
-  [seq elm]
-  (some #(= elm %) seq)
-  )

 (def ->js)

-(defn visit [obj visited]
+(defn array-append [arr seq]
+  "Inserts all elements from a Seq into an existing JS array."
+  (doseq [v seq]
+         (.push arr v))
+  arr)
+
+(defn visited? [visited obj]
+  "Check if a collection has been visited. If so, return its JS equivalent."
+  (if (contains? @visited obj)
+    (get @visited obj)))
+
+(defn visit!
   "Marks potentially linked objects as visited to handle circular refs."
-  (cond
-   (nil? obj) true
+  ([visited obj out]
+   (swap! visited assoc obj out)
+   out)

-   (vector? obj) true
-   (list?   obj) true
-   (seq?    obj) true
-
-   (in? @visited obj) nil
-   :else (swap! visited conj obj)))
+  ([visited obj] (visit! visited obj true)))

 (defn seq->js
   "Converts a seq-like value into a JS Array."
   ([obj visited]
-   (if (visit obj visited)
-     (into-array (map #(->js % visited) obj))
-     obj))
-  ([obj] (seq->js obj (atom ()))))
+   (let [was-visited (visited? visited obj)]
+     (if was-visited
+       was-visited
+       (let [out (array)]
+         (visit! visited obj out)
+         (array-append out (map #(->js % visited) obj))))))
+
+
+  ([obj] (seq->js obj (atom {}))))

 (defn map->js
   "Converts a map-like value into a JS Object."
   ([obj visited]
-   (if (visit obj visited)
-     (let [out (js-obj)]
-       (doall (map (fn [pair]
-                     (let [
-                           key (->js (first pair)  visited)
-                           val (->js (second pair) visited)]
-                       (aset out key val)))
-                   obj))
-       out)
-     obj))
-  ([obj] (map->js obj (atom ()))))
+   (let [was-visited (visited? visited obj)]
+     (if was-visited
+       was-visited
+       (let [out (js-obj)]
+         (visit! visited obj out)
+         (doall
+          (map
+           #(let [key (->js (first %)  visited)
+                   val (->js (second %) visited)]
+               (aset out key val))
+           obj))
+         out))))
+
+  ([obj] (map->js obj (atom {}))))

 (defn ->js
   "Converts a cljs data structure into a close JS approximation."
@@ -51,12 +60,13 @@
      cljs.core/Symbol  (name obj)
      cljs.core/Atom    (->js @obj visited)

-     cljs.core/PersistentVector (seq->js obj visited)
-     cljs.core/IndexedSeq       (seq->js obj visited)
-     cljs.core/LazySeq          (seq->js obj visited)
+     cljs.core/IndexedSeq        (seq->js obj visited)
+     cljs.core/LazySeq           (seq->js obj visited)
+     cljs.core/PersistentVector  (seq->js obj visited)
+     cljs.core/PersistentHashSet (seq->js obj visited)

-     cljs.core/PersistentHashSet  (seq->js obj visited)
+     cljs.core/PersistentArrayMap (map->js obj visited)
      cljs.core/PersistentHashMap  (map->js obj visited)
-     cljs.core/PersistentArrayMap (map->js obj visited)
      obj))
-  ([obj] (->js obj (atom ()))))
+
+  ([obj] (->js obj (atom {}))))


Fix docstring inaccuracies

Fix docstring inaccuracies

--- src/overtone/libs/event.clj
+++ src/overtone/libs/event.clj
@@ -23,10 +23,9 @@
   the fns event and sync-event.

   Takes an event-type (name of the event), a handler fn and a key (to
-  refer back to this handler in the future). The handler can
-  optionally accept a single event argument, which is a map containing
-  the :event-type property and any other properties specified when it
-  was fired.
+  refer back to this handler in the future). The handler must accept a
+  single event argument, which is a map containing the :event-type
+  property and any other properties specified when it was fired.

   (on-event \"/tr\" handler ::status-check )
   (on-event :midi-note-down (fn [event]
@@ -41,15 +40,16 @@

 (defn on-sync-event
   "Synchronously runs handler whenever events of type event-type are
-  fired on the event handling thread i.e. causes the event handling
-  thread to block until all sync events have been handled. Events may
-  be triggered with the fns event and sync-event.
+  fired on the thread that generated the event (by calling ether event
+  or event-sync). Note, this causes the event-generating thread to block
+  whilst this handler is being handled. For a non-blocking event handler
+  see on-event.
+

   Takes an event-type (name of the event), a handler fn and a key (to
-  refer back to this handler in the future). The handler can
-  optionally accept a single event argument, which is a map containing
-  the :event-type property and any other properties specified when it
-  was fired.
+  refer back to this handler in the future). The handler accept a single
+  event argument, which is a map containing the :event-type property and
+  any other properties specified when it was fired.

   (on-event \"/tr\" handler ::status-check )
   (on-event :midi-note-down (fn [event]


log ns

log ns

--- src/spq/lib.clj
+++ src/spq/lib.clj
@@ -27,10 +27,11 @@
                         (if-let [err (force ?err_)]
                           (str "\n" (timbre/stacktrace err))
                           "")))
-            #(let [{:keys [msg_ hostname_ timestamp_ instant level ?err_]} %]
+            #(let [{:keys [msg_ hostname_ timestamp_ instant level ?ns-str ?err_]} %]
                (println
                 (.toString (.toInstant instant))
                 level
+                (force ?ns-str)
                 (force hostname_)
                 (force msg_)
                 (if-let [err (force ?err_)]


Fixed process handling in terminate function.

--- src/cmr/dev/env/manager/process.clj
+++ src/cmr/dev/env/manager/process.clj
@@ -9,7 +9,8 @@
 ;;;   Constants   ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

-(def ^:dynamic *buffer-size* (* 10 1024))
+(def ^:dynamic *byte-buffer-size* 1024)
+(def ^:dynamic *channel-buffer-size* (* 10 1024))
 (def ^:dynamic *read-stream-delay* 5000)

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -49,9 +50,15 @@
   [str]
   (io/input-stream (str->bytes str)))

+(defn make-byte-array
+  ([]
+    (make-byte-array *byte-buffer-size*))
+  ([buffer-size]
+    (make-array Byte/TYPE buffer-size)))
+
 (defn- read-stream
   [^java.io.InputStream input-stream channel]
-  (let [bytes (make-array Byte/TYPE *buffer-size*)]
+  (let [bytes (make-byte-array)]
     (async/go-loop [stream input-stream
                     bytes-read (.read stream bytes)]
       (when (pos? bytes-read)
@@ -94,17 +101,16 @@
 (defn spawn!
   [& args]
   (let [process (apply shell/proc args)
-        out-chan (async/chan)
-        err-chan (async/chan)]
+        out-chan (async/chan *channel-buffer-size*)
+        err-chan (async/chan *channel-buffer-size*)]
     (log-process process out-chan err-chan)
     (merge process {:out-channel out-chan
                     :err-channel err-chan})))

 (defn terminate!
   [process-data]
-  (let [process (:process process-data)
-        exit-code (future (shell/exit-code process))]
-    (shell/destroy process)
+  (let [exit-code (future (shell/exit-code process-data))]
+    (shell/destroy process-data)
     (async/close! (:out-channel process-data))
     (async/close! (:err-channel process-data))
     @exit-code))


[#2376] Remove logs

[#2376] Remove logs

--- backend/src/akvo/lumen/lib/visualisation/maps.clj
+++ backend/src/akvo/lumen/lib/visualisation/maps.clj
@@ -125,8 +125,6 @@
     (let [metadata-array (metadata-layers tenant-conn layers)
           map-config (map-config/build tenant-conn "todo: remove this" layers metadata-array)
           headers* (headers tenant-conn)
-          _ (log/warn :map-config map-config)
-          _ (log/warn :headers headers)
           layer-group-id (-> (http.client/post* (format "%s/layergroup" windshaft-url)
                                                 (merge http-client-req-defaults
                                                        {:body (json/encode map-config)


Небольшие дополнинея по стилям в media

Небольшие дополнинея по стилям в media

--- radiolamp-6P3S/src/ixinfestor/omut.cljs
+++ radiolamp-6P3S/src/ixinfestor/omut.cljs
@@ -2235,8 +2235,9 @@
 (defn ui-media [{:keys [media-object
                         heading heading-2
                         href
+                        style
                         body]}]
-  (dom/div #js {:className "media"}
+  (dom/div #js {:className "media" :style style}
            (dom/div #js {:className "media-left"}
                     (dom/a #js {:href (or href "#")}
                            media-object))


Fix test failure due to missing namespace

--- src/com/puppetlabs/cmdb/command.clj
+++ src/com/puppetlabs/cmdb/command.clj
@@ -142,7 +142,7 @@
         parsed (assoc parsed :annotations (pl-utils/mapkeys keyword (:annotations parsed)))
         retries (get-in parsed [:annotations :retries] [])]
     (assoc-in parsed [:annotations :retries]
-              (conj retries (timestamp)))))
+              (conj retries (pl-utils/timestamp)))))

 ;; ## Command processing exception classes


Remove tick/cal/int-year

Remove tick/cal/int-year

Obscures better code paths.

--- src/tick/cal.clj
+++ src/tick/cal.clj
@@ -59,14 +59,11 @@
         :args (s/cat :name ::name :day ::date :hol ::date)
         :ret ::holiday)

-(defn int-year [year]
-  (core/int (core/year year)))
-
 (defn new-years-day [year]
-  (LocalDate/of (int-year year) 1 1))
+  (LocalDate/of (core/int (core/year year)) 1 1))

 (defn new-years-day-holiday [year]
-  (let [day (new-years-day (int-year year))
+  (let [day (new-years-day (core/int (core/year year)))
         hol (cond-> day (weekend? day) (first-named-day-from DayOfWeek/MONDAY))]
     (holiday "New Year's Day" day hol)))

@@ -78,7 +75,7 @@
   ;; TODO: From what year does this algorithm makes sense from, need
   ;; to throw an exception outside this range.
   [year]
-  (let [year (int-year year)
+  (let [year (core/int (core/year year))
         a (mod year 19)
         b (quot year 100)
         c (mod year 100)
@@ -96,41 +93,41 @@
     (LocalDate/of year n (+ p 1))))

 (defn good-friday [year]
-  (.minusDays (easter-sunday (int-year year)) 2))
+  (.minusDays (easter-sunday (core/int (core/year year))) 2))

 (defn good-friday-holiday [year]
-  (holiday "Good Friday" (good-friday (int-year year))))
+  (holiday "Good Friday" (good-friday (core/int (core/year year)))))

 (defn easter-monday [year]
-  (.plusDays (easter-sunday (int-year year)) 1))
+  (.plusDays (easter-sunday (core/int (core/year year))) 1))

 (defn easter-monday-holiday [year]
-  (holiday "Easter Monday" (easter-monday (int-year year))))
+  (holiday "Easter Monday" (easter-monday (core/int (core/year year)))))

 (defn may-day [year]
-  (LocalDate/of (int-year year) 5 1))
+  (LocalDate/of (core/int (core/year year)) 5 1))

 (defn early-may-bank-holiday [year]
   (holiday "Early May bank holiday"
-           (first-named-day-from (may-day (int-year year)) DayOfWeek/MONDAY)))
+           (first-named-day-from (may-day (core/int (core/year year))) DayOfWeek/MONDAY)))

 (defn spring-bank-holiday [year]
   (holiday "Spring bank holiday"
-           (last-monday-of-month (YearMonth/of (int-year year) Month/MAY))))
+           (last-monday-of-month (YearMonth/of (core/int (core/year year)) Month/MAY))))

 (defn summer-bank-holiday [year]
   (holiday "Summer bank holiday"
-           (last-monday-of-month (YearMonth/of (int-year year) Month/AUGUST))))
+           (last-monday-of-month (YearMonth/of (core/int (core/year year)) Month/AUGUST))))

 (defn christmas-day [year]
-  (LocalDate/of (int-year year) 12 25))
+  (LocalDate/of (core/int (core/year year)) 12 25))

 (s/fdef christmas-day
         :args (s/cat :year ::year)
         :ret ::date)

 (defn christmas-day-holiday [year]
-  (let [day (christmas-day (int-year year))
+  (let [day (christmas-day (core/int (core/year year)))
         hol (cond-> day
               (#{DayOfWeek/SATURDAY DayOfWeek/SUNDAY} (.getDayOfWeek day)) (.plusDays 2))]
     (holiday "Christmas Day" day hol)))
@@ -140,14 +137,14 @@
         :ret ::holiday)

 (defn boxing-day [year]
-  (LocalDate/of (int-year year) 12 26))
+  (LocalDate/of (core/int (core/year year)) 12 26))

 (s/fdef boxing-day
         :args (s/cat :year ::year)
         :ret ::date)

 (defn boxing-day-holiday [year]
-  (let [day (boxing-day (int-year year))
+  (let [day (boxing-day (core/int (core/year year)))
         hol (cond-> day
               (#{DayOfWeek/SATURDAY DayOfWeek/SUNDAY} (.getDayOfWeek day)) (.plusDays 2))]
     (holiday "Boxing Day" day hol)))


lock to portrait orientation

lock to portrait orientation

Former-commit-id: dc079cc2175e03f1ad1a0ade1fbdeb49a36c27a3

--- src/status_im/android/core.cljs
+++ src/status_im/android/core.cljs
@@ -48,6 +48,7 @@
          (.addOrientationListener
            orientation
            #(dispatch [:set :orientation (orientation->keyword %)]))
+         (.lockToPortrait orientation)
          (.addListener device-event-emitter
                        "keyboardDidShow"
                        (fn [e]


Tweak Snowball API doc.

Tweak Snowball API doc.

--- src/afterglow/fixtures/blizzard.clj
+++ src/afterglow/fixtures/blizzard.clj
@@ -342,7 +342,7 @@

 (defn snowball
   "[Snowball](http://www.blizzardlighting.com/index.php?option=com_k2&view=item&layout=item&id=100&Itemid=96)
-  multi-beam effect light."
+  multi-beam moonflower effect light."
   {:doc/format :markdown}
   []
   {:name "Blizzard Snowball"


working player-input

working player-input

--- src/tic_tac_toe/tic_tac_toe.clj
+++ src/tic_tac_toe/tic_tac_toe.clj
@@ -1,9 +1,7 @@
 (ns tic-tac-toe.tic-tac-toe
 	(:require [clojure.java.io :as io])
-  (:use [clojure.string :only (split join)]))
-
-(use '[clojure.pprint :only (pprint)])
-(use '[clojure.string :only (join)])
+  (:use [clojure.string :only (split join)]
+        [clojure.pprint :only (pprint)]))

 ;; done:
 ;; TDD
@@ -54,6 +52,16 @@

 ;; 3 get player input
 ;; (with-in-str "0 0"
+(defn chars-seq [string]
+  (split string #""))
+
+(defn map-to-ints [coll]
+  (map #(Integer/parseInt %) coll))
+
 (defn player-input []
-  nil)
+  (print "Where to put your sign? ")
+  (-> *in* java.io.BufferedReader. line-seq first chars-seq map-to-ints))

+;; (map-to-ints (split "00" #""))
+
+;; ((memfn Integer/parseInt) "1") ; dont work


More code on counterexample saturation

More code on counterexample saturation

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

--- src/conexp/fca/exploration/repl.clj
+++ src/conexp/fca/exploration/repl.clj
@@ -63,8 +63,10 @@

 (defn counterexample-via-repl
   "Starts a repl for counterexamples."
-  [ctx impl]
-  (loop [state {:context ctx, :implication impl}]
+  [ctx knowledge impl]
+  (loop [state {:context ctx,
+                :knowledge knowledge,
+                :implication impl}]
     (let [query  (ask "counterexample> "
                       #(read-string (str (read-line)))
                       (constantly true)
@@ -126,9 +128,16 @@
                             "Please enter new attributes: "))]
     (assoc state :negatives negatives)))

-(define-repl-fn saturate-partial-counterexample
-  "Saturates the given partial counterexample. NOT YET IMPLEMENTED."
-  (unsupported-operation "Not yet implemented"))
+(define-repl-fn saturate-partial-example
+  "Saturates the given partial counterexample."
+  (let [old-pos   (set (:positives state)),
+        old-neg   (set (:negatives state)),
+        [pos neg] (saturate-partial-example (:knowledge state)
+                                            old-pos
+                                            old-neg)]
+    (-> state
+        (assoc :positives pos)
+        (assoc :negatives neg))))

 (defn- valid-counterexample?
   "Checks the given example for being valid."


Fix function for checking environment

Fix function for checking environment

--- src/servisne_info/utils.clj
+++ src/servisne_info/utils.clj
@@ -2,4 +2,4 @@
   (:require [environ.core :refer [env]]))

 (defn production? []
-  (== (env :app-environment) "production")
+  (== (env :app-environment) "production"))


cope with non-numbers in numeric indices

--- src/sledge/db.clj
+++ src/sledge/db.clj
@@ -57,7 +57,9 @@
    ;; do anything useful with "like".
    :year {:empty-map (sorted-map)
           :tokenize-tags #(if-let [y (:year %)]
-                            (vector (Integer/parseInt y))
+                            (try [(Integer/parseInt y)]
+                                 (catch NumberFormatException e
+                                   []))
                             [])
           :tokenize-query #(vector (Integer/parseInt %))}
    })


Added multimethod for next-game.

Added multimethod for next-game.

--- src/tfe/core.cljs
+++ src/tfe/core.cljs
@@ -62,7 +62,9 @@
 (defn next-state [board]
   :playing)

-(defn next-game [direction game]
+(defmulti next-game (fn [d g] (:state g)))
+
+(defmethod next-game :playing [direction game]
   (let [board (:board game)
         state (:state game)]
     (assoc game


Remove self-reference

Remove self-reference

--- src/tick/core.clj
+++ src/tick/core.clj
@@ -4,8 +4,7 @@
   (:refer-clojure :exclude [+ - inc dec max min range time int long < >])
   (:require
    [clojure.spec.alpha :as s]
-   [clojure.string :as str]
-   [tick.core :as core])
+   [clojure.string :as str])
   (:import
    [java.util Date]
    [java.time Clock ZoneId ZoneOffset Instant Duration DayOfWeek Month ZonedDateTime LocalTime LocalDateTime LocalDate Year YearMonth ZoneId OffsetDateTime]


Refactoring

Refactoring

--- src/tree/core.clj
+++ src/tree/core.clj
@@ -3,26 +3,30 @@

 (def b 3)

+(defprotocol IKeyCompare
+  (compare [key1 key2]))
+
+;; TODO merge w/ IInsert?
 (defprotocol INodeLookup
   (lookup [node key] "Returns the child node which contains the given key"))

-(defprotocol IKeyCompare
-  (compare [key1 key2]))
-
+;;TODO rename to something other than IInsert
 (defprotocol IInsert
   (insert [node index new-child]
           [node index new-child1 median new-child2]
-          "Returns one or 2 new nodes, if it had to split"
-          ))
-
-(extend-protocol IKeyCompare
-  Object
-  (compare [key1 key2] (clojure.core/compare key1 key2)))
+          "Returns one or 2 new nodes, if it had to split")
+  (underflow [node parent] "returns the ") ;;TODO
+  )

 (defprotocol IResolve
   "This is how we store the children. The indirection enables background
    fetch and decode of the resource."
   (resolve [this]))
+
+(extend-protocol IKeyCompare
+  ;; By default, we use the default comparator
+  Object
+  (compare [key1 key2] (clojure.core/compare key1 key2)))

 (defn scan-children-array
   "This function takes an array of keys. There must be an odd # of elts in it.
@@ -49,6 +53,28 @@
 ;; TODO we should be able to find all uncommited data by searching for
 ;; resolved & unresolved children

+(defn handle-multi-insert
+  [factory {:keys [keys children] :as node} index new-child1 median new-child2]
+  (let [new-children (vec (concat (take index children)
+                                  [new-child1 new-child2]
+                                  (drop (inc index) children)))
+        ;;TODO find a better datastructure than vector
+        ;;use the vector with lg time split/merge
+        new-keys (vec (concat (take index keys)
+                              [median]
+                              (drop index keys)))]
+    (if (>= (count new-children) (* 2 b))
+      (let [split-med (nth new-keys (dec b))
+            ;; One day, this hardcoded ->IndexNode will cause pain
+            left-index (->IndexNode (vec (take (dec b) new-keys))
+                                    (vec (take b new-children)))
+            right-index (->IndexNode (vec (drop b new-keys))
+                                     (vec (drop b new-children)))
+            median (nth new-keys (dec b))]
+        [left-index median right-index])
+      [(factory new-keys
+                new-children)])))
+
 (defrecord IndexNode [keys children]
   IResolve
   (resolve [this] this) ;;TODO this is a hack for testing
@@ -58,24 +84,7 @@
     (let [new-children (assoc children index new-child)]
       [(->IndexNode keys new-children)]))
   (insert [node index new-child1 median new-child2]
-    (let [new-children (vec (concat (take index children)
-                                    [new-child1 new-child2]
-                                    (drop (inc index) children)))
-          ;;TODO find a better datastructure than vector
-          ;;use the vector with lg time split/merge
-          new-keys (vec (concat (take index keys)
-                                [median]
-                                (drop index keys)))]
-      (if (>= (count new-children) (* 2 b))
-        (let [split-med (nth new-keys (dec b))
-              left-index (->IndexNode (vec (take (dec b) new-keys))
-                                      (vec (take b new-children)))
-              right-index (->IndexNode (vec (drop b new-keys))
-                                       (vec (drop b new-children)))
-              median (nth new-keys (dec b))]
-          [left-index median right-index])
-        [(->IndexNode new-keys
-                      new-children)])))
+    (handle-multi-insert ->IndexNode node index new-child1 median new-child2))
   INodeLookup
   (lookup [root key]
     (scan-children-array keys key)))
@@ -87,26 +96,7 @@
     (let [new-children (assoc children index new-child)]
       [(->RootNode keys new-children)]))
   (insert [node index new-child1 median new-child2]
-    ;(println "root recieving split children")
-    (let [new-children (vec (concat (take index children)
-                                    [new-child1 new-child2]
-                                    (drop (inc index) children)))
-          ;;TODO find a better datastructure than vector
-          ;;use the vector with lg time split/merge
-          new-keys (vec (concat (take index keys)
-                                [median]
-                                (drop index keys)))]
-      ;(println "new keys:" new-keys)
-      (if (>= (count new-children) (* 2 b))
-        (let [split-med (nth new-keys (dec b))
-              left-index (->IndexNode (vec (take (dec b) new-keys))
-                                      (vec (take b new-children)))
-              right-index (->IndexNode (vec (drop b new-keys))
-                                       (vec (drop b new-children)))
-              median (nth new-keys (dec b))]
-          [left-index median right-index])
-        [(->RootNode new-keys
-                     new-children)])))
+    (handle-multi-insert ->RootNode node index new-child1 median new-child2))
   INodeLookup
   (lookup [root key]
     (scan-children-array keys key)))
@@ -264,6 +254,7 @@
         ;(println "path is" path)
         (let [insert-index (first path)
               insert-node (fnext path)
+              ;;TODO this apply should be direct dispatch b/c this is slow
               insert-result (apply insert insert-node insert-index new-elts)]
           ;(println "insert result was" insert-result)
           (if (= 2 (count path)) ; we've only got the root node
@@ -275,6 +266,11 @@
       ;; Special case for insert into empty tree, since we can't compute paths yet
       (->RootNode [] [(->DataNode [new-key])]))))

+(defn delete-key
+  [tree key]
+  (let [path (lookup-path tree key)])
+  )
+
 (defn empty-b-tree
   []
   (->RootNode [] [(->DataNode [])]))


Add `deps-cmd` to compielr options (#750)

As listed in the clojurescript ref:

https://clojurescript.org/reference/compiler-options#deps-cmd

--- sidecar/src/figwheel_sidecar/schemas/cljs_options.clj
+++ sidecar/src/figwheel_sidecar/schemas/cljs_options.clj
@@ -169,6 +169,16 @@
 code in nodejs.

   :target :nodejs")
+
+(def-key ::deps-cmd
+
+  "Set the command to install node_modules.
+
+Only \"npm\" and \"yarn\" supported.
+
+  :deps-cmd \"yarn\"")
+
+

 (def-key ::infer-externs boolean?
   "Experimental externs inference.
@@ -1116,6 +1126,7 @@
      ::verbose
      ::pretty-print
      ::target
+     ::deps-cmd
      ::infer-externs
      ::foreign-libs
      ::externs


do not normalize scores yet

do not normalize scores yet

--- src/crawler/rich_char_extractor.clj
+++ src/crawler/rich_char_extractor.clj
@@ -41,13 +41,12 @@
            xpath-nav-info       (map
                                  (fn [[xpath info]]
                                    {:xpath xpath
-                                    :score (double
-                                            (/ (reduce
-                                                (fn [acc an-info]
-                                                  (+ acc (:num-chars an-info)))
-                                                0
-                                                info)
-                                               page-wide-nav-chars))
+                                    :score (reduce
+                                            (fn [acc an-info]
+                                              (+ acc (:num-chars an-info)))
+                                            0
+                                            info)
+
                                     :hrefs (reduce
                                             (fn [acc an-info]
                                               (cons (:href an-info) acc))


Reformatted core.clj by zprint

Reformatted core.clj by zprint

--- src/zg/core.clj
+++ src/zg/core.clj
@@ -11,7 +11,7 @@
 ;

 (ns zg.core
-    "Core module that contains -main function called by Leiningen to start the application.")
+  "Core module that contains -main function called by Leiningen to start the application.")

 (require '[ring.adapter.jetty      :as jetty])
 (require '[ring.middleware.params  :as http-params])
@@ -25,54 +25,58 @@
 (require '[zg.middleware           :as middleware])

 (def default-port
-    "Default port on which zg accepts all HTTP requests."
-    "3000")
+  "Default port on which zg accepts all HTTP requests."
+  "3000")

 (def cli-options
-    "Definitions of all command line options that are  currenty supported."
-    ;; an option with a required argument
-    [["-p" "--port   PORT"    "port number"   :id :port]])
+  "Definitions of all command line options that are  currenty supported."
+  ;; an option with a required argument
+  [["-p" "--port   PORT" "port number" :id :port]])

 ; we need to load the configuration in advance so the 'app' could use it
 (def configuration (config/load-configuration "zg.ini"))

 (def app
-    "Definition of a Ring-based application behaviour."
-    (-> server/handler            ; handle all events
-        (middleware/inject-configuration configuration) ; inject configuration structure into the parameter
-        cookies/wrap-cookies      ; we need to work with cookies
-        http-params/wrap-params)) ; and to process request parameters, of course
+  "Definition of a Ring-based application behaviour."
+  (-> server/handler            ; handle all events
+      (middleware/inject-configuration configuration) ; inject configuration
+                                                      ; structure into the
+                                                      ; parameter
+      cookies/wrap-cookies      ; we need to work with cookies
+      http-params/wrap-params)) ; and to process request parameters, of course

 (defn start-server
-    "Start the HTTP server on the specified port."
-    [port]
-    (log/info "Starting the server at the port: " port)
-    (jetty/run-jetty app {:port (read-string port)}))
+  "Start the HTTP server on the specified port."
+  [port]
+  (log/info "Starting the server at the port: " port)
+  (jetty/run-jetty app {:port (read-string port)}))

 (defn get-and-check-port
-    "Accepts port number represented by string and throws AssertionError
+  "Accepts port number represented by string and throws AssertionError
      if port number is outside defined range."
-    [port]
-    (let [port-number (. Integer parseInt port)]
-        (assert (> port-number 0))
-        (assert (< port-number 65536))
-        port))
+  [port]
+  (let [port-number (. Integer parseInt port)]
+    (assert (> port-number 0))
+    (assert (< port-number 65536))
+    port))

 (defn get-port
-    "Returns specified port or default port if none is specified on the command line."
-    [specified-port]
-    (if (or (not specified-port) (not (string? specified-port)) (empty? specified-port))
-        default-port
-        (get-and-check-port specified-port)))
+  "Returns specified port or default port if none is specified on the command line."
+  [specified-port]
+  (if (or (not specified-port)
+          (not (string? specified-port))
+          (empty? specified-port))
+    default-port
+    (get-and-check-port specified-port)))

 (defn -main
-    "Entry point to the zg server."
-    [& args]
-    (let [all-options      (cli/parse-opts args cli-options)
-          options          (all-options :options)
-          port             (options :port)]
-          (config/print-configuration configuration)
-          (start-server    (get-port port))))
+  "Entry point to the zg server."
+  [& args]
+  (let [all-options      (cli/parse-opts args cli-options)
+        options          (all-options :options)
+        port             (options :port)]
+    (config/print-configuration configuration)
+    (start-server (get-port port))))

 ; finito


erm almost plays well

erm almost plays well

--- src/tenbytenbot/tactics.clj
+++ src/tenbytenbot/tactics.clj
@@ -6,17 +6,38 @@

+(defn compute-valid-positions-for-piece [board piece]
+  "returns the sequence of positions a piece can occupy on the given board"
+  (let [[bw bh] (:dims board)
+        [pw ph] (:dims piece)]
+    (filter
+      (fn [pos] (not (m/collides-with board piece pos)))
+      (for [x (range (inc (- bw pw)))
+            y (range (inc (- bh ph)))]
+        [x y]))))
+
+
+(defn compute-valid-moves [board slotnums]
+  "returns a sequence valid moves with keys for :slot-index and :pos"
+  (apply concat
+    (map
+      (fn [[index slotnum]]
+        (let [piece (get p/pieces slotnum)
+              positions (compute-valid-positions-for-piece board piece)]
+          (map
+            (fn [pos] {:slot-index index :pos pos})
+            positions)))
+      (filter
+        (fn [[index slotnum]] slotnum)
+        (map vector (iterate inc 0) slotnums)))))
+
+
+;(compute-valid-moves (m/mcreate [5 5]) [3 nil 6])
+
+
 (defn play [board slot-nums step]
-  "elects a move to perform"
-  (let [slots (vec (map (fn [num] (get p/pieces num)) slot-nums))]
-
-    (let [pos [(* step 3) 0]
-          slot-index step
-          slot (get slots slot-index)]
-
-      { :slot slot
-        :slot-index slot-index
-        :pos pos})))
+  (let [valid-moves (compute-valid-moves board slot-nums)]
+    (rand-nth valid-moves)))

@@ -38,18 +59,19 @@
         (println))

       (let [move (play board (:slots state) (:step state))
+            piece (get p/pieces (get (:slots state) (:slot-index move)))
             [x y] (:pos move)]

         (when verbose
           (println (str "About to play slot #" (:slot-index move) " on pos " x ", " y ))

-          (when (:slot move)
+          (when piece
             (println)
-            (m/mprint (:slot move))
+            (m/mprint piece)
             (println)))

         (let [new-board (try
-                          (m/glue board (:slot move) (:pos move))
+                          (m/glue board piece (:pos move))
                           (catch Exception ex
                             ;(println ex)
                             (println "invalid move!")


Correct flat-trajector; add interwell distance

--- src/test_utils/sandbox.cljs
+++ src/test_utils/sandbox.cljs
@@ -81,11 +81,11 @@
 (defn flat-trajectory [md x y z plot-angle]
   (let [next-fn (fn [[md0 x0 y0 z0]]
                   (let [step (typical-trajectory-md-length)
-                        step-angle (tuc/draw-normal plot-angle (/ plot-angle 10))]
+                        step-angle (tuc/draw-normal plot-angle 14)]
                     [(+ md0 step)
                      (+ x0 (* step (Math/cos (* (/ step-angle 180) Math.PI))))
                      (+ y0 (* step (Math/sin (* (/ step-angle 180) Math.PI))))
-                     (tuc/draw-normal z (/ z 10))]))]
+                     (tuc/draw-normal z 4)]))]
     (iterate next-fn [md x y z])))

 (defn typical-treatment-times []
@@ -100,7 +100,6 @@
       (rem (+ minute-0 duration-minute) 60)
       duration-seconds]]))

-
 (defn typical-stage-separation []
   (tuc/draw-normal 45 3))

@@ -112,3 +111,30 @@
                      [top bottom]))]
     (iterate next-fn extent-0)))

+;;; mean-traj-delta-x 824.6082 std-traj-delta-x 22.9065
+;;; mean-traj-delta-y 1048.7   std-traj-delta-y 0.6520
+;;; mean-traj-delta-z 1101.3   std-traj-delta-z 0.4614
+
+;;; mean-traj-delta-x std-traj-delta-x
+;;;  73.4429           11.4000
+;;; 226.1058            6.4168
+;;; 153.4668            6.3606
+;;; 150.1713            8.0515
+
+;;; mean-traj-delta-y std-traj-delta-y
+;;; 139.0710          11.8006
+;;;  16.4374           7.9442
+;;; 311.8567          10.0601
+;;;  61.0152          3.8705
+
+;;; mean-traj-delta-z std-traj-delta-z
+;;; 110.1814           1.9290
+;;; 122.2491           3.7357
+;;; 111.6584           4.4176
+;;; 120.4373           3.5104
+
+(defn typical-interwell-distance [plot-angle]
+  (let [euclidean-distance (tuc/draw-normal 874 37)
+        x-distance (* euclidean-distance (Math/cos (* (/ (+ plot-angle 90) 180) Math.PI)))
+        y-distance (* euclidean-distance (Math/sin (* (/ (+ plot-angle 90) 180) Math.PI)))]
+    [x-distance y-distance]))


Story ID: RPC-212 First crack at implementing has-attribute-value

--- src/untangled/test/dom.cljs
+++ src/untangled/test/dom.cljs
@@ -101,6 +101,19 @@
     (t/do-report {:type     :error :message (str "Could not find element " search-kind " " search-param)
                   :expected "DOM element" :actual "Nil"})))

+(defn has-attribute-value [attr attr-value search-kind search-param dom]
+  "Doc string"
+  (if-let [ele (find-element search-kind search-param dom)]
+    (if (= (get-attribute ele attr) attr-value)
+      (t/do-report {:type :pass})
+      (t/do-report {:type :fail :actual (get-attribute ele attr) :expected attr-value})
+      )
+    (t/do-report {:type     :error :message (str "Could not find element " search-kind " " search-param)
+                  :expected "DOM element" :actual "Nil"})))
+
+(defn has-class []
+
+  )

 (defn has-selected-option [search-type search-value dom-with-select selected-value]
   (if-let [ele (find-element search-type search-value dom-with-select)]


Refactor inline styles to classes

Refactor inline styles to classes

Move existing CSS styles to app-db namespace

--- src/day8/re_frame/trace/styles.cljs
+++ src/day8/re_frame/trace/styles.cljs
@@ -391,7 +391,7 @@
    ])

-(def panel-styles (apply garden/css [css-reset (into [:#--re-frame-trace--] rc/re-com-css) common/blue-modern re-frame-trace-styles app-db/app-db-styles]))
+(def panel-styles (apply garden/css [css-reset [:#--re-frame-trace-- rc/re-com-css] common/blue-modern re-frame-trace-styles app-db/app-db-styles]))
 ;(def panel-styles (macros/slurp-macro "day8/re_frame/trace/main.css"))


add missing declaration

add missing declaration

--- src/edu/berkeley/ai/util/macros.clj
+++ src/edu/berkeley/ai/util/macros.clj
@@ -42,6 +42,7 @@
      `(let [r# (cond-list ~@args)]
 	(if ~pred (cons ~elt r#) r#))))

+(declare distinct-elts? position)
 (defmacro parse-optional-argmap
   "Takes a map and set of bindings.  Each (required unique) var in bindings
    is bound to the corresponding keyword mapping in m, or to the result of the


CMR-6138: Fixed cache api test.

CMR-6138: Fixed cache api test.

--- system-int-test/test/cmr/system_int_test/admin/cache_api_test.clj
+++ system-int-test/test/cmr/system_int_test/admin/cache_api_test.clj
@@ -262,9 +262,9 @@
         (url/indexer-read-caches-url)
         "indexer-index-set-cache"
         "concept-mapping-types"
-        {:collection "collection"
-         :granule "granule"
-         :tag "tag"
-         :variable "variable"
-         :service "service"
-         :subscription "subscription"}))))
+        {:collection "properties"
+         :granule "properties"
+         :tag "properties"
+         :variable "properties"
+         :service "properties"
+         :subscription "properties"}))))


Move colorpalette to the parent dom node.

--- src/uxbox/ui/workspace.cljs
+++ src/uxbox/ui/workspace.cljs
@@ -44,21 +44,17 @@
     (html
      [:div
       (header)
+      (colorpalette)
       [:main.main-content

-       [:section.workspace-content {:class classes
-                                    :on-scroll on-scroll}
+       [:section.workspace-content {:class classes :on-scroll on-scroll}
         ;; Rules
         (horizontal-rule)
         (vertical-rule)

-        #_(coordinates)
-
         ;; Canvas
         [:section.workspace-canvas {:ref "workspace-canvas"}
          (viewport)]]
-
-       (colorpalette)

        ;; Aside
        (when left-sidebar?


Added find-or-create to make it easier to open or create a pail. Changed create to take a PailSpec or PailStructure. Added write-objects to make it easy to write a list of objects.

--- src/main/clojure/clj_pail/core.clj
+++ src/main/clojure/clj_pail/core.clj
@@ -17,13 +17,28 @@

 (defn ^Pail create
-  "Creates a Pail from a PailSpec at `path`."
-  [^PailSpec spec path & {:keys [filesystem fail-on-exists]
-                          :or {fail-on-exists true}}]
-  (if filesystem
-    (Pail/create filesystem path spec fail-on-exists)
-    (Pail/create path spec fail-on-exists)))
+   "Creates a Pail from a PailSpec at `path`."
+   [spec-or-structure path & {:keys [filesystem fail-on-exists]
+                              :or {fail-on-exists true}
+                              :as opts}]
+   (if (instance? PailStructure spec-or-structure)
+     (apply create (spec spec-or-structure) path (mapcat identity opts))
+     (if filesystem
+       (Pail/create filesystem path spec-or-structure fail-on-exists)
+       (Pail/create path spec-or-structure fail-on-exists))))

+(defn find-or-create [pstruct path & {:as create-key-args}]
+  "Get a pail from a path, or create one if not found"
+  (try (pail path)
+       (catch Exception e
+          (apply create pstruct path (mapcat identity create-key-args)))))
+
+(defn write-objects
+  "Writes a list of objects to a Pail."
+  [pail objects]
+  (with-open [writer (.openWrite pail)]
+    (doseq [o objects]
+      (.writeObject writer o))))

 (defn object-seq
   "Returns a sequence of objects read from the Pail."


example edits

example edits

--- src/main/clojure/dojo/examples.clj
+++ src/main/clojure/dojo/examples.clj
@@ -1,11 +1,11 @@
 (ns dojo.examples
   (:use clojure.core.matrix))

-;; construct a 1D array (i.e. a vector)
-(array [1 2])
+;; a 1D array (i.e. a vector)
+[1 2]

-;; construct a 2D array (i.e. a matrix)
-(array [[1 2] [3 4]])
+;; a 2D array (i.e. a matrix)
+[[1 2] [3 4]]

 ;; add two arrays
 (add [1 2] [3 4])
@@ -16,6 +16,8 @@
 ;; matrix transposition
 (transpose [[1 2] [3 4]])

+;; map a function over an array
+(emap inc [[1 2] [3 4]])

 ;; Use a specific matrix implementation: in this case vectorz-clj


void:vocabulary

void:vocabulary

--- src/grafter/rdf/ontologies/void.clj
+++ src/grafter/rdf/ontologies/void.clj
@@ -8,3 +8,4 @@
 (def void:dataDump (void "dataDump"))
 (def void:sparqlEndpoint (void "sparqlEndpoint"))
 (def void:triples (void "triples"))
+(def void:vocabulary (void "vocabulary"))


No longer need to :query-root most things

With Compassus' new `{:route-dispatch false}` option, page queries are
no longer nested under the route name, so we don't need `:query-root` to
raise the queries to the root.

--- src-cljs/frontend/parser.cljs
+++ src-cljs/frontend/parser.cljs
@@ -37,19 +37,6 @@
   [{:keys [state query] :as env} key params]
   (let [st @state]
     (om-next/db->tree query (get st key) st)))
-
-;; Most keys pass their queries on to the remote. We add :query-root true so
-;; that the key will be sent to the remote as one of the root keys in the
-;; query (using om-next/process-roots).
-;;
-;; This matters because our parser sits inside Compassus. The query that goes to
-;; the send function will have a single root key, which will be the route key,
-;; and the route component's remote query will be joined on that key. The send
-;; function will then use om-next/process-roots to raise the :query-roots to the
-;; root, so it can ignore UI concerns.
-(defmethod read-remote :default
-  [{:keys [ast] :as env} key params]
-  (assoc ast :query-root true))

 (def


Добработки

Добработки

--- src-cljs/ixinfestor/omut.cljs
+++ src-cljs/ixinfestor/omut.cljs
@@ -805,14 +805,17 @@
                           :has-warning?
                           :has-error?))))

+(defn input-css-string-has?-clean-and-set! [app k]
+  (-> app
+      (dissoc :has-success?
+              :has-warning?
+              :has-error?)
+      (assoc k true)))
+
 (defn input-css-string-has?-clean-and-set!! [app k]
   (om/transact! app
                 (fn [app]
-                  (-> app
-                      (dissoc :has-success?
-                              :has-warning?
-                              :has-error?)
-                      (assoc k true)))))
+                  (input-css-string-has?-clean-and-set! app k))))

 ;; END has
 ;;..................................................................................................
@@ -939,6 +942,9 @@

 (def no-select-v "NO-SELECT")

+(defn select-app-list [app]
+  (app :list))
+
 (defn select-app-list-set! [app new-list]
   (assoc app :list new-list))

@@ -947,13 +953,17 @@

 (defn select-app-selected-set-nil! [app]
   (assoc app :selected no-select-v))
-

 (defn select-app-selected [app]
   (let [sv (app :selected)]
     (if (or (nil? sv)
             (empty? sv)
             (= sv no-select-v)) nil sv)))
+
+
+(defn select-app-selected-int-or-nil [app]
+  (when-let [v (select-app-selected app)]
+    (js/parseInt v)))

 (defn select [app _ {:keys [first-item-text


Fix buggy blending boxes

Fix buggy blending boxes

--- app/pyrexia/src/pyrexia/core.cljs
+++ app/pyrexia/src/pyrexia/core.cljs
@@ -51,47 +51,43 @@
         weightTotal (apply + weights)
         weightedValues (map #(/ (:value %) (+ 1 (:distance %))) values)
         weightedSum (apply + weightedValues)]
-    ;(.log js/console "wa" weightedSum weightTotal (/ weightedSum weightTotal))
     (/ weightedSum weightTotal)))

 (defn alpha-blend [values]
   (let [distances (map :distance values)
-        maxDistance (apply max distances)
-        fudgeFactor 700.0]
-    ;(.log js/console "ab" maxDistance)
-    (min 1.0 (/ 1.0 (/ maxDistance fudgeFactor)))))
+        minDistance (apply min distances)
+        fudgeFactor 100.0]
+    (min 1.0 (/ 1.0 (/ minDistance fudgeFactor)))))

-(defn temp-for-locations [boxWidth boxHeight]
+(defn temp-for-locations []
   (let [locations (:locations @app-state)
         nodes (:nodes @app-state)]
-    (.log js/console "tl-beg" (keys locations) (keys nodes) (keys @app-state))
     (for [node (keys locations)
           :when (contains (keys nodes) node)
           :let [location (get locations node)
                 data (get nodes node)]]
-      (do
-        (.log js/console "tl" location data)
-        {:location location :temp (:temp data)}))))
+      {:location location :temp (:temp data)})))

 (defn rangeValues [node x y]
-  {:value (:temp node) :distance (Math/sqrt (+
-                                             (Math/pow (- (-> node :location first) x) 2.0)
-                                             (Math/pow (- (-> node :location second) y) 2.0)))})
+  {:value (:temp node)
+   :distance (Math/sqrt (+
+                         (Math/pow (- (-> node :location first) x) 2.0)
+                         (Math/pow (- (-> node :location second) y) 2.0)))})

 (defn draw-map [canvas mapImage]
   (let [context (.getContext canvas "2d")
-        gridSize 40
+        gridSize 20
         imageWidth (.-width mapImage)
         imageHeight (.-height mapImage)
-        boxWidth (/ (.-width canvas) gridSize)
-        boxHeight (/ (.-height canvas) gridSize)
+        boxWidth (/ imageWidth gridSize)
+        boxHeight (/ imageHeight gridSize)
         values (-> (:nodes @app-state) vals)
-        temp (-> (temp-for-locations boxWidth boxHeight) seq)
+        temp (seq (temp-for-locations))
         grid (apply merge
                     (for
                      [x (range 0 gridSize)
                       y (range 0 gridSize)
-                      :let [rangeVals (map #(rangeValues % (* (+ .5 x) imageWidth) (* (+ .5 y) imageHeight)) temp)]]
+                      :let [rangeVals (map #(rangeValues % (* (+ .5 x) boxWidth) (* (+ .5 y) boxHeight)) temp)]]
                       {[x y] {:average (weighted-average rangeVals)
                               :blend (alpha-blend rangeVals)}}))
         minTemp (apply min (vals grid))
@@ -100,15 +96,22 @@
     (set! (.-height canvas) imageHeight)
     (.log js/console "image" imageWidth imageHeight)
     (.drawImage context mapImage 0 0)
-    (doall (for [key (keys grid)
-                 :let [value (get grid key)
-                       x (first key)
-                       y (second key)]]
-             (do
-               ;(.log js/console "grid" (first key) (second key) (:blend value))
-               (set! (.-fillStyle context) "#ff0000")
-               (set! (.-globalAlpha context) (:blend value))
-               (.fillRect context (* x boxWidth) (* y boxHeight) boxWidth boxHeight))))))
+
+    (doall
+     (for [key (keys grid)
+           :let [value (get grid key)
+                 x (first key)
+                 y (second key)]]
+       (do
+         (set! (.-fillStyle context) "#ff0000")
+         (set! (.-globalAlpha context) (:blend value))
+         (.fillRect context (* x boxWidth) (* y boxHeight) boxWidth boxHeight))))
+
+    (set! (.-fillStyle context) "#000000")
+    (set! (.-globalAlpha context) 1.0)
+    (doall
+     (for [[x y] (-> @app-state :locations vals)]
+       (.fillRect context x y boxWidth boxHeight)))))

 (def canvas-dom (.getElementById js/document "map"))

@@ -142,12 +145,14 @@
   (reify
     om/IRender
     (render [this]
-      (dom/li #js {:onMouseOver (fn [e]
-                                  (classes/add (.-target e) "foo")
-                                  (.stopPropagation e))
-                   :onMouseOut (fn [e]
-                                 (classes/remove (.-target e) "foo")
-                                 (.stopPropagation e))}
+      (dom/li #js {:onMouseOver
+                   (fn [e]
+                     (classes/add (.-target e) "foo")
+                     (.stopPropagation e))
+                   :onMouseOut
+                   (fn [e]
+                     (classes/remove (.-target e) "foo")
+                     (.stopPropagation e))}
               (first sensor)
               (apply dom/ul nil
                      (map


Improved word importer: add-words-message, split-words, process-add-words etc.

--- src/zg/server.clj
+++ src/zg/server.clj
@@ -25,7 +25,7 @@
         user-name))

 (defn finish-processing
-    [request search-results]
+    [request search-results message]
     (let [params        (:params request)
           cookies       (:cookies request)
           word          (get params "word")
@@ -34,10 +34,10 @@
         (println word)
         (println search-results)
         (if user-name
-            (-> (http-response/response (html-renderer/render-front-page word user-name search-results))
+            (-> (http-response/response (html-renderer/render-front-page word user-name search-results message))
                 (http-response/set-cookie :user-name user-name {:max-age 36000000})
                 (http-response/content-type "text/html"))
-            (-> (http-response/response (html-renderer/render-front-page word user-name search-results))
+            (-> (http-response/response (html-renderer/render-front-page word user-name search-results message))
                 (http-response/content-type "text/html")))))

 (defn process-front-page
@@ -45,7 +45,7 @@
     (let [params         (:params request)
           word           (get params "word")
           search-results (if (not (empty? word)) (db-interface/read-words-for-pattern word))]
-        (finish-processing request search-results)))
+        (finish-processing request search-results nil)))

 (defn store-words
     [words user-name]
@@ -53,14 +53,27 @@
     (doseq [word words]
         (db-interface/add-new-word-into-dictionary word user-name)))

+(defn add-words-message
+    [words]
+    (if (seq words)
+        (str "The following words have been added into the dictionary: '" (clojure.string/join "," words) "'. Thank you!")
+        "No words have been added..."))
+
+(defn split-words
+    [input]
+    (if input
+        (->> (clojure.string/split input #"[\s,]")
+             (filter seq))))
+
 (defn process-add-words
     [request]
-    (let [input (-> (:params request) (get "new-words"))
-          words (if input (clojure.string/split input #"[\s,]"))
-          user-name (get-user-name request)]
-          (if words
+    (let [input     (-> (:params request) (get "new-words"))
+          words     (split-words input)
+          user-name (get-user-name request)
+          message   (add-words-message words)]
+          (if (seq words)
               (store-words words user-name))
-        (finish-processing request nil)))
+        (finish-processing request nil message)))

 (defn perform-operation
     [request]
@@ -77,19 +90,19 @@
     [request]
     (perform-operation request)
     (let [search-results (db-interface/read-all-words)]
-        (finish-processing request search-results)))
+        (finish-processing request search-results nil)))

 (defn process-deleted-words
     [request]
     (perform-operation request)
     (let [search-results (db-interface/read-deleted-words)]
-        (finish-processing request search-results)))
+        (finish-processing request search-results nil)))

 (defn process-active-words
     [request]
     (perform-operation request)
     (let [search-results (db-interface/read-active-words)]
-        (finish-processing request search-results)))
+        (finish-processing request search-results nil)))

 (defn read-changes-statistic
     []


CLJS-1405: type resolution needs to handle modifiers like leading !, trailing =, object syntax

punting on function & record syntax for now

--- src/main/clojure/cljs/compiler.cljc
+++ src/main/clojure/cljs/compiler.cljc
@@ -475,8 +475,38 @@
     (emits "(function(){throw " throw "})()")
     (emitln "throw " throw ";")))

-(defn resolve-type [env t]
-  (str (:name (ana/resolve-var env (symbol t)))))
+(def base-types
+  #{"boolean" "Boolean"
+    "string" "String"
+    "number" "Number"
+    "array" "Array"
+    "object" "Object"
+    "RegExp"
+    "Date"})
+
+(defn resolve-type [env ^String t]
+  (cond
+    (get base-types t) t
+
+    #?(:clj  (.startsWith t "!")
+       :cljs (gstring/startsWith t "!")) t
+
+    #?(:clj  (.startsWith t "{")
+       :cljs (gstring/startsWith t "{")) t
+
+    #?(:clj  (.startsWith t "function")
+       :cljs (gstring/startsWith t "function")) t
+
+    :else
+    (let [optional? #?(:clj  (.endsWith t "=")
+                       :cljs (gstring/endsWith t "="))
+          t         (if optional?
+                      (subs t 0 (dec (count t)))
+                      t)
+          ret       (str (:name (ana/resolve-var env (symbol t))))]
+      (if optional?
+        (str ret "=")
+        ret))))

 (defn resolve-types [env ts]
   (let [ts (-> ts string/trim (subs 1 (dec (count ts))))


Whitespace fixes.

Whitespace fixes.

--- src/leiningen/appengine_prepare.clj
+++ src/leiningen/appengine_prepare.clj
@@ -10,7 +10,7 @@
   (:import java.io.File))

 (defn- copy-to-dir [file dir]
-  (let [dir (if (isa? (type dir) File) dir (File. dir))
+  (let [dir (if (isa? (type dir) File) dir (File. dir))
         file-path (if (isa? (type file) File) (.getPath file) file)
         dest-file (File. dir (fs/base-name file))]
     (println "Copying" file-path "to" (.getPath dir))
@@ -41,8 +41,7 @@
                         :keep-non-project-classes true
                         :aot [(symbol (format "%s.%s"
                                               (_dash prj-application)
-                                              prj-servlet))]))
-          ]
+                                              prj-servlet))]))]
         ;; Leiningen will throw an exception if compile has failed
         (leiningen.compile/compile project)
         ;; delete existing content of target lib/
@@ -52,11 +51,10 @@
         ;; make a jar of the compiled app, and put it in WEB-INF/lib
         (let [{jar-file [:extension "jar"]} (leiningen.jar/jar (merge project
                                   {:omit-source true
-                                  :jar-exclusions [#"^WEB-INF/appengine-generated.*$"]}))
-              ]
+                                   :jar-exclusions [#"^WEB-INF/appengine-generated.*$"]}))]
           (copy-to-dir jar-file target-lib-dir))
         ;; copy important dependencies into WEB-INF/lib
-        (doseq [dep dependencies]
+        (doseq [dep dependencies]
           (copy-to-dir dep target-lib-dir))
       )


Correct building of prefix

Correct building of prefix

--- src/leiningen/new/cljskel/setup.clj
+++ src/leiningen/new/cljskel/setup.clj
@@ -1,9 +1,10 @@
 (ns {{name}}.setup
-  (:require [{{name}}.web :as web]
-            [environ.core :refer [env]]
-            [mixradio.instrumented-jetty :refer [run-jetty]]
-            [radix.setup :as setup])
-  (:gen-class))
+    (:require [{{name}}.web :as web]
+              [clojure.string :as str]
+              [environ.core :refer [env]]
+              [mixradio.instrumented-jetty :refer [run-jetty]]
+              [radix.setup :as setup])
+    (:gen-class))

 (defonce server
   (atom nil))
@@ -27,7 +28,7 @@
 (defn start
   []
   (setup/configure-logging)
-  (setup/start-graphite-reporting {:graphite-prefix (str (env :environment-name) (env :service-name) (env :box-id setup/hostname))})
+  (setup/start-graphite-reporting {:graphite-prefix (str/join "." [(env :environment-name) (env :service-name) (env :box-id setup/hostname)])})
   (reset! server (start-server)))

 (defn stop


Turn http-session into a protocol

Turn http-session into a protocol

--- web/src/immutant/web/servlet.clj
+++ web/src/immutant/web/servlet.clj
@@ -132,27 +132,33 @@
     .getUserProperties
     (get "HandshakeRequest")))

+(defprotocol ServletSession
+  "Obtain an instance of `javax.servlet.HttpSession`, typically from a
+  Ring request or a websocket channel, i.e. `javax.websocket.Session`"
+  (^HttpSession http-session [v]))
+
+(extend-protocol ServletSession
+  java.util.Map
+  (http-session [request]
+    (if-let [^HttpServletRequest hsr (:servlet-request request)]
+      (.getSession hsr)))
+  javax.websocket.Session
+  (http-session [channel]
+    (.getHttpSession (handshake-request channel))))
+
 (defn ring-session
   "Returns the Ring session data from the HttpSession associated with
   the websocket session"
   [^javax.websocket.Session channel]
-  (some-> (handshake-request channel)
-    .getHttpSession
+  (some-> (http-session channel)
     immutant.web.internal.servlet/ring-session))

 (defn reset-ring-session!
   "Resets the Ring session data in the HttpSession associated with the
   websocket session"
   [^javax.websocket.Session channel, data]
-  (-> (handshake-request channel)
-    .getHttpSession
+  (-> (http-session channel)
     (immutant.web.internal.servlet/set-ring-session! data)))
-
-(defn ^HttpSession http-session
-  "Returns the servlet's HttpSession from the ring request"
-  [request]
-  (if-let [^HttpServletRequest hsr (:servlet-request request)]
-    (.getSession hsr)))

 (defn ^String context-path
   "Returns the servlet context path from the ring request"


minor cleanup

minor cleanup

--- src/main/fulcro_template/server.clj
+++ src/main/fulcro_template/server.clj
@@ -146,7 +146,7 @@

 ; You need at least one of these. Specifies how to handle client requests, and participates in the component system
 ; of the server. Libraries can provide modules to install on your server to add functionality in a composable fashion.
-(defrecord APIModule [session-store user-db]
+(defrecord APIModule []
   core/Module
   (system-key [this] :api-module)                           ; this module will be known in the component system as :api-module. Allows you to inject the module.
   (components [this] {})                                    ; Additional components to build. This allows library modules to inject other dependencies that it needs into the system. Typically empty for applications.
@@ -166,7 +166,7 @@
   (stop [this] (dissoc this :full-server-middleware))
   (start [this]
     (let [wrap-api (:middleware api-handler)]
-      ; The chained middleware function needs to be *stored* at :middleware,
+      ; The chained middleware function needs to be *stored* at :full-server-middleware,
       ; because we're using a Fulcro web server and it expects to find it there.
       (assoc this :full-server-middleware
                   (-> not-found
@@ -187,7 +187,7 @@

 ; A component that creates a web server and hooks lifecycle up to it. The server-middleware-component (CustomMiddleware)
 ; and config are injected.
-(defrecord WebServer [port config server-middleware-component server]
+(defrecord WebServer [config ^CustomMiddleware server-middleware-component server port]
   component/Lifecycle
   (start [this]
     (try


Remove flag-action-map from SearchOptions in clojure

--- clojure/cljsearch/src/cljsearch/searchoptions.clj
+++ clojure/cljsearch/src/cljsearch/searchoptions.clj
@@ -98,29 +98,6 @@
     :version (fn [settings b] (assoc settings :version b))
   })

-(def flag-action-map
-  { :allmatches (fn [settings] (assoc settings :firstmatch false))
-    :archivesonly (fn [settings] (set-archivesonly settings true))
-    :debug (fn [settings] (set-debug settings true))
-    :excludehidden (fn [settings] (assoc settings :excludehidden true))
-    :firstmatch (fn [settings] (assoc settings :firstmatch true))
-    :help (fn [settings] (assoc settings :printusage true))
-    :includehidden (fn [settings] (assoc settings :excludehidden false))
-    :listdirs (fn [settings] (assoc settings :listdirs true))
-    :listfiles (fn [settings] (assoc settings :listfiles true))
-    :listlines (fn [settings] (assoc settings :listlines true))
-    :multilinesearch (fn [settings] (assoc settings :multilinesearch true))
-    :noprintmatches (fn [settings] (assoc settings :printresults false))
-    :norecursive (fn [settings] (assoc settings :recursive false))
-    :nosearcharchives (fn [settings] (assoc settings :searcharchives false))
-    :printmatches (fn [settings] (assoc settings :printresults true))
-    :recursive (fn [settings] (assoc settings :recursive true))
-    :searcharchives (fn [settings] (assoc settings :searcharchives true))
-    :uniquelines (fn [settings] (assoc settings :uniquelines true))
-    :verbose (fn [settings] (assoc settings :verbose true))
-    :version (fn [settings] (assoc settings :version true))
-  })
-
 (defn get-long-arg [arg]
   (let [longnames (map :long-arg OPTIONS)
         longmap (zipmap longnames (repeat 1))
@@ -139,7 +116,7 @@
       (cond
         (contains? arg-action-map k)
           (settings-from-map ((k arg-action-map) settings v) (rest ks) m errs)
-        (contains? flag-action-map k)
+        (contains? bool-flag-action-map k)
           (settings-from-map ((k bool-flag-action-map) settings v) (rest ks) m errs)
         (= k :startpath)
           (do
@@ -172,8 +149,8 @@
               (if a2
                 (settings-from-args ((k arg-action-map) settings a2) (drop 2 args) errs)
                 (settings-from-args settings (rest args) (conj errs (str "Missing arg for option " a))))
-            (contains? flag-action-map k)
-              (settings-from-args ((k flag-action-map) settings) (rest args) errs)
+            (contains? bool-flag-action-map k)
+              (settings-from-args ((k bool-flag-action-map) settings true) (rest args) errs)
             (= k :settings-file)
               (let [[file-settings file-errs] (settings-from-file settings a2)]
                 (settings-from-args file-settings (drop 2 args) (concat errs file-errs)))


remove leftover debug prn

remove leftover debug prn

--- src/main/shadow/build/classpath.clj
+++ src/main/shadow/build/classpath.clj
@@ -57,8 +57,6 @@
         :module-type (or module-type "goog"))))

 (defn inspect-js [{:keys [compiler] :as state} {:keys [resource-name url] :as rc}]
-
-  (prn [:js resource-name])
   (let [source
         (slurp url)

@@ -80,8 +78,7 @@
         (JsInspector/getFileInfo
           compiler
           ;; SourceFile/fromFile seems to leak file descriptors
-          (SourceFile/fromCode resource-name source))
-        ]
+          (SourceFile/fromCode resource-name source))]

     (cond
       (seq js-errors)


Fix redirect URL for paid event register

--- src/cljs/elevent_client/pages/events/id/register.cljs
+++ src/cljs/elevent_client/pages/events/id/register.cljs
@@ -55,7 +55,7 @@
                                #(do
                                   (callback)
                                   (swap! state/session dissoc :stripe-token)
-                                  (js/location.assign (routes/event-schedule) event)))
+                                  (js/location.assign (routes/event-schedule event))))
                         callback))
                     (api/attendees-endpoint
                       :create


Fix name of the flag used to keep track of the abstract merge.

--- src/oc/storage/resources/common.clj
+++ src/oc/storage/resources/common.clj
@@ -153,7 +153,7 @@
   :headline schema/Str
   :body schema/Str
   (schema/optional-key :abstract) (schema/maybe schema/Str)
-  (schema/optional-key :merged-abstract) (schema/maybe schema/Bool)
+  (schema/optional-key :abstract-merged) (schema/maybe schema/Bool)

   ;; Attachments
   (schema/optional-key :attachments) [Attachment]


fix max-iters specification in base-clusters k-means call

--- src/polismath/math/conversation.clj
+++ src/polismath/math/conversation.clj
@@ -360,7 +360,7 @@
             (clusters/kmeans in-conv-mat
               (:base-k opts')
               :last-clusters (:base-clusters conv)
-              :cluster-iters (:base-iters opts')))))
+              :max-iters (:base-iters opts')))))

       :base-clusters-proj
       (plmb/fnk [base-clusters]


Update benchmarks

Update benchmarks

--- src/taoensso/carmine/benchmarks.clj
+++ src/taoensso/carmine/benchmarks.clj
@@ -39,6 +39,9 @@

 (comment

+  ;;; 2013 Oct 12, Carmine 2.2.3
+  ;; {:wcar 73, :ping 741, :set 830, :get 785, :roundtrip 1105, :ping-pipelined 14171}
+
   ;;; 24 June 2013, + Perf. refactoring
   ;; {:wcar-unpooled 53188, :ping-unpooled 33540}
   ;; {:wcar 42, :ping 576, :set 608, :get 596, :roundtrip 875, :ping-pipelined 13939}
@@ -57,4 +60,4 @@
   ;; GET         1000 requests completed in 0.46 seconds
   ;; {:ping 430, :get 460, :set 460}

-  )+  )


wikidata: find union of property sets

wikidata: find union of property sets

--- src/main/clojure/conexp/fca/applications/wikidata.clj
+++ src/main/clojure/conexp/fca/applications/wikidata.clj
@@ -154,24 +154,30 @@
            (str/last-index-of label "("))
         (str/last-index-of label ")")))

-(defn get-properties-for-item
-  "generate a query to retrieve all properties for an item from WD"
-  [item]
-  (let [item item]
+(defn get-properties-for-entity
+  "generate a query to retrieve the set of all properties for an entity
+  from WD; more specifically, all properties p where the entity is
+  subject in a claim about"
+  [entity]
+  (let [entity entity]
     (with-sparql-bindings
       (str
        "SELECT "
-       "?p"
+       " Distinct ?p "
        " WHERE {\n  "
-       (entity-add-sparql-prefix item)
+       (entity-add-sparql-prefix entity)
        " ?p ?o"
        " . \n"
        " ?wd wikibase:claim ?p "
        "\n }  ")
-      (map (fn [{p "p"}]
-             (property-id-from-uri (get p "value")))
-           bindings))))
-
+      (set (map (fn [{p "p"}]
+                  (property-id-from-uri (get p "value")))
+                bindings)))))
+
+(defn get-union-of-properties-for-entities
+  "For a collection of entities, find union of property sets."
+  [entities]
+  (reduce #(union %1 %2) (map get-properties-for-entity entities)))

 ;; Stuff for dealing with implications


CMR-1980: Works for keywords without all of the fields in the hierarchy present

--- search-app/src/cmr/search/api/keyword.clj
+++ search-app/src/cmr/search/api/keyword.clj
@@ -41,12 +41,6 @@
                                 :variable-level-1 [{:value "MOBILE GEOGRAPHIC INFORMATION SYSTEMS"
                                                     :uuid "0dd83b2a-e83f-4a0c-a1ff-2fbdbbcce62d"
                                                     }]}]}]}]}
-
-  (def keyword-hierarchy
-    {:science-keywords [:category :topic :term :variable-level-1 :variable-level-2 :variable-level-3]
-     :providers [:level-0 :level-1 :level-2 :level-3 :short-name :long-name]
-     :platforms [:category :series-entity :short-name :long-name]
-     :instruments [:category :class :type :subtype :short-name :long-name]})

   (def keywords
     [{:uuid "0dd83b2a-e83f-4a0c-a1ff-2fbdbbcce62d",
@@ -85,7 +79,7 @@

   {:category (parse-hierarchical-keywords (:science-keywords keyword-hierarchy) keywords)}
-  {:level-0 (parse-hierarchical-keywords (:providers keyword-hierarchy) keywords)}
+  {:level-0 (parse-hierarchical-keywords (:providers keyword-hierarchy) test-keywords)}
   {:category (parse-hierarchical-keywords (:platforms keyword-hierarchy) keywords)}
   {:category (parse-hierarchical-keywords (:instruments keyword-hierarchy) keywords)}

@@ -109,6 +103,8 @@
   (def keywords
    (vals (kms/get-keywords-for-keyword-scheme
            {:system (cmr.indexer.system/create-system)} :instruments)))
+
+  (is-leaf? [:cat :dog] :cat)

   )

@@ -119,23 +115,57 @@

 (comment

+  (do
   (def test1
-    [{:a "A" :b "B" :c "C"}
-     {:a "D" :c "D"}
-     {:a "A" :d "D"}])
+    [{:a "A1" :b "B1" :c "C1"}
+     {:a "A2" :c "C2"}
+     {:a "A1" :d "D1"}])
+
+  (def test2
+    [{:a "A1" :b "B1"}])
+
+  (def test3
+    [{:a "A1" :c "C1"}]) )

   (get-subfields-for-keyword [:b :c :d] test1 :a "A")
+  {:a (parse-hierarchical-keywords [:a :b :c :d] test1)}
+
+  {:a [{:value "A1"
+        :subfields ["b" "d"]
+        :b [{:value "B1"
+             :subfields ["c"]
+             :c [{:value "C1"}]}]
+        :d [{:value "D1"}]}
+       {:value "A2"
+        :subfields ["c"]
+        :c [{:value "C2"}]}]}
+
+  (get-subfields-for-keyword [:b :c :d] test1 :a "A1")
+  (get-subfields-for-keyword [:b :c :d] test1 :a "A2")
+
+  {:a (parse-hierarchical-keywords [:a :b :c :d] test1)}
+
+  (= {:a (parse-hierarchical-keywords [:a :b :c :d] test1)}
+     {:a [{:value "A1"
+        :subfields ["b" "d"]
+        :b [{:value "B1"
+             :subfields ["c"]
+             :c [{:value "C1"}]}]
+        :d [{:value "D1"}]}
+       {:value "A2"
+        :subfields ["c"]
+        :c [{:value "C2"}]}]})

   )
 (defn- get-subfields-for-keyword
   "Figure out which subfield is directly below the current keyword. It is possible the next field
-  field in the hierarchy is nil, but further down the chain there is a non-nil field."
+  in the hierarchy is nil, but further down the chain there is a non-nil field."
   [remaining-hierarchy keywords field value]
   (loop [remaining-fields remaining-hierarchy
          matching-keywords (filter #(= value (field %)) keywords)
          all-subfields nil]
           (let [next-field (first remaining-fields)
-                keywords-below-with-next-field (keep next-field matching-keywords)
+                keywords-below-with-next-field (when next-field (keep next-field matching-keywords))
                 keywords-with-nil-next-field (filter #(nil? (next-field %)) matching-keywords)
                 all-subfields (if (seq keywords-below-with-next-field)
                                 (conj all-subfields next-field)
@@ -144,32 +174,83 @@
                 (recur (rest remaining-fields) keywords-with-nil-next-field all-subfields)
                 all-subfields))))

+(comment
+  (get-hierarchy-after (:providers the-keyword-hierarchy) :level-1))
+
+(def keyword-hierarchy
+  {:science-keywords [:category :topic :term :variable-level-1 :variable-level-2 :variable-level-3]
+   :providers [:level-0 :level-1 :level-2 :level-3 :short-name :long-name]
+   :platforms [:category :series-entity :short-name :long-name]
+   :instruments [:category :class :type :subtype :short-name :long-name]})
+
+(defn- get-hierarchy-from-field
+  "Returns all of the fields in the hierarchy starting from the provided field and including all
+  fields after."
+  [keyword-hierarchy field]
+  (let [field-index (.indexOf keyword-hierarchy field)]
+    (filter #(<= field-index (.indexOf keyword-hierarchy %)) keyword-hierarchy)))
+
 (defn- parse-hierarchical-keywords
   "Returns keywords in a hierarchical fashion based on the provided keyword hierarchy and keywords."
   [keyword-hierarchy keywords]
   (when-let [field (first keyword-hierarchy)]
     (let [next-field (second keyword-hierarchy)
-
-          ;; Find distinct values
           unique-values (distinct (keep field keywords))
           values-to-uuids (into {} (keep (fn [k-word]
                                            (when (is-leaf? (rest keyword-hierarchy) k-word)
                                              [(field k-word) (:uuid k-word)]))
                                          keywords))]
       (for [value unique-values
-            :let [subfields (parse-hierarchical-keywords
-                              (rest keyword-hierarchy)
-                              (filter #(= value (field %)) keywords))
+            :let [all-subfield-names (get-subfields-for-keyword (rest keyword-hierarchy) keywords
+                                                                field value)
                   uuid (get values-to-uuids value)
                   value-map (util/remove-nil-keys
                               {:value value
-                               :uuid uuid})]]
-
-        (if (seq subfields)
-          (assoc value-map
-                 :subfields [(name next-field)]
-                 next-field subfields)
-          value-map)))))
+                               :uuid uuid})
+                  subfield-maps (util/remove-nil-keys
+                                  (into {}
+                                        (for [subfield-name all-subfield-names
+                                              :let [subfields
+                                                    (parse-hierarchical-keywords
+                                                      (get-hierarchy-from-field keyword-hierarchy subfield-name)
+                                                      (filter #(= value (field %)) keywords))]]
+                                          [subfield-name (seq subfields)])))]]
+        ; (reduce #(assoc value-map (:subfield-name %) (:subfields %))
+        (util/remove-nil-keys
+          (merge value-map subfield-maps {:subfields (seq (map name (keys subfield-maps)))}))))))
+
+        ; (if (seq subfields)
+        ;   (assoc value-map
+        ;          :subfields [(name next-field)]
+        ;          next-field subfields)
+        ;   value-map))))))
+
+; (defn- parse-hierarchical-keywords
+;   "Returns keywords in a hierarchical fashion based on the provided keyword hierarchy and keywords."
+;   [keyword-hierarchy keywords]
+;   (when-let [field (first keyword-hierarchy)]
+;     (let [next-field (second keyword-hierarchy)
+
+;           ;; Find distinct values
+;           unique-values (distinct (keep field keywords))
+;           values-to-uuids (into {} (keep (fn [k-word]
+;                                            (when (is-leaf? (rest keyword-hierarchy) k-word)
+;                                              [(field k-word) (:uuid k-word)]))
+;                                          keywords))]
+;       (for [value unique-values
+;             :let [subfields (parse-hierarchical-keywords
+;                               (rest keyword-hierarchy)
+;                               (filter #(= value (field %)) keywords))
+;                   uuid (get values-to-uuids value)
+;                   value-map (util/remove-nil-keys
+;                               {:value value
+;                                :uuid uuid})]]
+
+;         (if (seq subfields)
+;           (assoc value-map
+;                  :subfields [(name next-field)]
+;                  next-field subfields)
+;           value-map)))))

 (def keyword-api-routes
   (context "/keywords" []


bump anglican-infcomp version

bump anglican-infcomp version

--- examples/project.clj
+++ examples/project.clj
@@ -4,7 +4,7 @@
   :dependencies [[org.clojure/clojure "1.8.0"]
                  [org.clojure/tools.cli "0.3.5"]
                  [anglican "1.0.1"]
-                 [anglican-infcomp "0.2.1-SNAPSHOT"]
+                 [anglican-infcomp "0.2.2-SNAPSHOT"]
                  [net.polyc0l0r/clj-hdf5 "0.2.2-SNAPSHOT"]
                  [rhizome "0.2.7"]]
   :java-source-paths ["src/helpers"]


added hit

added hit

--- src/babel/english/lexicon.clj
+++ src/babel/english/lexicon.clj
@@ -546,6 +546,9 @@
                    :pred :lui}
              :subcat '()}}

+   "hit" {:english {:past "hit"}
+             :synsem {:cat :verb
+                      :sem {:pred :hit}}}

    "hold"
    {:synsem {:cat :verb


allow either map or pmap during generation

--- src/babel/francais/writer.clj
+++ src/babel/francais/writer.clj
@@ -19,101 +19,105 @@
     (engine/expression medium spec)))

 (defn tout [ & [count]]
-  (let [count (if count (Integer. count) 10)
+  (let [use-map-fn map
+        count (if count (Integer. count) 10)
         root-verbs
         (zipmap
          (keys lexicon)
-         (map (fn [lexeme-set]
-                (filter (fn [lexeme]
-                          (and
-                           ;; uncomment to only generate for a desired verb, e.g. "se amuser"
-                           ;;                           (= (get-in lexeme [:français :français]) "se amuser")
-                           (= (get-in lexeme [:synsem :cat]) :verb)
-                           (= (get-in lexeme [:synsem :infl]) :top)
-                           (not (= :top (get-in lexeme [:synsem :sem :pred] :top)))))
-                        lexeme-set))
-              (vals lexicon)))
+         (use-map-fn
+          (fn [lexeme-set]
+            (filter (fn [lexeme]
+                      (and
+                       ;; uncomment to only generate for a desired verb, e.g. "se amuser"
+                       ;;                           (= (get-in lexeme [:français :français]) "se amuser")
+                       (= (get-in lexeme [:synsem :cat]) :verb)
+                       (= (get-in lexeme [:synsem :infl]) :top)
+                       (not (= :top (get-in lexeme [:synsem :sem :pred] :top)))))
+                    lexeme-set))
+          (vals lexicon)))
         root-verb-array
         (reduce concat
-                (map (fn [key]
-                       (get root-verbs key))
-                     (sort (keys root-verbs))))]
+                (use-map-fn (fn [key]
+                              (get root-verbs key))
+                            (sort (keys root-verbs))))]
     (write-lexicon "fr" lexicon)
     (log/info (str "done writing lexicon."))
     (log/info (str "generating examples with this many verbs:"
                    (.size root-verb-array)))

     ;; for debugging, change (pmap) to (map) so logging is easier to read: in-order rather than interleaved by multiple workers.
-    (.size (pmap (fn [verb]
-                   (log/trace (str "verb: " (strip-refs verb)))
-                   (let [root-form (get-in verb [:français :français])
-                         essere (get-in verb [:synsem :essere])]
-                     (log/info (str "generating with verb: '" root-form "'"))
-                     (.size (map (fn [tense]
-                                   (let [spec (unify {:root {:français {:français root-form}}}
-                                                     tense)]
-                                     (.size
-                                      (map (fn [gender]
-                                             (let [spec (unify spec
-                                                               {:comp {:synsem {:agr gender}}})]
-                                               (log/trace (str "generating from gender: " gender))
-                                               (.size
-                                                (map (fn [person]
-                                                       (let [spec (unify spec
-                                                                         {:comp {:synsem {:agr {:person person}}}})]
-                                                         (log/trace (str "generating from person: " person))
-                                                         (.size
-                                                          (map (fn [number]
-                                                                 (let [spec (unify spec
-                                                                                {:comp {:synsem {:agr {:number number}}}})]
-                                                                   (log/debug (str "generating from spec: " spec))
-                                                                   (try
-                                                                     (process [{:fill-one-language
-                                                                                {:count 1
-                                                                                :spec spec
-                                                                                :model medium
-                                                                                }}]
-                                                                              "fr")
-                                                                     ;; TODO: move this to *before*
-                                                                     ;; attempting generation that fails.
-                                                                     (catch Exception e
-                                                                       (cond
+    (.size (use-map-fn
+            (fn [verb]
+              (log/trace (str "verb: " (strip-refs verb)))
+              (let [root-form (get-in verb [:français :français])
+                    essere (get-in verb [:synsem :essere])]
+                (log/info (str "generating with verb: '" root-form "'"))
+                (.size (map (fn [tense]
+                              (let [spec (unify {:root {:français {:français root-form}}}
+                                                tense)]
+                                (.size
+                                 (map (fn [gender]
+                                        (let [spec (unify spec
+                                                          {:comp {:synsem {:agr gender}}})]
+                                          (log/trace (str "generating from gender: " gender))
+                                          (.size
+                                           (map (fn [person]
+                                                  (let [spec (unify spec
+                                                                    {:comp {:synsem {:agr {:person person}}}})]
+                                                    (log/trace (str "generating from person: " person))
+                                                    (.size
+                                                     (map (fn [number]
+                                                            (let [spec (unify spec
+                                                                              {:comp {:synsem {:agr {:number number}}}})]
+                                                              (log/debug (str "generating from spec: " spec))
+                                                              (try
+                                                                (process [{:fill-one-language
+                                                                           {:count 1
+                                                                            :spec spec
+                                                                            :model medium
+                                                                            }}]
+                                                                         "fr")
+                                                                ;; TODO: move this to *before*
+                                                                ;; attempting generation that fails.
+                                                                (catch Exception e
+                                                                  (cond

-                                                                         ;; "se appeler": there is currently only singular
-                                                                         ;; proper male names, so any attempt to use
-                                                                         ;; plural number with this verb will fail.
-                                                                         ;; Also verb is constrained in lexicon
-                                                                         ;; to only be present progressive.
-                                                                         (and
-                                                                          (= (get-in spec [:root :français :français])
-                                                                             "se appeler")
-                                                                          (or (= (get-in spec [:comp :synsem :agr :number])
-                                                                                :plur)
-                                                                              (= (get-in spec [:comp :synsem :agr :gender])
-                                                                                :fem)
-                                                                              (and (not (= (get-in spec [:synsem :sem :tense])
-                                                                                :present))
-                                                                                (not (= (get-in spec [:synsem :sem :aspect])
-                                                                                :progressive)))))
-                                                                         (do (log/info (str "ignoring exception (se-appeler): " e)))
+                                                                    ;; "se appeler": there is currently only singular
+                                                                    ;; proper male names, so any attempt to use
+                                                                    ;; plural number with this verb will fail.
+                                                                    ;; Also verb is constrained in lexicon
+                                                                    ;; to only be present progressive.
+                                                                    (and
+                                                                     (= (get-in spec [:root :français :français])
+                                                                        "se appeler")
+                                                                     (or (= (get-in spec [:comp :synsem :agr :number])
+                                                                            :plur)
+                                                                         (= (get-in spec [:comp :synsem :agr :gender])
+                                                                            :fem)
+                                                                         (and (not (= (get-in spec [:synsem :sem :tense])
+                                                                                :present))
+                                                                              (not (= (get-in spec [:synsem :sem :aspect])
+                                                                                :progressive)))))
+                                                                    (do (log/info (str "ignoring exception (se-appeler): " e)))
+
+                                                                    true
+                                                                    (throw e))))
+                                                              ))
+                                                          [:sing :plur]))))
+                                                [:1st :2nd :3rd]))))
+                                      (cond (and (= true essere)
+                                                 (= tense
+                                                    {:synsem {:sem {:aspect :perfect
+                                                                    :tense :past}}}))
+                                            [{:gender :masc}
+                                             {:gender :fem}]
+                                            true
+                                            [:top])))))
+                            (list {:synsem {:sem {:tense :conditional}}}
+                                  {:synsem {:sem {:tense :future}}}
+                                  {:synsem {:sem {:tense :present}}}
+                                  {:synsem {:sem {:aspect :perfect
+                                                  :tense :past}}}
+                                  )))))
+            root-verb-array))))

-                                                                         true
-                                                                         (throw e))))
-                                                                   ))
-                                                               [:sing :plur]))))
-                                                     [:1st :2nd :3rd]))))
-                                           (cond (and (= true essere)
-                                                      (= tense
-                                                         {:synsem {:sem {:aspect :perfect
-                                                                         :tense :past}}}))
-                                                      [{:gender :masc}
-                                                       {:gender :fem}]
-                                                      true
-                                                      [:top])))))
-                                 (list {:synsem {:sem {:tense :conditional}}}
-                                       {:synsem {:sem {:tense :future}}}
-                                       {:synsem {:sem {:tense :present}}}
-                                       {:synsem {:sem {:aspect :perfect
-                                                       :tense :past}}}
-                                       )))))
-                 root-verb-array))))