Write documents in jungerer.vis

Write documents in jungerer.vis

--- src/jungerer/vis.clj
+++ src/jungerer/vis.clj
@@ -1,4 +1,5 @@
 (ns jungerer.vis
+  "Functions to visualize a graph on Swing."
   (:import java.awt.Dimension
            javax.swing.JFrame
            [edu.uci.ics.jung.algorithms.layout CircleLayout FRLayout ISOMLayout
@@ -10,22 +11,33 @@
 ;; ------

 (defn ^CircleLayout circle-layout
+  "Returns an edu.uci.ics.jung.algorithms.layout.CircleLayout for graph. This
+  layout positions nodes equally spaced on a regular circle."
   [graph]
   (CircleLayout. graph))

 (defn ^FRLayout fr-layout
+  "Returns an edu.uci.ics.jung.algorithms.layout.FRLayout for graph. This layout
+  implements the Fruchterman-Reingold force-directed algorithm for node layout."
   [graph]
   (FRLayout. graph))

 (defn ^ISOMLayout isom-layout
+  "Returns an edu.uci.ics.jung.algorithms.layout.ISOMLayout for graph. This
+  layout implements a self-organizing map layout algorithm, based on Meyer's
+  self-organizing graph methods."
   [graph]
   (ISOMLayout. graph))

 (defn ^KKLayout kk-layout
+  "Returns an edu.uci.ics.jung.algorithms.layout.KKLayout for graph. This layout
+  implements the Kamada-Kawai algorithm for node layout. Does not respect filter
+  calls, and sometimes crashes when the view changes to it."
   [graph]
   (KKLayout. graph))

 (defn ^SpringLayout spring-layout
+  "Returns an edu.uci.ics.jung.algorithms.layout.SpringLayout for graph."
   [graph]
   (SpringLayout. graph))

@@ -33,7 +45,11 @@
 ;; -------------

 (defprotocol Visualizable
-  (view [this] [this option]))
+  (view [this] [this option]
+    "Visualizes graph on Swing. The first argument must be
+  edu.uci.ics.jung.graph.Graph or edu.uci.ics.jung.algorithms.layout.Layout. The
+  optional second argument is an option map including :title, :frame-size, and
+  :layout-size."))

 (extend-type Graph
   Visualizable


More test

More test

--- test/onyx/coordinator/multi_job_test.clj
+++ test/onyx/coordinator/multi_job_test.clj
@@ -158,6 +158,24 @@
                           [?job :job/catalog ?catalog]]
                   result (d/q query db (:db/id (:task payload-b)) (pr-str catalog-a))
                   jobs (map first result)]
+              (is (= (count jobs) 1)))))
+
+        (let [payload-a (extensions/read-place sync payload-node-a-2)]
+          (extensions/write-place sync peer-node-a payload-node-a-1)
+          (extensions/on-change sync payload-node-a-1 #(>!! sync-spy-a %))
+          (extensions/touch-place sync (:completion (:nodes payload-a)))
+
+          (<!! offer-ch-spy)
+          (<!! sync-spy-a))
+
+        (let [payload-a (extensions/read-place sync payload-node-a-1)]
+          (testing "Payload A is for job B"
+            (let [db (d/db (:conn log))
+                  query '[:find ?job :in $ ?task ?catalog :where
+                          [?job :job/task ?task]
+                          [?job :job/catalog ?catalog]]
+                  result (d/q query db (:db/id (:task payload-a)) (pr-str catalog-b))
+                  jobs (map first result)]
               (is (= (count jobs) 1)))))))

     {:eviction-delay 50000}))


Wishlists now assigned code

Wishlists now assigned code

--- src/wishlistd/models/queries.clj
+++ src/wishlistd/models/queries.clj
@@ -1,12 +1,13 @@
 (ns wishlistd.models.queries
   (:require [clojure.java.jdbc :as sql])
-  (:use wishlistd.code))
+  (:use wishlistd.code)) ; generate-code

 (def db {:classname "org.postgresql.Driver"
          :subprotocol "postgresql"
          :subname "//localhost:5432/cwl"
          :user "cwl"
          :password "wish"})
+
 ;wishlist
 ;[:id :serial "PRIMARY KEY"]
 ;[:title :varchar "NOT NULL"]
@@ -21,24 +22,23 @@
 ;[:wishlist :int]
 ;["constraint fk_wish_wishlist foreign key(wishlist) references Wishlist(id) on delete cascade"])))

-(defn get-wishlist-by-code [{:keys [code]}] ; code is unique not null
+(defn get-wishlist [{:keys [code]}] ; code is unique
   (sql/with-connection db
     (sql/with-query-results results
       ["select * from wishlist where code=?" code]
       (first (into [] results)))))

-(defn get-wishlist-by-id [{:keys [id]}]
-  (sql/with-connection db
-    (sql/with-query-results results
-      ["select * from wishlist where id=?" id]
-      (first (into [] results)))))
+(defn create-wishlist [wishlist]
+  (let [inserted (insert-wishlist wishlist) ; returns the wishlist
+        code (generate-code (:id inserted))] ; returns the code
+    (update-wishlist (assoc inserted :code code))))

 (defn insert-wishlist [wishlist]
   (first
     (sql/with-connection db
       (sql/insert-records :wishlist wishlist))))

-(defn delete-wishlist [{:keys [code]}] ; code is unique not null
+(defn delete-wishlist [{:keys [code]}] ; code is unique
   (first
     (sql/with-connection db
       (sql/delete-rows :wishlist ["code=?" code]))))
@@ -67,8 +67,8 @@
     (sql/with-connection db
       (sql/update-values :wish ["id=?" id] wish))))

-(defn get-code []
-  (sql/with-connection db
-    (sql/with-query-results results
-      ["select last_value+1 as last_value from wishlist_id_seq"]
-      (generate-code (:last_value (first (into [] results)))))))+; (defn get-code []
+;   (sql/with-connection db
+;     (sql/with-query-results results
+;       ["select last_value+1 as last_value from wishlist_id_seq"]
+;       (generate-code (:last_value (first (into [] results)))))))


Three tests for the function string/endsWith

--- test/zg/utils_test.clj
+++ test/zg/utils_test.clj
@@ -246,3 +246,28 @@
         (is (thrown? NullPointerException (startsWith "text" nil)))
         (is (thrown? NullPointerException (startsWith nil "text")))))

+(deftest test-ends-with-1 "Check the function zg.utils/ends-with."
+    (testing "the function zg.utils/ends-with."
+        (are [x y] (= x y)
+            true  (endsWith "Hello world!" "Hello world!")
+            false (endsWith "Hello world!" "hello world!")
+            true  (endsWith "Hello world!" "world!")
+            true  (endsWith "Hello world!" "!")
+            true  (endsWith "Hello world!" ""))))
+
+(deftest test-ends-with-2
+    "Check the function zg.utils/ends-with."
+    (testing "the function zg.utils/ends-with."
+        (are [x y] (= x y)
+            false (endsWith "" "hello")
+            false (endsWith "" "Hello")
+            false (endsWith "" "H")
+            true  (endsWith "" ""))))
+
+(deftest test-ends-with-NPE
+    "Check the function zg.utils/ends-with."
+    (testing "the function zg.utils/ends-with."
+        (is (thrown? NullPointerException (endsWith nil nil)))
+        (is (thrown? NullPointerException (endsWith "text" nil)))
+        (is (thrown? NullPointerException (endsWith nil "text")))))
+


Allow creating a model from a ModelData

Allow creating a model from a ModelData

--- src/play_clj/g3d.clj
+++ src/play_clj/g3d.clj
@@ -5,6 +5,7 @@
            [com.badlogic.gdx.graphics.g3d.attributes BlendingAttribute
             ColorAttribute CubemapAttribute DepthTestAttribute FloatAttribute
             IntAttribute TextureAttribute]
+           [com.badlogic.gdx.graphics.g3d.model.data ModelData]
            [com.badlogic.gdx.graphics.g3d.utils ModelBuilder]))

 ; environment
@@ -54,7 +55,15 @@
 (defmacro model
   "Returns an entity based on [ModelInstance](http://libgdx.badlogicgames.com/nightlies/docs/api/com/badlogic/gdx/graphics/g3d/ModelInstance.html)"
   [& args]
-  `(u/create-entity (ModelInstance. ~@args)))
+  `(u/create-entity
+     (let [arg1# ~(first args)]
+       (cond
+         (:object arg1#)
+         (ModelInstance. ^ModelInstance (:object arg1#))
+         (isa? arg1# ModelData)
+         (ModelInstance. ^Model (Model. ~@args))
+         :else
+         (ModelInstance. ~@args)))))

 (defmacro model!
   "Calls a single method on a `model`"


Clean up

Clean up

--- src/qcast/server.clj
+++ src/qcast/server.clj
@@ -70,7 +70,7 @@
                  (itunes/image (base-url "/styles/i/logo-big.jpg"))
                  (itunes/block false)
                  (itunes/explicit false)]
-        extensions [:atom :itunes :feedburner :simple-chapters :content :history]
+        extensions [:atom :itunes :simple-chapters]
         feed (rss/feed channel items extensions)]
     feed))


closer now to having :forward-events working.

--- src/re_frame/fx.cljs
+++ src/re_frame/fx.cljs
@@ -1,5 +1,6 @@
 (ns re-frame.fx
-  (:require [re-frame.router :refer [dispatch]]
+  (:require [reagent.ratom  :refer [IReactiveAtom]]
+            [re-frame.router :refer [dispatch]]
             [re-frame.db :refer [app-db]]
             [re-frame.events]
             [re-frame.loggers    :refer [console]]))
@@ -77,18 +78,22 @@
 #_(register
   :forward-events
   (let [id->listen-fn (atom {})
-        process-entry (fn [{:keys [listen events dispatch-to unlisten]}]
-                        (if  unlisten
-                          (do
-                            (unregister XXXX)
-                            (swap! id->listen-fn dissoc unlisten))))]
-
-
+        process-one-entry (fn [{:as m :keys [listen events dispatch-to unlisten]}]
+                            (let [_  (assert (map? m) (str "re-frame: effects handler for :forward-events expected a map or a list of maps. Got: " m))]   ;; XXX do this better
+                              (if  unlisten
+                                (do
+                                  (re-frame.core/remove-post-event-callback (@id->listen-fn unlisten))
+                                  (swap! id->listen-fn dissoc unlisten))
+                                (let [post-event-callback-fn  (fn [event-v _]
+                                                                (when (events (first event-v))
+                                                                  (dispatch (conj dispatch-to event-v))))]
+                                  (re-frame.core/add-post-event-callback  post-event-callback-fn)
+                                  (swap! id->listen-fn assoc listen post-event-callback-fn)))))]
     (fn [val]
       (cond
-        (map? val) (process-entry m)
-        (list? val) (doseq []))
-      (do-dispatches (:dispatch world)))))
+        (map? val) (process-one-entry val)
+        (list? val) (doall (map process-one-entry val)))     ;; XXX add else
+      )))

 (register
@@ -119,6 +124,10 @@
   [handler]
   (fn fx-handler
     [app-db event-vec]
+    (if-not (satisfies? IReactiveAtom app-db)
+        (if (map? app-db)
+          (console :warn "re-frame: Looks like you might be using \"fx\" middleware with \"def-event\".  Use \"def-event-fx\" to put Or something. ")
+          (console :warn "re-frame: \"pure\" middleware not given a Ratom.  Got: " app-db)))
     (let [world   {:db @app-db}]
       (->> (handler world event-vec)
            (map (fn [[key val]]


Remove ps option unsupported in Darwin.

Remove ps option unsupported in Darwin.

--- src/cmr/dev/env/manager/process/core.clj
+++ src/cmr/dev/env/manager/process/core.clj
@@ -15,7 +15,7 @@
     (get-ps-info "pid,ppid,pgid,comm"))
   ([output-format]
     (->> output-format
-         (util/get-cmd-output "ps" "--no-headers" "-eo")
+         (util/get-cmd-output "ps" "-eo")
          (string/split-lines)
          (info/output-lines->ps-info output-format))))


Basic unit values

Basic unit values

--- src/accounting/core.cljs
+++ src/accounting/core.cljs
@@ -27,8 +27,9 @@

 (def sample-txs [
   {:date "2015/02/17", :description "Starting Cash", :parts [
+    {:account :a-ameritrade, :amount 20000}
     {:account :a-cash, :amount 10000}
-    {:account :i-start, :amount -10000}]}
+    {:account :i-start, :amount -30000}]}
   {:date "2015/02/18", :description "Whole Foods", :parts [
     {:account :e-groceries, :amount 2000}
     {:account :a-cash, :amount -2000}]}
@@ -36,7 +37,14 @@
     {:account :e-groceries, :amount 2000, :note "Food"}
     {:account :e-alcohol, :amount 1000, :note "Beer"}
     {:account :a-cash, :amount -3000}]}
+  {:date "2015/02/20", :description "Ameritrade", :parts
+    [{:account :a-ameritrade, :amount 1000, :unit :SLV}
+     {:account :a-ameritrade, :amount -16000}
+     {:account :e-commission, :amount 1000}]}
 ])
