add test for cascaded normalization

add test for cascaded normalization

--- test/cljam/util/t_chromosome.clj
+++ test/cljam/util/t_chromosome.clj
@@ -69,6 +69,11 @@
     ;; TODO: Add more SN name
     )

+  ;; test for cascaded normalization
+  (is (= (-> "17_KI270730V1_RANDOM" chr/normalize-chromosome-key)
+         (-> "17_KI270730V1_RANDOM" chr/normalize-chromosome-key chr/normalize-chromosome-key)
+         (-> "17_KI270730V1_RANDOM" chr/normalize-chromosome-key chr/normalize-chromosome-key chr/normalize-chromosome-key)))
+
   (are [?key ?trimmed-key] (= (chr/trim-chromosome-key ?key) ?trimmed-key)
     "chr1" "1"
     "Chr2" "2"


Reword and fix in-ns tests

Reword and fix in-ns tests

--- test/cljs/replumb/repl_test.cljs
+++ test/cljs/replumb/repl_test.cljs
@@ -120,15 +120,15 @@
   (let [target-opts (if (doo/node?)
                       (core/nodejs-options load/fake-load-fn!)
                       (core/browser-options load/fake-load-fn!))]
-    (let [res (do (repl/read-eval-call target-opts validated-echo-cb "(in-ns 'first.namespace)")
-                  (repl/read-eval-call target-opts validated-echo-cb "(def a 3)")
-                  (repl/read-eval-call target-opts validated-echo-cb "(in-ns 'second.namespace)")
+    (let [res (do (repl/read-eval-call {} validated-echo-cb "(in-ns 'first.namespace)")
+                  (repl/read-eval-call {} validated-echo-cb "(def a 3)")
+                  (repl/read-eval-call {} validated-echo-cb "(in-ns 'second.namespace)")
                   (repl/read-eval-call target-opts validated-echo-cb "(require 'first.namespace)")
-                  (repl/read-eval-call target-opts validated-echo-cb "first.namespace/a"))
+                  (repl/read-eval-call {} validated-echo-cb "first.namespace/a"))
           out (unwrap-result res)]
-      (is (success? res) "Defining variable in namespace and querying it should succeed")
-      (is (valid-eval-result? out) "Defining variable in namespace and querying should be a valid result")
-      (is (= "3" out) "Defining variable in namespace and querying should interned var value")
+      (is (success? res) "Deffing a var in an in-ns namespace and querying it should succeed")
+      (is (valid-eval-result? out) "Deffing a var in an in-ns namespace and querying it should be a valid result")
+      (is (= "3" out) "Deffing a var in an in-ns namespace and querying it should retrieve the interned var value")
       (repl/reset-env! ['first.namespace 'second.namespace]))))

 (deftest process-ns
@@ -194,7 +194,7 @@
       (is (success? res) )
       (is (valid-eval-result? out) )
       (is (= 'd.ns (repl/current-ns)) "(require '[c.ns :refer [referred-a]]) should not change namespace")
-      (is (= "3" out) "(require '[c.ns :refer [referred-a]]) should interned var value")
+      (is (= "3" out) "(require '[c.ns :refer [referred-a]]) should retrieve the interned var value")
       (repl/reset-env! ['c.ns 'd.ns]))))

 (deftest warnings


Three new tests added: test-script-existence, test-flotr-scripts-existence and test-bool->string-existence

--- test/clj_flotr/generator_test.clj
+++ test/clj_flotr/generator_test.clj
@@ -1,5 +1,5 @@
 ;
-;  (C) Copyright 2015  Pavel Tisnovsky
+;  (C) Copyright 2015, 2016  Pavel Tisnovsky
 ;
 ;  All rights reserved. This program and the accompanying materials
 ;  are made available under the terms of the Eclipse Public License v1.0
@@ -26,3 +26,15 @@
     (testing "Test if stacked-bars function exists"
         (is (function? stacked-bars))))

+(deftest test-script-existence
+    (testing "Test if script function exists"
+        (is (function? script))))
+
+(deftest test-flotr-scripts-existence
+    (testing "Test if flotr-scripts function exists"
+        (is (function? flotr-scripts))))
+
+(deftest test-bool->string-existence
+    (testing "Test if bool->string function exists"
+        (is (function? bool->string))))
+


Fix ClojureScript version of apply-matrix test.

--- test/cljx/snippets/transform.cljx
+++ test/cljx/snippets/transform.cljx
@@ -5,20 +5,19 @@
   #+cljs
   (:use-macros [quil.snippet :only [defsnippet]]))

