Rules perftest

Rules perftest

--- test/test/datascript_perf.cljs
+++ test/test/datascript_perf.cljs
@@ -150,62 +150,54 @@
   (let [db (reduce #(d/with %1 [%2]) (d/empty-db) (:people opts))]
     (assoc opts :db db)))

-#_(def people-db (:db (test-setup-db (test-setup-people {:size 50}))))
-#_(dq/q '[:find  ?e ?a
-          :where [?e :name "Ivan"]
-                 [?e :age ?a]] people-db)
-
-#_(let [es (->> (d/-search people-db [nil :name "Ivan"])
-                                    (mapv :e))]
-            (hash-join people-db es :age))
-
-#_(do
-  (.time js/console "d/q")
-  (d/q '[:find ?e ?v
-         :where [?e :name "Ivan"]
-                [?e :age ?v]]
-      people-db)
-  (.timeEnd js/console "d/q"))
-
 (defn ^:export perftest-q []
   (perf/suite (fn [opts] ((:method opts) opts))
     :duration 1000
     :matrix   test-matrix-q
     :setup-fn (comp test-setup-db test-setup-people)))

-;; (perftest-q)
-
-;; (def db (:db (test-setup-db (test-setup-people {:size 1000}))))
-
-;; (let [es (->> (d/-search db [nil :name "Ivan"])
-;;              (mapv :e))]
-;;   (vec (hash-join db es :last-name)))
-
-;; (vec (d/seek-datoms db :avet :age 8.5))
-
-(defrecord X [a b c d])
-
-(defn ^:export perftest-get-in []
-  (perf/suite (fn [opts] ((:method opts) (:obj opts) (:path opts)))
+(defn- gen-wide-db [id depth width]
+  (if (pos? depth)
+    (let [children (map #(+ (* id width) %) (range width))]
+      (concat
+        (map #(vector :db/add id :follows %) children)
+        (mapcat #(gen-wide-db % (dec depth) width) children)))
+    []))
+
+(defn- gen-long-db [depth width]
+  (for [x (range width)
+        y (range depth)]
+    [:db/add (+ (* x (inc depth)) y) :follows (+ (* x (inc depth)) y 1)]))
+
+(defn ^:export perftest-rules []
+  (perf/suite (fn [opts]
+                ((get opts "version")
+                   '[:find ?e ?e2
+                     :in $ %
+                     :where (follows ?e ?e2)]
+                  (:db opts)
+                  '[[(follows ?x ?y)
+                     [?x :follows ?y]]
+                    [(follows ?x ?y)
+                     [?x :follows ?t]
+                     (follows ?t ?y)]]))
     :duration 1000
-    :matrix   [:obj    { "vec-vec" [[1 2 3 4] (X. 5 6 7 8) [9 10]] }
-               :path   [[0 2] [1 :b]]
-               :method { "get-in"   (fn [x p] (get-in x p))
-                         "nth-get"  (fn [x [p1 p2]] (get (nth x p1) p2)) }]))
-
-
-(defn ^:export perftest-getters []
-  (perf/suite (fn [opts] ((:method opts) (X. 1 2 3 4)))
-    :duration 1000
-    :matrix   [:method { "prop"    (fn [x] (+ (.-a x) (.-b x) (.-c x) (.-d x)))
-                         "keyword" (fn [x] (+ (:a x) (:b x) (:c x) (:d x)))
-                         "aget"    (fn [x] (+ (aget x "a") (aget x "b") (aget x "c") (aget x "d"))) }]))
-
-
-(defn ^:export perftest-array-getters []
-  (perf/suite (fn [opts] ((:method opts) #js [1 2 3 4 5 6] [1 2 3 4 5 6]))
-    :duration 1000
-    :matrix   [:method { "aget a"  (fn [x _] (+ (aget x 0) (aget x 1) (aget x 2) (aget x 3)))
-                         "nth  a"  (fn [x _] (+ (nth x 0) (nth x 1) (nth x 2) (nth x 3)))
-                         "get  v"  (fn [_ x] (+ (get x 0) (get x 1) (get x 2) (get x 3)))
-                         "nth  v"  (fn [_ x] (+ (nth x 0) (nth x 1) (nth x 2) (nth x 3)))}]))
+    :matrix   ["version" {;;"d" d/q
+                          "dq" dq/q}
+               "form" [
+;;                        [:wide 3 3]
+;;                        [:wide 5 3]
+;;                        [:wide 7 3]
+;;                        [:wide 4 6]
+;;                        [:long 10 3]
+;;                        [:long 5 5]
+                       [:long 30 3]
+                       [:long 30 5]
+                       ]]
+    :setup-fn (fn [opts]
+                (let [[form depth width] (get opts "form")
+                      datoms (case form
+                               :wide (gen-wide-db 1 depth width)
+                               :long (gen-long-db depth width))
+                      db (reduce #(d/with %1 [%2]) (d/empty-db) datoms)]
+                  (assoc opts :db db)))))


core(sorting).clj

core(sorting).clj

/bin/sh: 1: Syntax error: "(" unexpected


This is just bound to get out of date, use git log instead.

remote: Support for password authentication was removed on August 13, 2021.
remote: Please see https://docs.github.com/en/get-started/getting-started-with-git/about-remote-repositories#cloning-with-https-urls for information on currently recommended modes of authentication.
fatal: Authentication failed for 'https://github.com/shaunstanislaus/cljs2go.git/'


Formatting improvement

Formatting improvement

--- dev/src/dev.clj
+++ dev/src/dev.clj
@@ -20,11 +20,10 @@
 (defn new-dev-system
   "Create a development system"
   []
-  (let [config (config :dev)
-        s-map (new-system-map config)]
-    (-> s-map
-        (component/system-using (new-dependency-map))
-        (co-dependency/system-co-using (new-co-dependency-map)))))
+  (-> (config :dev)
+      (new-system-map)
+      (component/system-using (new-dependency-map))
+      (co-dependency/system-co-using (new-co-dependency-map))))

 (defn init
   "Constructs the current development system."


testing clojurescript

testing clojurescript

error: pathspec 'webapp/src-cljs/app.cljs' did not match any file(s) known to git

--- webapp/src-cljs/app.cljs
+++ webapp/src-cljs/app.cljs
@@ -0,0 +1,11 @@
+(ns app
+  (:require [figwheel.client :as fw]))
+
+(fw/watch-and-reload
+ :websocket-url   "ws://localhost:3449/figwheel-ws"
+ :jsload-callback
+ (fn []
+   (println "reloaded")))
+
+(.log js/console "Hello!!!")
+


Add problem68.clj

Add problem68.clj

error: pathspec 'euler_clojure/src/euler/problem68.clj' did not match any file(s) known to git

--- euler_clojure/src/euler/problem68.clj
+++ euler_clojure/src/euler/problem68.clj
@@ -0,0 +1,42 @@
+(ns euler.problem68
+  "https://projecteuler.net/problem=68
+
+  What is the maximum 16-digit string for a 'magic' 5-gon ring?"
+  (:require [euler.toolset :refer [digits]]
+            [clojure.string :as str]))
+
+(defn five-gon-rings
+  "Return a list of solutions to the 'magic' 5-gon ring problem, each line
+  summing to n. The empty list will be returned if there are no solutions"
+  [n]
+  (for [a (range 1 11)
+        b (range 1 11) :when (not= b a)
+        c (range 1 11) :when (not (contains? #{a b} c))
+        :when (= n (+ a b c))
+        d (range 1 11) :when (not (contains? #{a b c} d))
+        e (range 1 11) :when (not (contains? #{a b c d} e))
+        :when (= n (+ d c e))
+        f (range 1 11) :when (not (contains? #{a b c d e} f))
+        g (range 1 11) :when (not (contains? #{a b c d e f} g))
+        :when (= n (+ f e g))
+        h (range 1 11) :when (not (contains? #{a b c d e f g} h))
+        i (range 1 11) :when (not (contains? #{a b c d e f g h} i))
+        :when (= n (+ h g i))
+        j (range 1 11) :when (not (contains? #{a b c d e f g h i} j))
+        :when (= n (+ j i b))
+        :when (< a (min d f h j))]
+    ;; Each solution can be described uniquely starting from the group of three
+    ;; with the numerically lowest external node and working clockwise. So we
+    ;; specified at the end that (< a (min d f h j)
+    [[a b c] [d c e] [f e g] [h g i] [j i b]]))
+
+(defn problem68 []
+  (let [start 6  ; Each line cannot sum to less than 6 (1+2+3)
+        end 28]  ; Or greater than 27 (8+9+10)
+    (->> (map five-gon-rings (range start end))
+         (apply concat)
+         (filter (complement empty?))
+         (map (comp str/join #(map str %) flatten))
+         (filter #(= (count %) 16))
+         ((comp bigint last sort)))))
+


Intro to Tutorial Challanges in Algorithm/Sorting domain

error: pathspec 'src/hackerrank/IntrotoTutorialChallenges.clj' did not match any file(s) known to git

--- src/hackerrank/IntrotoTutorialChallenges.clj
+++ src/hackerrank/IntrotoTutorialChallenges.clj
@@ -0,0 +1,12 @@
+(require '[clojure.string :as str])
+
+(def input-string "4\n6\n1 4 5 7 9 12")
+
+(defn parseInt [string]
+  (Integer/parseInt string))
+
+(with-in-str input-string
+  (let [v (parseInt (read-line))
+        n (parseInt (read-line))
+        ar (map parseInt (str/split (read-line) #" "))]
+  (println (.indexOf ar v))))


associate newly created licenses with their members

remote: Support for password authentication was removed on August 13, 2021.
remote: Please see https://docs.github.com/en/get-started/getting-started-with-git/about-remote-repositories#cloning-with-https-urls for information on currently recommended modes of authentication.
fatal: Authentication failed for 'https://github.com/starcity-properties/odin.git/'


make headers consistent

make headers consistent


[WM] update signers list

[WM] update signers list

remote: Support for password authentication was removed on August 13, 2021.
remote: Please see https://docs.github.com/en/get-started/getting-started-with-git/about-remote-repositories#cloning-with-https-urls for information on currently recommended modes of authentication.
fatal: Authentication failed for 'https://github.com/democracyworks/election-notification-works.git/'


liburutruk -> liburuak

liburutruk -> liburuak

remote: Support for password authentication was removed on August 13, 2021.
remote: Please see https://docs.github.com/en/get-started/getting-started-with-git/about-remote-repositories#cloning-with-https-urls for information on currently recommended modes of authentication.
fatal: Authentication failed for 'https://github.com/lnmnd/magnet.bez.git/'


Make more readable.

Make more readable.

remote: Support for password authentication was removed on August 13, 2021.
remote: Please see https://docs.github.com/en/get-started/getting-started-with-git/about-remote-repositories#cloning-with-https-urls for information on currently recommended modes of authentication.
fatal: Authentication failed for 'https://github.com/mtravers/incidents.git/'


add stack trace for real this time

add stack trace for real this time


Make Either types printable

Make Either types printable

remote: Support for password authentication was removed on August 13, 2021.
remote: Please see https://docs.github.com/en/get-started/getting-started-with-git/about-remote-repositories#cloning-with-https-urls for information on currently recommended modes of authentication.
fatal: Authentication failed for 'https://github.com/tcsavage/cats.git/'


[EN] Refactor and annotate the find-by-identifiers function.

remote: Support for password authentication was removed on August 13, 2021.
remote: Please see https://docs.github.com/en/get-started/getting-started-with-git/about-remote-repositories#cloning-with-https-urls for information on currently recommended modes of authentication.
fatal: Authentication failed for 'https://github.com/democracyworks/scheduled-message-works.git/'


roman numerals

roman numerals

error: pathspec 'src/thw/romannumerals/solve.clj' did not match any file(s) known to git

--- src/thw/romannumerals/solve.clj
+++ src/thw/romannumerals/solve.clj
@@ -0,0 +1,78 @@
+(ns thw.romannumerals.solve
+  (:require [instaparse.core :as insta :refer [defparser]]))
+
+(defparser p
+           "roman = thousands? hundreds? tens? ones?
+            thousands = M | MM | MMM
+            hundreds = hunRep | CD | CM | D hunRep*
+            <hunRep> = C | CC | CCC
+            tens = tenRep | XL | XC | L tenRep*
+            <tenRep> = X | XX | XXX
+            ones = oneRep | IV | IX | V oneRep*
+            <oneRep> = I | II | III
+
+            (* based symbols *)
+            I = 'I'
+            V = 'V'
+            X = 'X'
+            L = 'L'
+            C = 'C'
+            D = 'D'
+            M = 'M'
+
+            (* The symbols I, X, C, and M can be repeated three times in succession, but no more. *)
+            II = 'II'
+            III = 'III'
+            XX = 'XX'
+            XXX = 'XXX'
+            CC = 'CC'
+            CCC = 'CCC'
+            MM = 'MM'
+            MMM = 'MMM'
+
+            (* I can be subtracted from V and X only *)
+            IV = 'IV'
+            IX = 'IX'
+
+            (* X can be subtracted from L and C only *)
+            XL = 'XL'
+            XC = 'XC'
+
+            (* C can be subtracted from D and M only *)
+            CD = 'CD'
+            CM = 'CM'")
+
+(def transform #(do (clojure.pprint/pprint %)
+                    (insta/transform
+                      {:I         (constantly 1)
+                       :II        (constantly 2)
+                       :III       (constantly 3)
+                       :IV        (constantly 4)
+                       :V         (constantly 5)
+                       :IX        (constantly 9)
+                       :X         (constantly 10)
+                       :XX        (constantly 20)
+                       :XXX       (constantly 30)
+                       :XL        (constantly 40)
+                       :L         (constantly 50)
+                       :XC        (constantly 90)
+                       :C         (constantly 100)
+                       :CC        (constantly 200)
+                       :CCC       (constantly 300)
+                       :CD        (constantly 400)
+                       :D         (constantly 500)
+                       :CM        (constantly 900)
+                       :M         (constantly 1000)
+                       :MM        (constantly 2000)
+                       :MMM       (constantly 3000)
+                       :thousands +
+                       :hundreds  +
+                       :tens      +
+                       :ones      +
+                       :roman     +}
+                      %)))
+
+(transform (p "MMVI"))
+(transform (p "XXXIX"))
+(transform (p "MCMIII"))
+(transform (p "MCMXLIV"))


Helper component to manage env/peer-group/peers.

error: pathspec 'test/onyx/helper_env.clj' did not match any file(s) known to git

--- test/onyx/helper_env.clj
+++ test/onyx/helper_env.clj
@@ -0,0 +1,102 @@
+(ns onyx.helper-env
+  (:require [clojure.core.async :refer [chan >!! <!! close! sliding-buffer go-loop]]
+            [onyx.peer.task-lifecycle-extensions :as l-ext]
+            [taoensso.timbre :refer [fatal] :as timbre]
+            [onyx.extensions :as extensions]
+            [com.stuartsierra.component :as component]
+            [onyx.plugin.core-async :refer [take-segments!]]
+            [onyx.test-helper :refer [load-config]]
+            [onyx.api]))
+
+(defprotocol Manager
+  (run-job [this job]
+           [this job inputs])
+  (lookup-peer [this peer-id])
+  (remove-n-peers [this n])
+  (remove-peer [this peer])
+  (add-peers [this n-peers])
+  (remove-peers [this n-peers]))
+
+(defrecord TestEnv [env-config peer-config]
+  Manager
+  (add-peers [component n-peers]
+    (swap! (:v-peers component) into (onyx.api/start-peers n-peers (:peer-group component))))
+
+  (lookup-peer [component peer-id]
+    (first (filter #(= peer-id @(:peer-id %))
+                   @(:v-peers component))))
+
+  (remove-peer [component v-peer]
+    (onyx.api/shutdown-peer v-peer)
+    (swap! (:v-peers component) disj v-peer))
+
+  (remove-n-peers [component n]
+    (let [v-peers (take n @(:v-peers component))]
+      (doseq [v-peer v-peers]
+        (remove-peer component v-peer))))
+
+  (run-job [component {:keys [workflow catalog task-scheduler] :as job}]
+    (let [n-peers-required (count (distinct (flatten workflow)))
+          n-peers (count @(:v-peers component))]
+      (when (< n-peers n-peers-required)
+        (throw (Exception. (format "%s peers required to run this job and only %s peers are available."
+                                   n-peers-required
+                                   n-peers)))))
+    (onyx.api/submit-job (:peer-config component)
+                         {:workflow workflow
+                          :catalog catalog
+                          :task-scheduler task-scheduler}))
+
+  component/Lifecycle
+  (component/start [component]
+    (let [id (java.util.UUID/randomUUID)
+          env-config (assoc env-config :onyx/id id)
+          peer-config (assoc peer-config :onyx/id id)
+          log-ch (chan)
+          env (onyx.api/start-env env-config)]
+      (try
+        (let [peer-group (onyx.api/start-peer-group peer-config)
+              !replica (atom {})
+              _ (go-loop [replica (extensions/subscribe-to-log (:log env) log-ch)]
+                         (let [position (<!! log-ch)
+                               entry (extensions/read-log-entry (:log env) position)
+                               new-replica (extensions/apply-log-entry entry replica)]
+                           (reset! !replica new-replica)
+                           (recur new-replica)))]
+          (println "Started helper environment:" id)
+          (assoc component
+                 :id id
+                 :env-config env-config
+                 :peer-config peer-config
+                 :env env
+                 :peer-group peer-group
+                 :replica !replica
+                 :v-peers (atom #{})
+                 :log-ch log-ch))
+        (catch Exception e
+          (fatal e "Could not start peer group")
+          (when log-ch (close! log-ch))
+          (onyx.api/shutdown-env env)))))
+  (component/stop [component]
+    (when-let [log-ch (:log-ch component)]
+      (close! log-ch))
+    (doseq [v-peer @(:v-peers component)]
+      (try
+        (onyx.api/shutdown-peer v-peer)
+        (catch Exception e
+          (fatal e "Could not shutdown v-peer " v-peer))))
+    (try
+      (onyx.api/shutdown-peer-group (:peer-group component))
+      (catch Exception e
+        (fatal e "Could not stop peer-group")))
+    (try
+      (onyx.api/shutdown-env (:env component))
+      (catch Exception e
+        (fatal e "Could not stop environment")))
+    (assoc component
+           :env nil
+           :id nil
+           :peer-group nil
+           :replica nil
+           :v-peers nil
+           :log-ch nil)))


placeholder: thread-last macro in Clojure

error: pathspec 'clojure/thread-macros.clj' did not match any file(s) known to git

--- clojure/thread-macros.clj
+++ clojure/thread-macros.clj
@@ -0,0 +1,12 @@
+(->> (range)
+     (map #(* % %))
+     (take 13)
+     (reduce +)
+     (#(println "First 13 square pyramidal numbers:" % "(https://oeis.org/A000330)")))
+
+(->> (range)
+     (map #(* % %))
+     (filter even?)
+     (take 13)
+     (reduce +)
+     (#(println "Sum of the first 13 even squares:" % "(https://oeis.org/A002492)")))


establish-composite

establish-composite

error: pathspec 'src/datomic/dodc/composites.clj' did not match any file(s) known to git

--- src/datomic/dodc/composites.clj
+++ src/datomic/dodc/composites.clj
@@ -0,0 +1,25 @@
+;; Copyright (c) Cognitect, Inc. All rights reserved.
+
+(ns datomic.dodc.composites
+  (:require [datomic.client.api :as d]))
+
+(defn establish-composite
+  "Reasserts all values of attr, in batches of batch-size, with
+pacing-sec pause between transactions. This will establish values
+for any composite attributes built from attr."
+  [conn {:keys [attr batch-size pacing-sec]}]
+  (let [db (d/db conn)
+        es (d/datoms db {:index :aevt
+                         :components [attr]
+                         :limit -1})]
+    (doseq [batch (partition-all batch-size es)]
+      (let [es (into #{} (map :e batch))
+            result (d/transact conn {:tx-data (map (fn [{:keys [e v]}]
+                                                     [:db/add e attr v])
+                                                   batch)})
+            added (transduce
+                   (comp (map :e) (filter es))
+                   (completing (fn [x ids] (inc x)))
+                   0
+                   (:tx-data result))]
+        (println {:batch-size batch-size :first-e (:e (first batch)) :added added})))))


Initial commit of functions adapted from compojure.html

--- src/hiccup.clj
+++ src/hiccup.clj
@@ -0,0 +1,48 @@
+;; Copyright (c) James Reeves. All rights reserved.
+;; The use and distribution terms for this software are covered by the Eclipse
+;; Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) which
+;; can be found in the file epl-v10.html at the root of this distribution. By
+;; using this software in any fashion, you are agreeing to be bound by the
+;; terms of this license. You must not remove this notice, or any other, from
+;; this software.
+
+(ns hiccup
+  "Efficiently generate HTML from a Clojure data structure."
+  (:use clojure.contrib.java-utils))
+
+(defn escape-html
+  "Change special characters into HTML character entities."
+  [string]
+  (.. (as-str string)
+    (replace "&"  "&")
+    (replace "<"  "<")
+    (replace ">"  ">")
+    (replace "\"" """)))
+
+(defn- format-attr
+  "Turn a key-value pair into a pair of attribute-value strings."
+  [[key value]]
+  (cond
+    (true? value) [(as-str key) (escape-html key)]
+    (not value)   nil
+    :otherwise    [(as-str key) (escape-html value)]))
+
+(defn- make-attrs
+  "Turn a map into a string of HTML attributes, sorted by attribute name."
+  [attrs]
+  (apply str
+    (for [[attr value] (sort (map format-attr attrs))]
+      (if attr
+        (str " " attr "=\"" value "\"")))))
+
+(defn- make-tag
+  "Wrap some content in an HTML tag."
+  [tag attrs content]
+  (str* "<" tag (map-to-attrs attrs) ">"
+          content
+        "</" tag ">"))
+
+(defn- make-closed-tag
+  "Make a closed XML tag with no content."
+  [tag attrs]
+  (str* "<" tag (map-to-attrs attrs) " />"))


Allow :nrepl-host option for binding nrepl to a non-localhost value

--- sidecar/src/figwheel_sidecar/repl.clj
+++ sidecar/src/figwheel_sidecar/repl.clj
@@ -491,6 +491,7 @@
   (when (:nrepl-port figwheel-options)
     (nrepl-serv/start-server
      :port (:nrepl-port figwheel-options)
+     :bind (:nrepl-host figwheel-options)
      :handler (apply nrepl-serv/default-handler
                      (conj (map resolve cider/cider-middleware) #'pback/wrap-cljs-repl)))))


cosmetic refactoring of p07.clj

cosmetic refactoring of p07.clj

remote: Support for password authentication was removed on August 13, 2021.
remote: Please see https://docs.github.com/en/get-started/getting-started-with-git/about-remote-repositories#cloning-with-https-urls for information on currently recommended modes of authentication.
fatal: Authentication failed for 'https://github.com/drcabana/euler-fp.git/'


Add template for routing / load balancing

error: pathspec 'router/resources/haproxy.route.conf.clj' did not match any file(s) known to git

--- router/resources/haproxy.route.conf.clj
+++ router/resources/haproxy.route.conf.clj
@@ -0,0 +1,24 @@
+global
+    daemon
+    maxconn 256
+
+defaults
+    mode http
+    timeout connect 5000ms
+    timeout client 50000ms
+    timeout server 50000ms
+
+frontend http
+    bind *:9999
+    <% (doseq [[{name :name regex :regex}] services]
+      %>acl <%= name %>-regex path_reg <%= regex %>
+    use_backend <%= name %>-backends if <%= name %>-regex
+    <%) %> <% (doseq [[{name :name} outs] services]
+        %>
+backend <%= name %>-backends
+    balance roundrobin
+    <% (doseq [[idx out] (map-indexed vector outs)]
+        %>server <%= (str name "-" idx) %> <%= out %> maxconn 32
+    <%
+       )
+%><%) %>


No IFn protocol-level varargs for now.

No IFn protocol-level varargs for now.


track interface change

track interface change

--- clojure/src/main/clj/cucumber/runtime/clj.clj
+++ clojure/src/main/clj/cucumber/runtime/clj.clj
@@ -51,7 +51,7 @@
        (str (:file location) ":" (:line location)))
      (getParameterTypes [_]
        nil)
-     (execute [_ args]
+     (execute [_ locale args]
        (apply fun args))
      (isDefinedAt [_ stack-trace-element]
        (and (= (.getLineNumber stack-trace-element)


Use (NOT) EXISTS instead of EXCEPT/IN

Use (NOT) EXISTS instead of EXCEPT/IN

--- src/com/puppetlabs/puppetdb/query/resource.clj
+++ src/com/puppetlabs/puppetdb/query/resource.clj
@@ -92,7 +92,7 @@
                                                                          (= :resource_params.value (db-serialize value)))))
                                            (project [:resource]))
                          [sql & params]  (compile resource_params nil)]
-                     (apply vector (format "SELECT catalog,resource FROM catalog_resources WHERE resource IN (%s)" sql) params))
+                     (apply vector (format "SELECT lhs.catalog,lhs.resource FROM catalog_resources lhs WHERE EXISTS (SELECT * FROM (%s) rhs WHERE lhs.resource = rhs.resource)" sql) params))
                                  ;; metadata match.
                                  [(metadata :when string?)]
                                  (select catalog_resources
@@ -154,6 +154,6 @@
     (throw (IllegalArgumentException. (str op " requires at least one term"))))
   (let [[subquery & params] (compile-query->sql (cons "or" terms))
         query               (->> subquery
-                 (format "SELECT catalog_resources.catalog,catalog_resources.resource FROM catalog_resources EXCEPT %s")
+                 (format "SELECT lhs.catalog,lhs.resource FROM catalog_resources lhs WHERE NOT EXISTS (SELECT * FROM %s rhs WHERE lhs.resource = rhs.resource AND lhs.catalog = rhs.catalog)")
                  (format "(%s)"))]
     (apply vector query params)))


Add ability to remove communities on application update

Also switched to use assoc-some to account for falsy values


Erregistratzea burutu

Erregistratzea burutu


Delete self-import

Delete self-import


Copy current induction to sas_dag, switch sas_hierarchy_induction to be cyclic version (to be started now.)

error: pathspec 'src/exp/sas_dag_hierarchy_induction.clj' did not match any file(s) known to git

--- src/exp/sas_dag_hierarchy_induction.clj
+++ src/exp/sas_dag_hierarchy_induction.clj
@@ -0,0 +1,679 @@
+(ns exp.sas-dag-hierarchy-induction
+  (:require [edu.berkeley.ai.util :as util]
+            [edu.berkeley.ai.util  [graphs :as graphs] [graphviz :as gv]]
+            [exp [env :as env]  [hierarchy :as hierarchy] [sas :as sas] [sas-analysis :as sas-analysis]])
+  (:import [java.util HashMap HashSet IdentityHashMap]))
+
+
+;; Right now, this is only for DAGs.
+
+;; Optimizations left TODO:
+
+; TODO: Backwards-greedy optimization:
+;  If a tail-seq of precond-sets will necessarily occur by some other interleaved refinement,
+;  do not execute these precond-sets except greedily as a result of executing the other.
+
+; TODO: ???
+;  General case of logistics thing: don't put a passenger down until another cab is ready
+;  to pick it up.  I.e., when something has multiple independent parents,
+;  require them to line up for multiple transitions before starting the first??
+
+; TODO: Non-ordering of independent things when interleaving
+;  Right now, we only do greedy ordering when not interleaving.  Should combine both.
+
+; Also, see many ideas for TODOs below.
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Utilities ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(def no-effect-val ::NO-EFFECT)
+(def no-effect-set #{no-effect-val})
+(def no-outcomes ::NO-EXIT)
+
+(defn disjoin-effect-set-maps
+  ([] {})
+  ([m] m)
+  ([m1 m2]
+     (cond (= m1 no-outcomes) m2
+           (= m2 no-outcomes) m1
+           :else (util/map-map
+                  (fn [k] [k (clojure.set/union (get m1 k no-effect-set) (get m2 k no-effect-set))])
+                  (distinct (concat (keys m1) (keys m2))))))
+  ([m1 m2 & maps]
+     (reduce disjoin-effect-set-maps m1 (cons m2 maps))))
+
+(defn sequence-effect-set-maps
+  ([] {})
+  ([m] m)
+  ([m1 m2]
+     (util/assert-is (map? m2))
+      (reduce (fn [m [ek evs]]
+                (let [ovs (get m1 no-effect-set)]
+                  (assoc m ek (if (contains? evs no-effect-val) (clojure.set/union ovs (disj evs no-effect-val)) evs))))
+              m1 m2))
+  ([m1 m2 & maps]
+     (reduce sequence-effect-set-maps m1 (cons m2 maps))))
+
+(defn apply-effect-set-map [init-sets effect-set-map]
+  (reduce (fn [m [ek evs]]
+            (let [ovs (util/safe-get init-sets ek)]
+              (assoc m ek (if (contains? evs no-effect-val) (clojure.set/union ovs (disj evs no-effect-val)) evs))))
+          init-sets effect-set-map))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Global bindings ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(def *vars* nil)
+(def *var-val-sets* nil)  ; Map from var name to set of all vals.
+(def *var-levels*   nil)  ; Map from var name to index in topological sort (0 is src, +n is sink)
+(def *extended-dtgs* nil) ; Map from var to map from prev val to map from post val to list of actions.
+(def *simple-dtgs* nil)   ; Map from var to edge list.
+(def #^HashMap *hla-cache* nil) ; a map from [action-name] to map from init-sets to action.
+(def #^IdentityHashMap *compile-cache* nil) ; a map from [action-name] to map from init-sets to action.
+(def *greedy-optimization?* true)
+
+;; Memoized partial computations to speed up acylic edge generation.
+(def #^HashMap *forward-reachability-cache* nil)
+(def #^HashMap *backward-reachability-cache* nil)
+
+(defn forward-reachable-nodes-and-necessary-predecessors [var-name from-val]
+  (util/cache-with *forward-reachability-cache* [var-name from-val]
+    (graphs/compute-reachable-nodes-and-necessary-predecessors
+     (util/safe-get *simple-dtgs* var-name) from-val)))
+
+(defn backward-reachable-nodes-and-necessary-predecessors [var-name to-val]
+  (util/cache-with *backward-reachability-cache* [var-name to-val]
+    (graphs/compute-reachable-nodes-and-necessary-predecessors
+     (map reverse (util/safe-get *simple-dtgs* var-name)) to-val)))
+
+(defn get-possibly-acyclic-edges
+  "Return a list of edges, where those provably on no acyclic s-t path have been eliminated.
+   Do so in polynomial time, possibly missing some always-cyclic edges."
+  [var from-val to-val]
+  (let [forward-sets  (forward-reachable-nodes-and-necessary-predecessors var from-val)
+        backward-sets (backward-reachable-nodes-and-necessary-predecessors var to-val)]
+    (filter
+     (fn [[a b]]
+       (let [f (forward-sets a)
+             b (backward-sets b)]
+         (and f b (empty? (clojure.set/intersection f b)))))
+     (util/safe-get *simple-dtgs* var))))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Action Protocol ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+
+;; Difference from precond-var-set and precondition-context is for primitives (?)
+;; Compile-Hla may return an HLA, or a single ref.  Takes a set of HLA types that should not be removed.
+; extend-hla-par! extends hla to handle any other action setting these effects in-between accesses to these vars.
+(defprotocol SAS-Induced-Action
+  (precond-var-set [a])
+;  (initial-sets    [a])
+  (effect-sets     [a])
+  (pre-ref-pairs   [a])
+  (compile-hla     [a retain-type-set])
+  (extend-hla!     [a init-sets par-effect-sets])
+  (hla-type        [a]))
+
+(extend ::env/FactoredPrimitive
+  SAS-Induced-Action
+    {:precond-var-set (fn [a] (util/keyset (:precond-map a)))
+;     :initial-sets    (fn [a] (util/map-vals (fn [x] #{x}) (:precond-map a))) ;?
+     :effect-sets     (fn [a] (util/map-vals (fn [x] #{x}) (:effect-map a)))
+     :pre-ref-pairs   (fn [a] (throw (UnsupportedOperationException.)))
+     :compile-hla     (fn [a retain-type-set] a)
+     :extend-hla!     (fn [a init-sets par-effect-sets] a)
+     :hla-type        (fn [a] (throw (UnsupportedOperationException.)))})
+
+(deftype SAS-Compiled-HLA [name orig-hla precond-vars effects refinements-and-preconditions-atom ref-generator-atom] :as this
+  SAS-Induced-Action
+    (precond-var-set [] precond-vars)
+    (effect-sets     [] effects)
+    (pre-ref-pairs   [] @refinements-and-preconditions-atom)
+    (compile-hla     [retain-type-set] this)
+    (hla-type        [] (hla-type orig-hla))
+    (extend-hla!     [init-sets par-effect-sets] (throw (UnsupportedOperationException.)))
+  env/Action
+    (action-name [] [:!C  name])
+    (primitive?  [] false)
+  env/ContextualAction
+    (precondition-context [s] precond-vars)
+  hierarchy/HighLevelAction
+    (immediate-refinements- [s] (@ref-generator-atom s))
+    (cycle-level-           [s] nil))
+
+(defn make-ref-generator [refinements-and-preconditions]
+  (if (every? empty? (map first refinements-and-preconditions))
+      (let [refs (map second refinements-and-preconditions)]
+        (constantly refs))
+    (fn gen [s]
+      (for [[pre-pairs ref] refinements-and-preconditions,
+            :when (every? (fn [[var val]] (= val (env/get-var s var))) pre-pairs)]
+        ref))))
+
+(defn make-compiled-hla [name orig-hla precond-vars effects]
+  (SAS-Compiled-HLA name orig-hla precond-vars effects (atom :dummy) (atom :dummy)))
+
+(defn set-compiled-hla-refinements [hla pre-ref-pairs]
+  (reset! (:refinements-and-preconditions-atom hla) pre-ref-pairs)
+  (reset! (:ref-generator-atom hla) (make-ref-generator pre-ref-pairs)))
+
+(defn compile-refinement [ref retain-type-set]
+  (loop [ref ref, compiled []]
+    (if-let [[f & r] (seq ref)]
+      (let [cf (compile-hla f retain-type-set)]
+        (if (or (nil? cf) (sequential? cf))
+            (recur r (into compiled cf))
+          (recur r (conj compiled cf))))
+      compiled)))
+
+
+(defn default-compile-hla-noflatten [hla retain-type-set]
+;  (println "compiling-noflatten" (env/action-name hla))
+  (or (get *compile-cache* hla)
+      (let [chla (make-compiled-hla (env/action-name hla) hla (precond-var-set hla) (effect-sets hla))]
+        (.put *compile-cache* hla chla)
+        (set-compiled-hla-refinements chla
+                                      (doall (for [[p r] (pre-ref-pairs hla)] [p (compile-refinement r retain-type-set)])))
+        chla)))
+
+(defn default-compile-hla [hla retain-type-set]
+;  (println "compiling" (env/action-name hla))
+  (let [pr (pre-ref-pairs hla)]
+     (if (and (util/singleton? pr)
+              (empty? (ffirst pr))
+              (not (contains? retain-type-set (hla-type hla))))
+         (compile-refinement (second (first pr)) retain-type-set)
+         (default-compile-hla-noflatten hla retain-type-set))))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; VV HLAs ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(declare get-current-action-hla extend-action-hla!)
+
+(declare extend-vv-hla!)
+;; TODO: special treatment for "free"  vars without self-loops.
+;; TODO: try harder to avoid cycles, e.eg. in logistics / multi-taxi domain.
+;; Either all-paths or blacklist approaches will work.
+
+(defn vv-hla-name [var src-val dst-val] [:!VV src-val dst-val])
+
+; successor-map is a map from dst-val to list of [ap-hla next-vv-hla] pairs.
+(deftype SAS-VV-HLA  [var src-val dst-val src?-atom dirty?-atom init-sets-atom par-effects-atom precond-vars-atom effect-sets-atom successor-map-atom] :as this
+  SAS-Induced-Action
+    (precond-var-set [] @precond-vars-atom)
+    (effect-sets     [] @effect-sets-atom)
+    (pre-ref-pairs   [] (if (= src-val dst-val) [[{} []]]
+                            (for [vs (vals @successor-map-atom), v vs] [{} v])))
+    (compile-hla     [retain-type-set] (if (= src-val dst-val) [] (default-compile-hla this retain-type-set)))
+    (hla-type        [] (type this))
+    (extend-hla!     [init-sets par-effect-sets] (extend-vv-hla! this init-sets par-effect-sets true))
+  env/Action
+    (action-name [] (vv-hla-name var src-val dst-val))
+    (primitive?  [] false)
+  env/ContextualAction
+    (precondition-context [s] @precond-vars-atom)
+  hierarchy/HighLevelAction
+    (immediate-refinements- [s] (if (= src-val dst-val) [[]] (apply concat (vals @successor-map-atom))))
+    (cycle-level-           [s] nil))
+
+(defn get-current-vv-hla [var src-val dst-val]
+  (util/cache-with *hla-cache* (vv-hla-name var src-val dst-val)
+    (if (= src-val dst-val)
+      (SAS-VV-HLA var src-val dst-val (atom true) (atom false) (atom *var-val-sets*) (atom {}) (atom #{var}) (atom {}) (atom {}))
+      (SAS-VV-HLA var src-val dst-val (atom false) (atom false) (atom {})            (atom {}) (atom #{var}) (atom no-outcomes) (atom {})))))
+
+(declare extend-vv-hla-edge!)
+
+(defn add-new-vv-edge! [var dst-val [s t]]
+  (let [sn (get-current-vv-hla var s dst-val)]
+    (when-not (contains? @(:successor-map-atom sn) t)
+      (when (seq @(:init-sets-atom sn)) #_(println "Warning: adding outgoing edge! (sas_hierarchy_induction)" [s t]))
+      (swap! (:successor-map-atom sn) assoc t
+             (doall (for [a (util/safe-get-in *extended-dtgs* [var s t])]
+                      [(get-current-action-hla a) (get-current-vv-hla var t dst-val)]))))))
+
+
+;; TODO: take "at most 1 free action" constraint into account.
+(defn designate-vv-hla-src! [hla]
+  (let [{:keys [var src-val dst-val src?-atom]} hla
+        edges    (get-possibly-acyclic-edges var src-val dst-val)
+        any-new? (some identity (doall (map #(add-new-vv-edge! var dst-val %) edges)))]
+;    (println "adding edges" edges "for" src-val "-->" dst-val)
+;    (gv/graphviz-el edges)
+    (util/assert-is (or (seq edges) (= src-val dst-val)) "%s" [src-val dst-val])
+    (reset! src?-atom true)
+    (when any-new?
+      (doseq [s (distinct (map first edges))]
+        (reset! (:dirty?-atom (get-current-vv-hla var s dst-val)) true)))))
+
+
+(defn extend-vv-hla!
+  "Extend this HLA to cover new init-sets, as needed. src? indicates whether this value can be a source from a descendent."
+  [hla init-sets par-effect-sets src?]
+  (assert (not (contains? (apply clojure.set/union (vals init-sets)) no-effect-val)))
+  (let [{:keys [var src-val dst-val src?-atom dirty?-atom init-sets-atom par-effects-atom precond-vars-atom successor-map-atom]} hla]
+;    (println "Extend" (:var hla) (:src-val hla) (:dst-val hla) new-inits? (count @successor-map-atom))
+    (util/assert-is (= (util/safe-get init-sets var) #{src-val}))
+    (when (and src? (not @src?-atom)) (designate-vv-hla-src! hla))
+    (when (or (not= (select-keys @init-sets-atom @precond-vars-atom)
+                    (select-keys (swap! init-sets-atom #(merge-with clojure.set/union % init-sets)) @precond-vars-atom))
+              (not= (select-keys @par-effects-atom @precond-vars-atom)
+                    (select-keys (swap! par-effects-atom #(merge-with clojure.set/union % par-effect-sets)) @precond-vars-atom))
+              @dirty?-atom)
+      (reset! dirty?-atom false)
+      (doseq [es (vals @successor-map-atom), e es] (extend-vv-hla-edge! hla e @init-sets-atom @par-effects-atom)))))
+
+;; TODO: make sure this is general enough handling of precond sets.
+(defn extend-vv-hla-edge!
+  "Extend this VV-HLA edge to cover new init-sets, as needed."
+  [hla [a next-vv-hla] init-sets par-effect-sets]
+  (assert (not (= (:src-val hla) (:dst-val hla))))
+;  (println "Start extend" (:src-val hla) (:dst-val hla) "via" (:src-val next-vv-hla))
+  (extend-hla! a init-sets par-effect-sets)
+;  (println (env/action-name hla) init-sets (effect-sets hla) (effect-sets a) (effect-sets next-vv-hla))
+  (extend-vv-hla! next-vv-hla (apply-effect-set-map init-sets (effect-sets a)) par-effect-sets false)
+  (when-not (= (effect-sets next-vv-hla) no-outcomes)
+;    (println "Warning: no effect sets ... cyclic dTG?")
+;    (throw (RuntimeException. (str (:src-val hla) (:dst-val hla) (:src-val next-vv-hla))))
+
+    (swap! (:precond-vars-atom hla) clojure.set/union       (precond-var-set a) (precond-var-set next-vv-hla))
+    (swap! (:effect-sets-atom hla)  disjoin-effect-set-maps (sequence-effect-set-maps (effect-sets a) (effect-sets next-vv-hla)))
+    (util/assert-is (= (get @(:effect-sets-atom hla) (:var hla)) #{(:dst-val hla)}) "%s" [(env/action-name hla)])
+;    (println "Finish extend" (:src-val hla) (:dst-val hla) "via" (:src-val next-vv-hla))
+    ))
+
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Precondition Nodes ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;; Each precond HLA is not cached, and is owned by a particular action.
+;; It just aggregates sets of src vv-hla nodes, more or less.
+;; src-map-atom maps from src vals to sas-vv-hla instances.  Init-sets describes current init-sets.
+
+(deftype SAS-Precond-HLA [var dst-val src-map-atom par-effects-atom] :as this
+  SAS-Induced-Action
+    (precond-var-set [] (apply clojure.set/union       (map precond-var-set (vals @src-map-atom))))
+    (effect-sets     [] (apply disjoin-effect-set-maps @par-effects-atom (map effect-sets     (vals @src-map-atom))))
+    (pre-ref-pairs   [] (if (util/singleton? @src-map-atom)
+                            [[{} [(first (vals @src-map-atom))]]]
+                          (for [[k v] @src-map-atom] [{var k} [v]])))
+    (compile-hla     [retain-type-set] (default-compile-hla this retain-type-set))
+    (hla-type        [] (type this))
+    (extend-hla!     [init-sets par-effect-sets]
+      (assert (every? set? (vals init-sets)))
+      (assert (every? set? (vals par-effect-sets)))
+      (assert (not (contains? (apply clojure.set/union (vals init-sets)) no-effect-val)))
+      (if (contains? par-effect-sets var)
+          (do ;(println "RAB")
+              (swap! par-effects-atom #(merge-with clojure.set/union par-effect-sets %))
+              (extend-hla! this (merge-with clojure.set/union init-sets (apply-effect-set-map init-sets par-effect-sets)) {}))
+        (let [par-effects? (seq (clojure.set/intersection (util/keyset par-effect-sets) (precond-var-set this)))]
+;          (println "OTH" );(set (get init-sets var)) (when par-effects? (keys @src-map-atom)))
+;          (println (util/map-vals type init-sets))
+          (assert (not (contains? (set (get init-sets var)) no-effect-val)))
+          (doseq [src-val (util/union-coll (set (get init-sets var)) (when par-effects? (keys @src-map-atom)))]
+            (util/assert-is  (not= src-val no-effect-val))
+            (when-not (contains? @src-map-atom src-val)
+              (swap! src-map-atom assoc src-val (get-current-vv-hla var src-val dst-val)))
+            (extend-hla! (util/safe-get @src-map-atom src-val) (assoc init-sets var #{src-val}) (if par-effects? par-effect-sets {}))))))
+  env/Action
+    (action-name [] [:precond var dst-val (System/identityHashCode this)])
+    (primitive?  [] false)
+  env/ContextualAction
+    (precondition-context [s] (precond-var-set this))
+  hierarchy/HighLevelAction
+    (immediate-refinements- [s] [[(util/safe-get @src-map-atom (env/get-var s var))]])
+    (cycle-level-           [s] nil))
+
+(defn make-precond-hla [var dst-val]
+  (SAS-Precond-HLA var dst-val (atom {}) (atom {})))
+
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;; Precondition Set Nodes ;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+ ; This assumes no value-added needed:
+
+;; Idea: graph where a, b connected if precond sets intersect.
+ ; Arc is a->b if a superset of b, bid. if no containment.
+ ; any Topological order gives proper structure? (SCC-graph must be a tree!)
+; This loses on things like a -> b -> c , d -> c where we should get orering of a/b.
+
+;; TODO: recursively do these sets, somehow.
+
+
+(defn compute-precond-var-sets [init-sets par-effect-sets ordered-preconds]
+  (loop [init-sets init-sets, ordered-preconds ordered-preconds, ret []]
+    (if-let [[f & r] (seq ordered-preconds)]
+        (do (extend-hla! f init-sets par-effect-sets)
+            (recur (apply-effect-set-map init-sets (effect-sets f))
+                   r
+                   (conj ret [f (precond-var-set f)])))
+      ret)))
+
+(defn compute-interference-graph [preconds-and-var-sets]
+  (concat
+   (for [g preconds-and-var-sets] [::ROOT g])
+   (for [[p1 s1 :as g1] preconds-and-var-sets, [p2 s2 :as g2] preconds-and-var-sets
+         :when (and (not (empty? (clojure.set/intersection s1 s2)))
+                    (not (util/superset? s2 s1)))]
+     [g1 g2])))
+
+(defn compute-topo-map [init-sets par-effect-sets ordered-preconds]
+  (graphs/topological-sort-indices
+   (compute-interference-graph
+    (compute-precond-var-sets init-sets par-effect-sets ordered-preconds))))
+
+;; TODO: To properly know which vars to fiddle, must be able to separate direct effects from transitive ones.
+
+;; TODO: also must remember prec/effect dichotomy.
+
+(declare extend-precond-set-hla! make-interleaving-hla)
+;; Preconds are ordered, max-level (deepest) first.
+(deftype SAS-Precond-Set-HLA [precond-map ordered-preconds ref-atom] :as this
+  SAS-Induced-Action
+    (precond-var-set [] (apply clojure.set/union        (map precond-var-set ordered-preconds)))
+    (effect-sets     [] (apply sequence-effect-set-maps (map effect-sets ordered-preconds)))
+    (pre-ref-pairs   [] [[{} @ref-atom]])
+    (compile-hla     [retain-type-set] (default-compile-hla this retain-type-set))
+    (hla-type        [] (type this))
+    (extend-hla!     [init-sets par-effect-sets]
+      (extend-precond-set-hla! this init-sets par-effect-sets))
+  env/Action
+    (action-name [] [:ps (System/identityHashCode this)])
+    (primitive?  [] false)
+  env/ContextualAction
+    (precondition-context [s] (precond-var-set this))
+  hierarchy/HighLevelAction
+    (immediate-refinements- [s] [@ref-atom])
+    (cycle-level-           [s] nil))
+
+;; For now, punt in several ways, only look for independent chunks, ...
+; Broken out so it can access bound vars.
+(defn extend-precond-set-hla! [hla init-sets par-effect-sets]
+  (let [{:keys [ordered-preconds ref-atom]} hla
+        topo-map (compute-topo-map init-sets par-effect-sets ordered-preconds)
+        chunks   (map #(map key %) (vals (util/group-by val topo-map)))]
+    (assert (= (first chunks) [::ROOT]))
+;    (println (map #(map (comp env/action-name first) %) (next chunks)))
+    (reset! ref-atom
+      (doall
+       (for [chunk (next chunks)]
+         (if (util/singleton? chunk)
+           (ffirst chunk)
+           (let [all-vars (apply concat (map second chunk))
+                 bad-vars (util/keyset (util/filter-map #(> (val %) 1) (util/frequencies all-vars)))
+                 par-effect-sets (select-keys *var-val-sets* bad-vars)]
+             (println "Interleaving HLAs with common ground:" bad-vars par-effect-sets)
+             (doseq [[hla] chunk] (extend-hla! hla {} par-effect-sets))
+             (assert (= (set all-vars) (set (apply concat (map second chunk)))))
+             (make-interleaving-hla (map (comp vector first) chunk) bad-vars))))))))
+
+(defn make-precond-set-hla [precond-map]
+  (SAS-Precond-Set-HLA
+   precond-map
+   (doall (map (partial apply make-precond-hla) (sort-by (comp - *var-levels* key) precond-map)))
+   (atom :dummy)))
+
+(defn trivially-satisfied-precond-set? [a s]
+  (if (= (type a) ::SAS-Compiled-HLA) (recur (:orig-hla a) s)
+      (and (= (type a) ::SAS-Precond-Set-HLA)
+           (every? (fn [p] (= (env/get-var s (:var p)) (:dst-val p)))
+                   (:ordered-preconds a)))))
+
+; (loop [init-sets init-sets, ordered-preconds ordered-preconds, used-vars #{}]
+;        (when-let [[f & r] (seq ordered-preconds)]
+;          (extend-hla! f init-sets)
+;          (util/assert-is (or (contains? used-vars (:var f))
+;                              (empty? (clojure.set/intersection used-vars (precond-var-set f))))
+;                          "%s" [used-vars (:var f) (precond-var-set f)])
+;          (recur (apply-effect-set-map init-sets (effect-sets f))
+;                 r
+;                 (clojure.set/union used-vars (precond-var-set f) (util/keyset (effect-sets f))))))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Action Nodes ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;; An action.
+;; TODO: think about splitting this based on which var it's being used for.
+
+(defn action-hla-name [action] [:!A (env/action-name action)])
+
+(deftype SAS-Action-HLA [action precond-set-hla]; init-sets-atom precond-vars-atom effect-sets-atom]
+                                :as this
+  SAS-Induced-Action
+    (precond-var-set [] (clojure.set/union (precond-var-set precond-set-hla) (util/keyset (:precond-map action))))
+    (effect-sets     [] (sequence-effect-set-maps (effect-sets precond-set-hla) (util/map-vals (fn [x] #{x}) (:effect-map action))))
+    (pre-ref-pairs   [] [[{} [precond-set-hla action]]])
+    (compile-hla     [retain-type-set] (default-compile-hla this retain-type-set))
+    (hla-type        [] (type this))
+    (extend-hla!     [init-sets par-effect-sets] (extend-hla! precond-set-hla init-sets par-effect-sets))
+  env/Action
+    (action-name     [] (action-hla-name action))
+    (primitive?      [] false)
+  env/ContextualAction
+    (precondition-context [s] (precond-var-set this))
+  hierarchy/HighLevelAction
+    (immediate-refinements- [s] [[precond-set-hla action]])
+    (cycle-level-           [s] nil))
+
+(defn get-current-action-hla [action]
+  (let [preconds     (:precond-map action)]
+    (util/cache-with *hla-cache* (action-hla-name action)
+      (SAS-Action-HLA action (make-precond-set-hla preconds)))))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Interleaving HLA ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;; Interleaving HLA takes a set of refinements and interleaves their access
+;; to a set of specified common ancestors.
+ ; Idea: greedily refine / execute everything except PrecondSet actions incl. key vars.
+ ; When all refinements start with such a PrecondSet,
+  ; Choose a first group, s.t. all other preconds are independent
+   ;
+
+; Once we start the first PC in a PrecondSet, we cannot falsify other PCs.
+; When a PC set can fire, it must ... but not an individual PC?
+
+; IF one PC set refers only to parent(A) but not A, and others refer to A,
+ ; We must consider all ways of interleaving, with that shared-var-set.
+; This does not occur if all refer to A and parent(A) since we must always achieve A first,
+ ; and then we are committed?
+
+; Note AND-OR structure, ignored so far.  Assuming all ORs pushed to search space.
+; Thus, we end up with X-product of choice points, + interleavings.
+
+; Also, what really matters is order *preconditions*, not sets, are achieved.
+
+;; First greedy condition -
+ ; if a precond-set HLA is trivially satisfied, greedily do it.
+ ; One issue: this can happen *before* or *after*
+
+;; TODO: figure out how to do greedy "tail" thing, if there are generalizations.
+ ; (i.e., drop off all passengers with dest in a square at same time.)
+  ; --> if tail sequence externalities necessarily occurs in other HLAs interleaved,
+  ;     don't do it (except by other greedy condition).
+
+(declare make-interleaving-hla-refinement)
+
+(deftype SAS-Interleaving-HLA [refinements shared-var-set] :as this
+  SAS-Induced-Action
+    (precond-var-set [] (apply clojure.set/union (map precond-var-set (apply concat refinements))))
+    (effect-sets     [] (throw (UnsupportedOperationException.)))
+    (pre-ref-pairs   [] (throw (UnsupportedOperationException.)))
+    (compile-hla     [retain-type-set]
+;      (println "interleaved compile" (map #(map env/action-name %) refinements))
+      (SAS-Interleaving-HLA. (vec (map #(compile-refinement % (conj retain-type-set ::SAS-Precond-Set-HLA)) refinements)) shared-var-set))
+    (hla-type        [] (type this))
+    (extend-hla!     [init-sets par-effect-sets] (throw (UnsupportedOperationException.)))
+  env/Action
+    (action-name     [] [:!I (map #(map env/action-name %) refinements) shared-var-set])
+    (primitive?      [] false)
+  env/ContextualAction
+    (precondition-context [s] (precond-var-set this))
+  hierarchy/HighLevelAction
+    (immediate-refinements- [s]
+      (let [[stalled-refs rest-refs] (split-with #(= (hla-type (first %)) ::SAS-Precond-Set-HLA) refinements)]
+;        (println "\n\n" s "\n" (map (comp env/action-name first) refinements))
+;        (println (map count [stalled-refs rest-refs]))
+;        (println (map #(map type %) rest-refs))
+        (if-let [[target-ref & more-refs] (seq rest-refs)]
+            (let [[first-a & rest-a] target-ref]
+              (for [ref (hierarchy/immediate-refinements first-a s)]
+                (make-interleaving-hla-refinement nil
+                  (concat stalled-refs [(concat ref rest-a)] more-refs)
+                  shared-var-set)))
+           ;; Interesting stuff here ... all refinements are blocked at precond set HLAs.
+           ;; First placeholder (not complete or smart): just pick one to do completely, no interleaving.
+          (if (and *greedy-optimization?* (some #(trivially-satisfied-precond-set? (first %) s) refinements))
+              (do ;(println "GREEDY") ;; TODO: is this the best place?
+                [(make-interleaving-hla-refinement
+                  [] ; (for [ref refinements :let [f (first ref)] :when (trivially-satisfied-precond-set? f s)] f)
+                  (for [ref refinements]
+                    (if (trivially-satisfied-precond-set? (first ref) s) (next ref) ref))
+                  shared-var-set)])
+            (for [i (range (count refinements))
+                  :let [[f & r] (nth refinements i)]]
+              (make-interleaving-hla-refinement [f]
+                (concat (subvec refinements 0 i) [r] (subvec refinements (inc i)))
+                shared-var-set))))))
+    (cycle-level-           [s] nil))
+
+(defn make-interleaving-hla [refinements shared-var-set]
+;  (println "MIH " (map #(map env/action-name %) refinements))
+  (SAS-Interleaving-HLA (vec refinements) shared-var-set))
+
+;; Greedily pull irrelevant actions out, until we get to a normalized HLA
+(defn make-interleaving-hla-refinement [pre-actions refinements shared-var-set]
+;  (println (count refinements))
+;  (println pre-actions (map type refinements) (map #(map type %) refinements))
+;  (println (map type pre-actions) (map type refinements) (map #(map type %) refinements))
+;  (println "MIHR" (map env/action-name pre-actions) (map #(map env/action-name %) refinements))
+  (loop [in-refinements refinements, out-refinements [], pre-actions pre-actions]
+    (if-let [[f & r] (seq in-refinements)]
+      (let [[front back] (split-with #(or (empty? (clojure.set/intersection shared-var-set (precond-var-set %)))
+                                          (env/primitive? %)) f)]
+        (recur r (if (seq back) (conj out-refinements back) out-refinements) (concat pre-actions front)))
+      (concat pre-actions (when (seq out-refinements) [(make-interleaving-hla out-refinements shared-var-set)])))))
+
+
+
+
+
+
+
+;; Ideas here:
+ ; If actions can be partitioned such that effects of each set disjoint with preconditions of all other sets,
+   ; Such sets can be ordered arbitrarily.
+     ; (+ caveat about idempotent effects)
+ ; Within a given set, ones with same effects can be ordered arbitrarily.
+
+ ; Finally, generate interleavings ...
+
+;; Watch out: what happens when single action establishes multiple preconditions, e.g. ..
+;; TODO: need to treat subsets (i.e., transitive closure edges) specially.
+
+;; TODO: induce stronger preconditions for refinements?
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Top Level  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+
+;; TODO: when can we use relaxed CG ?
+(defn induce-raw-hierarchy [sas-problem]
+  (let [{:keys [vars actions init]} sas-problem
+        dtgs (sas-analysis/domain-transition-graphs vars actions)]
+    (assert (graphs/dag? (sas-analysis/standard-causal-graph sas-problem)))
+    (binding [*vars*          vars
+              *var-val-sets*  (util/map-map (juxt :name (comp set :vals)) (vals vars))
+              *var-levels*    (graphs/topological-sort-indices (sas-analysis/standard-causal-graph sas-problem))
+              *extended-dtgs* dtgs
+              *simple-dtgs*   (util/map-vals (fn [dtg] (for [[pval emap] dtg, [eval _] emap] [pval eval])) dtgs)
+              *hla-cache*     (HashMap.)
+              *forward-reachability-cache* (HashMap.)
+              *backward-reachability-cache* (HashMap.)
+              ]
+;      (println "VVS"  *var-val-sets*)
+      (let [goal-action (util/safe-singleton (get-in *extended-dtgs* [sas/goal-var-name sas/goal-false-val sas/goal-true-val]))
+            goal-hla    (get-current-action-hla goal-action)]
+        (extend-hla! goal-hla (util/map-vals (fn [x] #{x}) init) {})
+        (hierarchy/SimpleHierarchicalEnv sas-problem [goal-hla])))))
+
+(defn compile-hierarchy [h]
+  (binding [*compile-cache* (IdentityHashMap.)]
+    (hierarchy/SimpleHierarchicalEnv (hierarchy/env h) (compile-refinement (hierarchy/initial-plan h) #{}))))
+
+(defn induce-hierarchy [sas-problem]
+  (compile-hierarchy (induce-raw-hierarchy sas-problem)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Printing  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defmulti pretty-print-action (fn [h done-set] (type h)))
+
+(defn pretty-print-hla [h #^HashSet done-set]
+  (when-not (.contains done-set h)
+    (.add done-set h)
+    (println (str "\nRefs for HLA" (env/action-name h)) );(precond-var-set h)  (effect-sets h))
+    (doseq [ref (map second (pre-ref-pairs   h))]
+      (println " " (util/str-join ", " (map env/action-name ref))))
+    (doseq [ref (map second (pre-ref-pairs   h)), a ref]
+      (pretty-print-action a done-set))))
+
+(defmethod pretty-print-action :default [h ds] (pretty-print-hla h ds))
+(defmethod pretty-print-action ::env/FactoredPrimitive [h ds] nil)
+
+
+(defn pretty-print-hierarchy [hierarchy]
+  (let [hs (HashSet.), ip (:initial-plan hierarchy)]
+    (println "\nInitial plan is:" (map env/action-name ip ))
+    (doseq [a ip] (pretty-print-action a hs))))
+
+
+
+
+
+
+
+
+
+
+;(induce-hierarchy  (make-sas-problem-from-pddl (prln (write-infinite-taxi-strips2 (make-random-infinite-taxi-env 2 2 1)))))
+
+(comment
+  ; not needed anymore?
+
+
+(defn find-all-acyclic-paths
+  ([var init-val-set goal-val reverse-dtg]
+     (find-all-acyclic-paths var init-val-set goal-val reverse-dtg nil #{} true))
+  ([var init-val-set goal-val reverse-dtg plan-suffix stack-val-set can-use-free?]
+;     (println "FACP" var init-val-set goal-val)
+     (when (and (seq init-val-set) (not (contains? stack-val-set goal-val)))
+       (if (contains? init-val-set goal-val)
+           (cons plan-suffix
+                 (find-all-acyclic-paths var (disj init-val-set goal-val) goal-val reverse-dtg plan-suffix
+                                         stack-val-set can-use-free?))
+         (apply concat
+           (for [[pval actions] (get reverse-dtg goal-val)
+                 a              actions
+                 :let  [action-free? (not (contains? (:precond-map a) var))]
+                 :when (or (not action-free?) can-use-free?)]
+             (find-all-acyclic-paths var init-val-set pval reverse-dtg (cons a plan-suffix)
+                                     (conj stack-val-set goal-val) (and can-use-free? (not action-free?)))))))))
+
+
+(defn induce-vv-hla- [var goal-val init-sets]
+  (util/print-debug 2 "Inducing HLA to get" var "to val" goal-val "from" (init-sets var))
+  (let [inits        (init-sets var)
+        reverse-dtg  (*reverse-dtgs* var)
+        paths        (find-all-acyclic-paths var inits goal-val reverse-dtg)
+        refs-results (filter identity (map #(progress-refinement % init-sets ) paths))]
+    (if (and (util/singleton? refs-results) (util/singleton? (ffirst refs-results)))
+        (first (ffirst refs-results))
+      (when (seq refs-results)
+        (assert (apply = (map util/keyset (map second refs-results)))) ;; Otherwise, no-effect not handled properly when not in PC.
+        (SAS-VV-HLA var goal-val
+                    (set (for [[ref _] refs-results, a ref, v (precond-var-set a)] v))
+                    init-sets
+                    (apply merge-with clojure.set/union (map second refs-results))
+                    (map first refs-results))))))
+
+)


New support for demultiplexing R2 from paired reads and QC filtered R1 demuxed reads

error: pathspec 'src/aerobio/htseq/paired.clj' did not match any file(s) known to git

--- src/aerobio/htseq/paired.clj
+++ src/aerobio/htseq/paired.clj
@@ -0,0 +1,113 @@
+;;--------------------------------------------------------------------------;;
+;;                                                                          ;;
+;;               A E R O B I O . H T S E Q . P A I R E D                    ;;
+;;                                                                          ;;
+;; Permission is hereby granted, free of charge, to any person obtaining    ;;
+;; a copy of this software and associated documentation files (the          ;;
+;; "Software"), to deal in the Software without restriction, including      ;;
+;; without limitation the rights to use, copy, modify, merge, publish,      ;;
+;; distribute, sublicense, and/or sell copies of the Software, and to       ;;
+;; permit persons to whom the Software is furnished to do so, subject to    ;;
+;; the following conditions:                                                ;;
+;;                                                                          ;;
+;; The above copyright notice and this permission notice shall be           ;;
+;; included in all copies or substantial portions of the Software.          ;;
+;;                                                                          ;;
+;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,          ;;
+;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF       ;;
+;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND                    ;;
+;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE   ;;
+;; LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION   ;;
+;; OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION    ;;
+;; WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.          ;;
+;;                                                                          ;;
+;; Author: Jon Anthony                                                      ;;
+;;                                                                          ;;
+;;--------------------------------------------------------------------------;;
+;;
+
+(ns aerobio.htseq.paired
+  [:require
+   [aerial.fs :as fs]
+   [aerial.utils.string :as str]
+   [aerial.utils.io :refer [letio] :as io]
+   [aerial.bio.utils.files :as bufiles]
+
+   [aerobio.params :as pams]])
+
+
+
+
+(defn rxy [rl]
+  (let [rv (str/split #":" rl)
+        [lane cell x] (->> rv (drop 3) (take 3))
+        y (->> 6 rv (str/split #" ") first)]
+    (str lane "-" cell "-" x "-" y)))
+
+(defn getr1-xyset [R1fq]
+  (letio [in (io/open-file R1fq :in)]
+    (loop [fqrec (bufiles/read-fqrec in)
+           r1xyset #{}]
+      (if (nil? (fqrec 0))
+        r1xyset
+        (recur (bufiles/read-fqrec in)
+               (conj r1xyset (rxy (fqrec 0))))))))
+
+;; base "/MiSeq/190515_M03632_0028_000000000-B29YM"
+;; datadir "Data/Intensities/BaseCalls"
+
+(defn demuxR2 [R1fq R2-infq R2-otfq]
+  (letio [r1xyset (getr1-xyset R1fq)
+          in (io/open-file R2-infq :in)
+          ot (io/open-file R2-otfq :out)]
+    (loop [fqrec (bufiles/read-fqrec in)
+           cnt 0]
+      (if (nil? (fqrec 0))
+        cnt
+        (let [r2xy (rxy (fqrec 0))
+              qcline (fqrec 3)]
+          (if #_(and (r1xyset r2xy) (pass-qcscore qcline 14 0.97))
+              (r1xyset r2xy)
+            (do
+              (bufiles/write-fqrec ot fqrec)
+              (recur (bufiles/read-fqrec in) (inc cnt)))
+            (recur (bufiles/read-fqrec in) cnt)))))))
+
+
+(defn R2fq-name [R1fq]
+  (let [dir (fs/dirname R1fq)]
+    (->> R1fq
+         fs/basename
+         (str/replace-re #"-R1" "-R2")
+         (fs/join dir))))
+
+
+(defn demux-R2-samp [eid samp]
+  (let [expoutdir (pams/get-params :scratch-base)
+        sampbase (fs/join expoutdir eid "Samples")
+        sampdir (fs/join sampbase samp)
+        R1fqs (fs/glob (fs/join sampdir "*R1.fastq.gz"))
+        fastqdir (fs/join expoutdir eid (pams/get-params :fastq-dirname))
+        R2infqs (fs/glob (fs/join fastqdir (str samp "*R2*.fastq.gz")))]
+    (doseq [R2-infq R2infqs]
+      (doseq [R1fq R1fqs]
+        (let [R2-otfq (R2fq-name R1fq)]
+          (println (apply format "%s -> %s : %s"
+                          (map fs/basename [R2-infq R1fq R2-otfq])))
+          (demuxR2 R1fq R2-infq R2-otfq))))))
+
+
+
+
+
+
+
+(comment
+  (demux-R2-samp "190515_M03632_0028_000000000-B29YM" "RTSP7BC02")
+  (demux-R2-samp "190515_M03632_0028_000000000-B29YM" "RTSP7BC03")
+  (demux-R2-samp "190515_M03632_0028_000000000-B29YM" "RTSP7BC05")
+
+  )
+
+
+


Remove constraint of quantization to 100%

remote: Support for password authentication was removed on August 13, 2021.
remote: Please see https://docs.github.com/en/get-started/getting-started-with-git/about-remote-repositories#cloning-with-https-urls for information on currently recommended modes of authentication.
fatal: Authentication failed for 'https://github.com/jtbeckha/alda.git/'


Bump up time between retries to > 11 seconds

If we're getting hit by a cached negative lookup taking 10 seconds before it's retried, this should make us wait longer than that between retries.

remote: Support for password authentication was removed on August 13, 2021.
remote: Please see https://docs.github.com/en/get-started/getting-started-with-git/about-remote-repositories#cloning-with-https-urls for information on currently recommended modes of authentication.
fatal: Authentication failed for 'https://github.com/democracyworks/email-works.git/'


hr bereizteko

hr bereizteko


Fix null pointer exception when removing projects

remote: Support for password authentication was removed on August 13, 2021.
remote: Please see https://docs.github.com/en/get-started/getting-started-with-git/about-remote-repositories#cloning-with-https-urls for information on currently recommended modes of authentication.
fatal: Authentication failed for 'https://github.com/bsmr-clojure/Nightcode.git/'


Add tests for rehydration on read & search


Working on contexts

Working on contexts

remote: Support for password authentication was removed on August 13, 2021.
remote: Please see https://docs.github.com/en/get-started/getting-started-with-git/about-remote-repositories#cloning-with-https-urls for information on currently recommended modes of authentication.
fatal: Authentication failed for 'https://github.com/lprefontaine/Boing.git/'


adding utilities

adding utilities

error: pathspec 'src/cljsfmt/util.cljs' did not match any file(s) known to git

--- src/cljsfmt/util.cljs
+++ src/cljsfmt/util.cljs
@@ -0,0 +1,38 @@
+(ns cljsfmt.util)
+
+(defn log
+  "Log a Clojure thing."
+  [thing]
+  (js/console.log (pr-str thing)))
+
+(defn js-log
+  "Log a JavaScript thing."
+  [thing]
+  (js/console.log thing))
+
+(defmacro import-def
+  "import a single fn or var
+   (import-def a b) => (def b a/b)
+  "
+  [from-ns def-name]
+  (let [from-sym# (symbol (str from-ns) (str def-name))]
+    `(def ~def-name ~from-sym#)))
+
+(defmacro import-vars
+  "import multiple defs from multiple namespaces
+   works for vars and fns. not macros.
+   (same syntax as potemkin.namespaces/import-vars)
+   (import-vars
+     [m.n.ns1 a b]
+     [x.y.ns2 d e f]) =>
+   (def a m.n.ns1/a)
+   (def b m.n.ns1/b)
+    ...
+   (def d m.n.ns2/d)
+    ... etc
+  "
+  [& imports]
+  (let [expanded-imports (for [[from-ns & defs] imports
+                               d defs]
+                           `(import-def ~from-ns ~d))]
+  `(do ~@expanded-imports)))


resource info form #134

resource info form
#134

error: pathspec 'src/cljs/swarmpit/component/service/info/resources.cljs' did not match any file(s) known to git

--- src/cljs/swarmpit/component/service/info/resources.cljs
+++ src/cljs/swarmpit/component/service/info/resources.cljs
@@ -0,0 +1,12 @@
+(ns swarmpit.component.service.info.resources
+  (:require [material.component :as comp]
+            [rum.core :as rum]))
+
+(rum/defc form < rum/static [{:keys [limit reservation]}]
+  [:div.form-service-view-group.form-service-group-border
+   (comp/form-section "Reservation")
+   (comp/form-item "CPU" (:cpu reservation))
+   (comp/form-item "MEMORY" (str (:memory reservation) " MB"))
+   (comp/form-section "Limit")
+   (comp/form-item "CPU" (:cpu limit))
+   (comp/form-item "MEMORY" (str (:memory limit) " MB"))])


add alternative derived-value impl that is disposable

error: pathspec 'src/org/martinklepsch/derived.cljc' did not match any file(s) known to git

--- src/org/martinklepsch/derived.cljc
+++ src/org/martinklepsch/derived.cljc
@@ -0,0 +1,72 @@
+(ns org.martinklepsch.derived)
+
+(defprotocol IDisposable
+  (dispose! [this]))
+
+(defrecord DerivedValue [sources sink k]
+  IDisposable
+  (dispose! [this]
+    (doseq [s sources]
+      (prn 'removing-watch s k)
+      (remove-watch s k))
+    this)
+  #?@(:cljs
+      [IDeref
+       (-deref [this]
+               (deref sink))]
+      :clj
+      [clojure.lang.IDeref
+       (deref [this]
+              (deref sink))]))
+
+(defn derived-value
+  ([refs key f]
+   (derived-value refs key f {}))
+  ([refs key f opts]
+   (let [{:keys [check-equals?]
+          :or {check-equals? true}} opts
+         recalc (case (count refs)
+                  1 (let [[a] refs] #(f @a))
+                  2 (let [[a b] refs] #(f @a @b))
+                  3 (let [[a b c] refs] #(f @a @b @c))
+                  #(apply f (map deref refs)))
+         sink   (atom (recalc))
+         watch  (if check-equals?
+                  (fn [_ _ _ _]
+                    (let [new-val (recalc)]
+                      (when (not= @sink new-val)
+                        (reset! sink new-val))))
+                  (fn [_ _ _ _]
+                    (reset! sink (recalc))))]
+     (doseq [ref refs]
+       (add-watch ref key watch))
+     (->DerivedValue refs sink key))))
+
+#?(:clj
+   (defmethod print-method DerivedValue [v ^java.io.Writer w]
+     (.write w "<<DerivedValue ")
+     (.write w (pr-str (into {} v)))
+     (.write w ">>")))
+
+(comment
+  (def a (atom {:a 1}))
+
+  (def b (atom {:b 1}))
+
+  (def der
+    (derived-atom [a b] :ab (fn [a b] (prn 'recomputing) (merge a b))))
+
+  (def derv
+    (derived-value [a b] :ab (fn [a b] (prn 'recomputing) (merge a b))))
+
+  @derv
+  (dispose! derv)
+
+  (swap! b update :b inc)
+
+  (pr-str (into {} (->DerivedValue nil nil nil)))
+  (pr (->DerivedValue nil nil nil))
+
+
+  )
+


First scraper pieces

First scraper pieces

error: pathspec 'src/servisne_info/scrape/ns_rs.clj' did not match any file(s) known to git

--- src/servisne_info/scrape/ns_rs.clj
+++ src/servisne_info/scrape/ns_rs.clj
@@ -0,0 +1,12 @@
+(ns servisne-info.scrape.ns-rs
+  (:require [net.cgrand.enlive-html :as en]))
+
+(defn info-links-page []
+  (en/html-resource (java.net.URL. "http://www.021.rs/Novi-Sad/Servisne-informacije/")))
+
+(defn info-links []
+  (map
+    #(->  % :attrs :href)
+    (en/select
+      (info-links-page)
+      [:div.najava :div.leading :a])))


remove silly test

remove silly test

remote: Support for password authentication was removed on August 13, 2021.
remote: Please see https://docs.github.com/en/get-started/getting-started-with-git/about-remote-repositories#cloning-with-https-urls for information on currently recommended modes of authentication.
fatal: Authentication failed for 'https://github.com/jsingle/restful-clojure.git/'


checking what node Client runs on

checking what node Client runs on

remote: Support for password authentication was removed on August 13, 2021.
remote: Please see https://docs.github.com/en/get-started/getting-started-with-git/about-remote-repositories#cloning-with-https-urls for information on currently recommended modes of authentication.
fatal: Authentication failed for 'https://github.com/jchli/jepsen-aurora.git/'


added axis rank scores implementation

added axis rank scores implementation

error: pathspec 'infant/src/infant/rank/rank.clj' did not match any file(s) known to git

--- infant/src/infant/rank/rank.clj
+++ infant/src/infant/rank/rank.clj
@@ -0,0 +1,28 @@
+(ns infant.rank.rank
+  (:require [infant.spec.spec :as sp]))
+
+(def preferred-bin-axis ::sp/x)
+(def preferred-temporal-axis ::sp/x)
+(def preferred-ordinal-axis ::sp/y)
+(def preferred-nominal-axis ::sp/y)
+(def preferred-facet ::sp/row)
+
+(def preferred-axes   {::sp/temporal preferred-temporal-axis
+                       ::sp/ordinal preferred-ordinal-axis
+                       ::sp/nominal preferred-nominal-axis})
+
+(defn set-name
+  [type channel]
+  (str type "-" channel))
+
+(defn init-scores
+  [preferred-axes]
+  (reduce (fn [x [k v]] (conj x {(set-name k v) -0.01})) {} preferred-axes))
+
+(defn get-score
+  [spec]
+  (let [scores (init-scores preferred-axes)
+        fields (::sp/fields spec)]
+    (reduce (fn [x y]
+              (+ x (get scores (set-name (::sp/type y) (::sp/channel y)) 0)))
+            0 fields)))


Components specs moved to their own ns

Components specs moved to their own ns

error: pathspec 'src/clj/hellhound/components/specs.clj' did not match any file(s) known to git

--- src/clj/hellhound/components/specs.clj
+++ src/clj/hellhound/components/specs.clj
@@ -0,0 +1,17 @@
+(ns hellhound.components.specs
+  "Spec definitions for `component` system live in here."
+  (:require [clojure.spec.alpha             :as s]
+            [hellhound.components.protocols :as protocols]))
+
+
+(s/def ::started? boolean?)
+(s/def ::requires (s/coll-of keyword?))
+(s/def ::inputs   (s/coll-of keyword?))
+
+(s/def ::instance #(satisfies? protocols/Lifecycle %))
+
+(s/def ::component-map
+  (s/keys :req [::instance]
+             :opt [::started? ::requires ::inputs]))
+
+(s/def ::components (s/map-of keyword? ::component-map))


Add example Hyper.

Add example Hyper.

error: pathspec 'src/cljs/quil_site/examples/hyper.cljs' did not match any file(s) known to git

--- src/cljs/quil_site/examples/hyper.cljs
+++ src/cljs/quil_site/examples/hyper.cljs
@@ -0,0 +1,48 @@
+(ns quil-site.examples.hyper
+  (:require [quil.core :as q :include-macros true]
+            quil-site.main ;DELETE
+            [quil.middleware :as m]))
+
+(defn setup []
+  (q/frame-rate 100)
+  (q/background 255)
+  (q/rect-mode :center)
+  {:r 0.0
+   :col 0})
+
+(defn tick [state]
+  (update-in state [:r] + 5.0))
+
+(defn flip [state]
+  {:r 0.0
+   :col (if (= 0 (:col state)) 255 0)})
+
+(defn update-state [state]
+  (if (< (:r state) 300)
+    (tick state)
+    (flip state)))
+
+(defn draw-state [state]
+  (q/stroke (:col state))
+  (let [hw (* 0.5 (q/width))
+        hh (* 0.5 (q/height))]
+    (dotimes [_ (quot (q/width) 10)]
+      (let [rand-ang (q/random 0 q/TWO-PI)
+            r (:r state)]
+        (q/line hh
+                hw
+                (+ hh (* (q/sin rand-ang) r))
+                (+ hw (* (q/cos rand-ang) r)))))))
+
+(defn run-sketch [host size] ;DELETE
+(q/sketch
+   :host host
+   :size [size size]
+   :setup setup
+   :update update-state
+   :draw draw-state
+   :middleware [m/fun-mode])
+) ;DELETE
+
+(quil-site.main/register-example! "hyper" "Erik Svedäng" run-sketch :interactive? false) ;DELETE
+


Minor bug fix in radial-coords regarding a missing space between - and y causing a symbol error.

remote: Support for password authentication was removed on August 13, 2021.
remote: Please see https://docs.github.com/en/get-started/getting-started-with-git/about-remote-repositories#cloning-with-https-urls for information on currently recommended modes of authentication.
fatal: Authentication failed for 'https://github.com/Yoshiyuka/cthulhu.git/'


Separated text outside double quotes

Separated text outside double quotes

remote: Support for password authentication was removed on August 13, 2021.
remote: Please see https://docs.github.com/en/get-started/getting-started-with-git/about-remote-repositories#cloning-with-https-urls for information on currently recommended modes of authentication.
fatal: Authentication failed for 'https://github.com/hudren/ebook-novel.git/'


[WM] fix memoization of core.async channels

OK, this was a fun one. What I *think* was going on here is that we were
memoizing the core.async channels returned by the search
fns. Sometimes (such as running the tests in my single-core Docker VM),
tests would fail on the second take from the memoed channel, which makes
sense. The craziest aspect is that, on my multi-core OS X host (I'm
assuming the number of cores has anything to do with this), the tests
passed. As though, if you hurry, you can take the same message from the
same channel twice in parallel on different threads. But who knows!

Anyway, this seems better?

remote: Support for password authentication was removed on August 13, 2021.
remote: Please see https://docs.github.com/en/get-started/getting-started-with-git/about-remote-repositories#cloning-with-https-urls for information on currently recommended modes of authentication.
fatal: Authentication failed for 'https://github.com/democracyworks/electorate-works.git/'


Reverting last commit

Reverting last commit

remote: Support for password authentication was removed on August 13, 2021.
remote: Please see https://docs.github.com/en/get-started/getting-started-with-git/about-remote-repositories#cloning-with-https-urls for information on currently recommended modes of authentication.
fatal: Authentication failed for 'https://github.com/iot-paas-home/telegram-iot-gateway.git/'


first tests for record invars

first tests for record invars

error: pathspec 'test/fogus/me/invariant_tests.clj' did not match any file(s) known to git

--- test/fogus/me/invariant_tests.clj
+++ test/fogus/me/invariant_tests.clj
@@ -0,0 +1,25 @@
+;;; invariant_tests.clj -- Contracts programming library for Clojure
+
+;; by Michael Fogus - http://fogus.me/fun/
+;; Sept 16, 2010
+
+;; Copyright (c) Michael Fogus, 2010. All rights reserved.  The use
+;; and distribution terms for this software are covered by the Eclipse
+;; Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
+;; which can be found in the file COPYING the root of this
+;; distribution.  By using this software in any fashion, you are
+;; agreeing to be bound by the terms of this license.  You must not
+;; remove this notice, or any other, from this software.
+
+(ns fogus.me.invariant-tests
+  (:use [fogus.me.trammel :only [defconstrainedrecord]])
+  (:use [clojure.test :only [deftest is]]))
+
+(defconstrainedrecord Foo [a 1 b 2]
+  [(every? number? [a b])]
+  Object
+  (toString [this] (str "record Foo has " a " and " b)))
+
+(deftest test-constrained-record
+  (is (= (:a (new-Foo :a 42 :b 108)) 42))
+  (is (= (:b (new-Foo :a 42 :b 108)) 108)))


add test for routes of old ui

add test for routes of old ui

error: pathspec 'backend/test/lambdaui/old_api_test.clj' did not match any file(s) known to git

--- backend/test/lambdaui/old_api_test.clj
+++ backend/test/lambdaui/old_api_test.clj
@@ -0,0 +1,56 @@
+(ns lambdaui.old-api-test
+  (:require [clojure.test :refer :all]
+            [org.httpkit.server :refer [run-server]]
+            [org.httpkit.client :as http]
+            [lambdaui.core :refer [pipeline-routes]]
+            [lambdaui.fixtures.pipelines :refer :all]
+            [clojure.data.json :refer [read-json]]
+            ))
+
+
+
+(def server-addr "http://localhost:8874")
+(def server-atom (atom nil))
+
+(defn server [] @server-atom)
+(defn url [path] (str server-addr path))
+
+(defn- stop-server! []
+  (when @server-atom (do (@server-atom) (reset! server-atom nil))))
+
+(defn- start-server! [pipeline]
+  (when @server-atom (@server-atom))
+  (reset! server-atom (run-server (pipeline-routes pipeline) {:port 8874}))
+  )
+
+(defn tmp-dir []
+  (lambdacd.util/create-temp-dir))
+
+(defn stop-server-fixture [test]
+  (let [pipe (lambdacd.core/assemble-pipeline simple-success-pipeline {:home-dir (tmp-dir)})]
+    (start-server! pipe)
+    (lambdacd.internal.execution/run (:pipeline-def pipe) (:context pipe)))
+
+  (test)
+  (stop-server!)
+
+  )
+
+(use-fixtures :each stop-server-fixture)
+
+
+
+(defn get-build [build-number builds]
+  (first (filter #(= build-number (:build-number %)) builds)))
+
+(deftest legacy-ui-routes
+  (testing "availability of legacy /api/builds"
+    (let  [{:keys [status headers body error] :as resp} @(http/get (url "/api/builds/") )]
+      (is (= 200 status))
+      (is (= {:build-number 1 :status "success"}
+             (select-keys (get-build 1 (read-json body)) [:build-number :status :out])))))
+  )
+
+
+
+


more fixes

more fixes

--- test/metabase/driver/query_processor_test.clj
+++ test/metabase/driver/query_processor_test.clj
@@ -997,27 +997,46 @@
 ;;; Nested Field in ORDER
 ;; Let's get all the tips Kyle posted on Twitter sorted by tip.venue.name
 (expect
-    [[446 "Cam's Mexican Gastro Pub"
-      {:mentions ["@cams_mexican_gastro_pub"], :tags ["#mexican" "#gastro" "#pub"], :service "twitter", :username "kyle"}]
-     [230 "Haight European Grill"
-      {:mentions ["@haight_european_grill"], :tags ["#european" "#grill"], :service "twitter", :username "kyle"}]
-     [319 "Haight Soul Food Pop-Up Food Stand"
-      {:mentions ["@haight_soul_food_pop_up_food_stand"], :tags ["#soul" "#food" "#pop-up" "#food" "#stand"], :service "twitter", :username "kyle"}]
-     [224 "Pacific Heights Free-Range Eatery"
-      {:mentions ["@pacific_heights_free_range_eatery"], :tags ["#free-range" "#eatery"], :service "twitter", :username "kyle"}]]
+    [[446
+      {:mentions ["@cams_mexican_gastro_pub"], :tags ["#mexican" "#gastro" "#pub"], :service "twitter", :username "kyle"}
+      "Cam's Mexican Gastro Pub is a historical and underappreciated place to conduct a business meeting with friends."
+      {:large "http://cloudfront.net/6e3a5256-275f-4056-b61a-25990b4bb484/large.jpg",
+       :medium "http://cloudfront.net/6e3a5256-275f-4056-b61a-25990b4bb484/med.jpg",
+       :small "http://cloudfront.net/6e3a5256-275f-4056-b61a-25990b4bb484/small.jpg"}
+      {:phone "415-320-9123", :name "Cam's Mexican Gastro Pub", :categories ["Mexican" "Gastro Pub"], :id "bb958ac5-758e-4f42-b984-6b0e13f25194"}]
+     [230
+      {:mentions ["@haight_european_grill"], :tags ["#european" "#grill"], :service "twitter", :username "kyle"}
+      "Haight European Grill is a horrible and amazing place to have a birthday party during winter."
+      {:large "http://cloudfront.net/1dcef7de-a1c4-405b-a9e1-69c92d686ef1/large.jpg",
+       :medium "http://cloudfront.net/1dcef7de-a1c4-405b-a9e1-69c92d686ef1/med.jpg",
+       :small "http://cloudfront.net/1dcef7de-a1c4-405b-a9e1-69c92d686ef1/small.jpg"}
+      {:phone "415-191-2778", :name "Haight European Grill", :categories ["European" "Grill"], :id "7e6281f7-5b17-4056-ada0-85453247bc8f"}]
+     [319
+      {:mentions ["@haight_soul_food_pop_up_food_stand"], :tags ["#soul" "#food" "#pop-up" "#food" "#stand"], :service "twitter", :username "kyle"}
+      "Haight Soul Food Pop-Up Food Stand is a underground and modern place to have breakfast on a Tuesday afternoon."
+      {:large "http://cloudfront.net/8f613909-550f-4d79-96f6-dc498ff65d1b/large.jpg",
+       :medium "http://cloudfront.net/8f613909-550f-4d79-96f6-dc498ff65d1b/med.jpg",
+       :small "http://cloudfront.net/8f613909-550f-4d79-96f6-dc498ff65d1b/small.jpg"}
+      {:phone "415-741-8726", :name "Haight Soul Food Pop-Up Food Stand", :categories ["Soul Food" "Pop-Up Food Stand"], :id "9735184b-1299-410f-a98e-10d9c548af42"}]
+     [224
+      {:mentions ["@pacific_heights_free_range_eatery"], :tags ["#free-range" "#eatery"], :service "twitter", :username "kyle"}
+      "Pacific Heights Free-Range Eatery is a wonderful and modern place to take visiting friends and relatives Friday nights."
+      {:large "http://cloudfront.net/cedd4221-dbdb-46c3-95a9-935cce6b3fe5/large.jpg",
+       :medium "http://cloudfront.net/cedd4221-dbdb-46c3-95a9-935cce6b3fe5/med.jpg",
+       :small "http://cloudfront.net/cedd4221-dbdb-46c3-95a9-935cce6b3fe5/small.jpg"}
+      {:phone "415-901-6541", :name "Pacific Heights Free-Range Eatery", :categories ["Free-Range" "Eatery"], :id "88b361c8-ce69-4b2e-b0f2-9deedd574af6"}]]
   (Q run against geographical-tips using mongo
-     return :data :rows (map (fn [[id source _ {venue-name :name}]] [id venue-name source]))
+     return :data :rows
      aggregate rows of tips
      filter and = source...service "twitter"
-     = source...username "kyle"
+                = source...username "kyle"
      order venue...name))

 ;; Nested Field in AGGREGATION
-(expect
-    {}
-    (Q run against geographical-tips using mongo
-       return :data :rows
-       aggregate distinct venue...name of tips))
+(expect 99
+  (Q run against geographical-tips using mongo
+     return :data :rows first first
+     aggregate distinct venue...name of tips))

 ;;; Nested Field in BREAKOUT


Add (mostly working) posterous theme

Add (mostly working) posterous theme

error: pathspec 'src/circle/web/views/posterous.clj' did not match any file(s) known to git

--- src/circle/web/views/posterous.clj
+++ src/circle/web/views/posterous.clj
@@ -0,0 +1,63 @@
+(ns circle.web.views.posterous
+  "Produces the posterous theme"
+  (:use [noir.core :only (defpartial)])
+  (:use [circle.web.views.common :only (layout)]))
+
+(declare posterous)
+
+;;; How to use this: At the repl, call (render). Paste the output into Posterous's advanced theming box. Hit save.
+
+(defn render []
+  (let [absolute-url "http://www.circleci.com/"
+        path "resources/posterous_theme.html"]
+    (hiccup.core/with-base-url absolute-url
+      (print (posterous)))))
+
+(defpartial posterous []
+  (layout {}
+   [:div#page_title_wrap
+    [:div#page_title
+     [:h3 "The Circle Blog"]]
+    [:div.clear]]
+   [:div#content_wrap
+    [:div#content
+     [:div#main_content_wide_wpadding.left
+      "{block:Posts}"
+      [:article {:class "post clearfix"
+                 :id "post_{PostID"}
+       [:header
+        [:section
+         "{block:NewDayDate}"
+         [:time {:datetime="{Year}-{MonthNumberWithZero}-{DayOfMonthWithZero}" :pubdate="pubdate"}
+          [:a {:href "{Permalink}"} "{Month} {DayOfMonth}, {Year}"]]
+         "{/block:NewDayDate}"]
+        [:h2
+         [:a {:href "{Permalink}"}]
+         "{Title}"]]
+       [:div.body
+        [:div.inner
+         "{Body}"]]
+       [:footer
+        "{block:List}"
+        "{block:TagList}"
+        [:section.tags
+         [:h1 "Filed under" [:span "&nbsp"]]
+         [:ul
+          "{block:TagListing}"
+          "
{TagName}
"
+          "{/block:TagListing}"]]
+        "{/block:TagList}"
+        "{/block:List}"
+        "{block:Responses}
+           {block:ResponsesShow}
+            {ResponseWidget}
+            {Responses}
+	    {ResponseForm}
+           {/block:ResponsesShow}
+          {/block:Responses}"]]
+      "{/block:Posts}"]
+     "{block:List}
+
+          {block:Pagination/}
+
+      {/block:List}"]]))


slightly more interesting sort criteria

slightly more interesting sort criteria

remote: Support for password authentication was removed on August 13, 2021.
remote: Please see https://docs.github.com/en/get-started/getting-started-with-git/about-remote-repositories#cloning-with-https-urls for information on currently recommended modes of authentication.
fatal: Authentication failed for 'https://github.com/talexand/kittens-gallery.git/'


core.clj: added

core.clj: added

error: pathspec 'src/elliot/core.clj' did not match any file(s) known to git

--- src/elliot/core.clj
+++ src/elliot/core.clj
@@ -0,0 +1,36 @@
+(ns elliot.core)
+
+(defn get-input []
+  (read-line))
+
+(defn change-input-fn [the-fn]
+  (defn get-input []
+    (the-fn)))
+
+(defn wait-on-user []
+  (get-input))
+
+(defn change-wait-on-user-fn [the-fn]
+  (defn wait-on-user []
+    (the-fn)))
+
+(defn put-output [output]
+  (println output))
+
+(defn change-output-fn [the-fn]
+  (defn put-output [output]
+    (the-fn output)))
+
+
+(defn create-daemon-img []
+  (put-output "Download img of the person")
+  (wait-on-user)
+  (put-output "Open up gimp")
+  (wait-on-user)
+  (put-output "Cut image and save as png")
+  (wait-on-user)
+  (put-output "Put image in resources/public/imgs/daemon_img.png")
+  (wait-on-user))
+
+
+(defn start [])


Rough out api namespace

Rough out api namespace

remote: Support for password authentication was removed on August 13, 2021.
remote: Please see https://docs.github.com/en/get-started/getting-started-with-git/about-remote-repositories#cloning-with-https-urls for information on currently recommended modes of authentication.
fatal: Authentication failed for 'https://github.com/terrancesnyder/engulf.git/'


Cover conversion with tests

Cover conversion with tests

error: pathspec 'test/clojure/clojurewerkz/cassaforte/conversion_test.clj' did not match any file(s) known to git

--- test/clojure/clojurewerkz/cassaforte/conversion_test.clj
+++ test/clojure/clojurewerkz/cassaforte/conversion_test.clj
@@ -0,0 +1,49 @@
+(ns clojurewerkz.cassaforte.conversion-test
+  (:import [java.util HashMap ArrayList HashSet])
+  (:require [clojurewerkz.cassaforte.conversion :refer :all]
+            [clojure.test :refer :all]))
+
+(deftest conversion-test
+  (testing "Map Conversion"
+    (let [java-map (HashMap. )]
+      (doto java-map
+        (.put "a" 1)
+        (.put "b" 2)
+        (.put "c" 3))
+      (is (= {"a" 1
+              "b" 2
+              "c" 3}
+             (to-clj java-map)))))
+
+  (testing "Empty Map Conversion"
+    (let [java-map (HashMap. )]
+      (is (= {}
+             (to-clj java-map)))))
+
+  (testing "List Conversion"
+    (let [java-list (ArrayList. )]
+      (doto java-list
+        (.add "a")
+        (.add "b")
+        (.add "c"))
+      (is (= ["a" "b" "c"]
+             (to-clj java-list)))))
+
+  (testing "Empty List Conversion"
+    (let [java-list (ArrayList. )]
+      (is (= []
+             (to-clj java-list)))))
+
+    (testing "List Conversion"
+    (let [java-list (HashSet. )]
+      (doto java-list
+        (.add "a")
+        (.add "b")
+        (.add "c"))
+      (is (= #{"a" "b" "c"}
+             (to-clj java-list)))))
+
+  (testing "Empty List Conversion"
+    (let [java-list (HashSet. )]
+      (is (= #{}
+             (to-clj java-list))))))


New messaging aspect for entities (Broadcast)


experiments in using nio directly:

experiments in using nio directly:

naive approach 1800 rq/s, compare with 3200 on backend directly

error: pathspec 'src/merlion/nio.clj' did not match any file(s) known to git

--- src/merlion/nio.clj
+++ src/merlion/nio.clj
@@ -0,0 +1,71 @@
+(ns merlion.nio
+  (:import [java.nio Buffer ByteBuffer]
+           [java.net InetSocketAddress]
+           [java.nio.channels SocketChannel ServerSocketChannel
+            Selector SelectionKey])
+  (:require [clojure.java.io :as io]
+            [clojure.pprint :refer [pprint]]
+            [clojure.core.async :as async
+             :refer [<! go chan >! close! alts!]]))
+
+(defn server-socket [port backends]
+  (let [ssc (ServerSocketChannel/open)
+        addr (InetSocketAddress. port)]
+    (.. ssc socket (bind addr))
+    (go (loop []
+          (let [sock (.accept ssc)
+                ports (map #(vector % sock) backends)]
+            (if (first (alts! ports))
+              (recur)
+              ))))))
+
+(defn copy-channel [in out buffer]
+  (let [bytes (.read in buffer)]
+    (when (> bytes -1)
+      (.flip buffer)
+      (.write out buffer)
+      (.clear buffer)
+      true)))
+
+(defn relay-to-backend [socketchannel host port]
+  (.configureBlocking socketchannel false)
+  (let [sbuffer (ByteBuffer/allocate 8192)
+        obuffer (ByteBuffer/allocate 8192)
+        bo (Selector/open)
+        skey (.register socketchannel bo SelectionKey/OP_READ)
+        outchannel (doto (SocketChannel/open)
+                     (.connect (InetSocketAddress. host port))
+                     (.configureBlocking false))
+        skey2 (.register outchannel bo SelectionKey/OP_READ)]
+    (loop []
+      (let [ready (.select bo)
+            keys (.selectedKeys bo)
+            key (first (seq keys))]
+        (when key
+          (.remove keys key)
+          (condp = (.channel key)
+            socketchannel
+            (when (copy-channel socketchannel outchannel sbuffer) (recur))
+            outchannel
+            (when (copy-channel outchannel socketchannel obuffer) (recur))))))
+    (.close outchannel)
+    (.close bo)
+    ))
+
+(defn backend-chan
+  "a channel that accepts nio SocketChannels and relays the data being sent to them onto a new connection to host:port"
+  [host port]
+  (let [ch (chan)]
+    (go
+      (loop []
+        (let [socketchannel (<! ch)]
+          (when socketchannel
+            (relay-to-backend socketchannel host port)
+            (.close socketchannel)
+            (recur)))))
+    ch))
+
+(defn bend [port]
+  (let [backend (backend-chan "127.0.0.1" 8023)]
+    (server-socket port [backend])
+    backend))


update subscription name

update subscription name

remote: Support for password authentication was removed on August 13, 2021.
remote: Please see https://docs.github.com/en/get-started/getting-started-with-git/about-remote-repositories#cloning-with-https-urls for information on currently recommended modes of authentication.
fatal: Authentication failed for 'https://github.com/starcity-properties/odin.git/'


Comment

Comment

--- examples/phonebook/src/phonebook/resources.clj
+++ examples/phonebook/src/phonebook/resources.clj
@@ -24,7 +24,7 @@
 ;; control definition does.

 ;; We must be very careful not to allow a rogue script on another
-;; website to hijack our cookies.
+;; website to hijack our cookies and destroy our phonebook!.
 (def access-control
   {:authentication
    {:realms


moved the code that coerces to a set to a single place, replaced other calls with new fn


Use consistent names

Use consistent names

remote: Support for password authentication was removed on August 13, 2021.
remote: Please see https://docs.github.com/en/get-started/getting-started-with-git/about-remote-repositories#cloning-with-https-urls for information on currently recommended modes of authentication.
fatal: Authentication failed for 'https://github.com/democracyworks/scheduled-message-works.git/'


rename arg

rename arg

remote: Support for password authentication was removed on August 13, 2021.
remote: Please see https://docs.github.com/en/get-started/getting-started-with-git/about-remote-repositories#cloning-with-https-urls for information on currently recommended modes of authentication.
fatal: Authentication failed for 'https://github.com/jeelabs/jet.git/'


fix failing test

fix failing test

remote: Support for password authentication was removed on August 13, 2021.
remote: Please see https://docs.github.com/en/get-started/getting-started-with-git/about-remote-repositories#cloning-with-https-urls for information on currently recommended modes of authentication.
fatal: Authentication failed for 'https://github.com/fhirbase/fhirterm.git/'


default fee percent to zero for migration


expand protocols

expand protocols

remote: Support for password authentication was removed on August 13, 2021.
remote: Please see https://docs.github.com/en/get-started/getting-started-with-git/about-remote-repositories#cloning-with-https-urls for information on currently recommended modes of authentication.
fatal: Authentication failed for 'https://github.com/michaelsbradleyjr/transwarp.git/'


Defer scale-munging for the station list.

remote: Support for password authentication was removed on August 13, 2021.
remote: Please see https://docs.github.com/en/get-started/getting-started-with-git/about-remote-repositories#cloning-with-https-urls for information on currently recommended modes of authentication.
fatal: Authentication failed for 'https://github.com/cstorey/nrod.git/'


cve_patches

error: pathspec 'src/cve_patches/cve_patches.clj' did not match any file(s) known to git

--- src/cve_patches/cve_patches.clj
+++ src/cve_patches/cve_patches.clj
@@ -0,0 +1,69 @@
+(ns atom-finder.cve-patches
+  (:require
+   [atom-finder.util :refer :all]
+   [atom-finder.classifier :refer :all]
+   [atom-finder.patch :refer :all]
+   [atom-finder.atom-stats :refer :all]
+   [atom-finder.atom-patch :refer :all]
+   [clojure.pprint :refer [pprint]]
+   [clojure.data.csv :as csv]
+   [clojure.java.io :as io]
+   [clj-jgit.porcelain :as gitp]
+   [clj-jgit.querying :as gitq]
+   [clj-jgit.internal :as giti]
+   [clj-cdt.clj-cdt :refer :all]
+   [clj-cdt.writer-util :refer :all]
+   [schema.core :as s]
+   [swiss.arrows :refer :all]
+   )
+  (:import
+   [atom_finder.classifier Atom]
+   [org.eclipse.jgit.lib ObjectReader Repository]
+   [org.eclipse.jgit.api Git]
+   [org.eclipse.jgit.revwalk RevCommit RevCommitList RevWalk]
+   [org.eclipse.jgit.treewalk TreeWalk filter.PathFilter]
+   [org.eclipse.cdt.core.dom.ast IASTTranslationUnit IASTNode]
+   [org.eclipse.cdt.internal.core.dom.parser ASTNode]
+   )
+  )
+
+
+(defn csv-to-maps [filename]
+  (with-open [reader (io/reader filename)]
+    (let [[header & csv-data] (csv/read-csv reader)]
+      (->> csv-data
+           (map (%->> (map vector header) (into {})))
+           doall))))
+
+(defn repo-name [git-repo-url]
+  (nth (re-find #"([^/]+?)(?:.git)?$" git-repo-url) 1))
+
+(def test-cve-repo-urls
+  #{"git://anongit.freedesktop.org/NetworkManager/NetworkManager"
+    "git://anongit.freedesktop.org/accountsservice"
+    "git://anongit.freedesktop.org/cairo"})
+
+(def test-cve-repos
+  (->> test-cve-repo-urls
+       (map repo-name)
+       (map #(vector (repo-name %1) (gitp/load-repo (str "src/cve_patches/repos/" %1))))
+       (into {})
+       )
+  )
+
+(def cve-patches (->> "src/cve_patches/frank_li_cve_patches.csv" csv-to-maps))
+
+(def cve-repo-hashes
+  (->> cve-patches
+       (map (%-> (get "git_repo_hash")))
+       distinct))
+
+;; Find all atoms in cve-patches
+'((->> cve-patches
+     (filter (%-> (get "git_repo_url") test-cve-repo-urls))
+     (take 10)
+     (map (fn [patch-map]
+            (let [repo (test-cve-repos (repo-name (patch-map "git_repo_url")))
+                  rev-commit (find-rev-commit repo (patch-map "git_commit_hash"))]
+            (parse-commit-for-atom repo atoms rev-commit))))
+     ))


remove unnecessary condition from conversion code

remote: Support for password authentication was removed on August 13, 2021.
remote: Please see https://docs.github.com/en/get-started/getting-started-with-git/about-remote-repositories#cloning-with-https-urls for information on currently recommended modes of authentication.
fatal: Authentication failed for 'https://github.com/fhirbase/fhirplace.git/'


pep-013

error: pathspec 'src/pep-013/solution1.clj' did not match any file(s) known to git


Make project namespacing consistent.

Make project namespacing consistent.