+
+(def sample-prices
+  [{:date "2015/02/20", :SLV 15}])

 (defn str->fixpt [s]
   (* s 100))
@@ -65,9 +73,12 @@
     (compare (Math/abs n2) (Math/abs n1))
     (compare n1 n2)))

-(defn display-amount [amount unit neg]
-  (str (if unit (str (subs (str unit) 1) " ") "$")
-       (fixpt->str (if neg (- amount) amount))))
+(defn display-amount
+  ([amount] (display-amount amount nil nil))
+  ([amount unit] (display-amount amount unit nil))
+  ([amount unit neg]
+   (str (if unit (str (subs (str unit) 1) " ") "$")
+        (fixpt->str (if neg (- amount) amount)))))

 (defn tx-tds [tx]
   (let [[from-part to-part :as parts] (sort-by :amount cmp-sign-abs (:parts tx))]
@@ -90,22 +101,26 @@
    {:account "", :amount ""}])

 (def app-state (atom
-  {:screen :import
+  {:screen :summary
    :txs sample-txs
+   :prices sample-prices
    :register-parts []
    :entry-parts empty-entry-parts}))

 (defn store-event [ev]
   {:target (aget ev "target")
-   :key-code (.-keyCode ev)
    :target-value (aget ev "target" "value")})

 (defn send!
   ([type] (send! type {}))
   ([type arg]
     (fn [ev]
-      (put! channel [type (store-event ev) arg]))))
+      (if (or (not= "keydown" (.-type ev)) (= 13 (.-keyCode ev)))
+        (put! channel [type (store-event ev) arg])))))

+(defn get-price [unit]
+  ((peek (:prices @app-state)) unit 1))
+
 (defn summarize [txs]
   (->> txs
        (map :parts)
@@ -117,8 +132,10 @@
        (apply concat)
        (group-by #(map % [:account :unit]))
        (map (fn [[[account unit] parts]]
-              {:account (account-vec->str account),
-               :amount (display-amount (apply + (map :amount parts)) unit)}))
+              (let [amount (apply + (map :amount parts))]
+                {:account (account-vec->str account)
+                 :amount (display-amount amount unit)
+                 :value (display-amount (* amount (get-price unit)))})))
        (sort-by :account)))

 (defn register-parts [account txs]
@@ -133,9 +150,15 @@
                      {:account (account-key->str account)
                       :amount (display-amount amount unit)})))))

