Minor code tidying.

Minor code tidying.

--- src/circleci/web/views/index.clj
+++ src/circleci/web/views/index.clj
@@ -74,35 +74,37 @@

 (defpartial signupform [& content]
   [:div.move-right
-  [:div.blue-box
+   [:div.blue-box
+    [:h2.takepart "Take part in the beta"]
+    [:p.whenready "We'll email you when we're ready."]
+    [:form {:action "/" :method "POST"}
+     [:fieldset#actualform
+      (unordered-list
+       [(list (text-field {:id "email"
+                           :type "text"
+                           :onfocus "if (this.value == 'Email address') { this.value=''};"
+                           :onblur "if (this.value == '') { this.value = 'Email address'};"}
+                           "email" "Email address"))
+        (list (check-box {:id "contact"
+                           :name "contact"
+                           :checked true} "contact")
+              [:div
+               [:div
+                (label {:id "contact-label"}
+                       "contact"
+                       "May we contact you to ask about your platform, stack, test suite, etc?")]])])]
+     [:fieldset
+      [:input.call_to_action {:type "submit"
+                              :value "Get Notified"}]]]]])

-  [:h2.takepart "Take part in the beta"]
-  [:p.whenready "We'll email you when we're ready."]
-  [:form {:action "/" :method "POST"}
-   [:fieldset#actualform
-    (unordered-list
-     [(list (text-field {:id "email"
-                         :type "text"
-                         :onfocus "if (this.value == 'Email address') { this.value=''};"
-                         :onblur "if (this.value == '') { this.value = 'Email address'};"}
-                         "email" "Email address"))
-      (list (check-box {:id "contact"
-                         :name "contact"
-                         :checked true} "contact")
-            [:div [:div
-            (label {:id "contact-label"} "contact" "May we contact you to ask about your platform, stack, test suite, etc?")]])])]
-   [:fieldset
-    [:input.call_to_action {:type "submit"
-                            :value "Get Notified"}]]]]]
-)

-;; You need expires for IE6-8
+
 (defn delete-cookie [name]
-  (cookies/put! name {:value "1"
+  (cookies/put! name {:value ""
                       :max-age 0
-                      :expires 0
+                      :expires 0 ; You need expires for IE6-8
                       :path "/"})
-  "")
+  "") ; return a string

 (defpartial youre-done [& content]
   (delete-cookie :signed-up)


Add quarterly data

Add quarterly data

--- src/clj_simple_chart/ssb/kpi.clj
+++ src/clj_simple_chart/ssb/kpi.clj
@@ -29,10 +29,31 @@
               ["Januar" "Februar" "Mars" "April" "Mai" "Juni" "Juli" "August" "September" "Oktober" "November" "Desember"]
               (mapv #(format "%02d" %) (range 1 13))))

+(def month-to-quarter
+  {"01" "1"
+   "02" "1"
+   "03" "1"
+
+   "04" "2"
+   "05" "2"
+   "06" "2"
+
+   "07" "3"
+   "08" "3"
+   "09" "3"
+
+   "10" "4"
+   "11" "4"
+   "12" "4"})
+
 (defn process-entry [x]
   (reduce (fn [o [k v]]
-            (cond (year k) (conj o {:dato  (str (year k) "-" (get months (:måned x)))
-                                    :kpi v})
+            (cond (year k) (conj o {:dato         (str (year k) "-" (get months (:måned x)))
+                                    :year         (str (year k))
+                                    :year-quarter (str (year k) "Q"
+                                                       (get month-to-quarter
+                                                            (get months (:måned x))))
+                                    :kpi          v})
                   :else o))
           []
           x))
@@ -44,5 +65,20 @@
                  (remove #(= "." (:kpi %)))
                  (vec)))

-(csv/write-csv "./data/08981/08981-kpi.csv"  {:data    parsed
-                                              :columns [:dato :kpi]})
+
+(csv/write-csv "./data/08981/08981-kpi.csv" {:data    parsed
+                                             :columns [:dato :kpi]})
+
+(def quarterly (->> parsed
+                    (group-by :year-quarter)
+                    (vals)
+                    (mapv (fn [x] {:dato (:year-quarter (first x))
+                                   :kpi  (/ (reduce + 0 (mapv (comp read-string :kpi) x))
+                                            (count x))
+                                   }))
+                    (sort-by :dato)
+                    (vec)))
+
+(csv/write-csv "./data/08981/08981-kpi-quarterly.csv"
+               {:data    (mapv #(assoc % :kpi (format "%.1f" (:kpi %))) quarterly)
+                :columns [:dato :kpi]})


Ball moves, collision doesn't

Ball moves, collision doesn't

--- src/cljs/clj_mini_apps/pong.cljs
+++ src/cljs/clj_mini_apps/pong.cljs
@@ -12,12 +12,14 @@

 (def paddle-width 20)

-(def speed 10)
+(def speed 7)
+
+(def ball-speed 2)

 (defn init-game []
   (log "init-game")
   ;Create background and outline
-  (q/frame-rate 1)
+  (q/frame-rate 60)
   (q/smooth)
   (q/background 209 209 210)
   (q/fill 255)
@@ -31,49 +33,80 @@
   (q/ellipse 550 250 ball-size ball-size)
   {:player {:x 59 :y 250} :computer {:x 1040 :y 250} :ball {:x 550 :y 250}})

-(defn handle-input [state]
-  (log "handle-input")
-  (log (q/key-as-keyword))
-  (condp = (q/key-as-keyword)
-    :w (move-player-paddle state :up)
-    :s (move-player-paddle state :down)
-    (keyword " ") (start-game state)
-    state)
-  state)
-
 (defn move-player-paddle
   [state direction]
-  (log "move-player-paddle")
-  (log direction)
+  ;(log "move-player-paddle")
   (if (= direction :down)
     (update-in state [:player :y] + speed)
     (update-in state [:player :y] - speed)))

 (defn start-game
   [state]
-  (log "start-game"))
+  ;(log "start-game")
+  (if (= 2 (count (:ball state)))
+    (as-> state state
+      (assoc-in state [:ball :x-dir] (rand-nth [+ -]))
+      (assoc-in state [:ball :y-dir] (rand-nth [+ -]))
+      (update-ball state))
+    state))

 (defn update-ball
   [state]
-  (log "update-ball"))
+  ;(log "update-ball")
+  (if (= 4 (count (state :ball)))
+    (as-> state state
+      (update-in state [:ball :y] (:y-dir (:ball state)) ball-speed)
+      (update-in state [:ball :x] (:x-dir (:ball state)) ball-speed))
+    state))
+
+(defn handle-input [state]
+  ;(log "handle-input")
+  (condp = (q/key-as-keyword)
+    :w (move-player-paddle state :up)
+    :s (move-player-paddle state :down)
+    (keyword " ") (start-game state)
+    state))
+
+#_(defn collision [state]
+  (let [ball-x (:x (:ball state))]
+       [ball-y (:y (:ball state))]
+       [new-y-dir (if (= + (:y-dir (:ball state)))
+                      -
+                      +)])
+  ;Check wall collision
+  (if (not (and (> ((:y-dir (state :ball)) ball-speed ball-y) (16.5))
+                (< ((:y-dir (state :ball)) ball-speed ball-y) (- 490 7.5))))
+    (as-> state state
+      (assoc-in state [:ball :y-dir] new-y-dir)
+      (if (= new-y-dir +)
+        (assoc state [:ball :y] 16.5)
+        (assoc state [:ball :y] 490))
+      (update-in state [:ball :y] (:y-dir (:ball state)) ball-speed))
+    (update-ball state)))

 (defn draw-game
   [state]
-  (log "draw-game")
+  ;(log "draw-game")
+  (log (:x-dir (:ball state)))
   (q/rect-mode :corner)
   (q/fill 255)
   (q/rect 9 9 1082 482)
   ;Create paddles and ball
   (q/fill 0)
   (q/rect-mode :center)
-  (q/rect (-> state :player :x) (-> state :player :y) 20 100)
-  (q/rect (-> state :computer :x) (-> state :computer :y) 20 100)
-  (q/ellipse (-> state :ball :x) (-> state :ball :y) ball-size ball-size)
-  (-> state (handle-input)))
+  (q/rect ((state :player) :x) ((state :player) :y) 20 100)
+  (q/rect ((state :computer) :x) ((state :computer) :y) 20 100)
+  (q/ellipse ((state :ball) :x) ((state :ball) :y) ball-size ball-size))
+
+(defn update-game
+  [state]
+  (-> state
+    (update-ball)))

 (q/defsketch pong-canvas
   :size [1100 500]
   :setup init-game
   :key-pressed handle-input
   :draw draw-game
+  :update update-game
   :middleware [m/fun-mode])


Add a domain extractor utility

Add a domain extractor utility

--- src/cljs/hacker_agent/utils.cljs
+++ src/cljs/hacker_agent/utils.cljs
@@ -9,3 +9,8 @@

 (defn log-clj [o]
   (.log js/console (clj->js o)))
+
+(defn domain [url]
+  (let [re (new js/RegExp "^https?\\:\\/\\/(www\\.)?([^\\/:?#]+)(?:[\\/:?#]|$)")
+        matches (.exec re url)]
+    (and matches (get matches 2))))


Store the hyphenations in a map

Store the hyphenations in a map

--- src/cljs/hyphen_keeper/core.cljs
+++ src/cljs/hyphen_keeper/core.cljs
@@ -8,7 +8,7 @@

 (defonce app-state
   (reagent/atom
-   {:hyphenations []
+   {:hyphenations {}
     :spelling 1
     :word ""
     :hyphenation ""
@@ -22,17 +22,17 @@
 (defn update-hyphenations! [f & args]
   (apply swap! app-state update-in [:hyphenations] f args))

-(defn add-hyphenation! [h]
-  (update-hyphenations! conj h))
-
-(defn remove-hyphenation! [h]
-  (update-hyphenations! (fn [hs] (vec (remove #(= % h) hs))) h))
+(defn remove-hyphenation! [{:keys [word]}]
+  (update-hyphenations! dissoc word))

 (defn load-hyphenation-patterns!
   [spelling word]
   (ajax/GET "/api/words"
             :params {:spelling spelling :search word}
-            :handler (fn [hyphenations] (swap! app-state assoc :hyphenations hyphenations))
+            :handler (fn [hyphenations] (swap! app-state assoc :hyphenations
+                                               (into (sorted-map)
+                                                     (map (fn [{:keys [word] :as pattern}] [word pattern])
+                                                          hyphenations))))
             :error-handler (fn [details]
                              (.warn js/console
                                     (str "Failed to refresh hyphenation patterns from server: " details)))
@@ -166,8 +166,8 @@
     [:table#hyphenations.table.table-striped
      [:thead [:tr [:th "Word"] [:th "Hyphenation"]]]
      [:tbody
-      (for [h (sort-by :word (:hyphenations @app-state))]
-        ^{:key (:word h)} [hyphenation-pattern h])]]]])
+      (for [[word pattern] (:hyphenations @app-state)]
+        ^{:key word} [hyphenation-pattern pattern])]]]])

 ;; -------------------------
 ;; Views


don't allow panning into negative space

don't allow panning into negative space

--- src/cljs/palimpsest/control.cljs
+++ src/cljs/palimpsest/control.cljs
@@ -40,10 +40,15 @@
     (swap! drawn-strokes extend-last-stroke coord)
     (redraw-all-strokes canvas-context @drawn-strokes @canvas-origin)))

+(defn add-negative [a b]
+  (let [c (+ a b)]
+    (if (> c 0) 0 c)))
+
 (defn update-pan [coord]
   (let [trans-x (- (:x coord) (:x @last-pan-coord))
         trans-y (- (:y coord) (:y @last-pan-coord))]
-    (swap! canvas-origin #(Coord. (+ (:x %) trans-x) (+ (:y %) trans-y)))
+    (swap! canvas-origin #(Coord. (add-negative (:x %) trans-x)
+                                  (add-negative (:y %) trans-y)))
     (swap! last-pan-coord #(-> coord))
     (redraw-all-strokes canvas-context @drawn-strokes @canvas-origin)))


Prevent infinite loop from :on-hide errors

--- src/clojure/nightmod/screens.clj
+++ src/clojure/nightmod/screens.clj
@@ -138,9 +138,13 @@
   (doseq [a (actor! entity :get-children)]
     (actor! a :set-visible show?)))

+(def ^:dynamic *set-blank-screen?* true) ; prevents ∞ loop from :on-hide errors
+
 (defn set-blank-screen!
   []
-  (set-screen! nightmod blank-screen overlay-screen))
+  (when *set-blank-screen?*
+    (binding [*set-blank-screen?* false]
+      (set-screen! nightmod blank-screen overlay-screen))))

 ; tiles on the main screen