-#+clj
 (defsnippet apply-matrix {:renderer :p3d}
   (q/camera 200 200 200 0 0 0 0 0 -1)
   (q/no-fill)
   (q/box 50)
-  (q/apply-matrix 1 0 50
-                0 1 -50)
-  (q/box 50)
+  #+clj (q/apply-matrix 1 0 50
+                        0 1 -50)
+  #+clj (q/box 50)
   (let [s (q/sin 1)
         c (q/cos 1)]
    (q/apply-matrix 1 0 0 0
-                 0 c s 50
-                 0 (- s) c -50
-                 0 0 0 1))
+                   0 c s 50
+                   0 (- s) c -50
+                   0 0 0 1))
   (q/box 50))

 (defsnippet push-matrix-pop-matrix {}


Palvelimen versio 1.1

Palvelimen versio 1.1

--- mtg-pairings-server/project.clj
+++ mtg-pairings-server/project.clj
@@ -1,4 +1,4 @@
-(defproject mtg-pairings-server "1.0.0"
+(defproject mtg-pairings-server "1.1.0"
   :license {:name "MIT License"
             :url "http://www.opensource.org/licenses/mit-license.php"}
   :dependencies [[org.clojure/clojure "1.8.0"]


Liquid forecast diagram

Liquid forecast diagram

--- src/clj_simple_chart/ncs/liquidprodpp/liquid_pp_forecast.clj
+++ src/clj_simple_chart/ncs/liquidprodpp/liquid_pp_forecast.clj
@@ -167,13 +167,12 @@
      (axis/render-axis (:y c))
      (clj-area/area c flat)
      (line/line c {:p         :date
-                   :path      {:stroke forecast-color :stroke-opacity 0.7}
+                   :path      {:stroke forecast-color :stroke-opacity 1.0 :stroke-width 3}
                    :dot       true
-                   :dot-style {:fill forecast-color}
+                   :dot-style {:fill "yellow" :stroke "black" :stroke-width 1 :r 4}
                    :h         :prfPrdLiquidsNetMillMboed} forecast)
      [:g {:transform (translate (xfn "2019-12") (yfn 1.6))}
-      (opentype/text {:text "OD Pronose 2016" :font "Roboto Black" :font-size 14 :text-anchor "middle"})]
-     #_(act/area-center-text c last-text)
+      (opentype/text {:text "OD Prognose 12.01.2017" :font "Roboto Black" :font-size 14 :text-anchor "middle"})]
      [:g (map make-txt (filter #(some #{(:date %)}
                                       [;"1971-12"
                                        "1975-12"
@@ -186,7 +185,8 @@
                                        "2005-12"
                                        "2010-12"
                                        "2013-12"
-                                       "2015-12"]) data))]
+                                       "2015-12"
+                                       "2016-12"]) data))]
      [:g (map make-txt (->> forecast (mapv #(assoc % :sum (:prfPrdLiquidsNetMillMboed %)))))]
      (axis/render-axis (:x c))]
     (let [infotext (opentype/stack {:fill         "white"


Update neko in template

Update neko in template

--- src/clojure/leiningen/new/libgdx_clojure/android-project.clj
+++ src/clojure/leiningen/new/libgdx_clojure/android-project.clj
@@ -4,7 +4,7 @@
   :dependencies [[com.badlogicgames.gdx/gdx "0.9.9-SNAPSHOT"
                   :use-resources true]
                  [com.badlogicgames.gdx/gdx-backend-android "0.9.9-SNAPSHOT"]
-                 [neko/neko "3.0.0-beta6"]
+                 [neko/neko "3.0.0-beta7"]
                  [org.clojure-android/clojure "1.5.1-jb" :use-resources true]]
   :repositories [["sonatype"
                   "https://oss.sonatype.org/content/repositories/snapshots/"]]


Added documentation to terminal module

Added documentation to terminal module

--- Clojure/src/snake/terminal.clj
+++ Clojure/src/snake/terminal.clj
@@ -1,10 +1,16 @@
 (ns snake.terminal)

-(defn clean []
-	(print ""))
+(defn clean
+  "Clear the terminal, i.e., remove all output."
+  []
+	(print "\u001B[2J"))

-(defn set-cursor [x y]
-	(printf "[%d;%dH" y x))
+(defn set-cursor
+  "Set the cursor for the next output to the given coordinates."
+  [x y]
+	(printf "\u001B[%d;%dH" y x))

-(defn put [str]
+(defn put
+  "Output the string at the current cursor coordinates."
+  [str]
 	(print str))


updated collapse algorithm -- faster and doesnt expand/collapse ranges

--- src/cambo/core.cljc
+++ src/cambo/core.cljc
@@ -83,12 +83,30 @@
 (defn range? [x]
   (instance? Range x))

-;; TODO: remove duplicates
-;; TODO: group into ranges?
+(defn ranges [ns]
+  (->> ns
+       distinct
+       sort
+       (reduce (fn [acc n]
+                 (let [a (-> acc last last)]
+                   (if (or (nil? a)
+                           (not= n (inc a)))
+                     (conj acc [n])
+                     (update acc (dec (count acc)) conj n))))
+               [])
+       (map (fn [ns]
+              (let [from (first ns)
+                    to (last ns)]
+                (range from (inc to)))))
+       (into [])))
+
 (defn keyset [keys]
   (if (= 1 (count keys))
     (first keys)
-    (into [] keys)))
+    (let [{ints true keys false} (group-by integer? keys)
+          keys (cond-> (into #{} keys)
+                       (seq ints) (into (ranges ints)))]
+      (into [] keys))))

 (defn keyset? [x]
   (or (key? x)
@@ -126,44 +144,78 @@
       (into [key] path))
     (map vector (keys keyset))))

+(defn expand-pathset'
+  [pathset]
+  (letfn [(inner-expand [path [keyset & pathset]]
+            (let [paths (map #(conj path %) (keys keyset))]
+              (if (seq pathset)
+                (mapcat #(inner-expand % pathset) paths)
+                paths)))]
+    (inner-expand [] pathset)))
+
+(defn expand-pathset''
+  [pathset]
+  (letfn [(walk-pathset [expansions path [keyset & pathset]]
+            (let [paths (into [] (map #(conj path %)) (keys keyset))]
+              (if (seq pathset)
+                (reduce (fn [expansions path]
+                          (walk-pathset expansions path pathset))
+                        expansions
+                        paths)
+                (reduce (fn [expansions path]
+                          (conj! expansions path))
+                        expansions
+                        paths))))]
+    (persistent! (walk-pathset (transient []) [] pathset))))
+
+(defn expand-pathset'''
+  [pathset]
+  (letfn [(pathset-seq [path [keyset & pathset]]
+            (let [paths (into [] (map #(conj path %)) (keys keyset))]
+              (if (seq pathset)
+                (mapcat #(pathset-seq % pathset) paths)
+                paths)))]
+    (into [] (pathset-seq [] pathset))))
+
 (defn expand-pathsets [pathsets]
-  (mapcat expand-pathset pathsets))
+  (into [] (mapcat expand-pathset''' pathsets)))

 (def leaf ::leaf)
 (defn leaf? [v] (= leaf v))

-;; TODO: remember wtf this is doing -- this has to be accidentally quadratic
-(defn pathsets*
-  [tree]
-  (if (leaf? tree)
-    ['()]
-    (->> tree
-         (reduce (fn [m [key sub-tree]]
-                   (let [paths (pathsets* sub-tree)]
-                     (reduce #(update %1 %2 (fnil conj []) key)
-                             m
-                             paths)))
-                 {})
-         (map (fn [[path keys]]
-                (conj path (keyset keys)))))))
-
-;; TODO: kill this once I remember wtf pathsets* is doing
 (defn pathsets [tree]
-  (map vec (pathsets* tree)))
-
-;; TODO: try and make tree stuff not do deep assoc-in -- maybe sort / recurse to minimize deep tree rebuilding
-;; TODO: same as above but with transients
+  (letfn [(inner-pathsets [path tree]
+            (mapcat (fn [[sub-tree kvs]]
+                      (let [path (conj path (keyset (map first kvs)))]
+                        (if (leaf? sub-tree)
+                          [path]
+                          (inner-pathsets path sub-tree))))
+                    (group-by second tree)))]
+    (inner-pathsets [] tree)))
+
+(defn length-tree'
+  [length pathsets]
+  (letfn [(keys [keyset]
+            (if (vector? keyset)
+              keyset
+              [keyset]))
+          (pathset-tree [tree [ks & pathset]]
+            (if (seq pathset)
+              (reduce (fn [tree k]
+                        (update tree k pathset-tree pathset))
+                      tree
+                      (keys ks))
+              (reduce (fn [tree k]
+                        (assoc tree k leaf))
+                      tree
+                      (keys ks))))]
+    [length (reduce pathset-tree {} pathsets)]))

 (defn length-tree
   [pathsets]
-  (->> pathsets
-       (group-by count)
-       (map (fn [[length pathsets]]
-              (loop [[p & ps] (expand-pathsets pathsets) tree {}]
-                (if p
-                  (recur ps (assoc-in tree p leaf))
-                  [length tree]))))
-       (into {})))
+  (into {}
+        (map (fn [[length tree]] (length-tree' length tree)))
+        (group-by count pathsets)))

 (defn length-tree-pathsets
   [length-tree]


more thorough xpath generation

more thorough xpath generation

--- src/crawler/dom.clj
+++ src/crawler/dom.clj
@@ -9,7 +9,8 @@
             [clojure.string :as str]
             [crawler.core :as core]
             [crawler.utils :as utils]
-            [misc.dates :as dates])
+            [misc.dates :as dates]
+            [org.bovinegenius [exploding-fish :as uri]])
   (:use [clj-xpath.core :only [$x $x:node $x:node+ $x:text+]])
   (:import (org.htmlcleaner HtmlCleaner DomSerializer CleanerProperties)
            (org.w3c.dom Document)))
@@ -265,6 +266,8 @@
     (-> dom-serializer
         (.createDOM tag-node))))

+(def file-format-ignore-regex #".jpg$|.css$|.gif$|.png$")
+
 (defn minimum-maximal-xpath-set-processed
   "This helper routine exists so we don't reparse
 the page several times"
@@ -286,27 +289,60 @@
                          second
                          (anchor-tag-xpaths-nodes a-tags))))]

-    (-> (reduce
-         (fn [acc xpath]
-           (let [xpath-links (set
-                              (map #(-> % :attrs :href)
-                                   ($x xpath processed-pg)))]
-             (if (= (clj-set/intersection (:links acc) xpath-links)
-                    xpath-links)
-               acc
-               (merge-with clj-set/union acc {:links  xpath-links
-                                              :xpaths #{xpath}}))))
-         {:xpaths (set [])
-          :links  (set [])}
-         xpaths-a-tags))))
+    (:xpaths (-> (reduce
+                  (fn [acc xpath]
+                    (let [xpath-links (set
+                                       (filter
+                                        #(not (re-find file-format-ignore-regex %))
+                                        (filter
+                                         identity
+                                         (map #(try (uri/fragment (-> % :attrs :href) nil)
+                                                    (catch Exception e nil))
+                                              ($x xpath processed-pg)))))]
+                      (if (= (clj-set/intersection (:links acc) xpath-links)
+                             xpath-links)
+                        acc
+                        (merge-with clj-set/union acc {:links  xpath-links
+                                                       :xpaths #{xpath}}))))
+                  {:xpaths (set [])
+                   :links  (set [])}
+                  xpaths-a-tags)))))

 (defn minimum-maximal-xpath-set
   "A maximal xpath set is a set of xpaths
 sufficient to span all the anchor tags on a
 page. The minimum here refers to the cardinality
 of the xpath set."
-  [page-src]
-  (minimum-maximal-xpath-set-processed (html->xml-doc page-src)))
+  [page-src src-link]
+  (let [processed (html->xml-doc page-src)
+        xpaths    (minimum-maximal-xpath-set-processed processed)]
+    (reduce
+     (fn [acc [xpath hrefs]]
+       (merge-with clojure.set/union acc {xpath hrefs}))
+     {}
+     (map
+      vector
+      xpaths
+      (map
+       (fn [xpath]
+         (set
+          (filter
+           #(not (re-find file-format-ignore-regex %))
+           (filter
+            identity
+            (map
+             (fn [res]
+               (try
+                 (uri/resolve-uri
+                  src-link
+                  (uri/fragment
+                   (-> res
+                       :attrs
+                       :href)
+                   nil))
+                 (catch Exception e nil)))
+             (filter
+              identity ($x xpath processed))))))) xpaths)))))

 (defn node-path-to-root
   "A version of path-root-seq for


for clarity, accept-fn no longer returns a fn. accept-connection now passes a partial.

--- src/custer/core.clj
+++ src/custer/core.clj
@@ -12,15 +12,14 @@
   (.flush os)
   (.close os))

-(defn accept-fn [server]
-  (fn [client-socket]
+(defn accept-fn [server client-socket]
     (respond (.getOutputStream client-socket) "HTTP/1.1 200 OK\r\n\r\nHello")
     (.close client-socket)
-    (accept-connection server (accept-fn server))))
+    (accept-connection server (partial accept-fn server)))

 (defn start-http-server [port]
   (let [server (start-server port)]
-    (do (accept-connection server (accept-fn server))
+    (do (accept-connection server (partial accept-fn server))
         server)))

 (defn -main [& args]


Parse `--amount` as an integer

Parse `--amount` as an integer

--- src/invadm/core.clj
+++ src/invadm/core.clj
@@ -10,7 +10,9 @@
   [["-c" "--currency CURRENCY" "Invoice currency"]
    ["-r" "--client CLIENT" "Client"]
    ["-f" "--filename FILENAME" "Attached file"]
-   ["-a" "--amount AMOUNT" "Total amount"]])
+   ["-d" "--issue-date ISSUE_DATE" "Issue data"]
+   ["-a" "--amount AMOUNT" "Total amount"
+    :parse-fn #(Integer/parseInt %)]])

 (defn usage [options-summary]
   (->> ["invadm - an invoice manager"


Remove commented code on util/forms.cljs file.

--- frontend/src/uxbox/util/forms.cljs
+++ frontend/src/uxbox/util/forms.cljs
@@ -152,30 +152,6 @@
   [store type field value]
   (ptk/emit! store (set-value type field value)))

-;; --- Validate Form
-
-;; (defrecord ValidateForm [type form data on-success]
-;;   ptk/WatchEvent
-;;   (watch [_ state stream]
-;;     (let [[errors data] (validate data form)]
-;;       (if errors
-;;         (rx/of (set-errors type errors))
-;;         (do
-;;           (on-success data)
-;;           (rx/empty))))))
-
-;; (defn validate-form
-;;   [& {:keys [type form data on-success]}]
-;;   {:pre [(keyword? type)
-;;          (map? form)
-;;          (map? data)
-;;          (fn? on-success)]}
-;;   (ValidateForm. type form data on-success))
-
-;; (defn validate-form!
-;;   [& args]
-;;   (f/emit! (apply validate-form args)))
-
 ;; --- Clear Form

 (defrecord ClearForm [type]
@@ -192,7 +168,7 @@
   [store type]
   (ptk/emit! store (clear-form type)))

-;; --- Clear Form
+;; --- Clear Errors

 (defrecord ClearErrors [type]
   ptk/UpdateEvent


Clean up robot-name-test

Clean up robot-name-test

Fix the scoping issues and use the optional
second argument to `is` to provide test descriptions.

Close #114
Close #115

--- exercises/robot-name/test/robot_name_test.clj
+++ exercises/robot-name/test/robot_name_test.clj
@@ -1,28 +1,26 @@
 (ns robot-name-test
-  (:require [clojure.test :refer [deftest is]]
+  (:require [clojure.test :refer [deftest is testing]]
             robot-name))

-(def robbie (robot-name/robot))
+(def ^:private robbie (robot-name/robot))
+(def ^:private clutz  (robot-name/robot))

-(def clutz  (robot-name/robot))
+(deftest robot-name
+  (testing "robot-name"
+    (is (re-seq #"[A-Z]{2}\d{3}" (robot-name/robot-name robbie))
+        "name matches expected pattern")
+    (is (= (robot-name/robot-name robbie) (robot-name/robot-name robbie))
+        "name is persistent")
+    (is (not= (robot-name/robot-name clutz) (robot-name/robot-name robbie))
+        "different robots have different names")))

-(deftest name-matches-expected-pattern
-  (is (re-find (re-matcher #"[A-Z]{2}\d{3}" (robot-name/robot-name robbie)))))
-
-(deftest name-is-persistent
-  (is (= (robot-name/robot-name robbie) (robot-name/robot-name robbie))))
-
-(deftest different-robots-have-different-names
-  (is (not (= (robot-name/robot-name clutz) (robot-name/robot-name robbie)))))
-
-(def original-name (robot-name/robot-name robbie))
-(robot-name/reset-name robbie)
-
-(deftest new-name-matches-expected-pattern
-  (is (re-find (re-matcher #"[A-Z]{2}\d{3}" (robot-name/robot-name robbie)))))
-
-(deftest new-name-is-persistent
-  (is (= (robot-name/robot-name robbie) (robot-name/robot-name robbie))))
-
-(deftest new-name-is-different-than-old-name
-  (is (not (= original-name (robot-name/robot-name robbie)))))
+(deftest reset-name
+  (testing "reset-name"
+    (let [original-name (robot-name/robot-name robbie)]
+      (robot-name/reset-name robbie)
+      (is (re-seq #"[A-Z]{2}\d{3}" (robot-name/robot-name robbie))
+          "new name matches expected pattern")
+      (is (= (robot-name/robot-name robbie) (robot-name/robot-name robbie))
+          "new name is persistent")
+      (is (not= original-name (robot-name/robot-name robbie))
+          "new name is different from old name"))))


remove github callback from init db event


removed numeric tower from :import

removed numeric tower from :import


Speedup strips successor generator by 2x

--- src/edu/berkeley/ai/domains/strips/instances.clj
+++ src/edu/berkeley/ai/domains/strips/instances.clj
@@ -111,14 +111,10 @@
    (envs/make-conjunctive-condition (:pos-pre schema) (:neg-pre schema))))

 ; Each pred has 3 options - yes, no, don't care.  Want to maximize # yes + no
-; MAYBE: Actually, would rather iterate through *true* literals in state than possible literals?
 ; MAYBE: compile sequence of tests?
-; MATBE: change to pass in mutable hashmap or some such?
-; MAYBE: optimize compilation speed
-; Single pass through actions, make single ordering?
-; but, seems fast enough for now!  (not on moderate WW instances)
-; user> (let [node (time (make-initial-state-space-node (constant-predicate-simplify (make-warehouse-strips-env 6 6 [1 2] true {0 '[b] 1 '[a] 2 '[c]} nil ['[a b c table5]])) (constantly 0)))] (time (map :name (first (a-star-graph-search node)))))
-;(comment
+; MAYBE: optimize compilation speed (actually hard to do, I tried)
+; Single pass through actions, make single ordering? (ditto)
+
 (import '(java.util HashMap HashSet Arrays ArrayList))
 (set! *warn-on-reflection* true)


optimized build target

optimized build target

--- src/dev/build.clj
+++ src/dev/build.clj
@@ -21,26 +21,35 @@
 (defn css [& args]
   (sass/build-packages css-packages))

-(defn browser-dev [& args]
+(defn project-setup [config]
   (-> (cljs/init-state)
-      (cljs/enable-source-maps)
-      (assoc :optimizations :none
-             :pretty-print true
-             :public-dir (io/file "test-project/public/js")
+      (assoc :public-dir (io/file "test-project/public/js")
              :public-path "js")
+      (merge config)
       (cljs/step-find-resources-in-jars)
       (cljs/step-find-resources "src/cljs")
       (cljs/step-find-resources "test-project/src/cljs")
       (cljs/step-configure-module :test ['test.app] #{})
       (cljs/step-finalize-config)
+      ))

+(defn browser-dev [& args]
+  (-> (project-setup {:optimizations :none})
+      (cljs/enable-source-maps)
       (devtools/start-loop
         {:css-packages css-packages}
         (fn [state modified]
           (-> state
-              #_ (create-debug-launcher)
+              #_(create-debug-launcher)
               (cljs/step-compile-modules)
               (cljs/flush-unoptimized))))))
+
+(defn browser-optimized [& args]
+  (-> (project-setup {:optimizations :advanced})
+      (cljs/enable-emit-constants)
+      (cljs/step-compile-modules)
+      (cljs/closure-optimize)
+      (cljs/flush-modules-to-disk)))

 (comment
   (nrepl/defmiddleware


bump change to trigger heroku

bump change to trigger heroku

--- src/dmgr/core.clj
+++ src/dmgr/core.clj
@@ -38,6 +38,8 @@
     (future (conch.core/stream-to :out proc *out*))
     (future (conch.core/stream-to :err proc *out*))
     (conch.core/exit-code proc)))
+
+

 (defn git-deploy-cmds
   "Creates the shell commands"


Minor cleanup, speedup

Minor cleanup, speedup

--- src/exp/sahdd.clj
+++ src/exp/sahdd.clj
@@ -30,15 +30,8 @@
  ; bottom-up: give me updates as you get them, only of particular form.
  ; For now, fix this, then extend.

-
 ; We should still (unfortunately) never close open subproblems with cycles.

-;; For now, how do we pass states up?
-  ; Store index / partial list in SubproblemEntry?
-  ; Store cost and loop through?
-  ; Keep queue, upwards pointers?
-  ;  Ideally, have single queue, "fingers" into it in each subproblem.
-  ;   Can almost do this with lazy seqs... ?!

 (defn viable? [reward cutoff]
@@ -126,7 +119,6 @@
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Cached Search ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

 ;; TODO: split refine into PartialResult type, always give new reward -- more accurate.
-;; TODO:

 (defn make-cached-search-factory
   "Return a cache-fn, where (cache-fn) returns fresh IncrementalSearch views on
@@ -197,13 +189,12 @@
   SearchNode
   (extract-goal-state []  nil)
   (expand-node        [min-reward]
-    (let [result (next-solution-or-cutoff subproblem min-reward)]
+    (let [result (next-solution-or-cutoff (force subproblem) min-reward)]
       (if (number? result)
           [[this result]]
         [[this (nth result 1)]
          (make-sp-recursive-node result remaining-actions)]))))

-;; TODO: lazy
 (defn make-initial-sp-nodes [state action]
   (if (env/primitive? action)
     (when-let [[ss sr] (and (env/applicable? action state) (env/successor action state))]
@@ -216,13 +207,15 @@
      (let [context          (env/precondition-context f state)
            state-in-context (env/extract-context state context)
            sub-name         [state-in-context (env/action-name f)]
-           sup-name         [state-in-context (map env/action-name remaining-actions)]
-           sp               (make-search-in-context
-                             (get-cached-search sub-name
-                               (make-incremental-dijkstra-search
-                                (make-initial-sp-nodes (env/get-logger state context) f)))
-                              state reward)]
-       (SPRecursiveNode sup-name sp r))
+           sup-name         [state-in-context (map env/action-name remaining-actions)]]
+       (SPRecursiveNode sup-name
+         (delay
+          (make-search-in-context
+           (get-cached-search sub-name
+             (make-incremental-dijkstra-search
+              (make-initial-sp-nodes (env/get-logger state context) f)))
+           state reward))
+         r))
      (GoalNode state))
    reward])


remove use of dag_unify.core/merge

remove use of dag_unify.core/merge

--- src/babel/francais/morphology.cljc
+++ src/babel/francais/morphology.cljc
@@ -393,8 +393,9 @@
                                                             (dissoc (copy lexeme) :serialized))]
                                            (if (not (= :none (get-in lexeme path :none)))
                                              (list {(get-in lexeme path :none)
-                                                    (dag_unify.core/merge
-                                                     lexeme
+                                                    (unifyc
+                                                     (dissoc-paths lexeme [path
+                                                                           [:français :français]])
                                                      (unifyc (apply merge-fn (list lexeme))
                                                              {:français {:exception true}}))}))))
                                        lexemes)))


minors

minors

--- src/blog/hashobject/views/post.clj
+++ src/blog/hashobject/views/post.clj
@@ -21,7 +21,7 @@
       [:link {:rel "shortcut icon" :href "/favicon.ico"}]
       [:link {:rel "publisher" :href "https://plus.google.com/118068495795214676039"}]
       [:link {:rel "author" :href "/humans.txt"}]
-      [:link {:rel "alternate" :type "application/rss+xml" :title "RSS" :href "feed.rss"}]
+      [:link {:rel "alternate" :type "application/rss+xml" :title "RSS" :href "/feed.rss"}]
       [:link {:rel "discussionUrl" :href (:discussion-url post)}]
       [:link {:rel "canonical" :href (:canonical-url post)}]
       (include-css "/css/app.css")


Added check for alternate SQL Server date type.

--- src/blutwurst/value_generators.clj
+++ src/blutwurst/value_generators.clj
@@ -137,7 +137,7 @@
    }
    {
        :name "Random Date / Timestamp Generator"
-       :determiner #(some #{(:type %)} '("DATE" "DATETIME" "TIMESTAMP"))
+       :determiner #(some #{(:type %)} '("DATE" "DATETIME" "TIMESTAMP" "DATETIME2"))
        :generator (fn [c] (random-datetime))
    }
   ])


wire up shuffle

wire up shuffle

random is stupid b/c it will inevitably randomly repeat. So, I think
shuffle is better b/c you can do it infinite #'s of times and
previous/next will still work as expected.

so say we all .....

--- src/cljs/apollo/client/player.cljs
+++ src/cljs/apollo/client/player.cljs
@@ -34,8 +34,7 @@
   (reify
     om/IInitState
     (init-state [this]
-      {:current-src ""
-       :current-offset 0
+      {:current-offset 0
        :current-track nil
        :ctrl :stop
        :current-position 0
@@ -48,10 +47,9 @@
                                   (last (take (inc offset) track-src))
                                   (first track-src))
                   cp (om/get-state owner :current-track)]
-              (when (not= ((current-track "track") "id")
-                        (((or cp {}) "track" {}) "id"))
+              (when (not= (((or current-track {}) "track" {}) "id")
+                          (((or cp {}) "track" {}) "id"))
                 (set-track current-track (or offset 0) owner))
-              (om/set-state! owner :current-src track-src)
               (om/transact! (state/ref-player) (fn [p]
                                                  (assoc p
                                                         :current-playlist track-src
@@ -62,7 +60,7 @@
                   current-offset (or (om/get-state owner :current-offset) 0)
                   previous-offset (dec current-offset)
                   next-offset (inc current-offset)
-                  track-src (om/get-state owner :current-src)
+                  track-src ((state/ref-player) :current-playlist)
                   next-track (last (take (inc next-offset) track-src))
                   previous-track (last (take (inc previous-offset) track-src))
                   current-track (last (take (inc current-offset) track-src))]
@@ -113,7 +111,11 @@
                 [:li {:on-click (fn [e] (put! channels/player-ctrl :next))}
                  [:i.fa.fa-step-forward]]
                 [:li [:i.fa.fa-repeat]]
-                [:li [:i.fa.fa-random]]]])))))
+                [:li {:on-click (fn [e] (om/transact!
+                                         (state/ref-player)
+                                         (fn [p]
+                                           (assoc p :current-playlist (shuffle (:current-playlist p))))))}
+                 [:i.fa.fa-random]]]])))))

 (defn view-now-playing [data owner]
   (reify


don't pr-str bREPL error just str

don't pr-str bREPL error just str

--- src/cljs/clojure/browser/repl.cljs
+++ src/cljs/clojure/browser/repl.cljs
@@ -48,7 +48,7 @@
                (gbrowser/isChrome) :chrome
                (gbrowser/isFirefox) :firefox
                (gbrowser/isIE) :ie)
-             :value (pr-str e)
+             :value (str e)
              :stacktrace
              (if (.hasOwnProperty e "stack")
                (.-stack e)


Fix matching self on room.

Fix matching self on room.

--- src/cljs/openslack/views/room.cljs
+++ src/cljs/openslack/views/room.cljs
@@ -68,13 +68,15 @@

     om/IInitState
     (init-state [_]
+      ;; TODO: improve matching self messages
       (let [roomname (get-in state [:page :room])
             room (st/get-room state roomname)
-            author (:author event)
+            author (get-in event [:from :resource])
             loggeduser (:user state)
             classname (if (= author (:local loggeduser))
                         "message self"
                         "message")]
+
         {:room room
          :author (:resource (:from event))
          :body (enrich-text (:body event))


Always reload currently selected file

Always reload currently selected file

--- src/clojure/nightcode/builders.clj
+++ src/clojure/nightcode/builders.clj
@@ -44,10 +44,17 @@
       (utils/write-pref! :robovm (.getCanonicalPath d))
       (show-builder! (ui/get-project-path @ui/tree-selection)))))

+(defn add-path
+  [paths path]
+  (if (and path (.endsWith path ".clj") (not (contains? (set paths) path)))
+    (conj paths path)
+    paths))
+
 (defn eval-in-repl!
   [console path timestamp]
   (let [source-paths (-> (lein/read-project-clj path)
                          (lein/stale-clojure-sources timestamp)
+                         (add-path @ui/tree-selection)
                          utils/sort-by-dependency)
         commands (map #(read-string (str \( 'do (slurp %) \newline \)))
                       source-paths)


Remind me to run a full build before pushing, especially when I'm mucking with fntest.

--- support/fntest/src/main/clojure/fntest/jboss.clj
+++ support/fntest/src/main/clojure/fntest/jboss.clj
@@ -74,24 +74,22 @@
   []
   (api :operation "shutdown"))

+(defn descriptor
+  "Return a File object representing the deployment descriptor"
+  [name & [content]]
+  (let [fname (if (re-seq #".+\.clj$" name) name (str name ".clj"))
+        file (io/file descriptor-root fname)]
+    (when content
+      (io/make-parents file)
+      (spit file (into content {:root (str (.getCanonicalFile (io/file (:root content))))})))
+    file))
+
 (defn deployment-name
   "Determine the name for the deployment."
   [name]
   (if (.endsWith name ".ima")
     name
-    (if (re-seq #".+\.clj$" name)
-      name
-      (str name ".clj"))))
-
-(defn descriptor
-  "Return a File object representing the deployment descriptor"
-  [name & [content]]
-  (let [fname (deployment-name name)
-        file (io/file descriptor-root fname)]
-    (when content
-      (io/make-parents file)
-      (spit file (into content {:root (str (.getCanonicalFile (io/file (:root content))))})))
-    file))
+    (.getName (descriptor name))))

 (defn deploy
   "Create an app deployment descriptor from the content and deploy it"


render-table-headings

render-table-headings

--- src/accounting/core.cljs
+++ src/accounting/core.cljs
@@ -136,12 +136,15 @@
 (defn render-import [state]
   (dom/textarea #js {:onKeyDown (send! :import) :rows 25 :cols 100}))

+(defn render-table-headings [headings]
+  (dom/thead nil
+    (apply dom/tr nil
+      (for [heading headings]
+        (dom/th nil heading)))))
+
 (defn render-summary [summary-rows]
   (dom/table nil
-    (dom/thead nil
-      (dom/tr nil
-        (dom/th nil "Account")
-        (dom/th nil "Amount")))
+    (render-table-headings ["Account" "Amount"])
     (apply dom/tbody nil
       (for [{:keys [account amount]} summary-rows]
         (dom/tr nil
@@ -151,10 +154,7 @@
 (defn render-detail [state]
   (dom/div nil
     (dom/table nil
-      (dom/thead nil
-        (apply dom/tr nil
-          (for [heading ["Date" "Description" "Account" "Amount"]]
-            (dom/th nil heading))))
+      (render-table-headings ["Date" "Description" "Account" "Amount"])
       (apply dom/tbody nil
         (let [parts (:entry-parts state)
               parts-count (count parts)]
@@ -171,10 +171,7 @@
                  :onBlur (send! :blur {:last? last?})}))
               (dom/td nil (if last? (dom/button #js {:type "button" :onClick (send! :create)} "Save"))))))))
     (dom/table nil
-      (dom/thead nil
-        (apply dom/tr nil
-          (for [heading ["Date" "Description" "Debit Acct" "" "Amt" "" "Credit Acct" "Note"]]
-            (dom/th nil heading))))
+      (render-table-headings ["Date" "Description" "Debit Acct" "" "Amt" "" "Credit Acct" "Note"])
       (apply dom/tbody nil
         (for [tx (:txs @app-state)
               {:keys [date description to-account amount from-account note]} (tx-tds tx)]
@@ -193,10 +190,7 @@
     "Account: "
     (dom/input #js {:value register-account, :onKeyDown (send! :register)})
     (dom/table nil
-      (dom/thead nil
-        (apply dom/tr nil
-          (for [heading ["Date" "Description" "Amount" "Note"]]
-            (dom/th nil heading))))
+      (render-table-headings ["Date" "Description" "Amount" "Note"])
       (apply dom/tbody nil
         (for [{:keys [date description amount note]} register-parts]
           (dom/tr nil


Its an array

Its an array

--- src/aurora/language.cljs
+++ src/aurora/language.cljs
@@ -177,7 +177,7 @@

           ;; ensure at least one index per output
           (dotimes [i (alength output-kinds)]
-            (.get-or-create-index kn (aget output-kinds i) (aget output-names i) (filter #(not (nil? %)) (aget output-fields i))))
+            (.get-or-create-index kn (aget output-kinds i) (aget output-names i) (into-array (filter #(not (nil? %)) (aget output-fields i)))))

           (Flow. solver output-kinds output-names output-fields))))))


don't need to cache serialization; dag_unify.core/unifyc handles this

--- src/babel/lexiconfn.cljc
+++ src/babel/lexiconfn.cljc
@@ -111,40 +111,6 @@
         (do (log/error message)
             (throw (exception message)))))))

-(defn cache-serialization [entry]
-  "Copying ((unify/copy)ing) lexical entries during generation or parsing is done by serializing and then deserializing.
-storing a deserialized form of each lexical entry avoids the need to serialize every time."
-  (if (fail? entry)
-    ;; TODO: better diagnostics: entry is just :fail, which isn't very helpful.
-    (log/warn (str "Ignoring this lexeme because (fail?=true): " entry))
-    ;; else, not fail, so add to lexicon.
-    (do
-      ;; TODO: should not make reference to particular languages here
-      (let [italian (get-in entry '(:italiano) :none)
-            english (get-in entry '(:english) :none)
-            entry
-            (conj
-             (if (= italian :none)
-               (if (= english :none)
-                 {}
-                 {:english (if (string? english)
-                             {:english english}
-                             english)})
-               {:italiano (if (string? italian)
-                            {:italiano italian}
-                            italian)})
-             (dissoc
-              (dissoc
-               (if (not (= :none (get entry :serialized :none)))
-                 (conj {:serialized (serialize entry)}
-                       entry)
-                 (conj {:serialized (serialize (dissoc entry :serialized))}
-                       entry))
-               :italiano)
-              :english))]
-        (log/trace (str "successfully serialized: " entry))
-        entry))))
-
 (defn encode-where-query [& where]
   "encode a query as a set of index queries."
   where)
@@ -459,13 +425,10 @@

    ;; create an intransitive version of this transitive verb by removing the second arg (:synsem :subcat :2), and replacing with nil.
    (list
-    ;; MUSTDO: regenerate :serialized.
-
-    (cache-serialization
-     (unifyc (dissoc-paths lexical-entry (list [:synsem :subcat :2]
-                                               [:serialized]))
-             {:synsem {:subcat {:2 '()}}
-              :canary :tweet43})) ;; if the canary tweets, then the runtime is getting updated correctly.
+    (unifyc (dissoc-paths lexical-entry (list [:synsem :subcat :2]
+                                              [:serialized]))
+            {:synsem {:subcat {:2 '()}}
+             :canary :tweet43}) ;; if the canary tweets, then the runtime is getting updated correctly.

     lexical-entry) ;; the original transitive lexeme.

@@ -569,10 +532,7 @@
                 ;; TODO: throw exception here
                 :fail)
               (if (isomorphic? result lexical-entry)
-                ;; done: one final step is to add serialization to the entry.
-                (cache-serialization
-                 (unifyc {:phrasal false}
-                         result))
+                result ;; done

                 ;; not done yet: continue.
                 (transform result rules)))))))


configuration errors will apear in log file

--- src/celestial/config.clj
+++ src/celestial/config.clj
@@ -16,7 +16,7 @@
     [clojure.pprint :only (pprint)]
     [bouncer [core :as b] [validators :as v]]
     [bouncer.validators :only (defvalidator)]
-    [taoensso.timbre :only (debug info error warn trace)]
+    [taoensso.timbre :only (set-config! set-level! debug info error warn trace)]
     [clojure.core.strint :only (<<)]
     [clojure.java.io :only (file)]
     [clj-config.core :as conf])
@@ -72,16 +72,19 @@

 (defn pretty-error
   "A pretty print error log"
-  [m]
+  [m c]
   (let [st (java.io.StringWriter.)]
     (binding [*out* st]
       (clojure.pprint/pprint m))
+    (set-config! [:shared-appender-config :spit-filename]
+          (get-in c [:celestial :log :path] "celestial.log"))
+    (set-config! [:appenders :spit :enabled?] true)
     (error "Following configuration errors found:\n" st)))

 (defn read-and-validate []
   (let [c (conf/read-config path) ]
     (when-let [v (:bouncer.core/errors (validate-conf c))]
-      (pretty-error v)
+      (pretty-error v c)
       (System/exit 1))
     c))


Read existing compiled js rather than recompiling.

--- src/clj/cljs/closure.clj
+++ src/clj/cljs/closure.clj
@@ -405,10 +405,14 @@
   (let [file (str (string/replace ns "." "/") ".cljs")
         js-file (comp/rename-to-js file)
         out-file (io/file (output-directory opts) js-file)
-        javascript (if (and (.exists out-file) (get @compiled-cljs ns))
-                     (get @compiled-cljs ns)
-                     (-compile (io/resource file)
-                               (merge opts {:output-file js-file})))]
+        javascript (cond (and (.exists out-file) (get @compiled-cljs ns)) (get @compiled-cljs ns)
+                         (.exists out-file) (let [ns-info (parse-js-ns
+                                                           (string/split-lines (slurp out-file)))]
+                                              (javascript-file (to-url out-file)
+                                                               (:provides ns-info)
+                                                               (:requries ns-info)))
+                         :else (-compile (io/resource file)
+                                         (merge opts {:output-file js-file})))]
     (do (swap! compiled-cljs (fn [old] (assoc old ns javascript)))
         javascript)))


preamble logic should use io/resource

preamble logic should use io/resource

--- src/clj/cljs/closure.clj
+++ src/clj/cljs/closure.clj
@@ -703,7 +703,7 @@
                    inputs)))))

 (defn preamble-from-paths [paths]
-  (str (apply str (map #(slurp (io/file %)) paths)) "\n"))
+  (str (apply str (map #(slurp (io/resource %)) paths)) "\n"))

 (defn make-preamble [{:keys [target preamble hashbang]}]
   (if preamble


renaming rules func

renaming rules func

--- src/clj/swarmpit/api.clj
+++ src/clj/swarmpit/api.clj
@@ -370,10 +370,10 @@
 ;; Placement API

 (defn- placement-rule
-  [nodes-attribute node-attribute-fn]
+  [nodes-attribute node-rule-fn]
   (->> nodes-attribute
        (map #(for [x [" == " " != "]]
-               (node-attribute-fn x %)))
+               (node-rule-fn x %)))
        (flatten)))

 (defn placement


Select only two players for a match

Select only two players for a match

--- src/cljs/darts/core.cljs
+++ src/cljs/darts/core.cljs
@@ -3,6 +3,7 @@
             [reagent.core :as reagent :refer [atom]]
             [reagent.session :as session]
             [clojure.walk :as walk]
+            [clojure.set :refer [difference]]
             [cognitect.transit :as t]
             [secretary.core :as secretary :include-macros true]
             [goog.events :as events]
@@ -18,6 +19,7 @@
                :matches []}))

 (defonce players (atom nil))
+(def selected-players (atom #{}))

 (defn add-new-player [name]
   (swap! db #(update-in % [:players] conj {:name name})))
@@ -41,13 +43,26 @@
     [:li [:a {:href "#/standings"} "Standings"]]]])

 (defn new-game-page []
+  (load-players)
   [:div
    [:a {:href "#"} "Home"]
    [:div [:h2 "New game"]
     [:a {:href "#/new-player"} "New player"]
-    [:h3 "List of players"]
-    (list-players)
-    ]])
+    [:h3 "Select two players"]
+    [:ul
+     (map (fn [{:keys [name]}]
+            ^{:key name}
+            [:li [:input {:type "checkbox"
+                          :disabled (and (= (count @selected-players)
+                                            2)
+                                         (not (@selected-players name)))
+
+                          :on-click (fn []
+                                      (if (@selected-players name)
+                                        (swap! selected-players difference #{name})
+                                        (swap! selected-players conj name)))}
+                  name]])
+          (parse-json @players))]]])

 (defn redirect-to [path]
   (set! js/window.location.href path))


Changing to %o printing

Changing to %o printing

--- src/cljs/klang/core.cljs
+++ src/cljs/klang/core.cljs
@@ -253,7 +253,11 @@
                     (tf/unparse (:hour-minute-second-ms tf/formatters)
                                 (:time lg-ev)))
                    ;; console.dir firefox & chrome only?
-                   (mapv #(js/console.dir %) (:msg lg-ev))
+                   ;;(mapv #(js/console.dir %) (:msg lg-ev))
+                   ;; %o calls either .dir() or .dirxml() if it's a DOM node
+                   ;; This means we get a real string and a real DOM node into
+                   ;; our console. Probably better than always calling dir
+                   (mapv #(js/console.log "%o" %) (:msg lg-ev))
                    (js/console.groupEnd)))}
     (if-let [rndr (get-in lg-ev [:render :msg])]
       [(apply comp rndr) (:msg lg-ev)]


Add a create-potoo function

Add a create-potoo function

--- src/cljs/potoo/core.cljs
+++ src/cljs/potoo/core.cljs
@@ -7,6 +7,12 @@
     {:potoos
      [{:key 1 :text "Ow man" :author "Morty"}
       {:key 2 :text "Don't judge" :author "Rick"}]}))
+
+(defn create-potoo [text]
+  (let [name "Mr. Meeseeks"
+        date (str (js/Date.))
+        potoo {:text text :name name :date date}]
+    (swap! app-state update-in [:potoos] conj potoo)))

 (defn potoo [p]
   [:li


Table

Table

--- src/cljs/ufo/client.cljs
+++ src/cljs/ufo/client.cljs
@@ -24,10 +24,12 @@
   Object
   (render [this]
           #_(println "Render Person" (-> this om/props :fname))
-          (let [{:keys [fname lname] :as props} (om/props this)]
+          (let [{:keys [fname lname] :as props} (om/props this)
+                style {:style {:border "1px" :borderStyle "solid"}}]
             (html
-             [:li
-              [:label (str fname " " lname)]]))))
+             [:tr
+              [:td style fname]
+              [:td style lname]]))))

 (def threep (om/factory ThreeP {:keyfn :fname}))

@@ -64,8 +66,10 @@
           #_(println "Render ThreePListView" (-> this om/path first))
           (let [list (om/props this)]
             (html
-             [:ul
-              (map threep list)]))))
+             [:table #_{:style {:border "1px" :borderStyle "solid"}}
+              #_[:thead ]
+              [:tbody
+               (map threep list)]]))))

 (def threep-list-view (om/factory ThreePListView))

@@ -107,7 +111,7 @@
        (list-view one)
        [:h2 "List B"]
        (list-view two)
-       [:h2 "List ThreeP"]
+       [:h2 "Table ThreeP"]
        ;; TODO transact from 'outside'
        (threep-list-view three)
        [:button


Make history contain full error vectors, not just totals

--- src/clojush/evaluate.clj
+++ src/clojush/evaluate.clj
@@ -55,7 +55,7 @@
                             (throw
                               (Exception.
                                 ":print-history must be true for :gens-since-total-error-change"))
-                            (let [hist (:history ind)]
+                            (let [hist (mapv (partial reduce +) (:history ind))]
                               (if (or (empty? hist)
                                       (apply = hist))
                                 1000000
@@ -66,7 +66,9 @@
                             (throw
                               (Exception.
                                 ":print-history must be true for :gens-since-total-error-improvement"))
-                            (let [diffs (mapv (fn [[a b]] (- a b)) (partition 2 1 (:history ind)))]
+                            (let [diffs (mapv (fn [[a b]] (- a b))
+                                              (partition 2 1 (mapv (partial reduce +)
+                                                                   (:history ind))))]
                               (if (or (empty? diffs)
                                       (not (some neg? diffs)))
                                 1000000
@@ -77,7 +79,9 @@
                             (throw
                               (Exception.
                                 ":print-history must be true for :total-error-improvement-ratio"))
-                            (let [diffs (mapv (fn [[a b]] (- a b)) (partition 2 1 (:history ind)))]
+                            (let [diffs (mapv (fn [[a b]] (- a b))
+                                              (partition 2 1 (mapv (partial reduce +)
+                                                                   (:history ind))))]
                               (if (empty? diffs)
                                 1000000
                                 (- 1 (/ (count (filter neg? diffs))
@@ -88,7 +92,7 @@
                             (throw
                               (Exception.
                                 ":print-history must be true for :total-error-new-best-ratio"))
-                            (let [hist (:history ind)]
+                            (let [hist (mapv (partial reduce +) (:history ind))]
                               (if (empty? (rest hist))
                                 1000000
                                 (loop [remaining hist
@@ -107,7 +111,7 @@
                             (throw
                               (Exception.
                                 ":print-history must be true for :discounted-total-error-new-best-ratio"))
-                            (let [hist (:history ind)]
+                            (let [hist (mapv (partial reduce +) (:history ind))]
                               (if (empty? (rest hist))
                                 1000000
                                 (loop [remaining hist
@@ -133,7 +137,7 @@
                             (if (empty? (rest (:history ind)))
                               1000000
                               (let [diffs (mapv (fn [[a b]] (- a b))
-                                                (partition 2 1 (:history ind)))
+                                                (partition 2 1 (mapv (partial reduce +) (:history ind))))
                                     improvements (mapv #(if (neg? %) 1.0 0.0)
                                                        diffs)
                                     persistence 0.5
@@ -235,7 +239,7 @@
                            :total-error te
                            :weighted-error we
                            :normalized-error ne
-                           :history (if print-history (cons te (:history i)) (:history i)))
+                           :history (if print-history (cons e (:history i)) (:history i)))
             me (calculate-meta-errors new-ind argmap)]
         (assoc new-ind :meta-errors me)))))


CMR-183: Added def for cache key

CMR-183: Added def for cache key

--- src/cmr/common/cache.clj
+++ src/cmr/common/cache.clj
@@ -4,6 +4,9 @@
   (:require [cmr.common.log :as log :refer (debug info warn error)]
             [clojure.core.cache :as cc]))

+(def general-cache-key
+  "The key used to store he general cache in the system cache map."
+  :general)

 (defn cache-lookup
   "Looks up the value of the cached item using the key. If there is a cache miss it will invoke


Turn s-pankki data into similar format as op, s-pankki support should now be completely implemented

--- src/clj/my_money/services/spankki_csv.clj
+++ src/clj/my_money/services/spankki_csv.clj
@@ -3,8 +3,22 @@
             [my-money.csv :as csv]
             [my-money.services.bank-csv :as bank]))

+(defn ->event [raw-data]
+  (let [amount (Integer/parseInt (str/replace (:Summa raw-data) "," ""))]
+    {:transaction-id (:Arkistointitunnus raw-data)
+     :transaction-date (bank/date-string->date (:Kirjauspäivä raw-data))
+     :amount amount
+     :recipient (if (and (pos? amount) (not= "-" (:Maksaja raw-data)))
+                  (:Maksaja raw-data)
+                  (:Saajannimi raw-data))
+     :type (:Tapahtumalaji raw-data)}))
+
+(defn ->events [data-from-csv]
+  (map ->event data-from-csv))
+
 (defmethod bank/read-bank-statement :spankki [file]
   (-> file
       slurp
       (str/replace "\uFEFF" "")
-      csv/csv->clj))+      csv/csv->clj
+      ->events))


nrepl -- fix pprint misalignment

nrepl -- fix pprint misalignment

--- src/com/billpiel/sayid/string_output2.clj
+++ src/com/billpiel/sayid/string_output2.clj
@@ -360,10 +360,6 @@
                    :line
                    :line-meta?
                    :line-break
-                   :start
-                   :start-col
-                   :start-column
-                   :start-line
                    :string
                    :zipper)
            remove-nil-vals
@@ -499,7 +495,6 @@
         {:keys [start start-line]} n']
     (when (and start start-line)
       (-> start
-          (+ (* 2 start-line))
           inc))))

 (defn find-up-node
@@ -550,6 +545,13 @@
         (assoc t :neighbors [out in prev next]))
       t)))

+(defn split-text-tag-coll*
+  [tokens]
+  [(->> tokens (map :string) (apply str))
+   (->> tokens
+        (mapv mk-text-props)
+        (remove #(or (nil? (first %)) (nil? (second %)))))])
+
 (defn value->text-prop-pair*
   [a]
   (->> a
@@ -557,7 +559,7 @@
        flatten
        (remove nil?)
        (map decorate-token)
-       split-text-tag-coll))
+       split-text-tag-coll*))

 (defn tokens->text-prop-pair
   [tokens]


Fix Up Links

Fix Up Links

--- src/lens/routes.clj
+++ src/lens/routes.clj
@@ -102,7 +102,7 @@
     (ring-resp/response
      {:links
       (-> {:self {:href "/study-events"}
-           :up {:href ""}}
+           :up {:href "/"}}
           (assoc-when :prev (when (< 1 page-num) (page-link (dec page-num))))
           (assoc-when :next (when next-page? (page-link (inc page-num)))))
       :embedded
@@ -119,19 +119,19 @@
      {:id (:subject/id subject)
       :type :subject
       :links
-      {:up {:href ""}
+      {:up {:href "/"}
        :self {:href (str "/subjects/" id)}}})
     (ring-resp/not-found
-     {:links {:up {:href ""}}
+     {:links {:up {:href "/"}}
       :error "Subject not found."})))

 (defn retract-subject [conn id]
   (if (api/retract-subject conn id)
     (ring-resp/response
       {:links
-       {:up {:href ""}}})
-    (ring-resp/not-found
-     {:links {:up {:href ""}}
+       {:up {:href "/"}}})
+    (ring-resp/not-found
+     {:links {:up {:href "/"}}
       :error "Subject not found."})))

 ;; ---- Forms -----------------------------------------------------------------
@@ -181,7 +181,7 @@
     (ring-resp/response
       {:links
        (-> {:self {:href "/forms"}
-            :up {:href ""}}
+            :up {:href "/"}}
            (assoc-when :prev (when (< 1 page-num) (page-link (dec page-num))))
            (assoc-when :next (when next-page? (page-link (inc page-num)))))
        :forms
@@ -444,7 +444,7 @@
      (-> {:id (:code-list/id code-list)
           :type :code-list
           :links
-          {:up {:href ""}
+          {:up {:href "/"}
            :self {:href (str "/code-lists/" (:code-list/id code-list))}}
           :embedded
           {:lens/code-list-items
@@ -454,7 +454,7 @@
                 (render-embedded-code-list-items))}}
          (assoc-when :name (:name code-list))))
     (ring-resp/not-found
-     {:links {:up {:href ""}}
+     {:links {:up {:href "/"}}
       :error "Code list not found."})))

 ;; ---- Query -----------------------------------------------------------------
@@ -467,7 +467,7 @@
 (defn query [db expr]
   (let [visits (api/query db (edn/read-string expr))]
     (ring-resp/response
-      {:links {:up {:href ""}}
+      {:links {:up {:href "/"}}
        :visit-count (count visits)
        :visit-count-by-study-event (visit-count-by-study-event visits)
        :subject-count (->> (map :visit/subject visits)
@@ -521,5 +521,5 @@
    (POST "/query" [db expr] (query db expr))

    (fn [_] (ring-resp/not-found
-             {:links {:up {:href ""}}
+             {:links {:up {:href "/"}}
               :error "Resource not found."}))))


add nil check

add nil check

--- src/neuseg/db.clj
+++ src/neuseg/db.clj
@@ -13,11 +13,12 @@
 (defn- enum-splited-line [data line]
   (let [[idx _ _] data
         items (clojure.string/split line #"\s+")
-        chk   (println items)
         wd    (first items)
         nvec  (normalise (vec (map #(Double. %1) (rest items))))]
-    (if (= (mod idx 1000) 0) (println idx))
-    (tuple (+ idx 1) wd nvec)))
+    (if idx
+      (do
+        (if (= (mod idx 1000) 0) (println idx))
+        (tuple (+ idx 1) wd nvec)))))

 (defn- reg-wd-neglect [name data]
   (let [[idx wd nvec] data]


Support specific branches in sheet db

Support specific branches in sheet db

--- src/aerobio/validate/common.clj
+++ src/aerobio/validate/common.clj
@@ -157,8 +157,11 @@
                 :indices indices :bt1indices bt1indices :starindices starindices
                 :norms norms})))

-(defn get-exp-sheet-data [EID k]
-  (get-in @sheet-db [EID k]))
+(defn get-exp-sheet-data
+  ([EID]
+   (get @sheet-db EID))
+  ([EID k]
+   (get-in @sheet-db [EID k])))


addign / to call and using refer

addign / to call and using refer

--- src/freenas/provider.clj
+++ src/freenas/provider.clj
@@ -12,6 +12,7 @@
 (ns freenas.provider
   "Freenas jails provider"
   (:require
+    [taoensso.timbre :as timbre]
     [clojure.core.strint :refer (<<)]
     [celestial.provider :refer (wait-for-ssh mappings wait-for)]
     [freenas.remote :refer [call]]
@@ -24,7 +25,7 @@
     [celestial.model :refer (hypervisor translate vconstruct)])
  )

-(import-logging)
+(timbre/refer-timbre)

 (defn instance-id*
   "grabbing instance id of spec"
@@ -40,7 +41,7 @@
 (defrecord Jail [spec]
   Vm
   (create [this]
-    (let [{:keys [id]} (call client/post "jails/jails" spec)]
+    (let [{:keys [id]} (call client/post "jails/jails/" spec)]
      (s/partial-system (spec :system-id) {:freenas {:id id}})
      (debug "created" id)
       this)


Add child_removed handler for clj

Add child_removed handler for clj

--- src/pani/core.clj
+++ src/pani/core.clj
@@ -71,4 +71,11 @@
                                (reify com.firebase.client.ChildEventListener
                                  (onChildAdded [this v _]
                                    (cb (.getValue v)))))
+
+       (= type :child_removed)
+       (.addChildEventListener node
+                               (reify com.firebase.client.ChildEventListener
+                                 (onChildRemoved [this v]
+                                   (cb (.getValue v)))))
+
        :else (throw (Exception. (str type " is not supported")))))))


make syntax-quote produce an array-map if size is above HASHTABLE_THRESHOLD

--- src/main/clojure/clojure/tools/reader.clj
+++ src/main/clojure/clojure/tools/reader.clj
@@ -554,6 +554,11 @@
       (list 'clojure.core/apply type res)
       res)))

+(defn map-func [coll]
+  (if (>= (count (:val coll)) 16)
+    'clojure.core/hash-map
+    'clojure.core/array-map))
+
 (defn- syntax-quote* [form]
   (->>
    (cond
@@ -585,13 +590,11 @@

     (coll? form)
     (cond
-     (instance? SyntaxQuotedMap form) (syntax-quote-coll 'clojure.core/hash-map (:val form))
+     (instance? SyntaxQuotedMap form) (syntax-quote-coll (map-func form) (:val form))
      (instance? SyntaxQuotedSet form) (syntax-quote-coll 'clojure.core/hash-set (:val form))

      (instance? IRecord form) form
-     (map? form) (syntax-quote-coll 'clojure.core/hash-map (flatten-map form))
      (vector? form) (syntax-quote-coll 'clojure.core/vector form)
-     (set? form) (syntax-quote-coll 'clojure.core/hash-set form)

      (or (seq? form) (list? form))
      (let [seq (seq form)]


simplify

simplify

--- src/main/clojure/org/dada/demo/whales.clj
+++ src/main/clojure/org/dada/demo/whales.clj
@@ -87,11 +87,52 @@
       :length (Float/TYPE)
       :weight (Float/TYPE)))

+;; could try using deftype thus:
+;; (deftype Cetacean [#^String key #^Integer version])
+;; you can use dates as field names !
+;;  user=> (def field-symbol (symbol (.toString (java.util.Date.))))
+;;  #'user/field-symbol
+;;  user=> (eval (list 'deftype 'Test [field-symbol]))
+;;  #'user/Test
+;;  user=> (def myTest (Test "foo"))
+;;  #'user/myTest
+;;  user=> myTest
+;;  #:Test{:Wed Apr 07 08:26:46 BST 2010 "foo"}
+;;  user=> (def field-key (keyword field-symbol))
+;;  #'user/field-key
+;;  user=> (field-key myTest)
+;;  "foo"
+;;  user=>
+;; but clojure does NOT define accessors only:
+;;  public clojure.lang.IObj user.Test__254.withMeta(clojure.lang.IPersistentMap)
+;;  public clojure.lang.IPersistentMap user.Test__254.meta()
+;;  public java.lang.Object user.Test__254.valAt(java.lang.Object)
+;;  public java.lang.Object user.Test__254.valAt(java.lang.Object,java.lang.Object)
+;;  public clojure.lang.ILookupThunk user.Test__254.getLookupThunk(clojure.lang.Keyword)
+;;  public clojure.lang.Keyword user.Test__254.getDynamicType()
+;;  public java.lang.Object user.Test__254.getDynamicField(clojure.lang.Keyword,java.lang.Object)
+;;  public clojure.lang.IPersistentMap user.Test__254.getExtensionMap()
+;; interestingly, clojure does define the following instance fields:
+;;  public final java.lang.Object user.Test__254.Wed Apr 07 08_COLON_26_COLON_46 BST 2010
+;;  public final java.lang.Object user.Test__254.__meta
+;;  public final java.lang.Object user.Test__254.__extmap
+
+;; a deftyped instance has slower access times - see below -
+;; getter1/test1 uses a deftyped object, whereas getter2/test2 uses a
+;; ClassFactory-ed object:
+
+;; user=> (time (dotimes [n 100000000] (getter1 test1)))
+;; "Elapsed time: 8615.820346 msecs"
+;; nil
+;; user=> (time (dotimes [n 100000000] (getter2 test2)))
+;; "Elapsed time: 5298.08904 msecs"
+;; nil
+
 (def #^Class Whale (apply make-class "org.dada.demo.whales.Whale" Object attributes))
 (def #^Metadata whale-metadata (apply metadata Whale :time :version attributes))
 (def #^Model whales (model "Whales" whale-metadata))

-(def num-whales 10000)
+(def num-whales 1000)
 (def start-time (System/currentTimeMillis))

 (insert *metamodel* whales)
@@ -115,22 +156,61 @@

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

+(defn dfilter [#^Model src-model #^String tgt-view #^Collection attr-keys #^IFn filter-fn]
+  ;; TODO: accept ready-made View
+  (insert *metamodel* (do-filter tgt-view src-model attr-keys filter-fn)))
+
+(defn dtransform [#^Model src-model #^String suffix & #^Collection attribute-descrips]
+  ;; TOODO: accept ready-made View ?
+  (insert *metamodel* (apply do-transform suffix src-model attribute-descrips)))
+
+(defn dcount
+  ([#^Model src-model key-value]
+   (let [key-type (type key-value)]
+     (dcount src-model key-type key-value)))
+  ([#^Model src-model #^Class key-type key-value]
+   (dcount src-model key-type key-value (count-reducer-metadata key-type)))
+  ([#^Model src-model #^Class key-type key-value #^Metadata metadata]
+   (insert *metamodel* (do-reduce-count src-model key-type key-value metadata)))
+  )
+
+(defn dsum
+  ([#^Model src-model #^Keyword attribute-key key-value]
+   (dsum src-model attribute-key (type key-value) key-value))
+  ([#^Model src-model #^Keyword attribute-key #^Class key-type key-value]
+   (insert *metamodel* (do-reduce-sum src-model attribute-key key-type key-value)))
+  )
+
+;; try to lose key-to-valua and vice-versa then define dpivot...
+(defn dsplit [#^Model src-model #^Keyword key #^boolean mutable #^IFn value-to-keys #^IFn key-to-value #^IFn tgt-hook]
+  (do-split
+   src-model
+   key
+   mutable
+   value-to-keys
+   key-to-value
+   (fn [#^Model model value]
+       (insert *metamodel* model)
+       (tgt-hook model value)
+       )
+   )
+  )
+
+;;----------------------------------------
+
 ;; demonstrate filtration - only selecting a subset of the values from
 ;; one model into another - based on their contents.

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

-(let [half-max-length (/ max-length 2)]
-  (def longer-whales
-       (do-filter (str "length>" half-max-length) whales '(:length) #(> % half-max-length))))
-
-(insert *metamodel* longer-whales)
-
-(let [half-max-weight (/ max-weight 2)]
-  (def heavier-whales
-       (do-filter (str "weight>" half-max-weight)  whales '(:weight) #(> % half-max-weight))))
-
-(insert *metamodel* heavier-whales)
+(def median-length (/ max-length 2))
+(def median-weight (/ max-weight 2))
+
+(def longer-whales
+     (dfilter whales (str "length>" median-length) '(:length) #(> % median-length)))
+
+(def heavier-whales
+     (dfilter whales (str "weight>" median-weight) '(:weight) #(> % median-weight)))

 ;;----------------------------------------
 ;; demonstrate transformation - only selecting a subset of the
@@ -138,26 +218,29 @@
 ;; attributes...
 ;;----------------------------------------

-(def longer-whales-weight (do-transform "weight" longer-whales :time :version :time :version :weight))
-(insert *metamodel* longer-whales-weight)
-
-(def #^Model heavier-whales-length (do-transform "length" heavier-whales :time :version :time :version :length))
-(insert *metamodel* heavier-whales-length)
+(def longer-whales-weight
+     (dtransform longer-whales "weight" :time :version :time :version :weight))
+
+(def #^Model heavier-whales-length
+     (dtransform heavier-whales "length" :time :version :time :version :length))

 ;;----------------------------------------
 ;; demonstrate transformation - a synthetic field - metric tons per metre
 ;;----------------------------------------

-(insert *metamodel*
-	(do-transform
-	 "tonsPerMetre"
-	 whales
-	 :time
-	 :version
-	 :time
-	 :version
-	 (list :tonsPerMetre Number '(:weight :length) (fn [weight length] (if (= length 0) 0 (/ weight length)))))
-	)
+(dtransform
+ whales
+ "tonsPerMetre"
+ :time
+ :version
+ :time
+ :version
+ (list
+  :tonsPerMetre
+  Number
+  '(:weight :length)
+  (fn [weight length] (if (= length 0) 0 (/ weight length))))
+ )

 ;;----------------------------------------
 ;; try a transformation on top of a filtration
@@ -165,60 +248,57 @@
 ;;----------------------------------------

 (def narwhals-length
-     (do-transform
-      "length"
-      (do-filter
+     (dtransform
+      (dfilter
+       whales
        "type=narwhal"
-       whales
        '(:type)
        #(= "narwhal" %))
+      "length"
       :time
       :version
       :time
       :version
       :length)
      )
-(insert *metamodel* narwhals-length)

 ;;----------------------------------------
 ;; demonstrate reduction (sum)
 ;;----------------------------------------

-(insert *metamodel* (do-reduce-count whales String "whales"))
-(insert *metamodel* (do-reduce-sum whales :length String "whales"))
-(insert *metamodel* (do-reduce-sum whales :weight String "whales"))
-(insert *metamodel* (do-reduce-count heavier-whales-length String "heavier-whales"))
-(insert *metamodel* (do-reduce-sum heavier-whales-length :length String "heavier-whales"))
-(insert *metamodel* (do-reduce-sum longer-whales-weight :weight String "longer-whales"))
-(insert *metamodel* (do-reduce-count longer-whales-weight String "longer-whales"))
-
-;;----------------------------------------
-;; demonstrate splitting [and more reduction)
-;;----------------------------------------
-
-(let [type-count-metadata (class-metadata
-       			   "org.dada.demo.whales.TypeCount"
-       			   Object
-       			   :key
-       			   :version
-       			   [:key String :version Integer :count Integer])
-      type-count-model (model "Whales.count(types)" type-count-metadata)
+(dcount whales "whales")
+(dsum whales :length "whales")
+(dsum whales :weight "whales")
+(dcount heavier-whales-length "heavier-whales")
+(dsum heavier-whales-length :length "heavier-whales")
+(dsum longer-whales-weight :weight "longer-whales")
+(dcount longer-whales-weight "longer-whales")
+
+;;----------------------------------------
+;; demonstrate splitting [and more reduction] - a pivot...
+;;----------------------------------------
+
+(let [pivot-metadata (class-metadata
+		      "org.dada.demo.whales.TypeCount"
+		      Object
+		      :key
+		      :version
+		      [:key String :version Integer :count Integer])
+      pivot-model (model "Whales.count(split(type))" pivot-metadata)
       ]
-  (insert *metamodel* type-count-model)
-  (do-split
+  (insert *metamodel* pivot-model)
+  (dsplit
    whales
    :type
    false
    list
    identity
    (fn [#^Model model value]
-       (insert *metamodel* model)
-       (let [tcm (do-reduce-count model String value type-count-metadata)]
-	 (insert *metamodel* tcm)
-	 (connect tcm type-count-model)
+       (let [tcm (dcount model String value pivot-metadata)]
+	 (connect tcm pivot-model)
 	 )
-       (insert *metamodel* (do-reduce-sum model :length String value))
-       (insert *metamodel* (do-reduce-sum model :weight String value))
+       (dsum model :length value)
+       (dsum model :weight value)
        model ; TODO: do we really need to be able to override the model ? should threading go here ?
        )
    ))


don't gzip when we upload to s3

don't gzip when we upload to s3

--- src/pc/assets.clj
+++ src/pc/assets.clj
@@ -158,9 +158,8 @@
     (log/infof "uploading %s to %s" full-path key)
     (s3/put-object :bucket-name cdn-bucket
                    :key key
-                   :input-stream (gzip/gzip full-path)
+                   :file full-path
                    :metadata {:content-type (mime-type-of full-path)
-                              :content-encoding "gzip"
                               :cache-control "max-age=3155692"})))

 (defn upload-manifest [sha1]
@@ -177,9 +176,8 @@
                              (log/infof "pushing %s to %s" file-path key)
                              (s3/put-object :bucket-name cdn-bucket
                                             :key key
-                                            :input-stream (gzip/gzip file-path)
+                                            :file file-path
                                             :metadata {:content-type (mime-type-of file-path)
-                                                       :content-encoding "gzip"
                                                        :cache-control "max-age=3155692"})
                              (assoc acc path {:s3-key key :s3-bucket cdn-bucket})))
                          {} manifest-paths)


\ to /

\ to /

Bug fix

--- src/hello_world/core.clj
+++ src/hello_world/core.clj
@@ -29,7 +29,7 @@
 (defn page [name]
   (str ""
        (if name
-  (str "Nice to meet you, " name "! \n" "
<\div>")
+  (str "Nice to meet you, " name "! \n" "

")
         (str "<form>"
               "Name: <input name='name' type='text'>"
               "<input type='submit'>"


Fix bug with vertical-alignment modes being incorrectly declared as a fn rather than a val

--- src/quil/core.clj
+++ src/quil/core.clj
@@ -3694,7 +3694,7 @@
                               :center PApplet/CENTER
                               :right PApplet/RIGHT})

-(defn ^{:private true}
+(def ^{:private true}
   vertical-alignment-modes {:top PApplet/TOP
                             :bottom PApplet/BOTTOM
                             :center PApplet/CENTER


category stats by distinct category

category stats by distinct category

--- src/spcr/core.clj
+++ src/spcr/core.clj
@@ -54,7 +54,9 @@

 (defn get-label-stats []
   (->> (get-labeled-data)
-       (group-by :labels)
+       (map :labels)
+       (flatten)
+       (group-by identity)
        (map (fn [[k v]] [k (count v)]))))

 (defn import-file [file-path]


Time arithmetic

Time arithmetic

--- src/tick/core.clj
+++ src/tick/core.clj
@@ -1,13 +1,13 @@
 ;; Copyright © 2016-2017, JUXT LTD.

 (ns tick.core
+  (:refer-clojure :exclude [+ - inc dec max min range])
   (:require
    [clojure.spec.alpha :as s])
   (:import
    [java.time Clock ZoneId Instant Duration DayOfWeek Month ZonedDateTime LocalDate]
    [java.time.format DateTimeFormatter]
    [java.time.temporal ChronoUnit]))
-

 (defn nanos [n]
   (Duration/ofNanos n))
@@ -27,6 +27,11 @@
 (defn days [n]
   (Duration/ofDays n))

+(defn weeks [n]
+  (Duration/ofDays (* 7 n)))
+
+(defn now [] (Instant/now))
+
 (s/def ::instant #(instance? Instant %))

 (defprotocol IInstant
@@ -35,3 +40,58 @@
 (extend-protocol IInstant
   String
   (instant [s] (Instant/from (.parse (DateTimeFormatter/ISO_INSTANT) s))))
+
+(defprotocol ITimeArithmetic
+  (plus-t [_ _] "Add time")
+  (minus-t [_ _] "Subtract time")
+  (inc-t [_] "Increment time")
+  (dec-t [_] "Decrement time")
+  (max-t [_ _] "Return maximum")
+  (min-t [_ _] "Return minimum")
+  (range-t [_] [_ _] [_ _ _] "Returns a lazy seq of times from start (inclusive) to end (exclusive, nil means forever), by step, where start defaults to 0, step to 1, and end to infinity."))
+
+(extend-type Instant
+  ITimeArithmetic
+  (plus-t [t x] (.plus t x))
+  (minus-t [t x] (.minus t x))
+  (inc-t [t] (plus-t t (seconds 1)))
+  (dec-t [t] (minus-t 1 (seconds 1)))
+  (max-t [x y] (if (>= (.toEpochMilli x) (.toEpochMilli y))
+                 x y))
+  (min-t [x y] (if (<= (.toEpochMilli x) (.toEpochMilli y))
+                 x y))
+  (range-t
+    ([from] (iterate #(.plusSeconds % 1) from))
+    ([from to] (cond->> (iterate #(.plusSeconds % 1) from)
+                 to (take-while #(.isBefore % to))))
+    ([from to step] (cond->> (iterate #(.plus % step) from)
+                      to (take-while #(.isBefore % to))))))
+
+(extend-type LocalDate
+  ITimeArithmetic
+  (plus-t [t x] (.plusDays t x))
+  (minus-t [t x] (.minusDays t x))
+  (inc-t [t] (.plusDays t 1))
+  (dec-t [t] (.minusDays t 1))
+  (max-t [x y] (if (>= (.toEpochDay x) (.toEpochDay y)) x y))
+  (min-t [x y] (if (<= (.toEpochDay x) (.toEpochDay y)) x y))
+  (range-t
+    ([from] (iterate #(.plusDays % 1) from))
+    ([from to] (cond->> (iterate #(.plusDays % 1) from)
+                 to (take-while #(.isBefore % to) )))
+    ([from to step] (cond->> (iterate #(.plusDays % step) from)
+                      to (take-while #(.isBefore % to))))))
+
+(defn + [arg & args]
+  (reduce #(plus-t %1 %2) arg args))
+
+(defn - [arg & args]
+ (reduce #(minus-t %1 %2) arg args))
+
+(defn max [arg & args]
+  (reduce #(max-t %1 %2) arg args))
+
+(defn min [arg & args]
+  (reduce #(min-t %1 %2) arg args))
+
+(def range range-t)


cleanup

cleanup

--- src/babel/forest.clj
+++ src/babel/forest.clj
@@ -53,38 +53,7 @@
                   (log/debug (str "generate-all(details): " (show-spec spec)))
                   (let [lb (lightning-bolt grammar
                                       lexicon
-                                      spec 0 index nil morph)
-                        check1 (remove #(= % nil)
-                                       (concat
-
-                                        (map #(get-in % [:head :head :subcat]) lb)
-                                        (map #(get-in % [:head :subcat]) lb)
-                                        (map #(get-in % [:subcat]) lb)
-
-                                        ))]
-                    (if (not (empty? check1))
-                      (let [message (str "BAD BOLT RESULT: (foo):"
-                                         (string/join ","
-                                                      (map #(get-in % [:synsem :foo])
-                                                           lb))
-                                         " >>> "
-                                         (string/join ","
-                                                      (map #(get-in % [:head :head :subcat] :none)
-                                                           lb))
-                                         " >>> "
-                                         (string/join ","
-                                                      (map #(get-in % [:head :subcat] :none)
-                                                           lb))
-                                         " >>> "
-                                         (string/join ","
-                                                      (map #(get-in % [:subcat] :none)
-                                                           lb))
-                                         " >>> "
-                                         (string/join "," (map #(get-in % [:rule])
-                                                               lb)))]
-                        (log/error message)
-                        (throw (Exception. message))))
-
+                                      spec 0 index nil morph)]
                     (-> lb
                         ;; TODO: allow more than a fixed maximum depth of generation (here, 4 levels from top of tree).
                         (add-complements-to-bolts [:head :head :head :comp] :top grammar lexicon index morph)


fix error when trying to parse less than 2 tokens

--- src/babel/parse.cljc
+++ src/babel/parse.cljc
@@ -40,34 +40,38 @@
   ;;  3 ([[0 2] [2 3]] [[1 2] [2 3]] ... ) ;; each pair has a combined size of 3
   ;;  4 ([[0 3] [3 4]] [[1 2] [2 4]] ..
   ;;  5 ([[0 4] [4 5]] [[1 3] [3 5]] ... ) } ;; each pair has a combined size of 5.
-  (let [
-        ;; TODO: rather than this function, make a static lookup table, at least for n < (e.g.) 5.
-        ;; e.g. (spanpairs 5) =>
-        ;; ([0 1] [0 2].. [0 5] [1 2] ..[1 4] [1 5] .... [4 5])
-        spanpairs (fn [n]
-                    (mapcat (fn [x]
-                              (map-fn (fn [y]
-                                        [x y])
-                                      (range (+ x 1) (+ n 1))))
-                            (range 0 n)))
+  (cond
+    (< n 2)
+    nil

-        spans (square-cross-product (spanpairs n))]
-    (merge
-     {1 (map-fn
-         (fn [i]
-           [i (+ 1 i)])
-         (range 0 n))}
-     (reduce (fn [resultant-map this-submap]
-               (merge-with union ;; TODO: this could get expensive - consider alternatives.
-                           resultant-map this-submap))
-             (map-fn (fn [span-pair]
-                       (let [left-span (first span-pair)
-                             left-boundary (first left-span)
-                             right-span (second span-pair)
-                             right-boundary (second right-span)]
-                         {(- right-boundary left-boundary)
-                          (list span-pair)}))
-                     spans)))))
+    true
+    (let [
+          ;; TODO: rather than this function, make a static lookup table, at least for n < (e.g.) 5.
+          ;; e.g. (spanpairs 5) =>
+          ;; ([0 1] [0 2].. [0 5] [1 2] ..[1 4] [1 5] .... [4 5])
+          spanpairs (fn [n]
+                      (mapcat (fn [x]
+                                (map-fn (fn [y]
+                                          [x y])
+                                        (range (+ x 1) (+ n 1))))
+                              (range 0 n)))
+          spans (square-cross-product (spanpairs n))]
+      (merge
+       {1 (map-fn
+           (fn [i]
+             [i (+ 1 i)])
+           (range 0 n))}
+       (reduce (fn [resultant-map this-submap]
+                 (merge-with union ;; TODO: this could get expensive - consider alternatives.
+                             resultant-map this-submap))
+               (map-fn (fn [span-pair]
+                         (let [left-span (first span-pair)
+                               left-boundary (first left-span)
+                               right-span (second span-pair)
+                               right-boundary (second right-span)]
+                           {(- right-boundary left-boundary)
+                            (list span-pair)}))
+                       spans))))))

 (defn parses [input n model span-map]
   (cond


replaced customized header with x-requested-with

--- src/cerber/error.clj
+++ src/cerber/error.clj
@@ -51,6 +51,12 @@
 (defn bad-request [message]
   (map->HttpError {:error "bad_request" :message message :code 400}))

+(defn ajax-request?
+  "Returns true if X-Requested-With header was found with
+  XMLHttpRequest value, returns false otherwise."
+  [headers]
+  (= (headers "x-requested-with") "XMLHttpRequest"))
+
 (defn error->redirect
   "Tranforms error into http redirect response.
   Error info is added as query param as described in 4.1.2.1. Error Response of OAuth2 spec"
@@ -70,13 +76,15 @@
   [http-error state headers uri]
   (let [{:keys [code error message]} http-error]
     (if (or (= code 401) (= code 403))
-      (if (headers "authorization")
+      (if (or (headers "authorization")
+              (ajax-request? headers))

         ;; oauth request
         {:status code
          :headers {"WWW-Authenticate" (str "Bearer realm=\"" (:realm app-config)
                                            "\",error=\"" error
                                            "\",error_description=\"" message "\"")}}
+
         ;; browser-based requested
         {:status 302
          :headers {"Location" (get-in app-config [:endpoints :authentication])}


Fixed scp failed

Fixed scp failed

--- src/control/core.clj
+++ src/control/core.clj
@@ -58,7 +58,7 @@
 (defmacro scp
   [host user files remoteDir]
   `(display ~host "scp" (str ~files " ==> " ~remoteDir))
-  (exec ~host ~user ["scp" ~@files (str (client ~host ~user) ":"  ~remoteDir)]))
+  `(exec ~host ~user ["scp" ~@files (str (client ~host ~user) ":"  ~remoteDir)]))


[#2385] Use FLOW API default page_size

[#2385] Use FLOW API default page_size

--- backend/src/akvo/lumen/lib/import/flow_common.clj
+++ backend/src/akvo/lumen/lib/import/flow_common.clj
@@ -45,8 +45,7 @@
 (defn form-instances
   "Returns a lazy sequence of form instances"
   [headers-fn form]
-  (let [initial-url (str (:formInstancesUrl form) "&page_size=300")]
-    (form-instances* headers-fn initial-url)))
+  (form-instances* headers-fn (:formInstancesUrl form)))

 (defn data-points*
   [headers-fn url]
@@ -61,9 +60,7 @@
   "Returns all survey data points"
   [headers-fn survey]
   (loop [all-data-points []
-         response (data-points* headers-fn
-                                (str (:dataPointsUrl survey)
-                                     "&page_size=300"))]
+         response (data-points* headers-fn (:dataPointsUrl survey))]
     (if-let [url (get response "nextPageUrl")]
       (recur (into all-data-points (get response "dataPoints"))
              (data-points* headers-fn url))


[#2384] Use defaults for Flow form instance import

--- backend/src/akvo/lumen/lib/import/flow_common.clj
+++ backend/src/akvo/lumen/lib/import/flow_common.clj
@@ -1,31 +1,49 @@
 (ns akvo.lumen.lib.import.flow-common
-  (:require [akvo.commons.psql-util :as pg]
-            [cheshire.core :as json]
-            [akvo.lumen.http.client :as http.client]
-            [clojure.java.jdbc :as jdbc]
-            [clojure.string :as str])
+  (:require
+   [akvo.commons.psql-util :as pg]
+   [akvo.lumen.http.client :as http.client]
+   [cheshire.core :as json]
+   [clojure.java.jdbc :as jdbc]
+   [clojure.string :as str]
+   [clojure.tools.logging :as log]
+   [diehard.core :as dh])
   (:import [java.time Instant]))

 ;; only use this value from a different thread/future
 (def ^:private http-client-req-defaults (http.client/req-opts 60000))

+(def retry-policy
+  {:retry-on Exception
+   :delay-ms 5000
+   :max-retries 6})
+
 (defn survey-definition
   [api-root headers-fn instance survey-id]
-  (-> (format "%s/orgs/%s/surveys/%s"
-              api-root instance survey-id)
-      (http.client/get* (merge http-client-req-defaults {:headers (headers-fn)
-                                                         :as :json}))
-      :body))
+  (dh/with-retry
+    {:policy
+     (assoc retry-policy
+            :on-retry (fn [_ e]
+                        (log/info ::survey-definition*-retry e))
+            :on-success (fn [{:keys [body]}]
+                          body))}
+    (-> (format "%s/orgs/%s/surveys/%s" api-root instance survey-id)
+        (http.client/get* (merge http-client-req-defaults
+                                 {:headers (headers-fn)
+                                  :as :json})))))

 (defn form-instances* [headers-fn url]
-  (let [response (-> url
-                     (http.client/get* (merge http-client-req-defaults
-                                              {:headers (headers-fn)
-                                               :as :json-string-keys}))
-                     :body)]
-    (lazy-cat (get response "formInstances")
-              (when-let [url (get response "nextPageUrl")]
-                (form-instances* headers-fn url)))))
+  (dh/with-retry
+    {:policy
+     (assoc retry-policy
+            :on-retry (fn [_ e]
+                        (log/info ::form-instances*-retry e))
+            :on-success (fn [{{:strs [formInstances nextPageUrl]} :body}]
+                          (lazy-cat formInstances
+                                    (when-let [url nextPageUrl]
+                                      (form-instances* headers-fn url)))))}
+    (http.client/get* url (merge http-client-req-defaults
+                                 {:headers (headers-fn)
+                                  :as :json-string-keys}))))

 (defn form-instances
   "Returns a lazy sequence of form instances"
@@ -35,11 +53,16 @@

 (defn data-points*
   [headers-fn url]
-  (-> url
-      (http.client/get* (merge http-client-req-defaults
-                               {:headers (headers-fn)
-                                :as :json-string-keys}))
-      :body))
+  (dh/with-retry
+    {:policy
+     (assoc retry-policy
+            :on-retry (fn [_ e]
+                        (log/info ::data-points*-retry e))
+            :on-success (fn [{:keys [body]}]
+                          body))}
+    (http.client/get* url (merge http-client-req-defaults
+                                 {:headers (headers-fn)
+                                  :as :json-string-keys}))))

 (defn data-points
   "Returns all survey data points"


Deduplication

Deduplication

--- src/yada/body.clj
+++ src/yada/body.clj
@@ -4,6 +4,7 @@
   (:require
    [clojure.walk :refer [keywordize-keys]]
    [clojure.pprint :refer [pprint]]
+   [clojure.tools.logging :refer :all]
    [byte-streams :as bs]
    [cheshire.core :as json]
    [hiccup.core :refer [html]]
@@ -13,6 +14,7 @@
    [ring.util.codec :as codec]
    [ring.swagger.schema :as rs]
    [yada.charset :as charset]
+   [yada.journal :as journal]
    [yada.media-type :as mt])
   (:import
    [clojure.core.async.impl.channels ManyToManyChannel]
@@ -51,14 +53,17 @@
 (defmulti render-map (fn [resource representation] (-> representation :media-type mt/media-type)))
 (defmulti render-seq (fn [resource representation] (-> representation :media-type mt/media-type)))

+(defn encode-message [s representation]
+  (bs/convert s java.nio.ByteBuffer
+              {:encoding (or (some-> representation :charset charset/charset)
+                             charset/default-platform-charset)}))
+
 (extend-protocol MessageBody

   String
   ;; A String is already its own representation, all we must do now is encode it to a char buffer
   (to-body [s representation]
-    (bs/convert s java.nio.ByteBuffer
-                {:encoding (or (some-> representation :charset charset/charset)
-                               charset/default-platform-charset)}))
+    (encode-message s representation))

   ;; The content-length is NOT the length of the string, but the
   ;; "decimal number of octets, for a potential payload body".
@@ -68,7 +73,12 @@

   clojure.lang.APersistentMap
   (to-body [m representation]
-    (to-body (render-map m representation) representation))
+    ;; We always try to arrive at a string which is then converted
+    (encode-message (render-map m representation) representation))
+
+  clojure.lang.APersistentVector
+  (to-body [v representation]
+    (encode-message (render-seq v representation) representation))

   File
   (to-body [f _]
@@ -154,10 +164,75 @@

 (defmethod render-map :default
   [m representation]
-  (throw (ex-info "Attempt to call render-map without a media-type"
+  (throw (ex-info (format "Attempt to call render-map without a media-type: %s" (pr-str representation))
                   {:representation representation})))

 (defmethod render-seq :default
   [m representation]
-  (throw (ex-info "Attempt to call render-seq without a media-type"
+  (throw (ex-info (format "Attempt to call render-seq without a media-type: %s" (pr-str representation))
                   {:representation representation})))
+
+
+;; Errors
+
+(def ^{:dynamic true
+       :doc "When set to logical true, errors will be printed. Defaults to true."}
+  *output-errors* true)
+
+(def ^{:dynamic true
+       :doc "When set to logical true, errors will be output with their stack-traces. Defaults to true."}
+  *output-stack-traces* true)
+
+(defmulti render-error (fn [status error representation ctx] (-> representation :media-type mt/media-type)))
+
+(defn get-error-message [status]
+  (case status
+    404 "Not Found"
+    "Unknown"))
+
+(defmethod render-error "text/html"
+  [status error representation {:keys [id options]}]
+  (html
+   [:body
+    [:h1 (format "%d: %s" status (get-error-message status))]
+
+    ;; Only
+    (when *output-errors*
+      [:div
+       [:p (.getMessage error)]
+       (when *output-stack-traces*
+         [:pre
+          (with-out-str (pprint error))])])
+
+    (when-let [path (:journal-browser-path options)]
+      [:div
+       [:p "Details"]
+       [:a {:href (str path (journal/path-for :entry :id id))} id]])
+
+    [:hr]
+    [:div
+     [:p "yada"]]]))
+
+(defmethod render-error "application/edn"
+  [status error representation {:keys [id options]}]
+  {:status status
+   :message (get-error-message status)
+   :id id
+   :error error})
+
+(cheshire.generate/add-encoder clojure.lang.ExceptionInfo
+                               (fn [ei jg]
+                                 (cheshire.generate/encode-map
+                                  {:error (str ei)
+                                   :data (pr-str (ex-data ei))} jg)))
+
+(defmethod render-error "application/json"
+  [status error representation {:keys [id options]}]
+  {:status status
+   :message (get-error-message status)
+   :id id
+   :error error})
+
+(defmethod render-error :default
+  [status error representation {:keys [id options]}]
+  nil)


should be working...

should be working...

--- src/bracketolojy/tournament.clj
+++ src/bracketolojy/tournament.clj
@@ -2,7 +2,7 @@
   (:require [clojure.math.combinatorics :as combo]
             [bracketolojy.util :refer :all]
             [bracketolojy.log5 :as log5]
-            [bracketolojy.team-data :as data]
+            [bracketolojy.zip :as bzip]
             [clojure.walk :as walk]
             [clojure.zip :as zip]))

@@ -77,7 +77,9 @@
                           (get-in [:data :round])
                           dec)
                   max-rnd)]
-      (recur max-rnd (zip/next (zip/edit loc (partial update-round rnd)))))))
+      (->> (zip/edit loc (partial update-round rnd))
+           zip/next
+           (recur max-rnd)))))

 (defn round-info [max-rounds tree]
   (->> (zip/zipper
@@ -111,18 +113,7 @@
                                                upset-pts)
                                              pick-pts))))))

-(defn- compute-matchup-dispatch [_ _ node]
-  (when (and (map? node) (contains? node :upper) (contains? node :lower))
-    :branch))
-
-(defmulti #^{:private true} compute-matchup
-          "Compute a matchup.  The first argument is an associative structure that gives the points per a correct pick
-           for each round.  The second argument is an associative structure that gives the points per an upset pick for each
-           round.  The third and final argument is the matchup data to perform the computation on."
-          compute-matchup-dispatch)
-(defmethod compute-matchup :default [_ _ node]
-  node)
-(defmethod compute-matchup :branch [pick-pts-fn upset-pts-fn node]
+(defn update-matchup [pick-pts-fn upset-pts-fn node]
   (let [round (get-in node [:data :round])
         pick-pts (pick-pts-fn round)
         upset-pts (upset-pts-fn round)]
@@ -137,7 +128,23 @@
                (assoc %1 name %2)))
            {})
          vals                                               ;get the aggregation
-         (assoc-in node [:data :teams]))))                  ;preserve the tree
+         (assoc-in node [:data :teams]))))
+
+(defn compute-matchup [pick-pts-fn upset-pts-fn loc]
+  (if (zip/end? loc)
+    loc
+    (->> (zip/edit loc (partial update-matchup pick-pts-fn upset-pts-fn))
+         bzip/post-order-next
+         (recur pick-pts-fn upset-pts-fn))))
+
+(defn matchup-info [pick-pts-fn upset-pts-fn tree]
+  (->> tree
+       (zip/zipper
+         branch?
+         children
+         make-node)
+       bzip/post-order-first
+       (compute-matchup pick-pts-fn upset-pts-fn)))

 (defn tournament-probabilities
   "Computes the probability of the various outcomes of a tournament.  Calculates the first round, then
@@ -205,6 +212,7 @@
        ->tournament-tree
        (#(let [tree %]
           (round-info (max-round tree) tree)))
+       (matchup-info pick-scoring upset-scoring)
        (tournament-probabilities
          pick-scoring
          upset-scoring)