+(def right-align #js {:style #js {:textAlign "right"}})
+
 (defn render-import [state]
-  (dom/textarea #js {:onKeyDown (send! :import) :rows 25 :cols 100}))
-
+  (dom/div nil
+    (dom/p nil "Import transaction data:")
+    (dom/textarea #js {:onKeyDown (send! :import-txs) :rows 20 :cols 100})
+    (dom/p nil "Import price data:")
+    (dom/textarea #js {:onKeyDown (send! :import-prices) :rows 20 :cols 100})))
+
 (defn render-table-headings [headings]
   (dom/thead nil
     (apply dom/tr nil
@@ -144,12 +167,13 @@

 (defn render-summary [summary-rows]
   (dom/table nil
-    (render-table-headings ["Account" "Amount"])
+    (render-table-headings ["Account" "Value" "Amount"])
     (apply dom/tbody nil
-      (for [{:keys [account amount]} summary-rows]
+      (for [{:keys [account value amount]} summary-rows]
         (dom/tr nil
           (dom/td nil account)
-          (dom/td #js {:style #js {:textAlign "right"}} amount))))))
+          (dom/td right-align value)
+          (dom/td right-align amount))))))

 (defn render-detail [state]
   (dom/div nil
@@ -196,13 +220,16 @@
           (dom/tr nil
             (dom/td nil date)
             (dom/td nil description)
-            (dom/td nil amount)
+            (dom/td right-align amount)
             (dom/td nil note)))))))
+
+(defn render-export [state]
+  (dom/p nil "Export screen coming soon!"))

 (defn render-menu [current-screen]
   (apply dom/p nil
     (interpose " \u00A0 "
-      (for [title ["Import" "Summary" "Detail" "Register"]
+      (for [title ["Import" "Summary" "Detail" "Register" "Export"]
             :let [screen (keyword (.toLowerCase title))]]
         (if (= screen current-screen)
           (dom/span #js {:style #js {:fontWeight "bold"}} title)
@@ -213,6 +240,7 @@
     (render-menu screen)
     (case screen
       :import (render-import state)
+      :export (render-export state)
       :summary (render-summary (summarize txs))
       :detail (render-detail state)
       :register (render-register state))))
@@ -273,6 +301,10 @@
   (into txs
         (map normalize-transaction
              (cljs.reader/read-string target-value))))
+
+(defn import-prices [{:keys [target-value]}]
+  ;(map #(update-in % [:amount] str->fixpt)
+       (cljs.reader/read-string target-value));)

 (defn create-transaction [{:keys [date description accounts amounts]}]
   {:date date
@@ -304,10 +336,9 @@
       (let [[type ev arg] (<! channel)]
         (case type
           :screen (om/update! app [:screen] arg)
-          :import (if (= 13 (:key-code ev))
-            (om/transact! app #(merge % {:screen :summary, :txs (import-transactions ev %)})))
-          :register (if (= 13 (:key-code ev))
-            (om/update! app [:register-parts] (register-parts (str->account (:target-value ev)) (:txs @app-state))))
+          :import-txs (om/transact! app #(merge % {:screen :summary, :txs (import-transactions ev %)}))
+          :import-prices (om/transact! app #(merge % {:screen :summary, :prices (import-prices ev %)}))
+          :register (om/update! app [:register-parts] (register-parts (str->account (:target-value ev)) (:txs @app-state)))
           :create (om/transact! app [:txs] #(conj % (create-transaction (get-inputs-state))))
           :change (om/transact! app [:entry-parts] #(change-part-field ev arg %))
           :blur (om/transact! app [:entry-parts] #(blur-amount ev arg %)))))))
@@ -324,5 +355,9 @@
   [["2015/02/23" "Whole Foods" :e-groceries 25 :l-amex]
    ["2015/02/24" "Trader Joe's" :e-groceries 20 :e-alcohol 10 :l-amex]
    ["2015/02/25" "Ameritrade" :a-ameritrade [100 :GLD] :a-ameritrade -10010]]
+
+  [{:date "2015/02/20", :SLV 15, :GLD 100 }
+   {:date "2015/02/21", :SLV 15.20, :GLD 103 }]
+
 )


Handle aggregates that ignore scoping restrictions

--- src/aurora/language.cljs
+++ src/aurora/language.cljs
@@ -266,7 +266,43 @@
               agg-index-id (str rule-id "-agg-index")
               has-aggs (@rule-id->has-agg rule-id)
               _ (assert (= (count has-aggs) 1))
-              [_ _ limit ordinal ascending|descending] (first has-aggs)]
+              [_ _ limit ordinal ascending|descending] (first has-aggs)
+              group-by-vars (for [[_ var] (@rule-id->group-by rule-id)]
+                              var)
+              sort-by-vars (into (sorted-map)
+                                 (for [[_ ix var] (@rule-id->sort-by rule-id)]
+                                   [ix var]))
+              agg-in-vars (for [[_ in-var agg-fun out-var] (@rule-id->agg-over rule-id)]
+                            in-var)
+              agg-out-vars (set
+                            (for [[_ in-var agg-fun out-var] (@rule-id->agg-over rule-id)]
+                              out-var))
+              pass-through-vars (for [[_ clause-type clause-id name] clauses
+                                      :when (not= clause-type "know")
+                                      [_ field-type key val] (@clause-id->fields clause-id)
+                                      :when (= field-type "variable")
+                                      :when (not= ordinal val)
+                                      :when (not (agg-out-vars val))]
+                                  val)
+              in-vars (into-array (distinct (concat group-by-vars [limit] (vals sort-by-vars) agg-in-vars pass-through-vars)))
+              out-vars (into-array (distinct (concat group-by-vars [limit] (vals sort-by-vars) agg-in-vars pass-through-vars [ordinal] agg-out-vars)))
+              var->ix (into {}
+                            (for [i (range (alength out-vars))]
+                              [(aget out-vars i) i]))
+              index (.get-or-create-index kn "know" agg-index-id in-vars)
+              group-len (count (conj (set group-by-vars) limit))
+              limit-ix (var->ix limit)
+              ascending? (= ascending|descending "ascending")
+              agg-ixes (into-array
+                        (for [[_ in-var agg-fun out-var] (@rule-id->agg-over rule-id)]
+                          (var->ix in-var)))
+              agg-funs (into-array
+                        (for [[_ in-var agg-fun out-var] (@rule-id->agg-over rule-id)]
+                          (aget js/aurora.aggregates agg-fun)))
+              sinks (into-array
+                     (for [[_ clause-type clause-id name] clauses
+                           :when (not= clause-type "when")]
+                       (sink-of rule-id clause-type clause-id name var->ix)))]

           ;; remove output clauses
           (doseq [[_ clause-type clause-id name] clauses
@@ -275,45 +311,12 @@

           ;; add a clause to output used vars to agg-index-ix
           (swap! rule-id->clauses update-in [rule-id] conj [rule-id "know" agg-clause-id agg-index-id])
-          (swap! clause-id->fields update-in [agg-clause-id] conj [agg-clause-id "variable" limit limit])
-          (doseq [[_ var] (@rule-id->group-by rule-id)]
+          (doseq [var in-vars]
             (swap! clause-id->fields update-in [agg-clause-id] conj [agg-clause-id "variable" var var]))
-          (doseq [[_ ix var] (@rule-id->sort-by rule-id)]
-            (swap! clause-id->fields update-in [agg-clause-id] conj [agg-clause-id "variable" var var]))
-          (doseq [[_ in-var agg-fun out-var] (@rule-id->agg-over rule-id)]
-            (swap! clause-id->fields update-in [agg-clause-id] conj [agg-clause-id "variable" in-var in-var]))

           ;; create an aggregate flow to read from agg-index-id
-          (let [group-by-vars (for [[_ var] (@rule-id->group-by rule-id)]
-                                var)
-                sort-by-vars (into (sorted-map)
-                                   (for [[_ ix var] (@rule-id->sort-by rule-id)]
-                                     [ix var]))
-                agg-in-vars (for [[_ in-var agg-fun out-var] (@rule-id->agg-over rule-id)]
-                              in-var)
-                agg-out-vars (for [[_ in-var agg-fun out-var] (@rule-id->agg-over rule-id)]
-                               out-var)
-                in-vars (into-array (distinct (concat group-by-vars [limit] (vals sort-by-vars) agg-in-vars)))
-                out-vars (into-array (distinct (concat group-by-vars [limit] (vals sort-by-vars) agg-in-vars [ordinal] agg-out-vars)))
-                var->ix (into {}
-                              (for [i (range (alength out-vars))]
-                                [(aget out-vars i) i]))
-                index (.get-or-create-index kn "know" agg-index-id in-vars)
-                group-len (count (conj (set group-by-vars) limit))
-                limit-ix (var->ix limit)
-                ascending? (= ascending|descending "ascending")
-                agg-ixes (into-array
-                          (for [[_ in-var agg-fun out-var] (@rule-id->agg-over rule-id)]
-                            (var->ix in-var)))
-                agg-funs (into-array
-                          (for [[_ in-var agg-fun out-var] (@rule-id->agg-over rule-id)]
-                            (aget js/aurora.aggregates agg-fun)))
-                sinks (into-array
-                       (for [[_ clause-type clause-id name] clauses
-                             :when (not= clause-type "when")]
-                         (sink-of rule-id clause-type clause-id name var->ix)))]
-            (swap! rule->flow assoc agg-rule-id (AggregateFlow. index group-len limit-ix ascending? agg-ixes agg-funs sinks))
-            (swap! kind->name->rules update-in ["know" agg-index-id] conj agg-rule-id)))))
+          (swap! rule->flow assoc agg-rule-id (AggregateFlow. index group-len limit-ix ascending? agg-ixes agg-funs sinks))
+          (swap! kind->name->rules update-in ["know" agg-index-id] conj agg-rule-id))))

     (doseq [[rule-id clauses] @rule-id->clauses]
       (let [var->when-count (atom {})]
@@ -340,70 +343,70 @@

               ;; make inputs
               constraints (for [[_ clause-type clause-id name] sorted-clauses
-                                     :when (= clause-type "when")]
-                                 (let [fields (get @clause-id->fields clause-id)]
-                                   (case name
-                                     "=constant" (let [variable (first (for [[_ field-type key val] fields
-                                                                             :when (= key "variable")]
-                                                                         val))
-                                                       constant (first (for [[_ field-type key val] fields
-                                                                             :when (= key "constant")]
-                                                                         val))
-                                                       ix (get var->ix variable)]
-                                                   (btree/constant constant ix))
-                                     "=variable" (let [variable-a (first (for [[_ field-type key val] fields
-                                                                               :when (= key "variable-a")]
-                                                                           val))
-                                                       variable-b (first (for [[_ field-type key val] fields
-                                                                               :when (= key "variable-b")]
-                                                                           val))
-                                                       ix-a (get var->ix variable-a)
-                                                       ix-b (get var->ix variable-b)]
-                                                   (btree/equal #js [ix-a ix-b]))
-                                     "=function" (let [variable (first (for [[_ field-type key val] fields
-                                                                             :when (= key "variable")]
-                                                                         val))
-                                                       js (first (for [[_ field-type key val] fields
-                                                                       :when (= key "js")]
-                                                                   val))
-                                                       result-ix (get var->ix variable)
-                                                       args (for [var vars
-                                                                  :when (>= (.indexOf js var) 0)]
-                                                              var)
-                                                       arg-ixes (map var->ix args)
-                                                       fun (apply js/Function (conj (vec args) (str "return (" js ");")))]
-                                                   (btree/function fun result-ix (into-array arg-ixes)))
-                                     "filter" (let [js (first (for [[_ field-type key val] fields
-                                                                    :when (= key "js")]
-                                                                val))
-                                                    args (for [var vars
-                                                               :when (>= (.indexOf js var) 0)]
-                                                           var)
-                                                    arg-ixes (map var->ix args)
-                                                    fun (apply js/Function (conj (vec args) (str "return (" js ");")))]
-                                                (btree/filter fun (into-array arg-ixes)))
-                                     "interval" (let [in (first (for [[_ field-type key val] fields
-                                                                      :when (= key "in")]
-                                                                  val))
-                                                      in-ix (get var->ix in)
-                                                      lo (first (for [[_ field-type key val] fields
-                                                                      :when (= key "lo")]
-                                                                  val))
-                                                      lo-ix (get var->ix lo)
-                                                      hi (first (for [[_ field-type key val] fields
-                                                                      :when (= key "hi")]
-                                                                  val))
-                                                      hi-ix (get var->ix hi)]
-                                                  (btree/interval in-ix lo-ix hi-ix))
-                                     (let [clause-vars&keys (sort-by (fn [[val key]] (var->ix val))
-                                                                     (for [[_ field-type key val] fields]
-                                                                       [val key]))
-                                           clause-vars (map first clause-vars&keys)
-                                           clause-vars-ixes (map var->ix clause-vars)
-                                           clause-keys (map second clause-vars&keys)
-                                           index (.get-or-create-index kn "know" name (into-array clause-keys))]
-                                       (swap! kind->name->rules update-in ["know" name] #(conj (or % #{}) rule-id))
-                                       (btree/contains (btree/iterator index) (into-array clause-vars-ixes))))))
+                                :when (= clause-type "when")]
+                            (let [fields (get @clause-id->fields clause-id)]
+                              (case name
+                                "=constant" (let [variable (first (for [[_ field-type key val] fields
+                                                                        :when (= key "variable")]
+                                                                    val))
+                                                  constant (first (for [[_ field-type key val] fields
+                                                                        :when (= key "constant")]
+                                                                    val))
+                                                  ix (get var->ix variable)]
+                                              (btree/constant constant ix))
+                                "=variable" (let [variable-a (first (for [[_ field-type key val] fields
+                                                                          :when (= key "variable-a")]
+                                                                      val))
+                                                  variable-b (first (for [[_ field-type key val] fields
+                                                                          :when (= key "variable-b")]
+                                                                      val))
+                                                  ix-a (get var->ix variable-a)
+                                                  ix-b (get var->ix variable-b)]
+                                              (btree/equal #js [ix-a ix-b]))
+                                "=function" (let [variable (first (for [[_ field-type key val] fields
+                                                                        :when (= key "variable")]
+                                                                    val))
+                                                  js (first (for [[_ field-type key val] fields
+                                                                  :when (= key "js")]
+                                                              val))
+                                                  result-ix (get var->ix variable)
+                                                  args (for [var vars
+                                                             :when (>= (.indexOf js var) 0)]
+                                                         var)
+                                                  arg-ixes (map var->ix args)
+                                                  fun (apply js/Function (conj (vec args) (str "return (" js ");")))]
+                                              (btree/function fun result-ix (into-array arg-ixes)))
+                                "filter" (let [js (first (for [[_ field-type key val] fields
+                                                               :when (= key "js")]
+                                                           val))
+                                               args (for [var vars
+                                                          :when (>= (.indexOf js var) 0)]
+                                                      var)
+                                               arg-ixes (map var->ix args)
+                                               fun (apply js/Function (conj (vec args) (str "return (" js ");")))]
+                                           (btree/filter fun (into-array arg-ixes)))
+                                "interval" (let [in (first (for [[_ field-type key val] fields
+                                                                 :when (= key "in")]
+                                                             val))
+                                                 in-ix (get var->ix in)
+                                                 lo (first (for [[_ field-type key val] fields
+                                                                 :when (= key "lo")]
+                                                             val))
+                                                 lo-ix (get var->ix lo)
+                                                 hi (first (for [[_ field-type key val] fields
+                                                                 :when (= key "hi")]
+                                                             val))
+                                                 hi-ix (get var->ix hi)]
+                                             (btree/interval in-ix lo-ix hi-ix))
+                                (let [clause-vars&keys (sort-by (fn [[val key]] (var->ix val))
+                                                                (for [[_ field-type key val] fields]
+                                                                  [val key]))
+                                      clause-vars (map first clause-vars&keys)
+                                      clause-vars-ixes (map var->ix clause-vars)
+                                      clause-keys (map second clause-vars&keys)
+                                      index (.get-or-create-index kn "know" name (into-array clause-keys))]
+                                  (swap! kind->name->rules update-in ["know" name] #(conj (or % #{}) rule-id))
+                                  (btree/contains (btree/iterator index) (into-array clause-vars-ixes))))))

               ;; make solver
               solver (btree/solver num-vars (into-array constraints))
@@ -437,6 +440,7 @@
     (Flows. (clj->js (map first @rule->flow)) (clj->js @rule->flow) #js {} (clj->js @kind->name->rules) (clj->js @name->transient?))))

 ;; TESTS
+
 (comment
 (enable-console-print!)

@@ -551,6 +555,22 @@

 (.add-facts kn "know" "agg-over" #js ["rule-id" "in-var" "agg-fun" "out-var"] #js [#js ["concat-overlap" "zz" "str" "ww"]])

+(.add-facts kn "know" "clauses" #js ["rule-id" "when|know|remember|forget" "clause-id" "name"] #js [#js ["limit-overlap" "when" "limit-get-foos" "foo"]
+                                                                                #js ["limit-overlap" "when" "limit-some-interval" "interval"]
+                                                                                #js ["limit-overlap" "remember" "limit-rem-frep" "frep"]])
+
+(.add-facts kn "know" "clause-fields" #js ["clause-id" "constant|variable" "key" "val"] #js [#js ["limit-get-foos" "variable" "x" "xx"]
+                                                                                #js ["limit-get-foos" "variable" "y" "yy"]
+                                                                                #js ["limit-some-interval" "variable" "lo" "xx"]
+                                                                                #js ["limit-some-interval" "variable" "hi" "yy"]
+                                                                                #js ["limit-some-interval" "variable" "in" "zz"]
+                                                                                #js ["limit-rem-frep" "variable" "x" "xx"]
+                                                                                #js ["limit-rem-frep" "variable" "o" "ord"]
+                                                                                #js ["limit-rem-frep" "variable" "z" "zz"]])
+
+
+(.add-facts kn "know" "has-agg" #js ["rule-id" "limit-variable|constant" "limit" "ordinal" "ascending|descending"] #js [#js ["limit-overlap" "constant" 3 "ord" "descending"]])
+

 (def flows (compile kn))

@@ -571,4 +591,6 @@
 (.get-or-create-index kn "know" "frip" #js ["x" "w"])

 (.get-or-create-index kn "know" "frop" #js ["x" "o" "z" "w"])
+
+(.get-or-create-index kn "know" "frep" #js ["x" "o" "z"])
 )


simplify and document

simplify and document

--- src/babel/parse.cljc
+++ src/babel/parse.cljc
@@ -17,33 +17,38 @@
   (log/trace (str "parse/over: grammar size: " (count grammar)))
   (over/over grammar left right))

-(defn cross-product [x y]
+(defn square-cross-product [x]
   (mapcat (fn [each-x]
             (filter #(not (nil? %))
                     (pmap (fn [each-y]
                             (if (= (second each-x) (first each-y))
                               [each-x each-y]))
-                          y)))
+                          x)))
           x))

-;; TODO: make a static lookup table, at least for n < (e.g.) 5.
-(defn spanpairs [n]
-  (mapcat (fn [x]
-            (pmap (fn [y]
-                    [x y])
-                  (range (+ x 1) (+ n 1))))
-          (range 0 n)))
-
-(defn square [x]
-  (let [pairs (spanpairs x)]
-    (cross-product pairs pairs)))
-
 (defn span-map [n]
-  "take a 'square span array' and reorganizes it into a map of size -> _spans_,
+  "take a 'square span array' and return a map of size -> _spans_,
    where _size_ is an integer, and _spans_ are all the [left,right] pairs whose combined
    size is equal to _size_."
-  (let [spans
-        (square n)]
+  ;; for example:
+  ;; (span-map 5) =>
+  ;; {1 ([0 1]         [1 2] ...) ;; all of these are of size 1
+  ;;  2 ([[0 1] [1 2]] [[1 2] [2 3]] ... ) ;; each pair has a combined size of 2
+  ;;  3 ([[0 2] [2 3]] [[1 2] [2 3]] ... ) ;; each pair has a combined size of 3
+  ;;  4 ([[0 3] [3 4]] [[1 2] [2 4]] ..
+  ;;  5 ([[0 4] [4 5]] [[1 3] [3 5]] ... ) } ;; each pair has a combined size of 5.
+  (let [
+        ;; TODO: rather than this function, make a static lookup table, at least for n < (e.g.) 5.
+        ;; e.g. (spanpairs 5) =>
+        ;; ([0 1] [0 2].. [0 5] [1 2] ..[1 4] [1 5] .... [4 5])
+        spanpairs (fn [n]
+                    (mapcat (fn [x]
+                              (pmap (fn [y]
+                                      [x y])
+                                    (range (+ x 1) (+ n 1))))
+                            (range 0 n)))
+
+        spans (square-cross-product (spanpairs n))]
     (merge
      {1 (pmap
          (fn [i]
@@ -75,12 +80,12 @@
                              ;; where each parse in parses matches the tokens from [i,j] in the input.
                              {

-                              ;; <key>
+                              ;; <key: [i,j]>
                               [(first (first span-pair))
                                (second (second span-pair))]
                               ;; </key>

-                              ;; <value>
+                              ;; <value: parses for strings indexed at [i,j]>
                               (let [left (get minus-1 (first span-pair))
                                     right (get minus-1 (second span-pair))
                                     left-strings (filter string? left)
@@ -104,9 +109,10 @@

                            (get span-map n)))))))

-(defn parse [input model]
+(defn parse
   "return a list of all possible parse trees for a string or a list of lists of maps
    (a result of looking up in a dictionary a list of tokens from the input string)"
+  [input model]
   (log/info (str "parsing input: '" input "'"))
   (let [tokens (string/split input tokenizer)
         token-count (count tokens)


improve comments

improve comments

--- src/babel/writer.clj
+++ src/babel/writer.clj
@@ -196,9 +196,14 @@
         debug (log/debug (str "populate-with-language: spec: " spec "; language: " language))]
     (dotimes [n num]
       (let [sentence (engine/expression model spec :truncate-children false)
-            ;; we don't want to truncate because we want to store the entire tree in the _structure_ and _serialized_ columns of the database,
-            ;; so that we can search for them with specifications that might include :comp and :head search keys.
-            ;; for example, (defn fill-language-by-spec) is passed a _spec_ param which, depending on the language's
+            ;; In the (engine/expression) call above, we don't want to
+            ;; truncate because we want to store the entire tree in
+            ;; the _structure_ and _serialized_ columns of the
+            ;; database, so that we can search for them with
+            ;; specifications that
+            ;; might include :comp and :head search keys.
+            ;; for example, (defn fill-language-by-spec) is passed a
+            ;; _spec_ param which, depending on the language's
             ;; writer implementation (e.g. babel.italiano/writer searches based on :comp and :head).
             fo (:morph model)


Many improvements and new operators.

Many improvements and new operators.

--- src/beicon/core.cljs
+++ src/beicon/core.cljs
@@ -136,19 +136,25 @@
   (-on-error [_ error] "Subscription error notification hook.")
   (-on-end [_] "Subscription termination notification hook."))

-(defprotocol ICancellable
-  (-cancel [_] "dispose resources."))
-
-(defn cancel!
+(defprotocol IDisposable
+  (-dispose [_] "dispose resources."))
+
+(defn dispose!
   "Dispose resources acquired by the subscription."
   [v]
-  (-cancel v))
+  (-dispose v))
+
+;; Alias
+(def unsub! dispose!)
+(def cancel! dispose!)

 (defn- wrap-disposable
   [disposable]
   (specify! disposable
-    ICancellable
-    (-cancel [this]
+    IFn
+    (-invoke ([this] (-dispose this)))
+    IDisposable
+    (-dispose [this]
       (.unsubscribe this))))

 (defn subscribe-with
@@ -280,21 +286,20 @@
   [e]
    (.throwError rx e))

+;; Alias
+(def error throw)
+
 (defn timer
   "Returns an observable sequence that produces a value after
   `ms` has elapsed and then after each period."
-  ([delay]
-   (.timer rx delay))
-  ([delay period]
-   (.timer rx delay period)))
+  ([delay] (.timer rx delay))
+  ([delay period] (.timer rx delay period)))

 (defn timeout
   "Returns the source observable sequence or the other
   observable sequence if dueTime elapses."
-  ([ms ob]
-   (pipe ob (.timeout rxop ms)))
-  ([ms other ob]
-   (pipe ob (.timeoutWith rxop ms other))))
+  ([ms ob] (pipe ob (.timeout rxop ms)))
+  ([ms other ob] (pipe ob (.timeoutWith rxop ms other))))

 (defn delay
   "Time shifts the observable sequence by dueTime. The relative
@@ -305,10 +310,8 @@
 (defn delay-when
   "Time shifts the observable sequence based on a subscription
   delay and a delay selector function for each element."
-  ([sf ob]
-   (pipe ob (.delayWhen rxop sf)))
-  ([sd sf ob]
-   (pipe ob (.delayWhen rxop sf sd))))
+  ([sf ob] (pipe ob (.delayWhen rxop sf)))
+  ([sd sf ob] (pipe ob (.delayWhen rxop sf sd))))

 (defn interval
   "Returns an observable sequence that produces a
@@ -342,6 +345,9 @@
 (defn- disposable-atom
   [ref disposable]
   (specify! ref
+    IFn
+    (-invoke [this] (-dispose this))
+
     ICancellable
     (-cancel [_]
       (.unsubscribe disposable))))
@@ -419,8 +425,8 @@
   or array/iterable into one observable sequence.

   In other languages is called: flatMap or mergeMap."
-  ([ob] (merge-map identity ob))
-  ([f ob] (pipe ob (.flatMap rxop #(f %)))))
+  [f ob]
+  (pipe ob (.flatMap rxop #(f %))))

 ;; Aliases
 (def fmap merge-map)
@@ -430,12 +436,21 @@
   "Projects each element of an observable sequence to an observable
   sequence and concatenates the resulting observable sequences or
   Promises or array/iterable into one observable sequence."
-  ([ob] (mapcat identity ob))
-  ([f ob] (pipe ob (.concatMap rxop #(f %)))))
+  [f ob]
+  (pipe ob (.concatMap rxop #(f %))))

 (defn mapcat-indexed
   [f ob]
   (pipe ob (.concatMap rxop #(f %2 %1))))
+
+(defn merge-all
+  ([ob] (pipe ob (.mergeAll rxop)))
+  ([^number concurrency ob]
+   (pipe ob (.mergeAll rxop concurrency))))
+
+(defn concat-all
+  [ob]
+  (pipe ob (.concatAll rxop)))

 (defn skip
   "Bypasses a specified number of elements in an
@@ -452,62 +467,69 @@
   (pipe ob (.skipWhile rxop #(boolean (f %)))))

 (defn skip-until
-  "Returns the values from the source observable sequence
-  only after the other observable sequence produces a value."
+  "Returns the values from the source observable sequence only after the
+  other observable sequence produces a value."
   [pob ob]
   (pipe ob (.skipUntil rxop pob)))

 (defn take
-  "Bypasses a specified number of elements in an
-  observable sequence and then returns the remaining
-  elements."
+  "Bypasses a specified number of elements in an observable sequence and
+  then returns the remaining elements."
   [n ob]
   (pipe ob (.take rxop n)))

 (defn first
-  "Return an observable that only has the first value
-  of the provided observable."
-  [ob]
-  (take 1 ob))
+  "Return an observable that only has the first value of the provided
+  observable. You can optionally pass a predicate and default value."
+  ([ob] (pipe ob (.first rxop)))
+  ([f ob] (pipe ob (.first rxop #(boolean (f %)))))
+  ([f default ob] (pipe ob (.first rxop #(boolean (f %)) default))))
+
+(defn last
+  "Return an observable that only has the last value of the provided
+  observable. You can optionally pass a predicate and default value."
+  [ob]
+  ([ob] (pipe ob (.last rxop)))
+  ([f ob] (pipe ob (.last rxop #(boolean (f %)))))
+  ([f default ob] (pipe ob (.last rxop #(boolean (f %)) default))))

 (defn take-while
-  "Returns elements from an observable sequence as long as a
-  specified predicate returns true."
+  "Returns elements from an observable sequence as long as a specified
+  predicate returns true."
   [f ob]
   (pipe ob (.takeWhile rxop #(boolean (f %)))))

 (defn take-until
-  "Returns the values from the source observable sequence until
-  the other observable sequence or Promise produces a value."
+  "Returns the values from the source observable sequence until the
+  other observable sequence or Promise produces a value."
   [other ob]
   (pipe ob (.takeUntil rxop other)))

 (defn reduce
-  "Applies an accumulator function over an observable
-  sequence, returning the result of the aggregation as a
-  single element in the result sequence."
+  "Applies an accumulator function over an observable sequence,
+  returning the result of the aggregation as a single element in the
+  result sequence."
   ([f ob] (pipe ob (.reduce rxop #(f %1 %2))))
   ([f seed ob] (pipe ob (.reduce rxop #(f %1 %2) seed))))

 (defn scan
-  "Applies an accumulator function over an observable
-  sequence and returns each intermediate result.
-  Same as reduce but with intermediate results"
+  "Applies an accumulator function over an observable sequence and
+  returns each intermediate result.  Same as reduce but with
+  intermediate results"
   ([f ob] (pipe ob (.scan rxop #(f %1 %2))))
   ([f seed ob] (pipe ob (.scan rxop #(f %1 %2) seed))))

 (defn with-latest
-  "Merges the specified observable sequences into
-  one observable sequence by using the selector
-  function only when the source observable sequence
-  (the instance) produces an element."
+  "Merges the specified observable sequences into one observable
+  sequence by using the selector function only when the source
+  observable sequence (the instance) produces an element."
   [f other source]
   (pipe source (.withLatestFrom rxop other f)))

 (defn combine-latest
-  "Combines multiple Observables to create an Observable
-  whose values are calculated from the latest values of
-  each of its input Observables."
+  "Combines multiple Observables to create an Observable whose values
+  are calculated from the latest values of each of its input
+  Observables."
   ([other ob]
    (combine-latest vector other ob))
   ([f other ob]
@@ -584,10 +606,17 @@
   (pipe ob (.sample rxop other)))

 (defn ignore
-  "Ignores all elements in an observable sequence leaving
-  only the termination messages."
+  "Ignores all elements in an observable sequence leaving only the
+  termination messages."
   [ob]
   (pipe ob (.ignoreElements rxop)))
+
+(defn finalize
+  "Returns an Observable that mirrors the source Observable, but will
+  call a specified function when the source terminates on complete or
+  error."
+  [f ob]
+  (pipe ob (.finalize rxop #(f))))

 (defn dedupe
   "Returns an observable sequence that contains only


Helper func test-basic.

Helper func test-basic.

--- src/cbfg/store-test.cljs
+++ src/cbfg/store-test.cljs
@@ -15,6 +15,9 @@
     (and pass (nil? result-nil))))

 (defn test [actx opaque-id]
+  (test-basic actx))
+
+(defn test-basic [actx opaque-id]
   (ago test actx
        (let [n (atom 0)
              s (store/make-store test)]


Acceleration when ball hits paddle.

Acceleration when ball hits paddle.

--- src/canvas/main.cljs
+++ src/canvas/main.cljs
@@ -281,9 +281,8 @@
         x2 (+ x1 (:width paddle))
         y2 (+ y1 (:height paddle))
         {x :x y :y radius :radius} ball]
-    ;; janky when the ball hits a corner, I think.
+    ;; janky depending on direction of ball
     (or (and (<= y1 y y2) (<= x1 x x2))
-        ;; Need to indicate if x or y direction is reversed
         (and (<= y1 y y2) (or (>= radius (dist x2 y x y))
                               (>= radius (dist x1 y x y))))
         (and (<= x1 x x2) (or (>= radius (dist x y2 x y))
@@ -293,7 +292,10 @@
   [{:keys [ball paddle-1 paddle-2 mode] :as state}]
   (if (or (hit? ball paddle-1)
           (hit? ball paddle-2))
-    (assoc state :ball (assoc ball :vx (* -1 (:vx ball))))
+    (let [{:keys [vx vy]} ball
+          vxf (if (< vx 0) dec inc)
+          vyf (if (< vy 0) dec inc)]
+      (assoc state :ball (assoc ball :vx (* -1 (vxf vx)) :vy (vyf vy))))
     state))

 (defn score-phase!
@@ -313,10 +315,9 @@
                        (>= score2 WIN_SCORE))
                  :game-over
                  (:mode state))
-          ball (cond
-                 p2? (assoc ball :x (- SCALE-W 25) :y (/ SCALE-H 2))
-                 p1? (assoc ball :x 25 :y (/ SCALE-H 2))
-                 :else ball)]
+          ball (if p2?
+                 (assoc ball :x (- SCALE-W 25) :y (/ SCALE-H 2) :vy -2 :vx -3)
+                 (assoc ball :x 25 :y (/ SCALE-H 2) :vy 2 :vx 3))]
       (assoc state :score-1 s1 :score-2 s2 :ball ball :mode mode))))

 (defn animate-loop!


finished updating casacalog queries for generating windows to walk across.

--- src/clj/forma/trends.clj
+++ src/clj/forma/trends.clj
@@ -8,7 +8,8 @@
   (:use cascalog.api
         [forma.matrix.utils :only (sparse-vector)]
         [clojure.contrib.math :only (ceil)]
-        [clojure.contrib.seq :only (positions)]))
+        [clojure.contrib.seq :only (positions)])
+  (:require [cascalog.ops :as c]))

 ;; ### Time Series Generation
 ;;
@@ -107,78 +108,63 @@

 ;; ## Walking the Matrix

-;; Great for testing what buffers will do; this returns a string
-;; representation of the input.
-
 (defbufferop tuples->string
+  {:doc "Returns a string representation of the tuples input to this
+  buffer. Useful for testing!"}
   [tuples]
   [(apply str (map str tuples))])

-;; ## Let's figure out how to get the chunks reconstituted.
-
-(def num-lines 20)
-(def num-samples 20)
-
+;; Generates combinations of `mod-h`, `mod-v`, `sample` and `line` for
+;; use in buffers.
 (def points
   (memory-source-tap
-   (for [h (range 3)
-         s (range num-samples)
-         l (range num-lines) :let [val s]]
-     [h 1 s l val])))
+   (for [mod-h  (range 3)
+         sample (range 20)
+         line   (range 20)
+         :let [val sample, mod-v 1]]
+     [mod-h mod-v sample line val])))

-;; Buffer to generate a sparse-vector from idx, val tuple pairs.
-(defbufferop [rebuild-lines [size placeholder]]
+(defbufferop [sparse-vec [length missing-val]]
+  {:doc "Receives 2-tuple pairs of the form `<idx, val>`, and inserts
+  each `val` into a sparse vector of the supplied length at the
+  corresponding `idx`. `missing-val` will be substituted for any
+  missing value."}
   [tuples]
-  [[(sparse-vector size tuples placeholder)]])
+  [[(sparse-vector length tuples missing-val)]])

-;; TODO: document the line-length, num-groups business. Right now, if
-;; I'm not mistaken, we need num-groups to divide evenly into
-;; line-length.
-;;
-;; TODO: Work out solution where group-length can unevenly divide.
+(defn vals->sparsevec
+  "Returns an aggregating predicate macro that stitches values into a
+  sparse vector with all `?val`s at `?idx`, and `empty-val` at all
+  other places. Lines are divided into `splits` based on that input
+  parameter. Currently, we require that `splits` divide evenly into
+  `final-length`."
+  [empty-val final-length splits]
+  {:pre [(zero? (mod final-length splits))]}
+  (let [split-length (ceil (/ final-length splits))]
+    (<- [?idx ?val :> ?split-idx ?split-vec]
+        (:sort ?idx)
+        ((c/juxt #'mod #'quot) ?idx split-length :> ?sub-idx ?split-idx)
+        (sparse-vec [split-length empty-val] ?sub-idx ?val :> ?split-vec))))

-(defn group-lines
-  "Function to generate an aggregating predicate macro that stitches
-  lines back together. Lines are grouped into `num-groups` total
-  blocks. Currently, we require that `num-groups` divide evenly into
-  `line-length`."
-  [line-length num-groups]
-  {:pre [(= 0 (mod line-length num-groups))]}
-  (let [group-length (ceil (/ line-length num-groups))]
-    (<- [?line ?sample ?val :> ?line-group ?full-line]
-        (:sort ?line ?sample)
-        (mod ?sample group-length :> ?subidx)
-        (quot ?sample group-length :> ?line-group)
-        (rebuild-lines [group-length 0] ?subidx ?val :> ?full-line))))
-
-(defn run-line-aggregator
+;; TODO: Docs
+(defn sample-aggregator
   "Takes a samples and line generator, and stitches lines back
   together. "
-  []
-  (let [agg-lines (group-lines 20 2)]
-    (?<- (stdout)
-         [?tile-h ?tile-v ?line ?line-group ?full-line]
-         (points ?tile-h ?tile-v ?sample ?line ?val)
-         (agg-lines ?line ?sample ?val :> ?line-group ?full-line))))
+  [point-source edge splits]
+  (let [sample-agger (vals->sparsevec 0 edge splits)]
+    (<- [?tile-h ?tile-v ?line ?line-vec-col ?line-vec]
+        (point-source ?tile-h ?tile-v ?sample ?line ?val)
+        (sample-agger ?sample ?val :> ?line-vec-col ?line-vec))))

-;; TODO: -- documentation on why we do this. Nearest neighbor analysis links.
-(defn walk-matrix
-  "Walks along the rows and columns of a matrix at the given window
-  size, returning all (window x window) snapshots."
-  [m window]
-  (mapcat (comp
-           (partial apply map vector)
-           (partial map (partial partition window 1)))
-          (partition window 1 m)))
-
-
-;; I think that I might be able to tag pixels as "edges", based on a
-;; combination of pixel value and length of groups. If I can get all
-;; of the edge pixels aggregated together... that would be a big win!
-;;
-;; Can we extend this to deal with the whole world, by calculating the
-;; global pixel sample and line? One issue would be that edges
-;; sometimes wouldn't be met be anything on the other side.
-;;
-;; ACTUALLY -- this is a problem now, and if we solve it, we solve the
-;; whole mess.
+;; Stitches lines together into a window!
+;; TODO: Docs
+(defn line-aggregator
+  "Stitches lines back together into little windows."
+  [point-source edge splits]
+  (let [line-source (sample-aggregator point-source edge splits)
+        line-agger (vals->sparsevec (-> (/ splits edge) (repeat 0) vec)
+                                    edge
+                                    splits)]
+    (<- [?tile-h ?tile-v ?window-col ?window-row ?window]
+        (line-source ?tile-h ?tile-v ?line ?window-col ?line-vec)
+        (line-agger ?line ?line-vec :> ?window-row ?window))))


Adds seek to position and repeat mode calls.

--- src/clj_spotify/core.clj
+++ src/clj_spotify/core.clj
@@ -488,21 +488,21 @@
   (api-get "me/player/devices"))

 (def get-info-about-current-users-current-playback
-  " Takes two arguments, a map with query parameters and an oauth-token t.
+  " Takes two arguments, a map m with query parameters and an oauth-token t.
   There are no compulsary keys in m, optional key is :market.
   :market is an ISO 3166-1 alpha-2 country code.
   Example: (get-info-about-current-users-current-playback {:market \"SE\"}  \"BQBw-JtC..._7GvA\")"
   (api-get "me/player"))

 (def get-users-currently-playing-track
-  " Takes two arguments, a map with query parameters and an oauth-token t.
+  " Takes two arguments, a map m with query parameters and an oauth-token t.
   There are no compulsary keys in m, optional key is :market.
   :market is an ISO 3166-1 alpha-2 country code.
   Example: (get-users-currently-playing-track {:market \"SE\"}  \"BQBw-JtC..._7GvA\")"
   (api-get "me/player/currently-playing"))

 (def transfer-current-users-playback
-  " Takes two arguments, a map with query parameters and an oauth-token t.
+  " Takes two arguments, a map m with query parameters and an oauth-token t.
   Compulsary key in m is :device_ids, optional key is :play.
   :device_ids is an array of devices IDs to where the playback should be transfered.
   Even though it is an array, only a single device_id is currently supported.
@@ -511,7 +511,7 @@
   (api-put "me/player"))

 (def start-or-resume-a-users-playback
-  " Takes two arguments, a map with query parameters and an oauth-token t.
+  " Takes two arguments, a map m with query parameters and an oauth-token t.
   There are no compulsary keys in m, optional keys are :device_id, : context_uri, :uris and :offset.
   :device_id is the device id of the device the command is targeting. If not supplied, the users current device is the target.
   :context_uri is the Spotify URI to play. Can be albums,artists or playlists.
@@ -521,21 +521,43 @@
   Example: (start-or-resume-a-users-playback {:device_id [\"74ASZWbe4lXaubB36ztrGX\"] :context_uri \"spotify:album:2cX9e3renOX5bUQEXWFrJr\"} :offset {:position 5}} \"BQBw-JtC..._7GvA\")"
   (api-put "me/player/play"))

-;;TODO Pause a users playback.
 (def pause-a-users-playback
-  " Takes two arguments, a map with query parameters and an oauth-token t.
+  " Takes two arguments, a map m with query parameters and an oauth-token t.
   There are no compulsary keys in m, optional key is :device_id.
   :device_id is the device id of the device the command is targeting. If not supplied, the users current device is the target.
   Example: (pause-a-users-playback {:device_id \"74ASZWbe4lXaubB36ztrGX\"} \"BQBw-JtC..._7GvA\")"
   (api-put "me/player/pause"))

-;;TODO Skip users playback to next track.
-
-;;TODO Skip users playback to previous track.
-
-;;TODO Seek to position in currently playing track.
+(def skip-users-playback-to-the-next-track
+  " Takes two arguments, a map m with query parameters and an oauth-token t.
+  There are no compulsary keys in m, optional key is :device_id.
+  :device_id is the device id of the device the command is targeting. If not supplied, the users current device is the target.
+  Example: (skip-users-playback-to-the-next-track {:device_id \"74ASZWbe4lXaubB36ztrGX\"} \"BQBw-JtC..._7GvA\")"
+  (api-post "me/player/next"))
+
+(def skip-users-playback-to-the-previous-track
+  " Takes two arguments, a map m with query parameters and an oauth-token t.
+  There are no compulsary keys in m, optional key is :device_id.
+  :device_id is the device id of the device the command is targeting. If not supplied, the users current device is the target.
+  Example: (skip-users-playback-to-the-previous-track {:device_id \"74ASZWbe4lXaubB36ztrGX\"} \"BQBw-JtC..._7GvA\")"
+  (api-post "me/player/previous"))
+
+(def seek-to-position-in-currently-playing-track
+  " Takes two arguments, a map m with query parameters and an oauth-token t.
+  Compulsary key in m is :position_ms, optional key is :device_id.
+  :position_ms is the position in milliseconds to seek to.
+  :device_id is the device id of the device the command is targeting. If not supplied, the users current device is the target.
+  Example: (seek-to-position-in-currently-playing-track {:device_id \"74ASZWbe4lXaubB36ztrGX\"} \"BQBw-JtC..._7GvA\")"
+  (api-put "me/player/seek"))

 ;;TODO Set repeat mode on user's playback.
+(def set-repeat-mode-on-users-playback
+  " Takes two arguments, a map m with query parameters and an oauth-token t.
+  Compulsary key in m is :state, optional key is :device_id.
+  :state one of \"track\",\"context\" or \"off\". track will repeat the current track, context will repeat the current context (album, playlist) and off will turn repeat off.
+  :device_id is the device id of the device the command is targeting. If not supplied, the users current device is the target.
+  Example: (set-repeat-mode-on-users-playback {:device_id \"74ASZWbe4lXaubB36ztrGX\"} \"BQBw-JtC..._7GvA\")"
+  (api-put "me/player/repeat"))

 ;;TODO Set volume for user's playback.


Test for functions one-word-like-this? and more-words-like-this?

--- test/clj_mrazik/irc_bot_test.clj
+++ test/clj_mrazik/irc_bot_test.clj
@@ -275,3 +275,39 @@
         (with-redefs [dictionary/find-words-like-this (fn [input] ["one" "two"])]
             (is (= (return-more-words-like-this "test") ["one" "two"])))))

+(deftest test-one-word-like-this?
+    "Check the behaviour of function clj-dopey.irc-bot/one-word-like-this?"
+    (testing "the function one-word-like-this?"
+        (with-redefs [dictionary/words-like-this (fn [input] 1)]
+            (is (one-word-like-this? "test*"))
+            (is (one-word-like-this? "*test"))
+            (is (one-word-like-this? "*test*"))
+            (is (one-word-like-this? "*")))
+        (with-redefs [dictionary/words-like-this (fn [input] 42)]
+            (is (not (one-word-like-this? "test*")))
+            (is (not (one-word-like-this? "*test")))
+            (is (not (one-word-like-this? "*test*")))
+            (is (not (one-word-like-this? "*"))))
+        (with-redefs [dictionary/words-like-this (fn [input] nil)]
+            (is (not (one-word-like-this? "test"))) ; no wildchars
+            (is (not (one-word-like-this? ""))) ; no wildchars
+)))
+
+(deftest test-more-words-like-this?
+    "Check the behaviour of function clj-dopey.irc-bot/more-words-like-this?"
+    (testing "the function more-words-like-this?"
+        (with-redefs [dictionary/words-like-this (fn [input] 42)]
+            (is (more-words-like-this? "test*"))
+            (is (more-words-like-this? "*test"))
+            (is (more-words-like-this? "*test*"))
+            (is (more-words-like-this? "*")))
+        (with-redefs [dictionary/words-like-this (fn [input] 1)]
+            (is (not (more-words-like-this? "test*")))
+            (is (not (more-words-like-this? "*test")))
+            (is (not (more-words-like-this? "*test*")))
+            (is (not (more-words-like-this? "*"))))
+        (with-redefs [dictionary/words-like-this (fn [input] nil)]
+            (is (not (more-words-like-this? "test"))) ; no wildchars
+            (is (not (more-words-like-this? ""))) ; no wildchars
+)))
+


Add client side connection to datomic REST

--- src/cljs/gtfve/data.cljs
+++ src/cljs/gtfve/data.cljs
@@ -65,3 +65,16 @@

 (defn GET-edn [url & {:as args}]
   (GET url (merge args {:response-format :edn})))
+
+(defn connect [rest-api-url storage db-name]
+  {:url rest-api-url
+   :db/alias (str storage "/" db-name)})
+
+(defn q
+  [query conn & args]
+  (let [args (into [(select-keys conn [:db/alias])] args)]
+    (GET-edn (str (:url conn) "/api/query")
+             :params {:q (pr-str query)
+                      :args (pr-str args)})))
+
+(def conn (connect "http://localhost:8001" "dev" "sakay"))


Storing location select options to save to the backend

--- src/cljs/ohds/pages.cljs
+++ src/cljs/ohds/pages.cljs
@@ -38,19 +38,29 @@
 (defn location-page [app-state]
   (let [location-id (atom "External ID")
         name (atom "Name")
-        parents (atom nil)]
+        parents (atom nil)
+        loctype (atom "URB")
+        parent (atom nil)]
     (go (let [result (<! (http/get
                           "/api/v1/locationHierarchy"
                           {:as :clojure}))
-              body (t/read json-reader (:body result))]
-          (reset! parents (map c/location-hierarchy-option body))))
+              body (t/read json-reader (:body result))
+              parents' (map c/location-hierarchy-option body)]
+          (reset! parents parents')
+          (reset! parent (first parents'))))
     (fn []
       [:div [:h2 "Location Page"]
        [:div
-        [:label "Parent Location"] [:select "Location Hierarchy" @parents]]
+        [:label "Parent Location"]
+        [:select  @parents]]
        [:div [:label "Name"] [c/atom-input name]]
        [:div [:label "External ID"] [c/atom-input location-id]]
-       [:div [:label "Type"] [:select
+       [:div [:label "Type"] [:select {:on-change #(reset! loctype (-> % .-target .-value))}
                               [:option {:value "RUR"} "Rural"]
                               [:option {:value "URB"} "Urban"]]]
-       [:div [:a {:href "/individual"} "go to individual page"]]])))
+       [:div @loctype]
+       [:div @parent]
+       [:div
+        [:button {:class "btn btn-lg btn-primary btn-block" :type "submit"
+                  :on-click (fn [])}
+         "Submit"]]])))


Changed error vectors from lists to vectors for optimization of lexicase.

--- src/clojush/evaluate.clj
+++ src/clojush/evaluate.clj
@@ -48,9 +48,9 @@
   [i error-function rand-gen]
   (binding [*thread-local-random-generator* rand-gen]
     (let [p (:program i)
-          e (if (and (seq? (:errors i)) @global-reuse-errors)
-              (:errors i)
-              (error-function p))
+          e (vec (if (and (seq? (:errors i)) @global-reuse-errors)
+                   (:errors i)
+                   (error-function p)))
           te (if (and (number? (:total-error i)) @global-reuse-errors)
                (:total-error i)
                (keep-number-reasonable (compute-total-error e)))


dont show file which no comments inside

dont show file which no comments inside

--- src/codeitlater/core.clj
+++ src/codeitlater/core.clj
@@ -50,15 +50,19 @@
    (doall (for [filepath (get-all-files)
                 :when (not (.isDirectory (io/file filepath)))
                 :let [mark (get commentDict (re-find #"(?<=\w)\.\w+$" filepath))]
-                :when mark]
-            (conj (read-comments-in-file filepath mark)
+                :when mark
+                :let [comment (read-comments-in-file filepath mark)]
+                :when (->> comment empty? not)]
+            (conj comment
                   filepath))))
   ([commentDict root]
    (doall (for [filepath (get-all-files root)
                 :when (not (.isDirectory (io/file filepath)))
                 :let [mark (get commentDict (re-find #"(?<=\w)\.\w+$" filepath))]
-                :when mark]
-            (conj (read-comments-in-file filepath mark)
+                :when mark
+                :let [comment (read-comments-in-file filepath mark)]
+                :when (->> comment empty? not)]
+            (conj comment
                   filepath))))
   ([commentDict root filetypes]
    (let [typepatterns (for [filetype filetypes
@@ -70,8 +74,10 @@
                   typepattern typepatterns
                   :when (re-matches (first typepattern) filepath)
                   :let [mark (get commentDict (re-find #"(?<=\w)\.\w+$" filepath))]
-                  :when mark]
-              (conj (read-comments-in-file filepath (get commentDict (last typepattern)))
+                  :when mark
+                  :let [comment (read-comments-in-file filepath (get commentDict (last typepattern)))]
+                  :when (->> comment empty? not)]
+              (conj comment
                     filepath))))))

 ;;:= TODO: make diferent behavior of deffirent args.


fins new bug

fins new bug

--- src/codeitlater/core.clj
+++ src/codeitlater/core.clj
@@ -43,11 +43,10 @@

 (defn read-files ;;:= TODO: directory format
-  "commentMarkFunc is a curry function to give read-comments-in-file
-=> (partial read-comments-inline commentMark)"
+  "(partial read-comments-inline commentMark)"
   ([commentDict]
    (doall (for [filepath (get-all-files)]
-            (conj (read-comments-in-file
+            (conj (read-comments-in-file ;;:= Debug: if filepath is "." or other directory
                    filepath (get commentDict (re-find #"(?<=\w)\..*$" filepath)))
                   filepath))))
   ([commentDict root]


renamed if-fn

renamed if-fn

--- src/main/clojure/czlab/hoard/connect.clj
+++ src/main/clojure/czlab/hoard/connect.clj
@@ -114,9 +114,9 @@
   (composite [me] (:co me))
   (simple [me] (:si me))
   c/Finzable
-  (finz [me] (c/if-fn? [f (:finz me)] (f me)))
+  (finz [me] (c/if-fn [f (:finz me)] (f me)))
   c/Openable
-  (open [me] (c/if-fn? [f (:open me)] (f me))))
+  (open [me] (c/if-fn [f (:open me)] (f me))))

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 (defn- dbobj<>


unused imports

unused imports

--- src/clj/hface/hz.clj
+++ src/clj/hface/hz.clj
@@ -1,12 +1,10 @@
 (ns hface.hz
   (:require [wall.hack :refer [field]])
   (:import [com.hazelcast.core Hazelcast]
-           [com.hazelcast.config XmlConfigBuilder]
            [com.hazelcast.client HazelcastClient]
            [com.hazelcast.client.impl HazelcastClientProxy]
            [com.hazelcast.client.config ClientConfig]
-           [com.hazelcast.instance HazelcastInstanceProxy
-                                   HazelcastInstanceImpl]))
+           [com.hazelcast.instance HazelcastInstanceProxy]))

 (defn new-instance
   ([] (new-instance nil))


[default] more cljc modifications.

[default] more cljc modifications.

--- src/cortex/core.cljc
+++ src/cortex/core.cljc
@@ -2,7 +2,7 @@
   "Main cortex API function namespace"
   (:refer-clojure :exclude [clone])
   (:require [cortex.impl.wiring :as wiring]
-            [cortex.impl.default]
+            [cortex.impl.default- :as cortex.impl.default]
             [cortex.protocols :as cp]
             [cortex.layers :as layers]
             [cortex.util :as util :refer [error]]
@@ -87,3 +87,4 @@
   "clones a module, including all internal state structures. New module will be independent of the original."
   ([m]
     (cp/clone m)))
+


test suite

test suite

--- src/flatgui/test.clj
+++ src/flatgui/test.clj
@@ -122,12 +122,21 @@
 ;;

 (defn key-event [id key-code char-code]
-  (KeyEvent. dummy-source id 0 0 (if (= id KeyEvent/KEY_TYPED) KeyEvent/VK_UNDEFINED key-code) char-code))
+  (KeyEvent. dummy-source id 0 0 (if (= id KeyEvent/KEY_TYPED) KeyEvent/VK_UNDEFINED key-code) (char char-code)))

-(defn create-key-type-events [key-code char-code]
-  [(key-event KeyEvent/KEY_PRESSED key-code char-code)
-   (key-event KeyEvent/KEY_TYPED key-code char-code)
-   (key-event KeyEvent/KEY_RELEASED key-code char-code)])
+(defn create-key-type-events
+  ([key-code char-code]
+   [(key-event KeyEvent/KEY_PRESSED key-code char-code)
+    (key-event KeyEvent/KEY_TYPED key-code char-code)
+    (key-event KeyEvent/KEY_RELEASED key-code char-code)])
+  ([key-code char-code cnt]
+    (loop [i 0
+           e []]
+      (if (< i cnt)
+        (recur
+          (inc i)
+          (vec (concat e (create-key-type-events key-code char-code))))
+        e))))

 (defn create-string-type-events [str]
   (let [len (.length str)]
@@ -142,6 +151,10 @@
 (defn type-string
   ([container target str] (.evolve container target (create-string-type-events str)))
   ([container str] (.evolve container (create-string-type-events str))))
+
+(defn type-key
+  ([container target key-code char-code cnt] (.evolve container target (create-key-type-events key-code char-code cnt)))
+  ([container key-code char-code cnt] (.evolve container (create-key-type-events key-code char-code cnt))))

 ;;;


Fix  a typehint

Fix  a typehint

--- src/useful/utils.clj
+++ src/useful/utils.clj
@@ -12,7 +12,7 @@
   "Raise exception unless test returns true."
   [test exception]
   `(when-not ~test
-     (throw (fix ~exception string? #(Exception. %)))))
+     (throw (fix ~exception string? #(Exception. ^String %)))))

 (def ^{:doc "The minimium value of vals, ignoring nils."
        :arglists '([& args])}


Fixed that

Fixed that

--- src/grimoire/api.clj
+++ src/grimoire/api.clj
@@ -15,7 +15,6 @@
             [detritus.variants :as v]
             [version-clj.core :as semver]))

-;; FIXME: a config TaggedValue would be nice.
 (defn dispatch [config & more]
   (v/tag config))


Get rid of not actual todo

Get rid of not actual todo

--- src/helda/schema.clj
+++ src/helda/schema.clj
@@ -8,7 +8,6 @@
   :action s/Str
   :source-entity-id s/Str
   :target-entity-id s/Str
-  ;todo id or whole instance?
   (s/optional-key :action-ctx) {s/Keyword s/Str} ;entity-id per key
   (s/optional-key :params-ctx) {s/Keyword s/Any}
   })


subst rewritten

subst rewritten

--- src/latte/syntax.clj
+++ src/latte/syntax.clj
@@ -1,10 +1,6 @@

-(ns typetheory.syntax
+(ns latte.syntax
   (:require [clj-by.example :refer [example do-for-example]])
-  (:require [clojure.spec :as s])
-  (:require [clojure.test.check :as tc])
-  (:require [clojure.test.check.generators :as gen])
-  (:require [clojure.test.check.properties :as prop])
   )

 ;;{
@@ -17,193 +13,100 @@
 ;; ## Lambda terms
 ;;}

-(s/def ::kind #{:kind})
-
-(example
- (s/valid? ::kind :kind) => true)
-
-(s/def ::type #{:type})
-
-(example
- (s/valid? ::type :type) => true)
-
-(s/def ::sort (s/or :kind ::kind
-                    :type ::type))
-
-(example
- (s/valid? ::sort :kind) => true)
-
-(example
- (s/valid? ::sort :type) => true)
-
-(s/def ::var symbol?)
-
-(example
- (s/valid? ::var 'x) => true)
-
-(s/def ::binder #{'lambda 'prod})
-
-(s/def ::binding (s/tuple ::var ::term))
-
-(s/def ::bind (s/cat :binder ::binder :binding ::binding :body ::term))
-
-(s/def ::product (s/cat :prod #{'prod} :binding ::binding :body ::term))
-
-(s/def ::app (s/cat :rator ::term :rand ::term))
-
-(s/def ::ref #{:ref})
-
-(s/def ::refered (s/cat :name symbol? :args (s/* ::term)))
-
-(s/def ::refer (s/tuple ::ref ::refered))
-
-(s/def ::term
-  (s/or :kind ::kind
-        :type ::type
-        :var ::var
-        :bind ::bind
-        :app ::app
-        :refer ::refer))
-
-(example
- (s/conform ::term :kind) => [:kind :kind])
-
-(example
- (s/conform ::term :type) => [:type :type])
-
-(example
- (s/conform ::term 'x) => [:var 'x])
-
-(example
- (s/conform ::term '(x y))
- => '[:app {:rator [:var x], :rand [:var y]}])
-
-(example
- (s/conform ::term '(lambda [x :kind] (x y)))
- => '[:bind {:binder lambda,
-             :binding [x [:kind :kind]],
-             :body [:app {:rator [:var x],
-                          :rand [:var y]}]}])
-
-(example
- (s/conform ::term '(prod [x :kind] (x y)))
- => '[:bind {:binder prod,
-             :binding [x [:kind :kind]],
-             :body [:app {:rator [:var x],
-                          :rand [:var y]}]}])
-
-(example
- (s/valid? ::product '(prod [x :kind] (x y))) => true)
-
-(example
- (s/conform ::term '[:ref (test x [:ref (test2 y z)] t)])
- => '[:refer [:ref {:name test,
-                    :args [[:var x] [:refer [:ref {:name test2,
-                                                   :args [[:var y] [:var z]]}]] [:var t]]}]])
-
-(defmacro conform [s v]
-  `(let [v# (s/conform ~s ~v)]
-     (if (= v# :clojure.spec/invalid)
-       nil
-       v#)))
-
-(example
- (conform ::term '(x y)) => (s/conform ::term '(x y)))
-
-(example
- (conform ::term :toto) => nil)
-
-(defmacro validate [s v]
-  `(if-let [res# (conform ~s ~v)]
-     res#
-     (throw (ex-info (str "Invalid " (quote ~s)) {:value (quote ~v) :explain (s/explain-data ~s ~v)}))))
+(defn kind? [t]
+  (= t :kind))
+
+(defn type? [t]
+  (= t :type))
+
+(defn sort? [t]
+  (or (kind? t)
+      (type? t)))
+
+(defn var? [t]
+  (symbol? t))
+
+(defn binder? [t]
+  (and (list? t)
+       (contains? '#{lambda prod} (first t))))
+
+(defn app? [t]
+  (and (vector? t)
+       (= (count t) 2)))
+
+(defn ref? [t]
+  (and (list? t)
+       (not (contains? '#{lambda prod} (first t)))))

 ;;{
 ;; ## Free and bound variables
 ;;}

-(defn free-vars- [[tag t]]
-  (case tag
-    :var #{t}
-    :bind (clojure.set/difference (free-vars- (:body t))
-                                  #{(first (:binding t))})
-    :app (clojure.set/union (free-vars- (:rator t))
-                            (free-vars- (:rand t)))
-    :refer (apply clojure.set/union (map free-vars- (:args (second t))))
-    #{}))
-
 (defn free-vars [t]
-  (free-vars- (validate ::term t)))
-
-(example
- (free-vars 'x) => #{'x})
-
-(example
- (free-vars '(x y)) => #{'x 'y})
-
-(example
- (free-vars '(lambda [x t] (x (y z)))) => #{'y 'z})
-
-(example
- (free-vars '(prod [x t] (x (y z)))) => #{'y 'z})
-
-(example
- (free-vars '(lambda [x t] [:ref (test x y z)])) => '#{y z})
-
-(defn vars- [[tag t]]
-  (case tag
-    :var #{t}
-    :bind (recur (:body t))
-    :app (clojure.set/union (vars- (:rator t))
-                            (vars- (:rand t)))
-    :refer (apply clojure.set/union (map vars- (:args (second t))))
-    #{}))
+  (cond
+    (var? t) #{t}
+    (binder? t) (let [[_ [x ty] body] t]
+                  (clojure.set/union (free-vars ty)
+                                     (disj (free-vars body) x)))
+    (app? t) (clojure.set/union (free-vars (first t))
+                                (free-vars (second t)))
+    (ref? t) (apply clojure.set/union (map free-vars (rest t)))
+    :else #{}))
+
+(example
+ (free-vars 'x) => #{'x})
+
+(example
+ (free-vars '[x y]) => #{'x 'y})
+
+(example
+ (free-vars '(lambda [x t] [x [y z]])) => #{'t 'y 'z})
+
+(example
+ (free-vars '(prod [x t] [x [y z]])) => #{'t 'y 'z})
+
+(example
+ (free-vars '(lambda [x t] (test x y z))) => '#{t y z})

 (defn vars [t]
-  (vars- (validate ::term t)))
-
-(example
- (vars 'x) => #{'x})
-
-(example
- (vars '(x y)) => #{'x 'y})
-
-(example
- (vars '(lambda [x t] (x (y z)))) => #{'x 'y 'z})
-
-(example
- (vars '(prod [x t] (x (y z)))) => #{'x 'y 'z})
-
-(example
- (vars '(lambda [x t] [:ref (test x y z)])) => '#{x y z})
+  (cond
+    (var? t) #{t}
+    (binder? t) (let [[_ [x ty] body] t]
+                  (clojure.set/union (vars ty) (vars body)))
+    (app? t) (clojure.set/union (vars (first t))
+                                (vars (second t)))
+    (ref? t) (apply clojure.set/union (map vars (rest t)))
+    :else #{}))
+
+(example
+ (vars 'x) => #{'x})
+
+(example
+ (vars '[x y]) => #{'x 'y})
+
+(example
+ (vars '(lambda [x t] (test x [y z]))) => #{'t 'x 'y 'z})
+
+(example
+ (vars '(prod [x t] (test x [y z]))) => #{'t 'x 'y 'z})

 (defn bound-vars [t]
-  (let [t (validate ::term t)]
-    (clojure.set/difference (vars- t) (free-vars- t))))
-
-(example
- (bound-vars 'x) => #{})
-
-(example
- (bound-vars '(x y)) => #{})
-
-(example
- (bound-vars '(lambda [x t] (x (y z)))) => #{'x})
-
-(example
- (bound-vars '(prod [x t] (x (y z)))) => #{'x})
-
-(example
- (bound-vars '(lambda [x t] [:ref (test x y z)])) => '#{x})
-
-(def vars-free-union-bound
-  (prop/for-all
-   [t (s/gen ::term)]
-   (= (clojure.set/union (free-vars t) (bound-vars t))
-      (vars t))))
-
-(example
- (:result (tc/quick-check 20 vars-free-union-bound)) => true)
+  (clojure.set/difference (vars t) (free-vars t)))
+
+(example
+ (bound-vars 'x) => #{})
+
+(example
+ (bound-vars '[x y]) => #{})
+
+(example
+ (bound-vars '(lambda [x t] (test x [y z]))) => #{'x})
+
+(example
+ (bound-vars '(lambda [x t] (test t [y z]))) => #{})
+
+(example
+ (bound-vars '(prod [x t] (test x [y z]))) => #{'x})

 ;;{
 ;; ## Substitution
@@ -217,30 +120,34 @@
 (example
  (mk-fresh 'x '#{x x' x''}) => 'x''')

-(s/def ::subst (s/map-of ::var ::term))
-
-(defn subst- [[tag t] sub forbid]
-  (case tag
-    :var [(get sub t t) forbid]
-    :bind (let [{binder :binder [x ty] :binding body :body} t
-                [x' sub' forbid']
-                (if (contains? forbid x)
-                  (let [x' (mk-fresh x forbid)]
-                    [x' (assoc sub x x') (conj forbid x')])
-                  [x sub forbid])
-                [ty' forbid''] (subst- ty sub forbid')
-                [body' forbid'''] (subst- body sub' forbid'')]
-            [(list binder [x' ty'] body')
-             forbid'''])
-    :app (let [[rator forbid'] (subst- (:rator t) sub forbid)
-               [rand forbid''] (subst- (:rand t) sub forbid')]
-           [(list rator rand) forbid''])
-    [t forbid]))
-
-(defn subst
-  ([t sub] (let [t (validate ::term t)]
-             (first (subst- t sub (free-vars- t)))))
-  ([t k v & kvs] (subst t (apply hash-map (cons k (cons v kvs))))))
+(defn subst-
+  ([t sub] (subst- t sub #{}))
+  ([t sub forbid]
+   (cond
+     (var? t) [(get sub t t) (conj forbid t)]
+     (binder? t) (let [[binder [x ty] body] t
+                       [x' sub' forbid']
+                       (if (contains? forbid x)
+                         (let [x' (mk-fresh x forbid)]
+                           [x' (assoc sub x x') (conj forbid x')])
+                         [x (dissoc sub x) forbid])
+                       [ty' forbid''] (subst- ty sub forbid')
+                       [body' forbid'''] (subst- body sub' forbid'')]
+                   ;; (println "term=" (list binder [x' ty'] body') "sub=" sub')
+                   [(list binder [x' ty'] body')
+                    forbid'''])
+     (app? t) (let [[rator forbid'] (subst- (first t) sub forbid)
+                    [rand forbid''] (subst- (second t) sub forbid')]
+                [[rator rand] forbid''])
+     (ref? t) (let [[args forbid'] (reduce (fn [[ts forbid] t]
+                                             (let [[t' forbid'] (subst- t sub forbid)]
+                                               [(conj ts t') forbid'])) ['() forbid] (rest t))]
+                [(conj (into '() args) (first t)) forbid'])
+     :else [t forbid])))
+
+(defn subst [t sub]
+  (let [[t' _] (subst- t sub #{})]
+    t'))

 (example
  (subst 'x {'x :type}) => :type)
@@ -249,15 +156,15 @@
  (subst 'y {'x :type}) => 'y)

 (example
- (subst '(y x) {'x :type}) => '(y :type))
-
-(example
- (subst '(x (lambda [x :type] (y x))) {'x :type})
- => '(:type (lambda [x' :type] (y x'))))
-
-(example
- (subst '(x (prod [x :type] (y x))) {'x :type, 'y 'x})
- => '(:type (prod [x' :type] (x x'))))
+ (subst '[y x] {'x :type}) => '[y :type])
+
+(example
+ (subst '[x (lambda [x :type] (test x y z))] {'x :type, 'y :kind})
+ => '[:type (lambda [x' :type] (test x' :kind z))])
+q
+(example
+ (subst '[x (prod [x :type] [y x])] {'x :type, 'y 'x})
+ => '[:type (prod [x' :type] [x x'])])
 ;; and not: '(:type (prod [x :type] (x x)))


Add behaviors for app pre/post-init

Add behaviors for app pre/post-init

--- src/lt/objs/app.cljs
+++ src/lt/objs/app.cljs
@@ -164,22 +164,42 @@
                               (.focus win)
                               ))

+(defn run-commands [this & commands]
+  (when (seq commands)
+    (let [commands (if (-> commands first vector?)
+                     (first commands)
+                     commands)]
+      (doseq [c commands]
+        (if (coll? c)
+          (apply cmd/exec! c)
+          (cmd/exec! c))))))
+
+(behavior ::run-pre-init
+          :triggers #{:pre-init}
+          :desc "App: Run commands before init"
+          :params [{:label "commands"
+                    :type :list
+                    :items cmd/completions}]
+          :type :user
+          :reaction run-commands)
+
 (behavior ::run-on-init
                   :triggers #{:init}
-                  :desc "App: Run commands on start"
+                  :desc "App: Run commands on init"
                   :params [{:label "commands"
                             :type :list
                             :items cmd/completions}]
                   :type :user
-                  :reaction (fn [this & commands]
-                              (when (seq commands)
-                                (let [commands (if (-> commands first vector?)
-                                                 (first commands)
-                                                 commands)]
-                                  (doseq [c commands]
-                                    (if (coll? c)
-                                      (apply cmd/exec! c)
-                                      (cmd/exec! c)))))))
+                  :reaction run-commands)
+
+(behavior ::run-post-init
+                  :triggers #{:post-init}
+                  :desc "App: Run commands after init"
+                  :params [{:label "commands"
+                            :type :list
+                            :items cmd/completions}]
+                  :type :user
+                  :reaction run-commands)

 (behavior ::set-default-zoom-level
           :triggers #{:init}


make test.theory-collections work

make test.theory-collections work

--- test/clojure/test/theory_collections.clj
+++ test/clojure/test/theory_collections.clj
@@ -1,5 +1,5 @@
-(ns test.axioms-coll
-  "entity-map collection axioms"
+(ns test.theory-collections
+  "theory of entity-map collections"
   (:refer-clojure :exclude [name hash])
   (:import [com.google.appengine.api.datastore
             Email
@@ -55,24 +55,6 @@
 ;(use-fixtures :once (fn [test-fn] (ds/get-datastore-service) (test-fn)))
 (use-fixtures :each ds-fixture)

-(deftest ^:coll emap-axiom1
-  (testing "emap axiom 1: an entity-map is a map"
-    (let [e1 (ds/entity-map [:A/B] {:a 1 :b 2})]
-      ;; (log/trace "e1 " (ds/print e1))
-      (is (coll? e1))
-      (is (map? e1))
-      (is (ds/emap? e1))
-      (is (= (keys e1) '(:a :b)))
-      (is (= (vals e1) '(1 2)))
-      )))
-
-(deftest ^:coll emap-axiom2
-  (testing "emap axiom 2: an entity-map is seqable"
-    (let [e1 (ds/entity-map [:A/B] {:a 1 :b 2})]
-      (is (not (seq? e1)))
-      (is (seq? (seq e1)))
-      )))
-
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;   collections api axioms

@@ -111,46 +93,89 @@
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;;   merge theorems
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-(deftest ^:merge emap-seq-merge
-  (testing "clojure map api: merge map with an emap-seq"
-    (do ;; construct elements of kind :A
-      (ds/entity-map! [:A] {:a 1})
-      (ds/entity-map! [:A] {:b 2})
-      (ds/entity-map! [:A] {:c 3})
-      (ds/entity-map! [:A] {:d 4})
-      (ds/entity-map! [:A] {:d 4})           ; a dup
-      ;; now do a Kind query, yielding an emap-seq
-      (let [ems (ds/emaps?? [:A])
-            foo (do (log/trace "ems" ems)
-                    (log/trace "(type ems)" (type ems))
-                    (log/trace "(class ems)" (class ems))
-                    (is (seq? ems))
-                    (is (= (count ems) 5))
-                    )
-            ;; em (merge {} ems)]
-            em (into {} ems)]
-        (log/trace "em" em)
-        (doseq [em ems]
-          (log/trace "em" (ds/print em))))
-
-      (let [ems (ds/emaps?? [:A])
-            foo (do ;; (log/trace "ems" ems)
-                    (is (= (count ems) 5))
-                    )
-            ;;em1 {:as (merge {} ems)}
-            em2 {:bs ems}
-            em3 {:cs (merge (into #{} ems) {:x 9})}
-            ]
-        ;;(log/trace "em1" em1 (type em1))
-        (log/trace "em2" em2 (type em2))
-        (log/trace "em3" em3 (type em3))
-        (log/trace "(:cs em3)" (:cs em3) (type (:cs em3))))
-        )))
+(deftest ^:merge merge-print
+  (testing "merge print")
+  (let [em1 (ds/entity-map [:A/B] {:a 1})
+        em2 (ds/entity-map [:A/B] {:b 2})
+        em3 (ds/entity-map [:A/B] {:a 2})
+        em4 (ds/entity-map [:X/Y] {:x 9})]
+    (log/trace "em1: " (ds/print-str em1))
+    (log/trace "em2: " (ds/print-str em2))
+    (log/trace "em3: " (ds/print-str em3))
+    (log/trace "merge em1 em2: " (ds/print-str (merge em1 em2)))
+    (log/trace "merge em1 em3: " (ds/print-str (merge em1 em3)))
+    (log/trace "merge em1 em4: " (ds/print-str (merge em1 em4)))
+    (log/trace "merge em1 {:x 9}: " (ds/print-str (merge em1 {:x 9})))
+    (log/trace "merge {}  em1: " (ds/print-str (merge {} em1)))
+    ))
+
+(deftest ^:merge merge-1
+  (testing "merge 1: merge m1 m2 adds m2 content to m1 content"
+    (is (= (ds/keychain (merge (ds/entity-map [:A/B] {:a 1})
+                               (ds/entity-map [:A/B] {:b 2})))
+           [:A/B]))
+    (is (= (ds/print-str (merge (ds/entity-map [:A/B] {:a 1})
+                                (ds/entity-map [:A/B] {:b 2})))
+           (ds/print-str (ds/entity-map [:A/B] {:a 1 :b 2}))))
+    ))
+
+(deftest ^:merge merge-2
+  (testing "merge 2: from fld content overrides to fld content"
+    (is (= (ds/print-str (merge (ds/entity-map [:A/B] {:a 1})
+                                (ds/entity-map [:A/B] {:a 2})))
+           (ds/print-str (ds/entity-map [:A/B] {:a 2}))))
+    (is (= (keys (merge (ds/entity-map [:A/B] {:a 1})
+                        (ds/entity-map [:A/B] {:a 2})))
+           '(:a)))
+      ))
+
+(deftest ^:merge merge-3
+  (testing "merge 2: emaps"
+    (is (= (ds/keychain (merge (ds/entity-map [:A/B] {:a 1})
+                               (ds/entity-map [:X/Y] {:b 1})))
+           [:A/B])
+      )))
+
+;; (deftest ^:merge emap-merge-4
+;;   (testing "merge map with an emap-seq"
+;;     (do ;; construct elements of kind :A
+;;       (ds/entity-map [:A] {:a 1})
+;;       (ds/entity-map [:A] {:b 2})
+;;       (ds/entity-map [:A] {:c 3})
+;;       (ds/entity-map [:A] {:d 4})
+;;       (ds/entity-map [:A] {:d 4})           ; a dup
+;;       ;; now do a Kind query, yielding an emap-seq
+;;       (let [ems (ds/emaps?? [:A])
+;;             foo (do (log/trace "ems" ems)
+;;                     (log/trace "(type ems)" (type ems))
+;;                     (log/trace "(class ems)" (class ems))
+;;                     (is (seq? ems))
+;;                     (is (= (count ems) 5))
+;;                     )
+;;             ;; em (merge {} ems)]
+;;             em (into {} ems)]
+;;         (log/trace "em" em)
+;;         (doseq [em ems]
+;;           (log/trace "em" (ds/print em))))
+
+;;       (let [ems (ds/emaps?? [:A])
+;;             foo (do ;; (log/trace "ems" ems)
+;;                     (is (= (count ems) 5))
+;;                     )
+;;             ;;em1 {:as (merge {} ems)}
+;;             em2 {:bs ems}
+;;             em3 {:cs (merge (into #{} ems) {:x 9})}
+;;             ]
+;;         ;;(log/trace "em1" em1 (type em1))
+;;         (log/trace "em2" em2 (type em2))
+;;         (log/trace "em3" em3 (type em3))
+;;         (log/trace "(:cs em3)" (:cs em3) (type (:cs em3))))
+;;         )))

 (deftest ^:merge merge-cljmap-emap
   (testing "clojure map api: merge entity-map to clj-map"
     (log/trace "test: clojure map api: merge-cljmap-emap")
-    (let [em1 (ds/entity-map! [:A/B] {:a 1 :b 2})]
+    (let [em1 (ds/entity-map [:A/B] {:a 1 :b 2})]
       ;; (log/trace "em1" em1)
       (let [cljmap (merge {} em1)]
         (log/trace "em1" em1 (class em1)))
@@ -180,12 +205,12 @@
       (log/trace "em1" (ds/print em1))
       (log/trace "em3" (ds/keychain em3) (ds/print em3))
       (log/trace "em3 type:" (type em3))
-      (is (not (= em1 em3)))
+      (is (= em1 em3))
 ;;      (is (ds/key= em1 em3))

       (let [em4 (merge em3 {:d 27})]
         (log/trace "em4" em4)
-        (is (not= em3 em4)))
+        (is (= em3 em4)))

       (let [em5 (merge em3 {:c #{{:d 3}}})]
         (log/trace "em5" em5)


fixed indicator fixtures

fixed indicator fixtures

--- test/ctia/http/routes/indicator_test.clj
+++ test/ctia/http/routes/indicator_test.clj
@@ -111,6 +111,8 @@
                                       :source "source"
                                       :relationship "relationship"
                                       :campaign_id "campaign-123"}]
+                 :composite_indicator_expression {:operator "and"
+                                                  :indicator_ids ["test1" "test2"]}
                  :related_COAs [{:confidence "High"
                                  :source "source"
                                  :relationship "relationship"
@@ -213,6 +215,8 @@
                                          :source "source"
                                          :relationship "relationship"
                                          :campaign_id "campaign-123"}]
+                    :composite_indicator_expression {:operator "and"
+                                                     :indicator_ids ["test1" "test2"]}
                     :related_COAs [{:confidence "High"
                                     :source "source"
                                     :relationship "relationship"
@@ -227,5 +231,3 @@
                                :headers {"api_key" "45c1f5e3f05d0"})]
           ;; Deleting indicators is not allowed
           (is (= 404 (:status response))))))))
-
-


quitting does not terminate open connections

* (this is a good thing)

--- src/merlion/core.clj
+++ src/merlion/core.clj
@@ -195,7 +195,15 @@
           (cond
             ;; Quit when we get a finished message
             (async/poll! finished-ch)
-            (do (debug "backend stopping") nil)
+            (let [key (first (filter #(= serversocket (.channel %))
+                                     (.keys selector)))]
+              (debug (.channel key))
+              (.cancel key)
+              (recur pending-write downstreams-for-upstreams))
+
+            (empty? (.keys selector))
+            (do (debug "backend stopped")
+                nil)

             ;; Zeroth, close the corresponding down/upstream for any up/downstream
             ;; on which we received eof while reading


More consistent comments for image.clj

More consistent comments for image.clj

--- src/mosaic/image.clj
+++ src/mosaic/image.clj
@@ -6,20 +6,20 @@
   (import com.mortennobel.imagescaling.ResampleOp))

 (defn load-image [^String f]
-  "Load an image f into a BufferedImage"
+  "Load filename f into a BufferedImage"
   (ImageIO/read
    (File. f)))

 (defn save-image [^BufferedImage b ^String f]
-  "Save a BufferedImage to filename f."
+  "Save image b to filename f."
   (ImageIO/write b "jpg" (File. f)))

 (defn rescale [x y ^BufferedImage b]
-  "Rescale an image b to dimensions x y."
+  "Rescale image b to dimensions x y."
   (. (ResampleOp. x y) (filter b nil)))

 (defn rescale-fixed-ratio [x ^BufferedImage b]
-  "Resize an image to width x, keeping the aspect ratio."
+  "Resize image b to width x, keeping the aspect ratio."
   (let [h (.getHeight b)
 	r (/ x (.getWidth b))
 	y (int (* h r))]
@@ -30,7 +30,7 @@
   (.getSubimage b x y dx dy))

 (defn get-samples [^BufferedImage b]
-  "Get a flat list of all samples in an image."
+  "Get a flat list of all samples in image b."
   (let [d (.getData b)]
     (for [x (range (.getWidth d))
 	  y (range (.getHeight d))
@@ -42,8 +42,8 @@
   (int (* n (Math/floor (/ x n)))))

 (defn image-floor [n ^BufferedImage b]
-  "Crop image b down the a width and height which
-   is a multiple of n."
+  "Crop image b to the largest width and height
+   which are multiples of n."
   (let [x (.getWidth b)
 	y (.getHeight b)]
     (.getSubimage b 0 0 (floor n x) (floor n y))))
@@ -51,7 +51,7 @@
 (defn insert! [^BufferedImage a
 	       ^BufferedImage b
 	       dx dy]
-  "Insert image a into image b at coordinates dx,dy."
+  "Insert image a into image b at coordinates dx dy."
   (let [da (.getRaster a)
 	db (.getRaster b)]
     (reduce = nil