Remove a debug println

Remove a debug println

--- src/catalog/web/views.clj
+++ src/catalog/web/views.clj
@@ -78,7 +78,6 @@
         (response/content-type "application/pdf"))))

 (defn neu-in-braille [year issue]
-  (println year issue)
   (let [editorial (db/read-editorial year issue :braille)
         recommendation (db/read-recommendation year issue :braille)]
     (-> (db/read-catalog year issue)


More tweaks to .lein/profiles.clj.

More tweaks to .lein/profiles.clj.

--- .lein/profiles.clj
+++ .lein/profiles.clj
@@ -1,9 +1,9 @@
-{:user {:plugins [[lein-tarsier "0.9.1"]
+{:user {:dependencies [[clj-stacktrace "0.2.4"]]
+        :plugins [[lein-tarsier "0.9.1"]
                   [lein-swank "1.4.4"]
                   [lein-difftest "1.3.7"]
                   [lein-clojars "0.9.0"]
                   ;[jark/jark-server "0.4.0"]
-                  [clj-stacktrace "0.2.4"]
                   [lein-pprint "1.1.1"]
                   [slamhound "1.2.0"]
                   [lein-cljsbuild "0.1.9"]
@@ -11,9 +11,9 @@
                   ;[lein-autodoc "0.9.0"]
                   [lein-marginalia "0.7.1"]]
         :repl-options {:timeout 60000}
-        ;:injections [(let [orig (ns-resolve (doto 'clojure.stacktrace require)
-                                            ;'print-cause-trace)
-                           ;new (ns-resolve (doto 'clj-stacktrace.repl require)
-                                           ;'pst)]
-                       ;(alter-var-root orig (constantly @new)))]
+        :injections [(let [orig (ns-resolve (doto 'clojure.stacktrace require)
+                                            'print-cause-trace)
+                           new (ns-resolve (doto 'clj-stacktrace.repl require)
+                                           'pst)]
+                       (alter-var-root orig (constantly @new)))]
         :vimclojure-opts {:repl true}}}


[#1796] Refactor

[#1796] Refactor

Make implicit to the function the thread model execution so we can quickly
understand the try/catch requirement inside the function

--- backend/src/akvo/lumen/lib/import.clj
+++ backend/src/akvo/lumen/lib/import.clj
@@ -57,20 +57,21 @@
   "Import runs within a future and since this is not taking part of ring
   request / response cycle we need to make sure to capture errors."
   [conn {:keys [sentry-backend-dsn] :as config} error-tracker job-execution-id claims]
-  (let [table-name (util/gen-table-name "ds")]
-    (try
-      (let [spec (:spec (data-source-spec-by-job-execution-id conn {:job-execution-id job-execution-id}))]
-        (with-open [importer (common/dataset-importer (get spec "source") config)]
-          (let [columns (p/columns importer)]
-            (common/create-dataset-table conn table-name columns)
-            (doseq [record (map common/coerce-to-sql (p/records importer))]
-              (jdbc/insert! conn table-name record))
-            (successful-import conn job-execution-id table-name columns spec claims))))
-      (catch Throwable e
-        (failed-import conn job-execution-id (.getMessage e) table-name)
-        (log/error e)
-        (p/track error-tracker e)
-        (throw e)))))
+  (future
+    (let [table-name (util/gen-table-name "ds")]
+      (try
+        (let [spec (:spec (data-source-spec-by-job-execution-id conn {:job-execution-id job-execution-id}))]
+          (with-open [importer (common/dataset-importer (get spec "source") config)]
+            (let [columns (p/columns importer)]
+              (common/create-dataset-table conn table-name columns)
+              (doseq [record (map common/coerce-to-sql (p/records importer))]
+                (jdbc/insert! conn table-name record))
+              (successful-import conn job-execution-id table-name columns spec claims))))
+        (catch Throwable e
+          (failed-import conn job-execution-id (.getMessage e) table-name)
+          (log/error e)
+          (p/track error-tracker e)
+          (throw e))))))

 (defn handle-import-request [tenant-conn config error-tracker claims data-source]
   (let [data-source-id (str (util/squuid))
@@ -81,6 +82,6 @@
                                      :spec (json/generate-string data-source)})
     (insert-job-execution tenant-conn {:id job-execution-id
                                        :data-source-id data-source-id})
-    (future (do-import tenant-conn config error-tracker job-execution-id claims))
+    (do-import tenant-conn config error-tracker job-execution-id claims)
     (lib/ok {"importId" job-execution-id
              "kind" kind})))


pull Collections into import

pull Collections into import

--- bigquery/src/gclouj/bigquery.clj
+++ bigquery/src/gclouj/bigquery.clj
@@ -1,7 +1,7 @@
 (ns gclouj.bigquery
   (:import [com.google.gcloud.bigquery BigQueryOptions BigQuery$DatasetListOption DatasetInfo DatasetId BigQuery$TableListOption TableInfo TableId BigQuery$DatasetOption BigQuery$TableOption Schema Field Field$Type Field$Mode TableInfo$StreamingBuffer InsertAllRequest InsertAllRequest$RowToInsert InsertAllResponse BigQueryError BigQuery$DatasetDeleteOption QueryRequest QueryResponse QueryResult JobId Field Field$Type$Value FieldValue FieldValue$Attribute]
            [com.google.common.hash Hashing]
-           [java.util List]))
+           [java.util List Collections]))

 (defmulti field-value->clojure (fn [attribute val]
@@ -167,7 +167,7 @@
   ;; correctly.
   (letfn [(wrap-map [x]
             (if (map? x)
-              (java.util.Collections/unmodifiableMap x)
+              (Collections/unmodifiableMap x)
               x))]
     (clojure.walk/postwalk wrap-map m)))


Fix Running Example chart-http

Fix Running Example chart-http

Added routes for the examples, css and js dir so that ring serves the
artifacts required.

--- src/om_data_vis/handler.clj
+++ src/om_data_vis/handler.clj
@@ -61,7 +61,9 @@
   (ANY "/device/:id/type/:type/measurements/" [id type] (measurements-resource id type))
   (ANY "/devices/" [] devices-resource)

-  (GET "/chart_http" [] {:status 200 :body (slurp (io/resource "chart-http/index.html"))})
+  (route/files "/examples" {:root "examples"})
+  (route/files "/css" {:root "css"})
+  (route/files "/js" {:root "js"})
   (route/not-found "Not Found"))


Use timeout channel if 0 segments are to be read.

--- src/onyx/plugin/datomic.clj
+++ src/onyx/plugin/datomic.clj
@@ -316,8 +316,10 @@
     (let [pending (count (keys @pending-messages))
           max-segments (min (- max-pending pending) batch-size)
           timeout-ch (timeout batch-timeout)
-          batch (->> (range max-segments)
-                     (keep (fn [_] (first (alts!! [read-ch timeout-ch] :priority true)))))]
+          batch (if (zero? max-segments)
+                  (<!! timeout-ch)
+                  (->> (range max-segments)
+                       (keep (fn [_] (first (alts!! [read-ch timeout-ch] :priority true))))))]
       (doseq [m batch]
         (let [message (:message m)]
           (when-not (= message :done)


Discovered 're-seq'.  :/

Discovered 're-seq'.  :/

--- Clojure/spraff.clj
+++ Clojure/spraff.clj
@@ -10,14 +10,6 @@
     [s re]
     (vec (.split re s)))

-(defn extract
-    [s re]
-    (let [
-        m (.matcher re s)
-        f (fn [r] (if (.find m) (recur (conj r (.group m))) r))
-        ]
-    (f [])))
-
-(map #(extract % word-extractor-pattern) (split "This is a test. This is another." sentence-delimiter-pattern))
+(map (partial re-seq word-extractor-pattern) (split "This is a test. This is another." sentence-delimiter-pattern))


CLJS-721: support :include-macros and :refer-macros

:require can now be given :include-macros true and :refer-macros
[syms...]  which will automatically load the required macro file and
refer macro vars if needed. This is implemented as sugar over the
existing functionality.

Relax some broken cases where vector? is required over sequential? for
ns specs.

--- src/clj/cljs/analyzer.clj
+++ src/clj/cljs/analyzer.clj
@@ -973,12 +973,12 @@
   (str msg "; offending spec: " (pr-str spec)))

 (defn basic-validate-ns-spec [env macros? spec]
-  (when-not (or (symbol? spec) (vector? spec))
+  (when-not (or (symbol? spec) (sequential? spec))
     (throw
       (error env
         (parse-ns-error-msg spec
           "Only [lib.ns & options] and lib.ns specs supported in :require / :require-macros"))))
-  (when (vector? spec)
+  (when (sequential? spec)
     (when-not (symbol? (first spec))
       (throw
         (error env
@@ -1072,6 +1072,29 @@
     {:import  import-map
      :require import-map}))

+(defn desugar-ns-specs [args]
+  (let [{:keys [require] :as indexed}
+        (->> args
+          (map (fn [[k & specs]] [k (into [] specs)]))
+          (into {}))
+        sugar-keys #{:include-macros :refer-macros}
+        to-macro-specs
+        (fn [specs]
+          (->> specs
+            (filter #(and (sequential? %) (some sugar-keys %)))
+            (map #(->> % (remove #{:include-macros true})
+                         (map (fn [x] (if (= x :refer-macros) :refer x)))))))
+        remove-sugar
+        (fn [spec]
+          (if (and (sequential? spec) (some sugar-keys spec))
+            (let [[l & r] (split-with #(not (contains? sugar-keys %)) spec)]
+              (concat l (drop 2 r)))
+            spec))]
+    (if-let [require-specs (seq (to-macro-specs require))]
+      (map (fn [[k v]] (cons k (map remove-sugar v)))
+        (update-in indexed [:require-macros] (fnil into []) require-specs))
+      args)))
+
 (defmethod parse 'ns
   [_ env [_ name & args :as form] _]
   (when-not (symbol? name)
@@ -1079,7 +1102,7 @@
   (let [docstring (if (string? (first args)) (first args))
         args      (if docstring (next args) args)
         metadata  (if (map? (first args)) (first args))
-        args      (if metadata (next args) args)
+        args      (desugar-ns-specs (if metadata (next args) args))
         excludes  (parse-ns-excludes env args)
         deps      (atom #{})
         aliases   (atom {:fns #{} :macros #{}})


Fix :refer/:as typo

Fix :refer/:as typo

--- src/clj/gtfve/handler.clj
+++ src/clj/gtfve/handler.clj
@@ -7,7 +7,7 @@
             [environ.core :refer [env]]
             [liberator.core :refer [defresource]]
             [gtfve.data.queries :as q]
-            [clojure.edn :refer edn]))
+            [clojure.edn :as edn]))

 (defn- begin-of-last-minute []
   (-> (System/currentTimeMillis)


headers come in all caps...

headers come in all caps...

--- src/clj/tictag/twilio.clj
+++ src/clj/tictag/twilio.clj
@@ -32,4 +32,4 @@
         (sha1-hmac-bytes (:account-token twilio))
         (b64/encode)
         (String. "UTF-8"))
-       (get-in req [:headers "X-Twilio-Signature"]))))
+       (get-in req [:headers "X-TWILIO-SIGNATURE"]))))


Properly separated subcomponents POC.

Properly separated subcomponents POC.

--- src/cljs/beatha/core.cljs
+++ src/cljs/beatha/core.cljs
@@ -7,514 +7,45 @@

 (enable-console-print!)

-(def app-state {:grid {:width 10 :height 10 :cells {}}
-                :display {:width 600 :height 600}
-                :started false})
+(def app-state {:automaton {:grid {:width 10 :height 10 :cells {}}
+                            :display {:width 600 :height 600}
+                            :started false}
+                :command {}})

+(defn automaton-view [data owner]
+  (reify
+    om/IWillMount
+    (will-mount [_]
+      (om/set-state!
+       owner :update-loop-id
+       (js/setInterval
+        (fn []
+          (om/transact! data [:grid :width] inc))
+        (or (om/get-state owner :animation-step) 1000))))
+    om/IRender
+    (render [_]
+      (println "automaton")
+      (dom/b nil (get-in data [:grid :width])))))

-(defn cell-view
-  [data owner]
-  (reify
-    om/IRenderState
-    (render-state [_ {:keys [cell-state-changed x y]}]
-      (let [{:keys [width height state started]} data
-            st #js {:width width :height height}]
-        (dom/div #js {:style st
-                      :className
-                      (apply str
-                             (interpose " " ["automaton-cell" (name state)]))
-                      :onClick #(when-not started
-                                  (put! cell-state-changed [x y]))})))))
-
-
-(defn grid-view
-  [data owner]
-  (reify
-    om/IRenderState
-    (render-state [_ state]
-      (let [grid-width (get-in data [:grid :width])
-            grid-height (get-in data [:grid :height])
-            cell-width (/ (get-in data [:display :width]) grid-width)
-            cell-height (/ (get-in data [:display :height]) grid-height)
-            default-cell (:default-cell state)]
-        (apply dom/div #js {:className "automaton-grid"}
-               (mapv (fn [y]
-                       (apply dom/div #js {:className "automaton-row row"}
-                              (mapv
-                               (fn [x]
-                                 (om/build
-                                  cell-view
-                                  (merge (get-in data [:grid :cells [x y]]
-                                                 default-cell)
-                                         {:started (:started data)}
-                                         {:width cell-width
-                                          :height cell-height})
-                                  {:init-state
-                                   {:cell-state-changed
-                                    (:cell-state-changed state)
-
-                                    :x x :y y}}))
-                               (range grid-width))))
-                     (range grid-height)))))))
-
-
-(defn handle-numeric-config-change
-  [e owner state key]
-  (let [value (.. e -target -value)]
-    (if (re-matches #"[0-9]+" value)
-      (om/set-state! owner key value)
-      (om/set-state! owner key (get state key)))))
-
-
-(defn grid-config-view
-  [data owner]
-  (reify
-    om/IRenderState
-    (render-state [_ {:keys [width height change-grid-dimensions] :as state}]
-      (let [started (:started data)]
-        (dom/div
-         #js {:role "form" :className "automaton-grid-control"}
-         (dom/label nil "Grid width")
-         (dom/input
-          #js {:type "text" :className "form-control" :value width
-               :disabled started
-               :onChange
-               #(handle-numeric-config-change % owner state :width)})
-         (dom/label nil "Grid height")
-         (dom/input
-          #js {:type "text" :className "form-control" :value height
-               :disabled started
-               :onChange
-               #(handle-numeric-config-change % owner state :height)})
-         (dom/button
-          #js {:type "button" :className "btn btn-danger btn-lg btn-block"
-               :disabled started
-               :onClick #(put! change-grid-dimensions [width height])}
-          "Reset grid"))))))
-
-
-(defn display-config-view
-  [data owner]
-  (reify
-    om/IRenderState
-    (render-state [_ {:keys [width height change-display-dimensions]
-                      :as state}]
-      (let [started (:started data)]
-        (dom/div
-         #js {:role "form" :className "automaton-display-control"}
-         (dom/label nil "Display width")
-         (dom/input
-          #js {:type "text" :className "form-control" :value width
-               :disabled started
-               :onChange
-               #(handle-numeric-config-change % owner state :width)})
-         (dom/label nil "Display height")
-         (dom/input
-          #js {:type "text" :className "form-control" :value height
-               :disabled started
-               :onChange
-               #(handle-numeric-config-change % owner state :height)})
-         (dom/button
-          #js {:type "button" :className "btn btn-warning btn-lg btn-block"
-               :disabled started
-               :onClick #(put! change-display-dimensions [width height])}
-          "Reset display"))))))
-
-(defn navigation-button
-  [text f]
-  (dom/button #js {:type "button"
-                   :className "btn btn-success btn-lg btn-block"
-                   :onClick f}
-    text))
-
-
-(defprotocol CellularAutomatonAppCustomization
-  (automaton-input-view [this]
-    "Generates Om component that renders block for sending commands to
-    automaton.")
-  (automaton-input-reset [this input-info-channel]
-    "Resets any changes created by the command sent to the automata.")
-  (automaton-output-handler [this data owner o]
-    "Handles messages posted by the cellular automaton.")
-  (automaton-output-view [this]
-    "Generates Om component that renders any changes produced by
-    the handler.")
-  (automaton-output-reset [this data owner]
-    "Resets changes produced by the handler."))
-
-(def ^:private empty-view
-  (fn [data owner] (reify om/IRender (render [_] (dom/span nil "")))))
-
-(declare render-menu-view)
-
-(defn gen-app-view
-  ([automaton-spec]
-     (gen-app-view automaton-spec
-                   (reify
-                     CellularAutomatonAppCustomization
-                     (automaton-input-view [_] empty-view)
-                     (automaton-input-reset [_ _])
-                     (automaton-output-handler [_ _ _ _])
-                     (automaton-output-view [_] empty-view)
-                     (automaton-output-reset [_ _ _]))))
-  ([automaton-spec customization]
-     (fn [data owner]
-       (reify
-         om/IInitState
-         (init-state [_]
-           {:change-grid-dimensions (chan)
-            :change-display-dimensions (chan)
-            :cell-state-changed (chan)
-            :started (chan)
-            :output-info-channel (chan)
-            :input-info-channel (chan)})
-         om/IWillMount
-         (will-mount [_]
-           (let [grid-c (om/get-state owner :change-grid-dimensions)
-                 display-c (om/get-state owner :change-display-dimensions)
-                 cell-state-c (om/get-state owner :cell-state-changed)
-                 started-c (om/get-state owner :started)
-                 output-info-c (om/get-state owner :output-info-channel)
-                 input-info-c (om/get-state owner :input-info-channel)]
-             (a/process-info-channel automaton-spec input-info-c)
-             (go (while true
-                   (alt!
-                     grid-c
-                     ([[width height]]
-                        (automaton-input-reset customization input-info-c)
-                        (automaton-output-reset customization data owner)
-                        (om/transact!
-                         data :grid
-                         (fn [grid]
-                           (assoc grid
-                             :width width :height height :cells {}))))
-
-                     display-c
-                     ([[width height]]
-                        (om/transact!
-                         data :display
-                         (fn [display]
-                           (assoc display :width width :height height))))
-
-                     cell-state-c
-                     ([[x y]]
-                        (om/transact!
-                         data [:grid :cells]
-                         (fn [grid]
-                           (let [cell (get grid [x y]
-                                           (a/default-cell automaton-spec))
-                                 state (:state cell)
-                                 cell (assoc cell
-                                        :state
-                                        (a/next-initial-state automaton-spec
-                                                              state))]
-                             (assoc grid [x y] cell)))))
-
-                     started-c
-                     ([started]
-                        (om/update! data :started started)
-                        (if started
-                          (om/set-state!
-                           owner :update-loop-id
-                           (js/setInterval
-                            (fn []
-                              (om/transact!
-                               data :grid
-                               (partial a/next-grid automaton-spec))
-                              (a/fill-output-info-channel
-                               automaton-spec (:grid @data) output-info-c))
-                            (or (om/get-state owner :animation-step) 1000)))
-                          (when-let [id (om/get-state owner :update-loop-id)]
-                            (js/clearTimeout id))))
-
-                     output-info-c
-                     ([o] (automaton-output-handler
-                           customization data owner o)))))))
-         om/IRenderState
-         (render-state [_ state]
-           (dom/div
-            #js {:className "container-liquid"}
-            (dom/div #js {:className "row"}
-                     (navigation-button "Menu" render-menu-view)
-                     (dom/hr nil))
-            (dom/div
-             #js {:className "row"}
-             (dom/div
-              #js {:className "col-sm-2"}
-              (let [started (:started data)]
-                (dom/div
-                 #js {:className "row"}
-                 (dom/button
-                  #js {:type "button"
-                       :className "btn btn-primary btn-lg btn-block"
-                       :onClick #(put! (:started state) (not started))}
-                  (if-not started "Start" "Stop"))))
-              (dom/div #js {:className "row"}
-                       (om/build (automaton-output-view customization) data))
-              (dom/hr nil)
-              (dom/div #js {:className "row"}
-                       (om/build
-                        (automaton-input-view customization)
-                        data
-                        {:init-state
-                         (select-keys state [:input-info-channel])}))
-              (dom/div
-               #js {:className "row"}
-               (om/build grid-config-view
-                         data
-                         {:init-state
-                          (merge state
-                                 {:width (get-in data [:grid :width])
-                                  :height (get-in data [:grid :height])})}))
-              (dom/hr nil)
-              (dom/div
-               #js {:className "row"}
-               (om/build display-config-view
-                         data
-                         {:init-state
-                          (assoc state
-                            :width (get-in data [:display :width])
-                            :height (get-in data [:display :height]))})))
-             (dom/div #js {:className "col-sm-10"}
-                      (dom/div #js {:className "row"})
-                      (om/build grid-view
-                                data
-                                {:init-state
-                                 (assoc state
-                                   :default-cell
-                                   (a/default-cell automaton-spec))})))))))))
-
-
-(def unrestricted-language-parser-customization
-  (reify
-    CellularAutomatonAppCustomization
-    (automaton-input-view [this]
-      (fn [data owner]
-        (reify
-          om/IRenderState
-          (render-state [_ state]
-            (let [c (:input-info-channel state)
-                  a-wildcard (get-in data [:command :a-wildcard])
-                  b-wildcard (get-in data [:command :b-wildcard])
-
-                  wildcard-fn
-                  (fn [wildcard neighbour-states cell]
-                    (let [{:keys [top-left top top-right left right
-                                  bottom-left bottom bottom-right]}
-                          neighbour-states]
-                      (if (and (#{:a :b} (:state cell)) (= :x left)
-                               (= wildcard bottom))
-                        {:state :x}
-                        false)))
-                  a-wildcard-fn (partial wildcard-fn :a)
-                  b-wildcard-fn (partial wildcard-fn :b)]
-              (dom/div nil
-               (dom/label nil "a as a wildcard")
-               (dom/input
-                #js {:type "checkbox"
-                     :checked a-wildcard
-                     :onClick
-                     (fn [] (om/transact! data [:command :a-wildcard] not))})
-               (dom/label nil "b as a wildcard")
-               (dom/input
-                #js {:type "checkbox"
-                     :checked b-wildcard
-                     :onClick
-                     (fn [] (om/transact! data [:command :b-wildcard] not))})
-               (dom/button
-                #js {:type "button"
-                     :className "btn btn-success btn-lg btn-block"
-                     :onClick
-                     #(cond
-                       (and b-wildcard (not a-wildcard))
-                       (put! c {:command b-wildcard-fn})
-
-                       (and a-wildcard (not b-wildcard))
-                       (put! c {:command a-wildcard-fn})
-
-                       (and a-wildcard b-wildcard)
-                       (put! c {:command
-                                (fn [neigbours s]
-                                  (if-let [a-res (a-wildcard-fn neigbours s)]
-                                    a-res
-                                    (b-wildcard-fn neigbours s)))})
-
-                       :else (fn [_ _] false))}
-                "Send command")
-               (dom/button
-                #js {:type "button"
-                     :className "btn btn-info btn-lg btn-block"
-                     :onClick #(automaton-input-reset this c)}
-                "Reset command")
-               (dom/hr nil)))))))
-    (automaton-input-reset [_ input-channel] (put! input-channel {}))
-    (automaton-output-handler [_ data owner {:keys [s f]}]
-      (when (or (> s 0) (> f 0))
-        (om/transact!
-         data (fn [d] (assoc d :result (if (> s 0) :success :failure))))
-        (put! (om/get-state owner :started) false)))
-    (automaton-output-view [_]
-      (fn [data _]
-        (reify
-          om/IRender
-          (render [_]
-            (dom/div #js {:className "row"
-                          :hidden (not (#{:success :failure} (:result data)))}
-                     (dom/h2 nil
-                             "Result: "
-                             (if (= :success (:result data))
-                               "word is parsed"
-                               "word is not parsed")))))))
-    (automaton-output-reset [_ data _]
-      (om/transact! data (fn [d] (assoc d :result :none))))))
-
-(defn- num->percent
-  [n]
-  (str (Math/floor (* n 100)) "%"))
-
-(defn- normalize
-  [n min max]
-  (cond
-   (< n min) min
-   (> n max) max
-   :else     n))
-
-(def market-model-customization
-  (reify
-    CellularAutomatonAppCustomization
-    (automaton-input-view [_]
-      (fn [data owner]
-        (reify
-          om/IRenderState
-          (render-state [_ state]
-            (let [c (:input-info-channel state)
-                  tax-rate (get-in data [:command :tax-rate])]
-              (dom/div
-               #js {:role "form" :className "economic-model-control"}
-               (dom/label nil "Tax rate (%)")
-               (dom/input
-                #js {:type "text" :className "form-control" :value tax-rate
-                     :onChange
-                     #(om/update! data [:command :tax-rate]
-                                  (.. % -target -value))})
-               (dom/button
-                #js {:type "button"
-                     :className "btn btn-success btn-lg btn-block"
-                     :onClick
-                     #(let [new-tax-rate
-                            (normalize
-                             (/ (js/parseFloat
-                                 (get-in @data [:command :tax-rate]))
-                                100)
-                             0 1.0)]
-                        (when-not (empty? tax-rate)
-                          (put! c {:tax-rate new-tax-rate})))}
-                "Send command")))))))
-    (automaton-input-reset [_ _])
-    (automaton-output-handler [_ data owner msg]
-      (om/transact! data (fn [d] (assoc d :market-state msg))))
-
-    (automaton-output-view [_]
-      (fn [data owner]
-        (let [get-market-info (fn [path] (get-in (:market-state data) path))]
-          (reify
-            om/IRender
-            (render [_]
-              (dom/div #js {:className "row"
-                            :hidden (not (contains? data :market-state))}
-                       (dom/b nil "Tax rate: ")
-                       (dom/span nil
-                         (num->percent (get-market-info [:tax-rate])))
-                       (dom/div nil)
-
-                       (dom/b nil "Utility function params: ")
-                       (dom/div nil
-                         (dom/span nil
-                           "a: " (get-market-info [:utility-params :a]))
-                         (dom/span nil
-                           " p: " (get-market-info [:utility-params :p])))
-
-                       (dom/b nil "Capital")
-                       (dom/div nil "Government: "
-                         (get-market-info [:capital :government]))
-                       (dom/div #js {:className "corp-1"} "Corporation 1: "
-                         (get-market-info [:capital :corp-1]))
-                       (dom/div #js {:className "corp-2"} "Corporation 2: "
-                         (get-market-info [:capital :corp-2]))
-                       (dom/div #js {:className "corp-3"} "Corporation 3: "
-                         (get-market-info [:capital :corp-3]))
-                       (dom/div #js {:className "corp-4"} "Corporation 4: "
-                         (get-market-info [:capital :corp-4]))
-
-                       (dom/b nil "User share")
-                       (dom/div #js {:className "without-good"}
-                         "Without good: "
-                         (num->percent
-                          (get-market-info
-                           [:global-user-share :without-good])))
-                       (dom/div #js {:className "corp-1"} "Corporation 1: "
-                         (num->percent
-                          (get-market-info [:global-user-share :corp-1])))
-                       (dom/div #js {:className "corp-2"} "Corporation 2: "
-                         (num->percent
-                          (get-market-info [:global-user-share :corp-2])))
-                       (dom/div #js {:className "corp-3"} "Corporation 3: "
-                         (num->percent
-                          (get-market-info [:global-user-share :corp-3])))
-                       (dom/div #js {:className "corp-4"} "Corporation 4: "
-                         (num->percent
-                          (get-market-info [:global-user-share :corp-4])))
-
-                       (dom/b nil "Good prices")
-                       (dom/div #js {:className "corp-1"} "Corporation 1: "
-                         (get-market-info [:prices :corp-1]))
-                       (dom/div #js {:className "corp-2"} "Corporation 2: "
-                         (get-market-info [:prices :corp-2]))
-                       (dom/div #js {:className "corp-3"} "Corporation 3: "
-                         (get-market-info [:prices :corp-3]))
-                       (dom/div #js {:className "corp-4"} "Corporation 4: "
-                         (get-market-info [:prices :corp-4]))))))))
-    (automaton-output-reset [_ data _]
-      (om/transact! data (fn [d] (dissoc d :market-state))))))
-
-
-(defn render-cellular-automaton
-  [view]
-  (om/root
-   view
-   app-state
-   {:target (. js/document (getElementById "app"))
-    :init-state {:animation-step 500}}))
-
-(defn menu-view
-  [data owner]
+(defn command-view [data owner]
   (reify
     om/IRender
     (render [_]
-      (dom/div #js {:className "app-menu"}
-        (dom/div #js {:className "page-header"}
-          (dom/h1 nil "Cellular automata experiments"))
-        (navigation-button
-         "Game of Life"
-         (partial render-cellular-automaton (gen-app-view a/game-of-life)))
-        (navigation-button
-         "Unrestricted language parser"
-         (partial render-cellular-automaton
-                  (gen-app-view
-                   a/unrestricted-language-parser
-                   unrestricted-language-parser-customization)))
-        (navigation-button
-         "Economic model"
-         (partial render-cellular-automaton
-                  (gen-app-view
-                   a/market-model market-model-customization)))))))
+      (println "command")
+      (dom/input #js {:type "text"}))))

-(defn render-menu-view
-  []
-  (om/root
-   menu-view
-   app-state
-   {:target (. js/document (getElementById "app"))}))
+(defn root-view [data owner]
+  (reify
+    om/IRender
+    (render [_]
+      (println "parent")
+      (dom/div #js {:className "row"}
+               (dom/h2 nil "Hello")
+               (om/build command-view (:command data))
+               (om/build automaton-view (:automaton data))))))

-(render-menu-view)
+(om/root
+   root-view
+   app-state
+   {:target (. js/document (getElementById "app"))})


Added string support to reader

Added string support to reader

--- src/cljs/cljs/reader.cljs
+++ src/cljs/cljs/reader.cljs
@@ -132,6 +132,28 @@
    (re-matches ratio-pattern s) (match-ratio s)
    (re-matches float-pattern s) (match-float s)
    :default (throw (str "Invalid number format [" s "]"))))
+
+(def escape-char-map {\t "\t"
+                      \r "\r"
+                      \n "\n"
+                      \\ \\
+                      \" \"
+                      \b "\b"
+                      \f "\f"})
+
+(defn read-unicode-char
+  [reader initch]
+  (throw "Unicode characters not supported by reader (yet)"))
+
+(defn escape-char
+  [buffer reader]
+  (let [ch (read-char reader)
+        mapresult (get escape-char-map ch)]
+    (if mapresult
+      mapresult
+      (if (or (= \u ch) (numeric? ch))
+        (read-unicode-char reader ch)
+        (throw (str "Unsupported escape charater: \\" ch))))))

 (defn read-past
   "Read until first character that doesn't match pred, returning
@@ -191,10 +213,17 @@
       (do
         (unread reader ch)
         (match-number (.toString buffer)))
-      (recur buffer (read-char reader)))))
+      (recur (do (.append buffer ch) buffer) (read-char reader)))))

 (defn read-string
-  [reader initch])
+  [reader _]
+  (loop [buffer (gstring/StringBuffer.)
+         ch (read-char reader)]
+    (cond
+     (nil? ch) (throw "EOF while reading string")
+     (= "\\" ch) (recur (escape-char buffer reader) (read-char reader))
+     (= \" ch) (.toString buffer)
+     :default (recur (do (.append buffer ch) buffer) (read-char reader)))))

 (defn read-symbol
   [reader initch is-recursive])


Refactored the readers dispatch on character type to use chars directly

--- src/cljs/cljs/reader.cljs
+++ src/cljs/cljs/reader.cljs
@@ -41,30 +41,30 @@
   [ch]
   (gstring/isNumeric ch))

-(defn- comment?
-  "Checks whether the reader is at the beginning of a comment"
-  [reader]
-  (= \; (peek reader)))
+(defn- comment-prefix?
+  "Checks whether the character begins a comment."
+  [ch]
+  (= \; ch))

 (defn- number-literal?
-  "Checks whether the reader is at the first digit of a number"
+  "Checks whether the reader is at the start of a number literal"
   [reader]
   (let [ch (peek reader)]
     (or (numeric? ch)
         (and (or (= \+ ch) (= \- ch))
              (numeric? (peek reader 2))))))

-(defn- string-literal?
-  "Checks whether the reader is at the first character of a string literal"
-  [reader])
+(defn- string-prefix?
+  "Checks whether the character starts a string"
+  [ch])

-(defn- vector-literal?
-  "Checks whether the reader is at the first character of a vector literal"
-  [reader])
+(defn- vector-prefix ?
+  "Checks whether the char is the start of a vector literal"
+  [ch])

 (defn- map-literal?
-  "Checks whether the reader is at the first character of a map literal"
-  [reader])
+  "Checks whether the char is the start of a map literal"
+  [ch])

 (declare read)

@@ -95,15 +95,16 @@
   "Reads the first object from a PushbackReader. Returns the object read.
 Returns nil if the reader did not contain any forms."
   [reader]
-  (if (not (nil? (peek reader)))
-    (cond
-     (whitespace? (peek reader)) (do (read-char reader) (recur reader))
-     (comment? reader) (recur (skip-line reader))
-     (number-literal? reader) (read-number reader)
-     (string-literal? reader) (read-string reader)
-     (vector-literal? reader) (read-vector reader)
-     (map-literal? reader) (read-map reader)
-     :default (read-symbol reader))))
+  (let [ch (peek reader)]
+    (if (not (nil? ch))
+      (cond
+       (whitespace? ch) (do (read-char reader) (recur reader))
+       (comment-prefix? ch) (recur (skip-line reader))
+       (number-literal? reader) (read-number reader)
+       (string-prefix? ch) (read-string reader)
+       (vector-prefix? ch) (read-vector reader)
+       (map-prefix? ch) (read-map reader)
+       :default (read-symbol reader)))))

 (defn read-all
   "Reads a lazy sequence of objects from a reader."


* src/cljs/cljs/reader.cljs: move reader away from case to cond + identical?

--- src/cljs/cljs/reader.cljs
+++ src/cljs/cljs/reader.cljs
@@ -158,15 +158,15 @@
    (re-matches* float-pattern s) (match-float s)))

 (defn escape-char-map [c]
-  (case c
-    \t "\t"
-    \r "\r"
-    \n "\n"
-    \\ \\
-    \" \"
-    \b "\b"
-    \f "\f"
-    nil))
+  (cond
+   (identical? c \t) "\t"
+   (identical? c \r) "\r"
+   (identical? c \n) "\n"
+   (identical? c \\) \\
+   (identical? c \") \"
+   (identical? c \b) "\b"
+   (identical? c \f) "\f"
+   :else nil))

 (defn read-unicode-char
   [reader initch]
@@ -270,10 +270,12 @@
      (identical? \" ch) (. buffer (toString))
      :default (recur (do (.append buffer ch) buffer) (read-char reader)))))

-(def special-symbols
-  {"nil" nil
-   "true" true
-   "false" false})
+(defn special-symbols [t not-found]
+  (cond
+   (identical? t "nil") nil
+   (identical? t "true") true
+   (identical? t "false") false
+   :else not-found))

 (defn read-symbol
   [reader initch]
@@ -281,7 +283,7 @@
     (if (gstring/contains token "/")
       (symbol (subs token 0 (.indexOf token "/"))
               (subs token (inc (.indexOf token "/")) (.-length token)))
-      (get special-symbols token (symbol token)))))
+      (special-symbols token (symbol token)))))

 (defn read-keyword
   [reader initch]
@@ -341,35 +343,35 @@
   rdr)

 (defn macros [c]
-  (case c
-    \" read-string*
-    \: read-keyword
-    \; not-implemented ;; never hit this
-    \' (wrapping-reader 'quote)
-    \@ (wrapping-reader 'deref)
-    \^ read-meta
-    \` not-implemented
-    \~ not-implemented
-    \( read-list
-    \) read-unmatched-delimiter
-    \[ read-vector
-    \] read-unmatched-delimiter
-    \{ read-map
-    \} read-unmatched-delimiter
-    \\ read-char
-    \% not-implemented
-    \# read-dispatch
-    nil))
+  (cond
+   (identical? c \") read-string*
+   (identical? c \:) read-keyword
+   (identical? c \;) not-implemented ;; never hit this
+   (identical? c \') (wrapping-reader 'quote)
+   (identical? c \@) (wrapping-reader 'deref)
+   (identical? c \^) read-meta
+   (identical? c \`) not-implemented
+   (identical? c \~) not-implemented
+   (identical? c \() read-list
+   (identical? c \)) read-unmatched-delimiter
+   (identical? c \[) read-vector
+   (identical? c \]) read-unmatched-delimiter
+   (identical? c \{) read-map
+   (identical? c \}) read-unmatched-delimiter
+   (identical? c \\) read-char
+   (identical? c \%) not-implemented
+   (identical? c \#) read-dispatch
+   :else nil))

 ;; omitted by design: var reader, eval reader
 (defn dispatch-macros [s]
-  (case s
-    "{" read-set
-    "<" (throwing-reader "Unreadable form")
-    "\"" read-regex
-    "!" read-comment
-    "_" read-discard
-    nil))
+  (cond
+   (identical? s "{") read-set
+   (identical? s "<") (throwing-reader "Unreadable form")
+   (identical? s "\"") read-regex
+   (identical? s"!") read-comment
+   (identical? s "_") read-discard
+   :else nil))

 (defn read
   "Reads the first object from a PushbackReader. Returns the object read.


watch :count rather than :counters

watch :count rather than :counters

--- src/cljs/hello2/core.cljs
+++ src/cljs/hello2/core.cljs
@@ -12,12 +12,15 @@
 (defn get-counters [state key]
   (let [st @state]
     (into [] (map #(get-in st %)) (get st key))))
+
 (defmulti read om/dispatch)
+
 (defmethod read :counters
   [{:keys [state] :as env} key params]
   {:value (get-counters state key)})

 (defmulti mutate om/dispatch)
+
 (defmethod mutate 'counter/increment
   [{:keys [state]} _ {:keys [id]}]
   {:action
@@ -38,7 +41,7 @@
                      (dom/span nil (str "Count: " count " id: " id))
                      (dom/button
                       #js {:onClick
-                           (fn [e] (om/transact! this `[(counter/increment ~props) :counters]))}
+                           (fn [e] (om/transact! this `[(counter/increment ~props) :count]))}
                       "Click me!")))))
 (def counter-view (om/factory Counter {:keyfn :id}))


Complete comment for iprint

Complete comment for iprint

--- src/clojure/bozo/core.clj
+++ src/clojure/bozo/core.clj
@@ -26,7 +26,9 @@
             3 <= m <= 7 is recommended (default 5)
     :eps    accuracy with which the solution is to be found (default 1.0e-5)
     :xtol   estimate of the machine precision (default 1.0e-16)
-    :iprint ...
+    :iprint pair [i1 i2] to specify the output generated by lbfgs (default [-1 0])
+            - i1 specifies the frequency of the output: -1 (silent), 0 (once) or > 0
+            - i2 specifies the type of output generated: 0, 1, 2 or 3
   Override the defaults like this:
     (lbfgs f x0 {:m 3})
   "


PointLights

PointLights

--- src/clojure/yaw/world.clj
+++ src/clojure/yaw/world.clj
@@ -1,7 +1,7 @@
 (ns yaw.world
   (:import (yaw.engine.meshs MeshBuilder)
            (yaw.engine World)
-           (yaw.engine.light AmbientLight DirectionalLight))
+           (yaw.engine.light AmbientLight DirectionalLight PointLight))
   (:require [yaw.mesh]))
   ;;(gen-class)

@@ -164,6 +164,16 @@
   (let [[r g b] color [dx dy dz] direction]
     (.setSun (lights world) (DirectionalLight. r g b i dx dy dz))))

+(defn set-point-light!
+  "Set the `n`th pointlight with the given `color`, `position`, `itensity`, and attenuation factors"
+  [world n & {{:keys [const lin quad] :or {const 0.3 lin 0.5 quad 0.9}} :att
+              :keys [color i position]
+              :or {color [1 1 1]
+                   i 1
+                   position [0 0 0]}}]
+  (let [[r g b] color [px py pz] position]
+    (.setPointLight (lights world) (PointLight. r g b px py pz i const lin quad) n)))
+
 ;;COLLISIONS------------------------------------------------------

 (defn create-bouding-box!


Adds support for converting whole namespaces with ->js

--- src/overcode/introvert.cljs
+++ src/overcode/introvert.cljs
@@ -3,6 +3,9 @@
 ;;***************************************************************************
 ;; Utilities
 ;;***************************************************************************
+(defn atom? [v]
+  (= (type v) Atom))
+
 (defn arr? [v]
   "Returns if an object is a JS Array."
   (= (type v) js/Array))
@@ -74,18 +77,40 @@
   ([obj flat] (map->js obj flat (atom {})))
   ([obj] (map->js obj false (atom {}))))

+(defn ns->js
+  "Converts a namespace obj into a JS Object."
+  ([obj flat visited]
+   (let [was-visited (visited? visited obj)]
+     (if was-visited
+       (if flat
+         "Circular NS"
+         was-visited)
+       (let [out (js-obj)]
+         (visit! visited obj out)
+         (dorun
+          (map
+           #(let [key %
+                  val (->js (aget obj %) flat visited)]
+              (aset out key val))
+           (.keys js/Object obj)))
+         out))))
+
+  ([obj flat] (ns->js obj flat (atom {})))
+  ([obj] (ns->js obj false (atom {}))))
+
 (defn ->js
   "Converts a cljs data structure into a close JS approximation."
   ([obj flat visited]
    (cond
-     (= (type obj) Atom) (->js @obj flat visited)
-     (keyword? obj)      (name obj)
-     (symbol? obj)       (name obj)
-     (map? obj)          (map->js obj flat visited)
-     (seq? obj)          (seq->js obj flat visited)
-     (set? obj)          (seq->js obj flat visited)
-     (vector? obj)       (seq->js obj flat visited)
-     :else               obj))
+     (atom? obj)         (->js @obj flat visited)
+     (keyword? obj) (name obj)
+     (symbol? obj)  (name obj)
+     (map? obj)     (map->js obj flat visited)
+     (seq? obj)     (seq->js obj flat visited)
+     (set? obj)     (seq->js obj flat visited)
+     (vector? obj)  (seq->js obj flat visited)
+     (obj? obj)     (ns->js obj flat visited)
+     :else          obj))

   ([obj flat] (->js obj flat (atom {})))
   ([obj] (->js obj false (atom {}))))


Clojure?

Clojure?

--- airesources/Clojure/src/hlt/entity.clj
+++ airesources/Clojure/src/hlt/entity.clj
@@ -34,7 +34,7 @@
   planet."
   [ship planet]
   (<= (math/distance-between ship planet)
-      (+ dock-radius (:radius planet))))
+      (+ dock-radius ship-radius (:radius planet))))

 (defn remaining-docking-spots
   "Returns the number of remaining docking spots for this planet"


Working through adding indirect tensor addressing.

--- src/cortex/tensor/dimensions.clj
+++ src/cortex/tensor/dimensions.clj
@@ -1,8 +1,13 @@
 (ns cortex.tensor.dimensions
-  "Cortex tensors dimensions control the shape and stride of the tensor along with offsetting into
-the actual data buffer.  This allows multiple backends to share a single implementation of
-a system that will allow transpose, reshape, etc. assuming the backend correctly interprets the
-shape and stride of the dimension objects.")
+  "Cortex tensors dimensions control the shape and stride of the tensor along with offsetting
+  into the actual data buffer.  This allows multiple backends to share a single implementation
+  of a system that will allow transpose, reshape, etc. assuming the backend correctly interprets
+  the shape and stride of the dimension objects.
+
+  Shape vectors may have an index buffer in them at a specific dimension instead of a number.
+  This means that that dimension should be indexed indirectly.  If a shape has any index buffers
+  then it is considered an indirect shape."
+  (:require [clojure.core.matrix :as m]))

 (defmacro when-not-error
@@ -25,10 +30,51 @@
     (vec (reverse item-seq))))

+(defn map-reversev
+  [map-fn item-seq]
+  (if (vector? item-seq)
+    (let [len (count item-seq)
+          retval (transient [])]
+      (loop [idx 0]
+        (if (< idx len)
+          (do
+            (conj! retval (map-fn (item-seq (- len idx 1))))
+            (recur (inc idx)))
+          (persistent! retval))))
+    (vec (reverse item-seq))))
+
+
+(defn- disambiguate-shape-entry
+  "Disambiguate a shape entry from a union of long or tensor to just a long."
+  ^long [shape-entry]
+  (if (number? shape-entry)
+    (long shape-entry)
+    (long (m/ecount shape-entry))))
+
+
+(defn disambiguate-shape
+  [shape-vec]
+  (mapv ->disambiguate-shape-entry shape-vec))
+
+
+(defn direct-shape?
+  [shape]
+  (every? number? shape))
+
+(defn indirect-shape?
+  [shape]
+  (not (direct-shape? shape)))
+
+
+(defn reverse-shape
+  [shape-vec]
+  (map-reversev disambiguate-shape-entry shape-vec))
+
+
 (defn extend-strides
   [shape strides]
   (let [rev-strides (reversev strides)
-        rev-shape (reversev shape)]
+        rev-shape (reverse-shape shape)]
    (->> (reduce (fn [new-strides dim-idx]
                   (let [dim-idx (long dim-idx)
                         cur-stride (get rev-strides dim-idx)]
@@ -46,17 +92,19 @@

 (defn dimensions
-  "A dimension is a map with at least a shape (vector of integers) and potentially another
-vector of dimension names.  By convention the first member of the shape is the slowest changing
-and the last member of the shape is the most rapidly changing.  There can also be optionally a
-companion vector of names which name each dimension.  Names are used when doing things that are
-dimension aware such as a 2d convolution.  Shape is the same as a core-matrix shape."
+  "A dimension is a map with at least a shape (vector of integers or index buffers) and
+  potentially another vector of dimension names.  By convention the first member of the shape is
+  the slowest changing and the last member of the shape is the most rapidly changing.  There can
+  also be optionally a companion vector of names which name each dimension.  Names are used when
+  doing things that are dimension aware such as a 2d convolution.  Shape is the same as a
+  core-matrix shape."
   [shape & {:keys [names strides]}]
   (let [strides (extend-strides shape strides)
         sorted-shape-stride (->> (map vector shape strides)
                                  (sort-by second >))
         max-stride (apply max 0 (map second sorted-shape-stride))
-        elem-count (apply * 1 (drop 1 (map first sorted-shape-stride)))]
+        elem-count (apply * 1 (drop 1 (map (comp disambiguate-shape-entry first)
+                                           sorted-shape-stride)))]
     (when-not-error (<= (long elem-count)
                         (long max-stride))
       "Stride appears to be too small for element count"
@@ -64,7 +112,6 @@
        :elem-count elem-count
        :strides strides
        :shape shape})
-
     {:shape (vec shape)
      :strides strides
      :names names}))
@@ -83,14 +130,13 @@
 (defn ecount
   "Return the element count indicated by the dimension map"
   ^long [{:keys [shape]}]
-  (long (apply * shape)))
-
-
-(defn dimension-buffer-ecount
-  ^long [{:keys [shape strides]}]
-  (+ (long (or 1 (second strides)))
-     (* (- (long (first shape)) 1)
-        (long (first strides)))))
+  (long (apply * (disambiguate-shape shape))))
+
+
+(defn- ensure-direct-shape
+  [shape-seq]
+  (when-not (direct-shape? shape-seq)
+    (throw (ex-info "Index buffers not supported for this operation." {}))))

 (defn ->2d-shape
@@ -102,7 +148,7 @@
     {:shape shape})
   (if (= 1 (count shape))
     [1 (first shape)]
-    [(apply * (drop-last shape)) (last shape)]))
+    [(apply * (ensure-direct-shape (drop-last shape))) (last shape)]))

 (defn ->batch-shape
@@ -114,12 +160,12 @@
     {:shape shape})
   (if (= 1 (count shape))
     [1 (first shape)]
-    [(first shape) (apply * (drop 1 shape))]))
+    [(first shape) (apply * (ensure-direct-shape (drop 1 shape)))]))

 (defn shape
   [{:keys [shape]}]
-  shape)
+  (disambiguate-shape shape))

 (defn strides
@@ -129,37 +175,40 @@

 (defn dense?
   [{:keys [shape strides]}]
-  (if (= 1 (count shape))
-    (= 1 (long (first strides)))
-    (let [[shape strides] (->> (map vector shape strides)
-                               (remove #(= 1 (first %)))
-                               (sort-by second >)
-                               ((fn [shp-strd]
-                                  [(mapv first shp-strd)
-                                   (mapv second shp-strd)])))
-          max-stride (first strides)
-          shape-num (apply * 1 (drop 1 shape))]
-      (= max-stride shape-num))))
+  (and (direct-shape? shape)
+       (if (= 1 (count shape))
+         (= 1 (long (first strides)))
+         (let [[shape strides] (->> (map vector shape strides)
+                                    (remove #(= 1 (first %)))
+                                    (sort-by second >)
+                                    ((fn [shp-strd]
+                                       [(mapv first shp-strd)
+                                        (mapv second shp-strd)])))
+               max-stride (first strides)
+               shape-num (apply * 1 (drop 1 shape))]
+           (= max-stride shape-num)))))

 (defn access-increasing?
-  "Are these dimensions setup such a naive seq through the data will be accessing memory in order.
-This is necessary for external library interfaces (blas, cudnn).  An example would be after almost any
-transpose that is not made concrete (copied) this condition will probably not hold."
+  "Are these dimensions setup such a naive seq through the data will be accessing memory in
+  order.  This is necessary for external library interfaces (blas, cudnn).  An example would be
+  after almost any transpose that is not made concrete (copied) this condition will probably not
+  hold."
   [{:keys [shape strides]}]
-  (apply >= strides))
+  (and (direct-shape? shape)
+       (apply >= strides)))

 (defn ->most-rapidly-changing-dimension
   "Get the size of the most rapidly changing dimension"
   ^long [{:keys [shape]}]
-  (last shape))
+  (disambiguate-shape-entry (last shape)))

 (defn ->least-rapidly-changing-dimension
   "Get the size of the least rapidly changing dimension"
   ^long [{:keys [shape]}]
-  (first shape))
+  (disambiguate-shape-entry (first shape)))

 (defn elem-idx->addr
@@ -177,12 +226,17 @@
                      (< idx num-items))
               (let [next-max (long (rev-max-shape idx))
                     next-stride (long (rev-strides idx))
-                    next-dim (long (rev-shape idx))
+                    next-dim-entry (rev-shape idx)
+                    next-dim (disambiguate-shape-entry next-dim-entry)
                     max-idx (rem arg next-max)
                     shape-idx (rem arg next-dim)]
                 (recur (inc idx)
                        (quot arg next-max)
-                       (+ offset (* next-stride shape-idx))))
+                       (+ offset (* next-stride
+                                    (if (number? next-dim)
+                                      shape-idx
+                                      (long (m/mget next-dim
+                                                    shape-idx)))))))
               offset)))))

@@ -213,7 +267,8 @@

 (defn- max-extend-strides
   [shape strides max-count]
-  (let [num-items (count shape)
+  (let [shape (disambiguate-shape shape)
+        num-items (count shape)
         max-stride-idx (long
                         (loop [idx 1
                                max-idx 0]
@@ -270,9 +325,11 @@
   (let [shapes (map :shape args)
         strides (map :strides args)
         max-count (long (apply max 0 (map count shapes)))
+        ;;Max extend strides that are too small.
         strides (map (fn [shp stride]
                        (max-extend-strides shp stride max-count))
                      shapes strides)
+        ;;One extend shapes that are too small
         shapes (map (fn [shp]
                       (->> (concat (repeat (- max-count (count shp)) 1)
                                    shp)
@@ -280,7 +337,7 @@
                     shapes)]
     {:max-shape (vec (apply map (fn [& args]
                                   (apply max 0 args))
-                            shapes))
+                            (map disambiguate-shape shapes)))
      :dimensions (mapv #(hash-map :shape %1 :strides %2) shapes strides)}))

@@ -291,17 +348,21 @@
   [dimensions]
   (let [stripped (->> (mapv vector (:shape dimensions) (:strides dimensions))
                       (remove (fn [[shp str]]
-                                (= 1 (long shp)))))]
+                                (and (number? shp)
+                                     (= 1 (long shp))))))]
     (if (= 0 (count stripped))
       {:shape [1] :strides [1]}
       (let [reverse-stripped (reverse stripped)
             reverse-stripped (reduce (fn [reverse-stripped [[cur-shp cur-stride]
                                                             [last-shp last-stride]]]
-                                       (if (= (long cur-stride)
-                                              (* (long last-shp) (long last-stride)))
+                                       ;;If the dimension is direct and the stride lines up.
+                                       (if (and (number? last-shp)
+                                                (= (long cur-stride)
+                                                   (* (long last-shp) (long last-stride))))
                                          (let [[str-shp str-str] (last reverse-stripped)]
                                            (vec (concat (drop-last reverse-stripped)
-                                                        [[(* (long str-shp) (long cur-shp)) str-str]])))
+                                                        [[(* (long str-shp) (long cur-shp))
+                                                          str-str]])))
                                          (conj reverse-stripped [cur-shp cur-stride])))
                                      [(first reverse-stripped)]
                                      (map vector (rest reverse-stripped) reverse-stripped))
@@ -311,8 +372,9 @@

 (defn in-place-reshape
-  "Return new dimensions that correspond to an in-place reshape.  This is a very difficult algorithm
-to get correct as it needs to take into account changing strides and dense vs non-dense dimensions."
+  "Return new dimensions that correspond to an in-place reshape.  This is a very difficult
+  algorithm to get correct as it needs to take into account changing strides and dense vs
+  non-dense dimensions."
   [existing-dims shape]
   (let [new-dims (dimensions shape)]
     (when-not-error (<= (ecount new-dims)
@@ -392,7 +454,7 @@
         {:shape shape
          :strides (extend-strides shape (reversev rev-new-strides))})
       :else
-      (throw (ex-info "Cannot (at this point) in-place-reshape transposed dimensions"
+      (throw (ex-info "Cannot (at this point) in-place-reshape transposed or indirect dimensions"
                       {})))))

@@ -411,11 +473,11 @@

 (defn select
-  "Limited implementation of the core.matrix select function call.
-Same rules apply *Except* if you pass in an array of numbers for a dimension
-then they must be contiguous and monotonically increasing (a proper inclusive range).
-This is due to limitations of the current gpu implementation and a strong reluctance
-to add complexity there.  There must be an entry for every dimension of the tensor.
+  "Limited implementation of the core.matrix select function call.  Each dimension must have an
+entry and each entry may be:
+:all
+monotonically increasing inclusive range
+Index tensor (has exactly 1 dimension and it itself has a direct non-strided shape).
 see:
 https://cloojure.github.io/doc/core.matrix/clojure.core.matrix.html#var-select"
   [dimensions & args]


made category menu consistent with main and video menus

--- src/distillery/view/category.clj
+++ src/distillery/view/category.clj
@@ -66,8 +66,8 @@
   [:base-path "../../"
    :title job-name
    :secondary-menu [["Übersicht" (jshref "innerpage('overview')")]
+                    ["Wortwolke" (jshref "innerpage('cloud')")]
                     ["Videos" (jshref "innerpage('videos')")]
-                    ["Cloud" (jshref "innerpage('cloud')")]
                     ["Glossar" (jshref "innerpage('glossary')")]]
    :page
      [(render-headline args)


fix the test

fix the test

--- frontend/ab.cljs
+++ frontend/ab.cljs
@@ -6,7 +6,7 @@

 (def cookie-name "ab_test_user_seed")

-(defn get-user-seed []
+(defn ^:export get-user-seed []
   (.get (goog.net.Cookies. js/document) cookie-name))

 (defn set-user-seed! []
@@ -29,13 +29,17 @@
         md5-bytes (.digest container)]
     (get-int (take 4 md5-bytes))))

+(defn ^:export choose-option-index [seed test-name options]
+  (let [word (first-md5-word (str seed (name test-name)))]
+    (Math/abs (mod word (if (neg? word)
+                          (- (count options))
+                          (count options))))))
+
 (defn choose [seed test-definitions & {:keys [overrides] :or {overrides {}}}]
-  (reduce (fn [choices [test-name options]]
-            (let [word (first-md5-word (str seed (name test-name)))]
-              (assoc choices test-name (nth options (Math/abs (mod word (if (neg? word)
-                                                                          (- (count options))
-                                                                          (count options))))))))
-          {} (merge test-definitions overrides)))
+  (merge (reduce (fn [choices [test-name options]]
+                   (assoc choices test-name (nth options (choose-option-index seed test-name options))))
+                 {} test-definitions)
+          overrides))

 (defn notify-mixpanel [choices]
   (let [mixpanel-choices (reduce (fn [m-choices [key value]]


Do `(hash-set)` instead of `hash-set` so tests actually pass.

Travis CI didn't catch this. Probably because I changed the build script at same time.

--- src/clj/freefrog/governance.clj
+++ src/clj/freefrog/governance.clj
@@ -299,9 +299,9 @@

   ([circle new-role-name purpose domains accountabilities]
    (add-role circle (Role. new-role-name purpose
-                           (if (seq domains) (into hash-set domains) nil)
+                           (if (seq domains) (into (hash-set) domains) nil)
                            (if (seq accountabilities)
-                             (into hash-set accountabilities)
+                             (into (hash-set) accountabilities)
                              nil) nil))))

 (defn update-purpose [entity new-purpose]


Add comments to the tops of functions

Add comments to the tops of functions

--- src/cljs/cljs_leaflet/core.cljs
+++ src/cljs/cljs_leaflet/core.cljs
@@ -7,7 +7,7 @@
             [clojure.data :refer [diff]]
             [reagent.core :as r]))

-;; define your app data so that it doesn't get over-written on reload
+;; Global application state, `defonce` to persist data between updates
 (defonce app-state
   (r/atom {:latest-id 0
            :add-points-qty 10
@@ -20,11 +20,12 @@
 (defn get-layer-id! []
   (:latest-id (swap! app-state update-in [:latest-id] inc)))

-;; Get n valid IDs
+;; Get n new layer IDs, updating the app-state to track the next latest
 (defn get-new-layer-ids! [n]
   (let [id (:latest-id (swap! app-state update-in [:latest-id]  #(+ % n)))]
     (range (- id n) id) ))

+;; Get the IDs of the last n layers; not updating app-state
 (defn get-last-layer-ids [n]
   (let [id (:latest-id @app-state)]
     (range (- id n) id)))
@@ -33,11 +34,13 @@
 (defn add-point! [point-data]
   (swap! app-state assoc-in [:map-layers (get-layer-id!)] point-data))

+;; Takes an array of GeoJSON Point geometries and plots them on the map
 (defn add-points! [points-list]
   (let [ids (get-new-layer-ids! (count points-list))
         points-map (zipmap ids points-list)]
     (swap! app-state assoc :map-layers (merge (:map-layers @app-state) points-map)) ))

+;; Takes one or more IDs and removes the points associated with them
 (defn remove-point! [id]
    (swap! app-state assoc :map-layers (apply dissoc (:map-layers @app-state) id))
    (let [max-id (apply max (-> @app-state :map-layers keys))
@@ -46,7 +49,7 @@
                      (+ 1 max-id) )]
      (swap! app-state assoc :latest-id latest-id) ))

- ;; Listens for state changes in the atom and updates the map accordingly
+;; Listens for state changes in the atom and updates the map accordingly
 (add-watch app-state :map-layers-watcher
   (fn [r k old-state new-state]
     (when (not= (:map-layers old-state) (:map-layers new-state))


Correct the reagent hiccup data being produced

--- src/cljs/comic_reader/main.cljs
+++ src/cljs/comic_reader/main.cljs
@@ -88,7 +88,7 @@
                      " from site " site)]
            [:br]
            (when comic-imgs
-             comic-imgs)])))))
+             (into [:div] comic-imgs))])))))

 (defn comic-reader []
   (let [page (rf/subscribe [:page])]


fix: Use /usr/bin/env which (#130)

fix: Use /usr/bin/env which (#130)

This breaks packaging on nixos because /usr/bin isn't a thing.

--- src/clojupyter/util_actions.clj
+++ src/clojupyter/util_actions.clj
@@ -124,7 +124,7 @@

 (defmulti  find-executable (fn [_] (os/operating-system)))
 (letfn [(find-exe [exe]
-          (let [{:keys [out err exit]} (sh/sh "/usr/bin/which" exe)]
+          (let [{:keys [out err exit]} (sh/sh "/usr/bin/env which" exe)]
             (when (zero? exit)
               (-> out str/trim io/file)))) ]
   (defmethod find-executable :macos [exe]


More tests for `minimal-hypergraph-transversals'

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

--- src/conexp/tests/base.clj
+++ src/conexp/tests/base.clj
@@ -440,9 +440,32 @@
 (deftest test-minimal-hypergraph-transversals
   (are [sets minimal-sets] (= (set minimal-sets)
                               (set (minimal-hypergraph-transversals (reduce union sets) sets)))
-    [#{2} #{2 4}] [#{2}]
-    [#{1 2 3} #{2 3 4} #{2 3 5}] [#{1 4 5} #{2} #{3}]
-    [#{1 2} #{1 3} #{2 3}] [#{1 2} #{1 3} #{2 3}]))
+       [#{2} #{2 4}] [#{2}]
+       [#{1 2 3} #{2 3 4} #{2 3 5}] [#{1 4 5} #{2} #{3}]
+       [#{1 2} #{1 3} #{2 3}] [#{1 2} #{1 3} #{2 3}])
+  (forall [selection (map (partial take 20)
+                          (take 100 (iterate shuffle (subsets (set-of-range 10)))))]
+    (let [mhts (minimal-hypergraph-transversals (set-of-range 10) selection)]
+      (is (every? (fn [mht]
+                    (forall [x selection]
+                      (not-empty (intersection x mht))))
+                  mhts))
+      (is (every? (fn [mht]
+                    (every? (fn [sub-mht]
+                              (exists [x selection]
+                                (empty? (intersection x sub-mht))))
+                            (map #(disj mht %)
+                                 mht)))
+                  mhts))))
+  (forall [selection (map (partial take 20)
+                          (take 100 (iterate shuffle (subsets (set-of-range 10)))))]
+    (let [base-set (reduce union selection),
+          mscs     (minimum-set-covers base-set selection),
+          mhts     (minimal-hypergraph-transversals
+                    selection
+                    (set-of (set-of S | S selection :when (contains? S m))
+                            | m base-set))]
+      (is (= (set mscs) (set mhts))))))

 ;;;


[#1416] The root folder has keyId=0, not null

--- Dashboard/app/cljs/src/org/akvo/flow/dashboard/users/user_details.cljs
+++ Dashboard/app/cljs/src/org/akvo/flow/dashboard/users/user_details.cljs
@@ -184,7 +184,7 @@
                                                     (contains? object-paths "/")))))
                                   (cons {"name" (t> _all_folders) "keyId" 0 "projectType" "PROJECT_FOLDER"}
                                         (projects-store/get-projects projects-store 0))
-                                  (projects-store/get-projects projects-store (get (peek selected-folders) "keyId")))]
+                                  (projects-store/get-projects projects-store (or (get (peek selected-folders) "keyId") 0)))]
                    (om/build b/dropdown
                              {:placeholder (t> _select_a_folder_or_survey)
                               :data (sort-folders-and-surveys projects)


parametrized splitting function

parametrized splitting function

--- src/corpus_utils/text.clj
+++ src/corpus_utils/text.clj
@@ -74,20 +74,22 @@
    Paragraphs are defined as:
    1) one or more non-empty lines delimited by one empty line or BOF/EOF
    2) lines prefixed with fullwidth unicode space '　'"
-  [lines]
-  (into []
-        (comp
-         ; Partition by paragraph (empty line or indented line (common in BCCWJ)).
-         (partition-by #(or (nil? %) (empty? %) (= (subs % 0 1) "　")))
-         (map (fn [paragraphs]
-                (->> paragraphs
-                     (sequence
-                      (comp (filter identity)
-                            (remove empty?)
-                            (map split-japanese-sentence)))
-                     flatten)))
-         (remove (partial every? empty?))) ; Remove paragraph boundaries.
-        lines))
+  ([lines]
+   (lines->paragraph-sentences lines #(or (nil? %) (empty? %) (= (subs % 0 1) "　"))))
+  ([lines split-fn]
+   (into []
+         (comp
+          ;; Partition by paragraph (empty line or indented line (common in BCCWJ)).
+          (partition-by split-fn)
+          (map (fn [paragraphs]
+                 (->> paragraphs
+                      (sequence
+                       (comp (filter identity)
+                             (remove empty?)
+                             (map split-japanese-sentence)))
+                      flatten)))
+          (remove (partial every? empty?))) ; Remove paragraph boundaries.
+         lines)))

 (defn add-tags [paragraphs]
   (into [] (map #(hash-map :tags #{} :sentences %) paragraphs)))


Changed back set-session-id and modified merge-response instead.

Signed-off-by: weavejester <9dadf8ecafa226c8f7c16002bdcb090267879343@weavejester.com>

--- src/compojure/http/response.clj
+++ src/compojure/http/response.clj
@@ -20,13 +20,19 @@
   (:import java.net.URL)
   (:import clojure.lang.Keyword))

+(defn- merge-body
+  [to from]
+  (if (and (string? to) (string? from))
+    (str to from)
+    to))
+
 (defn merge-response
   "Intelligently merge two response maps together."
   [to from]
   (-> to
     (merge from)
     (assoc :headers (merge (:headers to) (:headers from)))
-    (assoc :body    (str (:body to) (:body from)))))
+    (assoc :body    (merge-body (:body to) (:body from)))))

 (defmulti response-from class)


Update spray_test.clj

Update spray_test.clj

--- test/swagger_gen/language/spray_test.clj
+++ test/swagger_gen/language/spray_test.clj
@@ -38,5 +38,3 @@
     (is (= "" (parenthesize [])))
     (is (= "foo" (parenthesize ["foo"])))
     (is (= "(foo, bar") (parenthesize ["foo", "bar"]))))
-
-


calculate statistics regarding correction potential

--- src/error_codes/files.clj
+++ src/error_codes/files.clj
@@ -1,5 +1,6 @@
 (ns error-codes.files
-  (:require [clojure.java.io :refer [file]]
+  (:require [clojure.java.io :as io :refer [file]]
+            [clojure.core.reducers :as r]
             [clojure.set :as set])
   (:use [clojure.core.matrix]))

@@ -414,7 +415,7 @@
      (generate-correction-statistics base-directory-unverbessert base-directory-verbessert [strip-newline-errors strip-start-and-end-errors]))
   ([base-directory-unverbessert base-directory-verbessert filters]
      (let [gts (get-files-sorted (file base-directory-unverbessert "ground-truth/"))
-           gt-text (map lurp gts)
+           gt-text (map slurp gts)
            ocr-res-unverb (map slurp (get-files-sorted (file base-directory-unverbessert "ocr-results/")))
            ocr-res-verb (map slurp (get-files-sorted (file base-directory-verbessert "ocr-results/")))
            error-codes-verb (map (comp read-string slurp) (get-files-sorted (file base-directory-verbessert "edits/")))
@@ -427,3 +428,61 @@

 (edits "a" "b")
+
+(defn read-dict [path]
+  (with-open [in (io/reader path)]
+    (let [words (->> (line-seq in)
+                     (r/map #(clojure.string/split % #"\s+"))
+                     (r/map (fn [[cnt orig simpl]] [orig (bigint cnt)])))
+          word-count (r/fold + (r/map second words))]
+      (->> words
+           (r/map (fn [[w c]] [w (/ c word-count)]))
+           (into {})))))
+
+(def dict (read-dict "/home/kima/programming/bote/resources/dta-freq.d/dta-core-1850+.fuw"))
+
+(defn word-at [idx s]
+  ;;(prn "hi")
+  (let [start (or (first (drop-while #(Character/isLetter (nth s %)) (range idx -1 -1))) -1)
+        end  (or (first (drop-while #(Character/isLetter (nth s %)) (range idx (count s)))) (count s))]
+  ;;  (prn start end)
+    (.substring ^String s (inc start) end)))
+
+(defn error-words [gt ocr edits]
+  ;;(prn "error-words " (first edits))
+  (distinct (doall (for [[code [a b] :as ec] edits
+                         :when (and (<= 0 a (dec (count gt)))
+                                    (<= 0 b (dec (count ocr))))
+                         :when (and (Character/isLetter (nth gt a))
+                                    (Character/isLetter (nth ocr b)))
+                         :let [gt-word (word-at a gt)
+                               ocr-word (word-at b ocr)]]
+                     {:gt-word gt-word
+                      :ocr-word ocr-word}))))
+(defn correction-potential [base-directory]
+  (let [gt (map slurp (get-files-sorted (file base-directory "ground-truth")))
+        ocr (map slurp (get-files-sorted (file base-directory "ocr-results")))
+        edits (map (comp read-string slurp) (get-files-sorted (file base-directory "edits")))
+        error-words (mapcat error-words gt ocr edits)]
+    ;(prn "hi " (type error-words))
+    (for [ew error-words]
+      (do ;(prn "ew " ew)
+          (assoc ew :ocr-in-dict? (dict (:ocr-word ew))
+                 :gt-in-dict? (dict (:gt-word ew)))))))
+
+;;687 mit 1850+ count ocr-in-dict?
+;;2431          count gt-in-dict?
+
+;;für core
+;;836
+;;2541
+
+;;für full
+;;984
+;;2648
+
+;;neue wortrennung wieder mit 1850
+;;760
+;;2914
+
+;;wörter im gt die nicht im 1850 dict stehen


Generalized HOF for output redirection.

Generalized HOF for output redirection.

--- src/fm/simrunner/exec.clj
+++ src/fm/simrunner/exec.clj
@@ -8,12 +8,18 @@
   (:require
     [clojure.java.io :as jio])
   (:import
-    (java.io InputStream PrintWriter)))
+    (java.io PrintWriter)))

-(defn write-lines [^InputStream source ^PrintWriter target]
+(defn drain-lines [source drain]
   (with-open [reader (jio/reader source)]
     (doseq [line (line-seq reader)]
-      (.println target line))))
+      (drain line))))
+
+(defn- print-line [^PrintWriter target ^String line]
+  (.println target line))
+
+(defn write-lines [source ^PrintWriter target]
+  (drain-lines source (partial print-line target)))

 (defn out>-system-out [out]
   (write-lines out *out*))
@@ -29,5 +35,5 @@
               :or {out> out>-system-out err> err>-system-err}}]
   (future (out> (.getInputStream process)))
   (future (err> (.getErrorStream process)))
-  nil)
+  process)


replaced merge with assoc

replaced merge with assoc

--- src/frontend/uploads.cljs
+++ src/frontend/uploads.cljs
@@ -139,9 +139,9 @@
                                            (swap! app-state/app-state
                                                   assoc
                                                   :uploads
-                                                  (merge uploads
-                                                         {first-inactive-upload-id
-                                                          (start-upload first-inactive-upload)})))))
+                                                  (assoc (:uploads @app-state/app-state)
+                                                         first-inactive-upload-id
+                                                         (start-upload first-inactive-upload))))))
                                    (and (= action :unpaused)
                                         (:started? upload))
                                      (do
@@ -153,9 +153,9 @@
                                            (swap! app-state/app-state
                                                   assoc
                                                   :uploads
-                                                  (merge uploads
-                                                         {upload-to-stop-id
-                                                          (stop-upload upload-to-stop)})))))
+                                                  (assoc (:uploads @app-state/app-state)
+                                                         upload-to-stop-id
+                                                         (stop-upload upload-to-stop))))))
                                    (= action :stopped)
                                      (.unpipe blob-stream)
                                    (and (= action :started)


fixed issue in uploads

fixed issue in uploads

--- src/frontend/uploads.cljs
+++ src/frontend/uploads.cljs
@@ -140,7 +140,7 @@
                                        (let [first-inactive-upload-id (first (filter #(unpaused-and-not-started? (uploads %)) uploads-order))
                                              first-inactive-upload    (uploads first-inactive-upload-id)]
                                          (if (and (not (nil? first-inactive-upload))
-                                                  true #_(> (count (active-uploads uploads-order uploads))
+                                                  (> (count (active-uploads uploads-order uploads))
                                                      upload-slots))
                                            (swap! app-state/app-state
                                                   assoc


added new bang for word definition !def

added new bang for word definition !def

--- src/xebang/models/bangs.clj
+++ src/xebang/models/bangs.clj
@@ -6,6 +6,7 @@
    '!weather    "http://weatherspark.com/#!dashboard;q={{{s}}}"
    '!w          "http://weatherspark.com/#!dashboard;q={{{s}}}"
    '!syn        "http://thesaurus.com/browse/{{{s}}}"
+   '!def        "http://dictionary.com/browse/{{{s}}}"
    '!devdocs    "http://devdocs.io/#q={{{s}}}"
    '!js         "http://devdocs.io/#q=js {{{s}}}"
    '!css        "http://devdocs.io/#q=css {{{s}}}"


[#2254] Refactor & working version

[#2254] Refactor & working version

--- backend/src/akvo/lumen/lib/update.clj
+++ backend/src/akvo/lumen/lib/update.clj
@@ -16,6 +16,21 @@
 (hugsql/def-db-fns "akvo/lumen/lib/job-execution.sql")
 (hugsql/def-db-fns "akvo/lumen/lib/transformation.sql")
 (hugsql/def-db-fns "akvo/lumen/lib/dataset.sql")
+
+(defn columns-used-in-txs [initial-dataset-version latest-dataset-version]
+  (log/debug :columns (walk/keywordize-keys (:columns initial-dataset-version)))
+  (log/debug :all-txs (walk/keywordize-keys (:transformations latest-dataset-version)))
+  (let [res (loop [columns (-> initial-dataset-version :columns walk/keywordize-keys)
+                   txs (-> latest-dataset-version :transformations walk/keywordize-keys)
+                   cols0 #{}]
+              (let [tx (first txs)
+                    cols1 (apply  conj cols0 (engine/columns-used (first txs) columns))]
+                (if-let [txs (seq (next txs))]
+                  (recur (engine/undif-columns tx columns) txs cols1)
+                  cols1))
+              )]
+    (log/error :YUPIE res)
+    res))

 (defn- successful-update
   "On a successful update we need to create a new dataset-version that
@@ -91,8 +106,16 @@
     (with-open [importer (import/dataset-importer (get data-source-spec "source") import-config)]
       (let [initial-dataset-version  (initial-dataset-version-to-update-by-dataset-id conn {:dataset-id dataset-id})
             imported-dataset-columns (vec (:columns initial-dataset-version))
-            importer-columns         (p/columns importer)]
-        (if-let [compatible-errors (compatible-columns-error? imported-dataset-columns importer-columns)]
+            importer-columns         (p/columns importer)
+
+            columns-used (columns-used-in-txs
+                          initial-dataset-version
+                          (latest-dataset-version-by-dataset-id tenant-conn {:dataset-id dataset-id}))
+            imported-dataset-columns-checked (reduce (fn [c co]
+                                                       (if (contains? columns-used (get co "columName"))
+                                                         (conj c co)
+                                                         c)) [] imported-dataset-columns)]
+        (if-let [compatible-errors (compatible-columns-error? imported-dataset-columns-checked importer-columns)]
           (failed-update conn job-execution-id
                          (cond-> "Column mismatch"
                            (seq (:missed-columns compatible-errors))
@@ -156,18 +179,5 @@
      (lib/ok {"updateId" job-execution-id}))))

-(defn consistency? [initial-dataset-version latest-dataset-version]
-  (log/error :columns (walk/keywordize-keys (:columns initial-dataset-version)))
-  (log/error :all-txs (walk/keywordize-keys (:transformations latest-dataset-version)))

-  (let [res (loop [columns (-> initial-dataset-version :columns walk/keywordize-keys)
-                   txs (-> latest-dataset-version :transformations walk/keywordize-keys)
-                   cols0 []]
-              (let [tx (first txs)
-                    cols1 (apply conj cols0 (engine/columns-used (first txs) columns))]
-                (if-let [txs (seq (next txs))]
-                  (recur (engine/undif-columns tx columns) txs cols1)
-                  cols1))
-              )]
-    (log/error :YUPIE res)))


Add validation, initial new msg support

Add validation, initial new msg support

--- src/aerobio/server.clj
+++ src/aerobio/server.clj
@@ -80,6 +80,8 @@
    [aerobio.htseq.termseq :as httm]
    [aerobio.htseq.tnseq   :as htts]
    [aerobio.htseq.wgseq   :as htws]
+   ;; Validation
+   [aerobio.validate.all :as va]
    ;; Program graph construction, execution, delivery
    [aerobio.pgmgraph :as pg]
    ;; REST actions
@@ -261,15 +263,15 @@
 (defonce app-db (atom {:rcvcnt 0 :sntcnt 0}))

 (defn update-adb
-  ([] (com/update-db app-db {:rcvcnt 0 :sntcnt 0}))
+  ([] (hc/update-db app-db {:rcvcnt 0 :sntcnt 0}))
   ([keypath vorf]
-   (com/update-db app-db keypath vorf))
+   (hc/update-db app-db keypath vorf))
   ([kp1 vof1 kp2 vof2 & kps-vs]
-   (apply com/update-db app-db kp1 vof1 kp2 vof2 kps-vs)))
+   (apply hc/update-db app-db kp1 vof1 kp2 vof2 kps-vs)))

 (defn get-adb
-  ([] (com/get-db app-db []))
-  ([key-path] (com/get-db app-db key-path)))
+  ([] (hc/get-db app-db []))
+  ([key-path] (hc/get-db app-db key-path)))

@@ -283,21 +285,28 @@
 (defmethod user-msg :default [msg]
   (infof "ERROR: unknown user message %s" msg)
   #_(srv/send-msg
-   (msg :ws) {:op "error" :payload "ERROR: unknown user message"}))
-
-
-
-
-;;; ------------------------------------------------------------------------;;;
-;;;                Control  starting and stoping Webserver                  ;;;
-;;; ------------------------------------------------------------------------;;;
+     (msg :ws) {:op "error" :payload "ERROR: unknown user message"}))
+
+(defmethod user-msg :run [msg]
+  (let [info (msg :payload)
+        ws (info :ws)
+        eid (info "eid")
+        eid (if (str/ends-with? eid "/") (austr/butlast 1 eid) eid)
+        eid (if (str/starts-with? eid "/") (austr/drop 1 eid) eid)]
+    (infof "RUN: %s" info)
+    (srv/send-msg ws {:op :validate :payload (va/validate-exp eid)})
+    (srv/send-msg ws {:op :stop :payload {}} :noenvelope true)))

 (defn msg-handler [msg]
-  (infof ":MSG-HANDLER :MSG %s" msg)
-  (let [{:keys [op data]} (msg :data)]
+  (let [{:keys [ws data]} msg
+        {:keys [op data]} data]
+    (infof "MSG-HANDLER: MSG %s" (msg :data))
     (case op
+      (:done "done")
+      (do (infof "WS: %s, sending stop msg" ws)
+          (srv/send-msg ws {:op :stop :payload {}} :noenvelope true))
       ;;null for now
-      (user-msg (msg :data)))))
+      (user-msg {:op op :payload (assoc data :ws ws)}))))

 (defn on-open [ch op payload]
@@ -309,11 +318,12 @@
         data (connfn {:uid uid})
         name-uuids (or (get-adb uid-name) [])]
     (infof ":SRV :open %s" uid)
-    (update-adb [uuid :ws] ws, [uuid :name] uid-name
+    (update-adb :ws ws
+                [ws :uuid] uuid
+                [uuid :ws] ws, [uuid :name] uid-name
                 [uuid :rcvcnt] 0, [uuid :sntcnt] 0
-                [ws :uuid] uuid
                 uid-name (conj name-uuids uuid))
-    (srv/send-msg ws {:op :register :data data})))
+    (srv/send-msg ws {:op :register :payload data})))

 (defn server-dispatch [ch op payload]
@@ -381,12 +391,13 @@

 (defn start-server
-  [port & {:keys [route-handler connfn]
+  [port & {:keys [route-handler idfn connfn]
            :or {route-handler (aerobio-handler (aerobio-routes))
                 connfn identity}}]
   (let [ch (srv/start-server port :main-handler route-handler)]
-    (printchan "Server start, reading msgs from " ch)
+    (infof "Server start, reading msgs from %s" ch)
     (update-adb :chan ch
+                :idfn [idfn]
                 :connfn [connfn])
     (go-loop [msg (<! ch)]
       (let [{:keys [op payload]} msg]
@@ -398,12 +409,36 @@
   (async/>!! (get-adb :chan) {:op :stop :payload {:cause :userstop}}))

-#_(hmi/start-server
+(defn connfn [data] data)
+
+#_(start-server
    7070
-   :route-handler (hmi/aerobio-handler
-                   (hmi/aerobio-routes :index-path "public/Fig/index.html"))
-   :idfn (constantly "Exploring")
+   :route-handler (aerobio-handler
+                   (aerobio-routes :index-path "public/index.html"))
+   :idfn (constantly "Aerobio")
    :connfn connfn)
+#_(stop-server)
+
+
+(defn start! [port]
+  (timbre/set-level! :info) ; :debug
+  (start-tool-watcher)
+  (start-job-watcher)
+  (start-server
+   port
+   :idfn (constantly "Aerobio")
+   :connfn connfn
+   :route-handler
+   (aerobio-handler (aerobio-routes :index-path "public/index.html"))))
+
+(defn stop! []
+  (stop-tool-watcher)
+  (stop-job-watcher)
+  (stop-server))
+
+
+
+

@@ -463,34 +498,3 @@
          [:p (str "Params" params)]
          [:hr]
          [:p (str "User Agent: " user-agent)])))))
-
-
-
-(defn start-server
-  [port]
-  (let [ch (srv/start-server port :main-handler aerobio-handler)]
-    (infof "Server start, reading msgs from %s" ch)
-    (update-adb :chan ch
-                :idfn [(partial gensym "aerobio-")]
-                :connfn [identity])
-    (go-loop [msg (<! ch)]
-      (let [{:keys [op payload]} msg]
-        (future (server-dispatch ch op payload))
-        (when (not= op :stop)
-          (recur (<! ch)))))))
-
-(defn stop-server []
-  (async/>!! (get-adb :chan) {:op :stop :payload {:cause :userstop}}))
-
-
-(defn start! [port]
-  (timbre/set-level! :info) ; :debug
-  (start-tool-watcher)
-  (start-job-watcher)
-  (start-server port))
-
-(defn stop! []
-  (stop-tool-watcher)
-  (stop-job-watcher)
-  (stop-server))
-


Remove completed todo

Remove completed todo

--- src/afterglow/midi.clj
+++ src/afterglow/midi.clj
@@ -189,7 +189,6 @@
          (throw (IllegalArgumentException. (str "More than one MIDI clock source " (describe-name-filter name-filter)
                                                 "was found."))))))))

-;; TODO function to return next control or note message received, to aid mapping
 (defn identify-mapping
   "Report on the next MIDI control or note message received, to aid in
   setting up a mapping to a button, fader, or knob. Call this, then


Add S3 configuration bindings

Add S3 configuration bindings

--- src/asciinema/main.clj
+++ src/asciinema/main.clj
@@ -8,7 +8,10 @@

 (defn -main [& args]
   (let [bindings {'http-port (Integer/parseInt (:port env "3000"))
-                  'db-uri    (:database-url env)}
+                  'db-uri    (:database-url env)
+                  's3-bucket (:s3-bucket env)
+                  's3-access-key (:s3-access-key env)
+                  's3-secret-key (:s3-secret-key env)}
         system   (->> (load-system [(io/resource "asciinema/system.edn")] bindings)
                       (component/start))]
     (add-shutdown-hook ::stop-system #(component/stop system))