Penn problem reconfiguration and documentation.

--- src/clojush/problems/classification/penn.clj
+++ src/clojush/problems/classification/penn.clj
@@ -1,6 +1,6 @@
 ;; penn.clj
 ;;
-;; Lee Spector, lspector@hampshire.edu, 20170522
+;; Lee Spector, lspector@hampshire.edu, 20170607
 ;;
 ;; Adapted from bioavailibility.clj.

@@ -13,29 +13,73 @@
   (:require [clojure.string :as string]
             [clojure-csv.core :as csv]))

-(defn rmse
-  "Returns the root of the mean square error for use in error reporting."
-  [errors]
-  (sqrt (/ (apply + (map #(* % %)
-                         errors))
-           (count errors))))
+;; This problem file allows for experimentation with Penn Machine Learning Benchmarks problems,
+;; or other other problems with data in the Penn ML format.
+;;
+;; A random 50/50 split of the data will be created each time this is run, with one half of the
+;; split used for training and the other half reserved for testing, which is done only for to
+;; report on the best (lowest total training error) individual at the end of each generation.
+;;
+;; Although 50% of the data in the file is *available* for use in training, this implementation
+;; allows one to specify that only some proportion of that data is actually used. In addition,
+;; it allows for the specific subset of training that is used to be resampled each generation.
+;;
+;; Unlike most Clojush problems, this one contains parameters that cannot be set from the command
+;; line. This is because they are required for reading in the data, which currently happens when
+;; this file is loaded, before the command-line parameters are interpreted. This means that to
+;; change these aspects of the problem you must run it from the source code (not just including
+;; Clojush as a dependency in another project) and edit/save this file prior to running the
+;; system. Other parameters can still be set from the command line, overriding the parameters
+;; specified in the argmap definition below.
+;;
+;; Access to the input variables could, in principle, be handled in various ways. What is done
+;; here is to provide a boolean input for whether each input variable is each of the values
+;; that appear in the data. For example, for some of the target data files the variables in
+;; the data are all 0, 1, or 2. In this case, evolving programs will have access to three
+;; boolean inputs for each input variable. If a particular variable is 0 then these inputs
+;; will be true, false, false, while if it is 1 they will be false, true, false, and if it
+;; is 2 they will be false, false, true.
+;;
+;; Similarly, specification of the program output could, in principle, be handled in various
+;; ways. What is done here is to provide string literals for each of the values in the "CLASS"
+;; (output) column in the data, and to use the :string stack only for the purpose of accumulating
+;; instances of these literals, which act as votes. At the end of program execution, whichever
+;; literal occurs most frequently on the :string stack is taken to be the output of the program.
+;;
+;; Some of the values for standard pushgp parameters specified here, in the argmap definition
+;; below, are intended to help lineages weather the disruptions caused by generational resampling
+;; of the training data. Specifically, we specify the use of leaky lexicase selection with
+;; a high leakage value, and the production of some offspring with very low variation rates.
+
+;; Here are the three data-related parameters that can only be set here, in the source code:
+
+;; The data file, which must be in src/clojush/problems/classification/data/:
+(def data-file
+  ;"GAMETES_Epistasis_2-Way_20atts_0.4H_EDM-1_1.txt"
+  ;"a_5000s_2000her_0.1__maf_0.2_EDM-1_01.txt"
+  ;"xor_2_a_20s_1600_EDM-1_01.txt"
+  "xor_3_a_20s_1600_EDM-1_01.txt"
+  ;"xor_4_a_20s_1600_EDM-1_01.txt"
+  )
+
+;; The proportion of the training data that will be used to evaluate individuals each generation:
+(def training-proportion 0.2)
+
+;; A flag indicating whether the subset of the training data used for evaluation should be
+;; resampled each generation:
+(def resampling true)
+
+;; Here we define functions to read the data and to split it into training and testing sets.
+;; We also extract a subset of the full training set to use for evaluation if training-proportion
+;; is less than 1, and we store this in an atom so that we can update the training data
+;; if resampling is true.

 (defn read-data []
   "Reads data into a sequence of sequences."
-  (let [f (slurp* (str "src/clojush/problems/classification/data/"  ;; todo?: allow command-line arg
-                       ;"GAMETES_Epistasis_2-Way_20atts_0.4H_EDM-1_1.txt"
-                       ;"a_5000s_2000her_0.1__maf_0.2_EDM-1_01.txt"
-                       "xor_2_a_20s_1600_EDM-1_01.txt"
-                       ;"xor_3_a_20s_1600_EDM-1_01.txt"
-                       ;"xor_4_a_20s_1600_EDM-1_01.txt"
-                       ))
+  (let [f (slurp* (str "src/clojush/problems/classification/data/" data-file))
         lines (csv/parse-csv f :delimiter \tab)]
     (println "Total number of data lines:" (count lines))
     (mapv #(mapv read-string %) lines)))
-
-(def training-proportion 0.1) ;; proportion of training cases to use each generation
-
-(def resampling true)

 (defn define-fitness-cases
   "Returns a map with two keys: train and test. Train maps to a
@@ -63,9 +107,11 @@
      :train (vec (take (int (* training-proportion train-num)) (lshuffle all-training-cases)))
      :test all-testing-cases}))

-;; Define the fitness cases once per run, so that train and test
-;; subsets stay the same throughout a run.
 (def penn-fitness-cases (atom (define-fitness-cases)))
+
+;; The error function runs the program on the specified subset of the data, returning
+;; errors of 0 whenever the resulting string stack has the correct answer as its most
+;; frequent value, and 1 otherwise.

 (defn penn-error-function
   "Error function for the penn problem."
@@ -74,30 +120,23 @@
     (for [fitness-case (get @penn-fitness-cases fitness-set)]
       (let [inputs (:inputs fitness-case)
             target (:target fitness-case)
-            state (run-push program
-                            #_(loop [to-push (reverse inputs)
-                                   with-inputs (make-push-state)]
-                              (if (empty? to-push)
-                                with-inputs
-                                (recur (rest to-push)
-                                       (push-item (first to-push)
-                                                  :input
-                                                  with-inputs))))
-                            (assoc (make-push-state) :input inputs))
-        ;    top-string (top-item :string state)]
-        ;(if (string? top-string)
-        ;  (if (= top-string target) 0 1)
-        ;  10000)))))
-            [most second-most] (take 2 (reverse (sort-by val (frequencies (:string state)))))
+            push-state (run-push program (assoc (make-push-state) :input inputs))
+            [most second-most] (take 2 (reverse (sort-by val (frequencies (:string push-state)))))
             answer (if (or (not most)
                            (= (second most) (second second-most)))
                      nil
                      (first most))]
         (if (= answer target) 0 1)))))

+(defn rmse
+  "Returns the root of the mean square error for use in error reporting."
+  [errors]
+  (sqrt (/ (apply + (map #(* % %) errors))
+           (count errors))))

 (defn penn-report
-  "Customized generational report."
+  "Customized generational report for the penn problem, which also resamples (and prints)
+  the training cases if appropriate."
   [best population generation error-function report-simplifications]
   (let [best-program (not-lazy (:program best))
         best-test-errors (penn-error-function :test best-program)]
@@ -113,36 +152,44 @@
              #(assoc % :train (vec (take (count (:train %))
                                          (lshuffle (:all-train %))))))
       (println "New training cases:")
-      (println (:train @penn-fitness-cases)))
-    ))
+      (println (:train @penn-fitness-cases)))))

 (defn penn-initial-report
+  "Initial report function for the penn problem, which prints the training and testing cases."
   [argmap]
   (println "Train and test cases:")
   (println @penn-fitness-cases)
   (println ";;******************************"))

 (defn cycle-to-longest
+  "A utility for producing a collection with equal representation from multiple sequences.
+  The longest sequence will be included in its entirety, and shorter ones will be cycled
+  as necessary to produce the same number of elements."
   [& sequences]
   (let [max-count (apply max (map count sequences))]
     (vec (apply concat (map #(take max-count (cycle %)) sequences)))))

 (def penn-atom-generators
-  (cycle-to-longest (concat (distinct (mapv :target (:all-train @penn-fitness-cases))) ;; classes, for output
-                            (list (tag-instruction-erc [:exec :integer :boolean :string] 1000)
-                                  (tagged-instruction-erc 1000)
-                                  (fn [] (lrand-int 1000))))
-                    (for [n (map inc ;; inputs
-                                 (range (count (:inputs (first (:train @penn-fitness-cases))))))]
-                      (symbol (str "in" n)))
-                    (concat (registered-for-stacks [:exec :integer :boolean :parentheses])
-                            '(string_pop string_dup string_dup_times string_dup_items ;; just stack ops for strings, for outputs
-                                         string_swap string_rot string_flush string_eq string_stackdepth
-                                         string_yank string_yankdup string_shove string_empty))
-                    (map first ;; more of anything that usese booleans
-                         (filter (fn [[instr instr-fn]]
-                                   (some #{boolean} (:stack-types (meta instr-fn))))
-                                 @instruction-table))))
+  (cycle-to-longest
+    ;; input instructions
+    (for [n (map inc (range (count (:inputs (first (:train @penn-fitness-cases))))))]
+      (symbol (str "in" n)))
+    ;; output class strings
+    (distinct (mapv :target (:all-train @penn-fitness-cases)))
+    ;; other instructions and ephemeral random constants
+    (concat (registered-for-stacks [:exec :integer :boolean :parentheses])
+            ;; for strings, which are used only for output class literals, just stack instructions
+            '[string_pop string_dup string_dup_times string_dup_items  string_swap string_rot
+              string_flush string_eq string_stackdepth string_yank string_yankdup string_shove
+              string_empty]
+            [(tag-instruction-erc [:exec :integer :boolean :string] 1000)
+             (tagged-instruction-erc 1000)
+             (fn [] (lrand-int 1000))])
+    ;; more of anything that uses booleans
+    (map first
+         (filter (fn [[instr instr-fn]]
+                   (some #{boolean} (:stack-types (meta instr-fn))))
+                 @instruction-table))))

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Main call
@@ -155,36 +202,24 @@
    :evalpush-limit 1600
    :population-size 1000
    :max-generations 300
-   ;:parent-selection :lexicase
    :parent-selection :leaky-lexicase ;:lexicase
    :lexicase-leakage 0.5
-   ;:genetic-operator-probabilities {:alternation 0.2
-   ;                                 :uniform-mutation 0.2
-   ;                                 :uniform-close-mutation 0.1
-   ;                                 [:alternation :uniform-mutation] 0.5
-   ;                                 ;:genesis 0.1 ;***
-   ;                                 }
-   ;:genetic-operator-probabilities {:uniform-addition-and-deletion 0.45
-   ;                                 :uniform-combination-and-deletion 0.45
-   ;                                 :genesis 0.1}
-   ;:genetic-operator-probabilities {:uniform-addition-and-deletion 0.9
-   ;                                 :uniform-combination-and-deletion 0.1}
    :genetic-operator-probabilities {:uniform-addition-and-deletion 0.5
                                     :alternation 0.5}
-   :uniform-addition-and-deletion-rate [0.01 0.1]
-   :uniform-combination-and-deletion-rate 1 ;[1 1/2 1/4 1/8]
-   :alternation-rate [0.01 0.1]
-   :alignment-deviation [1 10 100]
-   :uniform-mutation-rate [0.01 0.1]
+   :uniform-addition-and-deletion-rate [0.001 0.01 0.1]
+   :alternation-rate [0.001 0.01 0.1]
+   :alignment-deviation [0 1 10 100]
    :problem-specific-report penn-report
    :problem-specific-initial-report penn-initial-report
    ;:print-behavioral-diversity true ;; requires maintaining @population-behaviors
    :report-simplifications 0
-   :final-report-simplifications 5000
+   :final-report-simplifications 1000
+   ;; === parameters for experimenting with age-mediated parent selection (AMPS)
    ;:age-mediated-parent-selection [0.05 0.5]
    ;:age-combining-function :max
    ;:age-combining-function :proportionate
    ;:age-combining-function :first-reuse
+   ;; === parameters for experimenting with autoconstruction
    ;:autoconstructive true
    ;:autoconstructive-genome-instructions :uniform
    ;:autoconstructive-diversification-test :three-gens-size-and-instruction


CMR-258: Made page-size optional in execute-query function.

--- src/cmr/search/data/elastic_search_index.clj
+++ src/cmr/search/data/elastic_search_index.clj
@@ -60,8 +60,9 @@

 (defn execute-query
   "Executes a query to find concepts. Returns concept id, native id, and revision id."
-  [context query page-size]
+  [context query & [page-size]]
   (let [{:keys [concept-type]} query
+        page-size (or page-size 10)
         results (send-query-to-elastic context (q2e/query->elastic query) concept-type page-size)]
     (rc/elastic-results->query-results concept-type results)))


pages-in-month sorts by date

pages-in-month sorts by date

--- src/yablog/page.clj
+++ src/yablog/page.clj
@@ -61,9 +61,11 @@
   (time/within? interval (:date page) ))

 (defn pages-in-month [y m pages]
-  (filter (partial page-in-date-interval?
-                   (date-interval-for y m))
-          (vals pages)))
+  (sort-by :date
+           (org.joda.time.DateTimeComparator/getInstance)
+           (filter (partial page-in-date-interval?
+                            (date-interval-for y m))
+                   (vals pages))))

 (defn find-page [y m slug pages]
   (get pages (str "/" y "/" m "/" slug)))


review changes

review changes

--- src/clj/org/openforis/ceo/db/projects.clj
+++ src/clj/org/openforis/ceo/db/projects.clj
@@ -366,15 +366,13 @@
                                     (str/replace #"X|LONGITUDE|LONG|CENTER_X" "LON")
                                     (str/replace #"Y|LATITUDE|CENTER_Y" "LAT"))
                                hr))
-            header-set (set headers)]
+            header-diff (set/difference (set must-include) set headers)]
         (cond
-          (not (set/subset must-include header-set))
-          (init-throw (str "Header fields "
-                           (str/join "," (set/difference (set must-include) header-set))
-                           " are missing. "))
-
           (not (str/includes? header-row ","))
           (init-throw "The CSV file must use commas for the delimiter.")
+
+          (seq header-diff)
+          (init-throw (str "Header fields " header-diff " are missing."))

           :else
           (do


CMR-3203 Change map-n-all to partition-all

--- search-app/src/cmr/search/services/humanizers_service.clj
+++ search-app/src/cmr/search/services/humanizers_service.clj
@@ -30,7 +30,7 @@

 (defn- rfms->umm-collections
   [context rfms]
-  (lazy-seq (map #(rfm->umm-collection context %) rfms)))
+  (map #(rfm->umm-collection context %) rfms))

 (defn- get-all-collections
   "Retrieves all collections from the Metadata cache"
@@ -41,7 +41,7 @@
     ;(map #(rfm->umm-collection context %) (metadata-cache/all-cached-revision-format-maps context)))
   (let [[t1 rfms] (u/time-execution (metadata-cache/all-cached-revision-format-maps context))]
     (debug "Get rfms" t1)
-    (let [[t2 collections] (u/time-execution (lazy-seq (u/map-n-all #(rfms->umm-collections context %) n rfms)))]
+    (let [[t2 collections] (u/time-execution (map #(rfms->umm-collections context %) (partition-all n rfms)))]
       (debug "Convert to collections" t2)
       collections)))

@@ -104,7 +104,7 @@
                          (apply concat humanized-rows))]
           (debug "write " (count rows) "rows to csv")
           (csv/write-csv string-writer rows)
-        (debug "Write humanizer report of " (count humanized-rows) " rows"
+        (debug "Write humanizer report of " (count rows) " rows"
                "In batches of size " n
                "get-all-collections:" t1
                "get humanized rows:" t2


New tests: parse-int-overflow and parse-int-bad-input

--- test/zg/config_test.clj
+++ test/zg/config_test.clj
@@ -89,3 +89,16 @@
     "Check the behaviour of function zg.config/parse int."
     (is (= Integer/MAX_VALUE (parse-int "2147483647"))))

+(deftest test-parse-int-overflow
+    "Check the behaviour of function zg.config/parse int."
+    (are [x] (thrown? NumberFormatException x)
+        (parse-int "2147483648")
+        (parse-int "-2147483649")))
+
+(deftest test-parse-int-bad-input
+    "Check the behaviour of function zg.config/parse int."
+    (are [x] (thrown? NumberFormatException x)
+        (parse-int "")
+        (parse-int "xyzzy")
+        (parse-int "+1")))
+


fixing dest path

fixing dest path

--- src/remote/capistrano.clj
+++ src/remote/capistrano.clj
@@ -24,20 +24,19 @@

 (import-logging)

-(defconstrainedrecord Capistrano [src args dst timeout]
-  "A capistrano remote agent"
-  []
+;; A capistrano remote agent
+(defrecord Capistrano [src args dst timeout]
   Remoter
   (setup [this]
          (when (exists? (dest-path src dst))
            (throw+ {:type ::old-code :message "Old code found in place, cleanup first"}))
          (mkdirs dst)
+         (copy src dst)
          (try
-           (sh- "cap" "-T" {:dir dst})
+           (sh- "cap" "-T" {:dir (dest-path src dst)})
            (catch Throwable e
              (error e)
-             (throw+ {:type ::cap-sanity-failed :message "Failed to run Capistrano sanity"})))
-         (copy src dst))
+             (throw+ {:type ::cap-sanity-failed :message "Failed to run Capistrano sanity"}))))
   (run [this]
        (info (dest-path src dst))
        (apply sh- "cap" (conj args {:dir (dest-path src dst) :timeout timeout})))


removed unused imports from server_render.clj

--- src/rum/server_render.clj
+++ src/rum/server_render.clj
@@ -2,7 +2,7 @@
   (:require
    [clojure.string :as str])
   (:import
-   [clojure.lang IPersistentVector ISeq Named Numbers Ratio Keyword PersistentArrayMap]))
+   [clojure.lang IPersistentVector ISeq Ratio Keyword]))

 (defn nothing? [element]
   (and (vector? element)


add comment referencing clojure bugs

add comment referencing clojure bugs

--- src/main/clojure/clojure/tools/reader.clj
+++ src/main/clojure/clojure/tools/reader.clj
@@ -514,6 +514,8 @@
     ret))

 (defn- syntax-quote-coll [type coll]
+  ;; We use sequence rather than seq here to fix http://dev.clojure.org/jira/browse/CLJ-1444
+  ;; But because of http://dev.clojure.org/jira/browse/CLJ-1586 we still need to call seq on the form
   (let [res (list 'clojure.core/sequence
                   (list 'clojure.core/seq
                         (cons 'clojure.core/concat


Changed the delay of scheduler from 1 to 2 mins

--- src/shuppet/scheduler.clj
+++ src/shuppet/scheduler.clj
@@ -54,7 +54,7 @@
   []
   (when-not (contains? environments "local") ;dont want the auto scheduler for our test envs
     (doseq [environ environments]
-      (at-at/after (* 1 60 1000)
+      (at-at/after (* 2 60 1000)
                    #(schedule environ)
                    (get-pool environ)
                    :desc (rfc2616-time)))))


fix Exercise 1.10

fix Exercise 1.10


(SERVER-977) move delete-certificate-request! return schema into def

--- src/clj/puppetlabs/puppetserver/certificate_authority.clj
+++ src/clj/puppetlabs/puppetserver/certificate_authority.clj
@@ -96,6 +96,10 @@

 (def CertificateRevocationList
   (schema/pred utils/certificate-revocation-list?))
+
+(def OutcomeInfo
+  "Generic map of outcome & message for API consumers"
+  {:outcome (schema/enum :success :not-found :error) :message schema/Str})

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; Definitions
@@ -991,8 +995,7 @@
         (autosign-certificate-request! subject csr settings)
         (fs/delete (path-to-cert-request csrdir subject))))))

-(schema/defn ^:always-validate delete-certificate-request!
-  :- {:outcome (schema/enum :success :not-found :error) :message schema/Str}
+(schema/defn ^:always-validate delete-certificate-request! :- OutcomeInfo
   "Delete pending certificate requests for subject"
   [{:keys [csrdir]} :- CaSettings
    subject :- schema/Str]


removing ELB in favour of ALB for public slaves

--- src/terraboot/cluster.clj
+++ src/terraboot/cluster.clj
@@ -247,10 +247,8 @@
            public-slave-instance-type
            subnet-cidr-blocks
            mesos-ami
-           public-slave-elb-listeners
-           public-slave-elb-sg
-           public-slave-elb-health
            public-slave-alb-listeners
+           public-slave-alb-sg
            account-number]}]
   (let [vpc-unique (vpc-unique-fn vpc-name)
         vpc-id-of (id-of-fn vpc-unique)
@@ -309,14 +307,13 @@
                                      {:allow-all-sg (cluster-id-of "aws_security_group" "slave-security-group")}
                                      {:allow-all-sg (cluster-id-of "aws_security_group" "master-security-group")})

-             (apply (partial cluster-security-group "public-slave-elb" {}) public-slave-elb-sg)
-             (apply (partial cluster-security-group "public-apps-alb" {}) public-slave-elb-sg)
+             (apply (partial cluster-security-group "public-slave-alb-sg" {}) public-slave-alb-sg)

              (cluster-security-group "public-slave-security-group" {}
                                      {:allow-all-sg (cluster-id-of "aws_security_group" "master-security-group")}
                                      {:allow-all-sg (cluster-id-of "aws_security_group" "public-slave-security-group")}
                                      {:allow-all-sg (cluster-id-of "aws_security_group" "slave-security-group")}
-                                     {:allow-all-sg (cluster-id-of "aws_security_group" "public-slave-elb")}
+                                     {:allow-all-sg (cluster-id-of "aws_security_group" "public-slave-alb-sg")}
                                      {:port 5001
                                       :cidr_blocks [vpc-cidr-block]})

@@ -481,20 +478,10 @@
                    :alb [{:name "public-apps"
                           :listeners (map #(assoc % :account-number account-number) public-slave-alb-listeners)
                           :subnets elb-subnets
-                          :security-groups (concat [(cluster-id-of "aws_security_group" "public-slave-elb")
+                          :security-groups (concat [(cluster-id-of "aws_security_group" "public-slave-alb-sg")
                                                     (remote-output-of "vpc" "sg-allow-http-https")]
                                                    remote-default-sgs)}]
-                   :elb [{:name "public-slaves"
-                          :health_check {:healthy_threshold 2
-                                         :unhealthy_threshold 2
-                                         :target public-slave-elb-health
-                                         :timeout 5
-                                         :interval 30}
-                          :listeners (mapv elb-listener public-slave-elb-listeners)
-                          :subnets elb-subnets
-                          :security-groups (concat [(cluster-id-of "aws_security_group" "public-slave-elb")
-                                                    (remote-output-of "vpc" "sg-allow-http-https")]
-                                                   remote-default-sgs)}]})
+                   :elb []})

              (cluster-resource "template_file" "slave-user-data"
                                {:template (mesos-slave-user-data)


Remove posible race condition on page sync and history load.

--- src/uxbox/data/pages.cljs
+++ src/uxbox/data/pages.cljs
@@ -88,20 +88,29 @@

 ;; --- Sync Page

+(defrecord PageSynced [page]
+  rs/UpdateEvent
+  (-apply-update [this state]
+    (-> state
+        (assoc-in [:pages-by-id (:id page) :version] (:version page))
+        (stpr/assoc-page page))))
+
+(defn- page-synced?
+  [event]
+  (instance? PageSynced event))
+
 (defrecord SyncPage [id]
   rs/WatchEvent
   (-apply-watch [this state s]
     (println "SyncPage")
     (letfn [(on-success [{page :payload}]
-              (rx/of
-               #(assoc-in % [:pages-by-id id :version] (:version page))
-               #(stpr/assoc-page % page)))
+              (->PageSynced page))
             (on-failure [e]
               (uum/error (tr "errors.page-update"))
               (rx/empty))]
       (let [page (stpr/pack-page state id)]
         (->> (rp/do :update/page page)
-             (rx/mapcat on-success)
+             (rx/map on-success)
              (rx/catch on-failure))))))

 (defn sync-page
@@ -120,9 +129,13 @@
     (let [page (get-in state [:pages-by-id id])]
       (if (:history page)
         (rx/empty)
-        (rx/of (sync-page id)
-               (fetch-page-history id)
-               (fetch-pinned-page-history id))))))
+
+        (rx/merge
+         (rx/of (sync-page id))
+         (->> (rx/filter page-synced? s)
+              (rx/take 1)
+              (rx/mapcat #(rx/of (fetch-page-history id)
+                                 (fetch-pinned-page-history id)))))))))

 (defn update-page
   [id]


Added select-entries-within-period to query.

--- src/wealthpulse/query.clj
+++ src/wealthpulse/query.clj
@@ -8,12 +8,20 @@
   (let [entry-if-account-contains (fn [entry] #(if (.contains (string/lower-case (:account entry)) (string/lower-case %)) entry))]
     (filter #(some (entry-if-account-contains %) tokens) entries)))

+
 (defn exclude-entries-with
   "Returns vector of entries where entries with accounts containing one of the strings in exclude-accounts-with have been removed."
   [entries tokens]
   (let [entry-if-not-account-contains (fn [entry] #(if (not (.contains (string/lower-case (:account entry)) (string/lower-case %))) entry))]
     (filter #(some (entry-if-not-account-contains %) tokens) entries)))

+
+(defn select-entries-within-period
+  "Returns vector of entries where entry date is within period-start and period-end."
+  [entries & {:keys [period-start period-end]}]
+  (let [satisfies-period-start? #(or (nil? period-start) (>= (.compareTo (get-in % [:header :date]) period-start) 0))
+        satisfies-period-end? #(or (nil? period-end) (<= (.compareTo (get-in % [:header :date]) period-end) 0))]
+    (filter #(and (satisfies-period-start? %) (satisfies-period-end? %)) entries)))

 (defn balance


Factored out account-contains? from select-entries-with and exclude-entries-with.

--- src/wealthpulse/query.clj
+++ src/wealthpulse/query.clj
@@ -1,19 +1,23 @@
 (ns wealthpulse.query
   (:require [clojure.string :as string]))
+
+
+(defn account-contains?
+  "Returns a function to testing whether an entry account contains a token."
+  [entry]
+  #(.contains (string/lower-case (:account entry)) (string/lower-case %)))

 (defn select-entries-with
   "Returns vector of entries where account contains one of the strings in accounts-with."
   [entries tokens]
-  (let [entry-if-account-contains (fn [entry] #(if (.contains (string/lower-case (:account entry)) (string/lower-case %)) entry))]
-    (filter #(some (entry-if-account-contains %) tokens) entries)))
+  (filter #(some (account-contains? %) tokens) entries))

 (defn exclude-entries-with
   "Returns vector of entries where entries with accounts containing one of the strings in exclude-accounts-with have been removed."
   [entries tokens]
-  (let [entry-if-not-account-contains (fn [entry] #(if (not (.contains (string/lower-case (:account entry)) (string/lower-case %))) entry))]
-    (filter #(some (entry-if-not-account-contains %) tokens) entries)))
+  (filter #(not (some (account-contains? %) tokens)) entries))

 (defn select-entries-within-period


Clean up pair-sp switching.

Clean up pair-sp switching.

--- src/angelic/search/implicit/dash_astar.clj
+++ src/angelic/search/implicit/dash_astar.clj
@@ -43,8 +43,15 @@

 ;;   X --> Y ==> for all child keys k, child(X, k) --> child(Y, k)

-;; TODO: we seem to be losing sa/oc sometimes ...
-;; TODO: wrapping names don't match pair-stub1.  Drop them for now, restore?
+;; --> TODO: every SP should watch all subsuming SPs for children with matching
+;;     names, add these as subsumption parents.
+;; (Except any direct parents)
+;; --> TODO: this should happen as soon as stub is created, not have to wait for SP.
+;; This means that TS needs to know about stubs-in-training.
+
+;; TODO: wrapping names don't match pair-stub1.  Get rid of norm-name hack?
+
+

 (set! *warn-on-reflection* true)

@@ -52,6 +59,7 @@
 (def *collect-equal-outputs* true) ;; Collect identical output sets
 (def *decompose-cache*       true) ;; nil for none, or bind to hashmap
 (def *state-abstraction*     :eager ) ;; Or lazy or nil.
+(def *propagate-subusmption* false)

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -232,12 +240,27 @@
 (defn- sp-ts   [s] (tree-summarizer (stub s)))

 (defmethod print-method angelic.search.implicit.dash_astar.Subproblem [sp o]
-  (print-method (format "#<SP$%8h %s>" (System/identityHashCode (stub sp)) (sp-name sp)) o))
-
-(defn- add-sp-child! [sp child-sp]
+ (print-method (format "#<SP$%8h %s>" (System/identityHashCode (stub sp)) (sp-name sp)) o))
+
+(defn direct-sp? [sp] (= (ts-stub (sp-ts sp)) (stub sp)))
+
+(defn- add-sp-child!* [sp child-sp]
   (assert (not (terminal? sp)))
   (summaries/summary-changed-local! sp)
   (add-output! sp child-sp))
+
+(defn- add-sp-child! [sp child-sp]
+  (when (direct-sp? sp) #_ ::TODO)
+  (add-sp-child!* sp child-sp))
+
+(defn- add-sp-child-stub! [sp child-stub]
+  (when (direct-sp? sp) #_ ::TODO)
+  (connect-and-watch-stub! sp child-stub #(add-sp-child!* sp %)))
+
+(defn- add-sp-child-stub-up! [sp child-stub]
+  (when (direct-sp? sp) #_ ::TODO)
+  (connect-and-watch-stub-up! sp child-stub #(add-sp-child!* sp %)))
+

 (traits/deftrait simple-subproblem [stb out-set term? ri-fn] [] [watched-node]
   Subproblem (stub            [s] stb)
@@ -294,8 +317,7 @@
               (summaries/summary-changed! ret))
           (if (#{:SA :OC} (first (sp-name o)))
             (add-sp-child! ret o)
-            (connect-and-watch-stub! ret (make-output-collecting-stub (stub o))
-              #(add-sp-child! ret %)))))) ;; No update needed
+            (add-sp-child-stub! ret (make-output-collecting-stub (stub o)))))))
     ret))

@@ -345,7 +367,7 @@
         ret (traits/reify-traits
              [summaries/or-summarizable (simple-subproblem stb out (terminal? inner-sp) ri-fn)])]
     (connect-and-watch! ret inner-sp
-      (fn [o] (connect-and-watch-stub-up! ret (make-state-abstracted-stub (stub o) in) #(add-sp-child! ret %))))
+      (fn [o] (add-sp-child-stub-up! ret (make-state-abstracted-stub (stub o) in))))
     ret))

@@ -385,27 +407,20 @@

 ;; TODO: we keep reward for :blocked case
 ;; Note: weirdly, sometimes ignoring it helps. (not always)
+;; Three cases here: terminal, subsuming sp to piggyback, fresh.
 (defn- make-atomic-subproblem [stb out-set reward status]
   (let [inp-set  (input-set stb)
         ri-fn    (fn [s ri] (get-stub (stub-name stb) ri))]
-    (util/cond-let [subsuming-sp]
-      (not (= status :live))
-      (make-simple-subproblem
-       stb out-set true
-       (fn [s] (summary/make-simple-summary (min (summaries/get-bound s) reward) status s)) ri-fn)
-
-      ;; TODO: order?
-      (util/find-first #(not (terminal? %)) (subsuming-sps (tree-summarizer stb)))
+    (if (not (= status :live))
+      (let [leaf-s #(summary/make-simple-summary (min (summaries/get-bound %) reward) status %)]
+        (make-simple-subproblem stb out-set true leaf-s ri-fn))
       (let [ret (make-simple-subproblem stb out-set false summaries/or-summary ri-fn)]
-        (connect-and-watch! ret subsuming-sp
-          (fn [sub-out]
-            (connect-and-watch-stub-up! ret (refine-input sub-out inp-set) #(add-sp-child! ret %))))
-        ret)
-
-      :else
-      (let [ret (make-simple-subproblem stb out-set false summaries/or-summary ri-fn)]
-        (doseq [child-name (map make-fs-seq-name (fs/child-seqs (second (stub-name stb)) inp-set))]
-          (connect-and-watch-stub! ret (get-stub child-name inp-set) #(add-sp-child! ret %)))
+        (if-let [subsuming-sps (seq (filter #(not (terminal? %)) (subsuming-sps (tree-summarizer stb))))]
+          (connect-and-watch! ret (apply min-key (comp summary/max-reward summaries/summary sp-ts) subsuming-sps)
+            (fn [sub-out]
+              (add-sp-child-stub-up! ret (refine-input sub-out inp-set))))
+          (doseq [child-name (map make-fs-seq-name (fs/child-seqs (second (stub-name stb)) inp-set))]
+            (add-sp-child-stub! ret (get-stub child-name inp-set))))
         ret))))

 ;; Note: this is double-stage to lazily generate children.  Could be simpler single-stage.
@@ -453,37 +468,38 @@

 (declare make-pair-stub1 make-pair-stub2)

+
+
+(defn init-pair-sp! [sp r? l-sp r-sp]
+  (let [ss (summaries/make-sum-summarizer (if r? [(sp-ts l-sp) r-sp] [l-sp (sp-ts r-sp)]))]
+    (summaries/connect! sp ss)
+    (let [[watch stub-f] (if r? [r-sp #(make-pair-stub2 l-sp (stub %))]
+                                [l-sp #(make-pair-stub2 % (refine-input r-sp (output-set %)))])]
+      (add-watcher! watch
+        (fn [o]
+          (summaries/summary-changed-local! ss)
+          (add-sp-child-stub-up! sp (stub-f o)))))))
+
 ;; Note: disconnect is needed since blocked trumps live.
 ;; TODO: get rid of disconnect -- just need to kill at the right time ?
 ;; Note: this is the only place logic depends on summary.  Potential for problems?
 (defn- make-pair-subproblem [stb left-sp right-sp]
   (let [expand-right? (and (summary/solved? (summaries/summary left-sp)) (empty? (get-outputs left-sp)))
-        kids (if expand-right? [(sp-ts left-sp) right-sp] [left-sp (sp-ts right-sp)])
-        ss   (summaries/make-sum-summarizer kids)
         ret (make-simple-subproblem
              stb (output-set right-sp) false
-             (if (or expand-right? (not *collect-equal-outputs*)) summaries/or-summary
-                 (let [left-done? (atom false)] ;; Manually take into account left-solved, when no output message.
-                   (fn [s]
-                     (when (and (not @left-done?) (summary/solved? (summaries/summary left-sp))
-                                (empty? (get-outputs left-sp)))
-;                       (print ".")
-                       (reset! left-done? true)
-                       (summaries/disconnect! s ss )
-                        ;; Make sure we don't double count, because child will use tree-summarizer of left.
-                       (add-watcher! left-sp (fn [o] (def *bad* [stb left-sp right-sp])
-                                               (throw (RuntimeException. "Solved and children."))))
-                       (add-sp-child! s (get-stub-output! (make-pair-stub2 left-sp (stub right-sp)))))
-                     (summaries/or-summary s))))
+             (if (or expand-right? (not *collect-equal-outputs*)) ;; Switch to right when left solved, no output.
+               summaries/or-summary
+               (let [left-done? (atom false)]
+                 (fn [s]
+                   (when (and (not @left-done?) (summary/solved? (summaries/summary left-sp))
+                              (empty? (get-outputs left-sp)))
+                     (reset! left-done? true)
+                     (summaries/disconnect! s (util/safe-singleton (summaries/child-nodes s)))
+                     (add-watcher! left-sp (fn [o] (throw (RuntimeException. "Solved and children."))))
+                     (init-pair-sp! s true left-sp right-sp))
+                   (summaries/or-summary s))))
              (fn [s ri] (make-pair-stub1 (stub-name stb) (refine-input left-sp ri) #(refine-input right-sp %))))]
-    (summaries/connect! ret ss)
-    (let [[watch stub-f] (if expand-right?
-                           [right-sp #(make-pair-stub2 left-sp (stub %))]
-                           [left-sp #(make-pair-stub2 % (refine-input right-sp (output-set %)))])]
-      (add-watcher! watch
-         (fn [o]
-           (summaries/summary-changed-local! ss)
-           (connect-and-watch-stub-up! ret (stub-f o) #(add-sp-child! ret %)))))
+    (init-pair-sp! ret expand-right? left-sp right-sp)
     ret))


Eliminated another use of tabling.

Eliminated another use of tabling.

--- EkekoAspectJ/src/damp/ekeko/aspectj/weaverworld.clj
+++ EkekoAspectJ/src/damp/ekeko/aspectj/weaverworld.clj
@@ -366,13 +366,12 @@
 (def
   aspect-declaredsuper+
   "Relation between an aspect and one of the ancestors in its declared super hierarchy."
-  (tabled
-    [?aspect ?ancestor]
-    (conde
-      [(aspect-declaredsuper ?aspect ?ancestor) ]
-      [(fresh [?inbetween]
-              (aspect-declaredsuper+ ?aspect ?inbetween)
-              (aspect-declaredsuper ?inbetween ?ancestor))])))
+  [?aspect ?ancestor]
+  (conde
+    [(aspect-declaredsuper ?aspect ?ancestor) ]
+    [(fresh [?inbetween]
+              (aspect-declaredsuper ?aspect ?inbetween)
+              (aspect-declaredsuper+ ?inbetween ?ancestor))]))

 (defn
   aspect-declaredsuperaspect+


Added a way to configure the datastore service.

--- src/appengine_magic/services/datastore.clj
+++ src/appengine_magic/services/datastore.clj
@@ -1,6 +1,8 @@
 (ns appengine-magic.services.datastore
   (:import [com.google.appengine.api.datastore DatastoreService DatastoreServiceFactory
-            Key KeyFactory KeyRange
+            DatastoreServiceConfig DatastoreServiceConfig$Builder
+            ReadPolicy ReadPolicy$Consistency ImplicitTransactionManagementPolicy
+            Key KeyFactory
             Entity
             FetchOptions$Builder
             Query Query$FilterOperator Query$SortDirection]))
@@ -8,6 +10,16 @@

 (defonce *datastore-service* (atom nil))
 (defonce *current-transaction* nil)
+
+
+(defonce *datastore-read-policy-map*
+  {:eventual ReadPolicy$Consistency/EVENTUAL
+   :strong ReadPolicy$Consistency/STRONG})
+
+
+(defonce *datastore-implicit-transaction-policy-map*
+  {:auto ImplicitTransactionManagementPolicy/AUTO
+   :none ImplicitTransactionManagementPolicy/NONE})

 (defonce *filter-operator-map*
@@ -32,6 +44,23 @@
   (when (nil? @*datastore-service*)
     (reset! *datastore-service* (DatastoreServiceFactory/getDatastoreService)))
   @*datastore-service*)
+
+
+(defn init-datastore-service [& {:keys [deadline read-policy implicit-transaction-policy]}]
+  (let [datastore-config-object (DatastoreServiceConfig$Builder/withDefaults)]
+    (when deadline
+      (.deadline datastore-config-object deadline))
+    (when read-policy
+      (.readPolicy
+       datastore-config-object
+       (ReadPolicy. (get *datastore-read-policy-map* read-policy))))
+    (when implicit-transaction-policy
+      (.implicitTransactionManagementPolicy
+       datastore-config-object
+       (get *datastore-implicit-transaction-policy-map* implicit-transaction-policy)))
+    (reset! *datastore-service*
+            (DatastoreServiceFactory/getDatastoreService datastore-config-object))
+    @*datastore-service*))

 (defprotocol EntityProtocol


fixed colors in the ndvi graph presentation

--- src/clj/forma/presentation/ndvi_filter.clj
+++ src/clj/forma/presentation/ndvi_filter.clj
@@ -65,7 +65,6 @@
                             :legend true
                             :series-label "NDVI")))

-;; (c/set-stroke-color java.awt.Color/red)
 ;; Add the points indicating bad (read: unreliable) values on the
 ;; original NDVI time-series.

@@ -74,16 +73,21 @@
 ;; Create a new plot with the HP-filter to be updated by the slider,
 ;; based on the interpolated NDVI values.

-(def plot2
-  (doto (c/time-series-plot forma-range
-                            ;; (fix-time-series #{1} reli ndvi)
-                            (hp-filter (fix-time-series #{1} reli ndvi) 2)
-                            :title "NDVI and the H-P Filter"
-                            :x-label ""
-                            :y-label ""
-                            :legend true
-                            :series-label "Filtered NDVI")
-    (c/set-stroke-color java.awt.Color/blue)))
+(def plot2 (c/time-series-plot forma-range
+                               (hp-filter (fix-time-series #{1} reli ndvi) 2)
+                               :title "NDVI and H-P Filter"
+                               :x-label ""
+                               :y-label ""
+                               :legend true
+                               :series-label "H-P Filter"))
+
+;; Add a plot of the interpolated NDVI values to serve as the
+;; background to the updating slider.
+
+(c/add-lines plot2 forma-range (fix-time-series #{1} reli ndvi) :series-label "Conditioned NDVI")
+
+;; Add the slider to the original time-series plot, defined in the
+;; first definition of plot2

 (let [x forma-range]
   (c/slider #(i/set-data plot2
@@ -91,13 +95,10 @@
             (map (partial round-places 2) (range 0 20 0.1))
             "lambda"))

-;; Add a plot of the interpolated NDVI values to serve as the
-;; background to the updating slider.
+;; Add the original kill plots, just in case we want to show the
+;; original scale. Note that we can just turn this feature on and off.

-;; TODO Swap colors and the layering, so that the filter is on top.
-
-(c/add-lines plot2 forma-range (fix-time-series #{1} reli ndvi) :series-label "Conditioned NDVI")
+(c/add-points plot2 forma-range kill-vals :shape 1 :series-label "Unreliable Values in Original NDVI Series")

-


Drop outgoing blocks when ACK'd (WIP)

Drop outgoing blocks when ACK'd (WIP)

This happens in the wrong place, and it hasn't been tested

--- src/clojure/frereth_cp/message/helpers.clj
+++ src/clojure/frereth_cp/message/helpers.clj
@@ -30,7 +30,7 @@
            ::specs/transmissions]
     :as block}]
   {:pre [transmissions]}
-  (println "flag-acked-blocks:" start "-" stop "for" block)
+  (log/debug "flag-acked-blocks:" start "-" stop "for" block)
   (update
    (if (<= start
            start-pos
@@ -40,7 +40,17 @@
          (update ::specs/outgoing
                  (fn [cur]
                    (-> cur
-                       (assoc-in [::specs/blocks n ::specs/time] 0)
+                       ;; The reference implementation flags them
+                       ;; sent by setting the time to 0.
+                       ;; This seems like a terrible idea when I
+                       ;; do so much scheduling based on the earliest
+                       ;; block time.
+                       ;; Plus, this needs to update un-ackd-blocks
+                       ;; rather than the obsolete ::blocks
+                       #_(assoc-in [::specs/blocks n ::specs/time] 0)
+                       ;; Removing them doesn't match the intent of
+                       ;; the function. But it should do what I want.
+                       (update ::specs/un-ackd-blocks disj block)
                        (update ::specs/total-blocks inc)
                        (update ::specs/total-block-transmissions + transmissions)))))
      acc)
@@ -82,13 +92,13 @@
   [{{:keys [::specs/un-ackd-blocks
             ::specs/send-eof
             ::specs/send-eof-acked]} ::specs/outgoing
-    {:keys [::specs/message-loop-name]}
+    :keys [::specs/message-loop-name]
     :as state}
    start
    stop]
   (log/debug (str message-loop-name
-                  ": Setting ACK flags on blocks with addresses from"
-                  start "to" stop))
+                  ": Setting ACK flags on blocks with addresses from "
+                  start " to " stop))
   (if (not= start stop)
 ;;;           159-167: Flag these blocks as sent
 ;;;                    Marks blocks between start and stop as ACK'd


fix problem handling special parameter "all"

--- src/babel/espanol/writer.clj
+++ src/babel/espanol/writer.clj
@@ -53,24 +53,25 @@

         root-verb-array
         (reduce concat
-                (use-map-fn (fn [key]
-                              (get root-verbs key))
-                            (if lexeme
-                              [lexeme]
-                              (sort (keys root-verbs)))))]
+                (map (fn [key]
+                       (get root-verbs key))
+                     (if (and lexeme
+                              (not (= lexeme "all")))
+                       [lexeme]
+                       (sort (keys root-verbs)))))]
     (init-db)
     (write-lexicon "es" lexicon)
     (log/info (str "done writing lexicon."))
     (log/info (str "generating examples with this many verbs:"
-                   (.size root-verb-array)))
-    (.size
+                   (clojure.core/count root-verb-array)))
+    (doall
      (->> root-verb-array
           (use-map-fn
            (fn [verb]
              (log/debug (str "verb: " (strip-refs verb)))
-             (let [root-form (get-in verb [:espanol :espanol])
-                   spec {:root {:espanol {:espanol root-form}}}]
-               (log/info (str "generating with verb: '" root-form "'"))
+            (let [root-form (get-in verb [:espanol :espanol])
+                  spec {:root {:espanol {:espanol root-form}}}]
+              (log/info (str "generating with verb: '" root-form "'"))
                (writer/generate-from-spec
                 model (strip-refs spec)
                 (vals babel.espanol.grammar/tenses)


fix(frontend): minor fix on icon shape component

--- frontend/src/uxbox/main/ui/shapes/icon.cljs
+++ frontend/src/uxbox/main/ui/shapes/icon.cljs
@@ -66,7 +66,7 @@
                :width width
                :height height
                :preserve-aspect-ratio "none"
-               :dangerouslySetInnerHTML {:__html content}}
+               :dangerouslySetInnerHTML #js {:__html content}}

         attrs (merge props (attrs/extract-style-attrs shape))]
     [:g {:transform (str xfmt)}


Fix movement

Fix movement

--- src/try_lwjgl/logic.clj
+++ src/try_lwjgl/logic.clj
@@ -7,6 +7,7 @@
 (def mode (atom :angle-speed))
 (def player-position (atom [(float 0.0) (float 1.0) (float 10.0)]))
 (def player-direction (atom [(float 0.0) (float 0.0) (float 0.0)]))
+(def show-player? (atom false))

 (defn inc-angle []
   (swap! angle #(+ % @angle-speed)))
@@ -14,32 +15,39 @@
 (defn rotate-direction [direction axis angle]
   (assoc direction axis (+ (direction axis) angle)))

-(defn translate-with-direction [position direction]
-  ;; Direction, measured in 3 angles.
-  ;; (0, 0, 0) is origin, upright, facing -z
-  (let [[angle-x angle-y angle-z] direction
-        distance 1.0
-        [px py pz] position
-        dx (* -1.0 distance (Math/sin angle-y))
-        dy 0.0
-        dz (* -1.0 distance (Math/cos angle-y))
-        new-x (+ px dx)
-        new-y (+ py dy)
-        new-z (+ pz dz)]
-    [new-x new-y new-z]))
+(defn translate-with-direction
+  ([position direction] (translate-with-direction position direction (float 1.0)))
+  ([position direction distance]
+     ;; Direction, measured in 3 angles.
+     ;; (0, 0, 0) is origin, upright, facing -z
+     (let [[angle-x angle-y angle-z] direction
+           [px py pz] position
+           dx (* -1.0 distance (Math/sin angle-y))
+           dy 0.0
+           dz (* -1.0 distance (Math/cos angle-y))
+           new-x (+ px dx)
+           new-y (+ py dy)
+           new-z (+ pz dz)]
+       [new-x new-y new-z])))

-(defn print-info []
-  (println "player-position:" @player-position
-           ", player-direction:" @player-direction
-           ", direction point:" (translate-with-direction @player-position @player-direction)))
+(defn print-player []
+  (when @show-player?
+    (println "player-position:" @player-position
+             ", player-direction:" @player-direction
+             ", direction point:" (translate-with-direction @player-position @player-direction))))
+
+(defn player-moved []
+  (print-player))

 (defn key-left-down []
   (swap! player-direction #(rotate-direction % 1 0.1))
-  (print-info))
+  (player-moved)
+  @player-direction)

 (defn key-right-down []
   (swap! player-direction #(rotate-direction % 1 -0.1))
-  (print-info))
+  (player-moved)
+  @player-direction)

 (def up-down-callbacks
   {:angle-speed {:atom angle-speed, :amount 0.1}})
@@ -48,9 +56,7 @@
   (let [spec (type up-down-callbacks)
         value-atom (:atom spec)
         amount (:amount spec)]
-    (swap! value-atom #(identity (if up? (+ % amount) (- % amount))))
-    (println "New value:" @value-atom)
-    @value-atom))
+    (swap! value-atom #(identity (if up? (+ % amount) (- % amount))))))

 (defn key-up []
   (adjust-value @mode true))
@@ -62,17 +68,16 @@
   (println "Mode:" m)
   (swap! mode (fn [_] identity m)))

-(defn move [axis amount]
-  (swap! player-position (fn [pos]
-                           (let [old-val (pos axis)
-                                 new-val (+ old-val (* amount 1.0))]
-                             (assoc pos axis new-val)))))
+(defn move [direction amount]
+  (swap! player-position (fn [pp] (translate-with-direction pp direction amount)))
+  (player-moved)
+  @player-position)

 (defn move-sideways [amount]
-  (move 0 amount))
+  (move (rotate-direction @player-direction 1 (* -0.5 Math/PI)) amount))

 (defn move-forward [amount]
-  (move 2 (* -1.0 amount)))
+  (move @player-direction amount))

 (def listeners
   [{:key :left, :down? true, :repeat? false :callback key-left-down}
@@ -87,7 +92,7 @@
    ;; Debugging keys
    {:key :up, :down? true, :repeat? false :callback key-up}
    {:key :down, :down? true, :repeat? false :callback key-down}
-   {:key :1, :down? true, :repeat? false :callback (fn [] (set-mode :angle-speed))}
+   {:key :1, :down? true, :repeat? false :callback (fn [] (swap! show-player? #(not %)))}
    {:key :2, :down? true, :repeat? false :callback (fn [] (set-mode :eye-z))}])

 (defn register-listeners []
@@ -96,7 +101,8 @@

 (defn init []
   (input/init)
-  (register-listeners))
+  (register-listeners)
+  (print-player))

 (defn update [delta]
   (let [x (Mouse/getX)


Whitespace again

Whitespace again

--- src/useful/parallel.clj
+++ src/useful/parallel.clj
@@ -16,4 +16,4 @@
                (map (fn [slice]
                       (let [body (wrap-fn #(doall (map f slice)))]
                         (future-call body)))
-                    (slice *pcollect-thread-num* coll))))))+                    (slice *pcollect-thread-num* coll))))))


add reference to the documentation

add reference to the documentation

--- src/hu/ssh/github_changelog/conventional.clj
+++ src/hu/ssh/github_changelog/conventional.clj
@@ -1,6 +1,7 @@
 (ns hu.ssh.github-changelog.conventional
   (:require [clojure.string :as string]))

+; https://help.github.com/articles/closing-issues-via-commit-messages/
 (defn- fixes-pattern [pattern]
   (let [close-keywords ["close" "closes" "closed" "fix" "fixes" "fixed" "resolve" "resolves" "resolved"]]
     (re-pattern (format "(?i:%s) %s" (string/join \| close-keywords) pattern))))


Set lower defaults resource requiremens for dev profile.

--- backend/profiles.clj
+++ backend/profiles.clj
@@ -1,8 +1,9 @@
 {:dev
  {:plugins [[lein-ancient "0.6.10"]]
   :dependencies [[clj-http "2.1.0"]]
+  :jvm-opts ^:replace ["-Xms500m" "-Xmx500m" "-XX:+UseG1GC"]
   :main ^:skip-aot uxbox.main}

  :prod
- {:jvm-opts ^:replace ["-Xms4g" "-Xmx4g" "-XX:+UseG1GC"
+ {:jvm-opts ^:replace ["-Xms1g" "-Xmx1g" "-XX:+UseG1GC"
                        "-XX:+AggressiveOpts" "-server"]}}


improve comments for DimDraw

improve comments for DimDraw

--- src/main/clojure/conexp/layouts/dim_draw.clj
+++ src/main/clojure/conexp/layouts/dim_draw.clj
@@ -10,9 +10,13 @@
 (defn lt-seq
   "Constructs a constraint stating that at most `k` of the given variables `xs` are true.

-  This is from ??.
+  Input: A list `xs` of variables and a number `k`
+  Output: A CNF stating that at most k of the variables are true,
+  usable for rolling-stones sat solver.

-  Could be replaced by `rolling-stones.core/at-most`."      ; todo paper name
+  This is from \"Towards an optimal CNF Encoding of Boolean Cardinality
+  Constraints\", Carsten Sinz (2005).
+  Could be replaced by `rolling-stones.core/at-most`."
   ([xs k]
    (lt-seq xs k (Math/random)))
   ([xs k prefix]
@@ -38,10 +42,17 @@

 (defn sat-reduction
-  "Reduces the problem of finding a maximum bipartite subgraph to satisfiability.
+  "Reduces the problem of finding a maximum bipartite subgraph to satisfiability
+  and solves it.

+  The vertices of the graph get partitioned in 3 sets: `P_1`, `P_2` and `C`, s.t.
+  `P_1` and `P_2` constitute the bipartite graph and `C` has cardinality at most k.

-  As described in Section 5.2 of Dominik's paper."          ; todo paper name
+  Input: An undirected graph and optionally a maximum cardinality for `C`.
+  Output: The set to be removed from the graph s.t. the graph becomes bipartite.
+  nil, if there is no such set of cardinality at most `k`.
+
+  See Section 5.2, Dürrschnabel, Hanika, Stumme (2019) https://arxiv.org/abs/1903.00686"
   ([g]
    (first (drop-while #(= % nil) (map #(sat-reduction g %) (range)))))
   ([g k]
@@ -61,17 +72,16 @@
          C (if (= raw-solution nil)
              nil
              (map first (filter #(and (sat/positive? %) (= (% 1) 3)) raw-solution)))]
-     ;(println node-clauses)
-     ;(println edge-clauses)
-     ;(println no-more-than-k-bad-edges-clauses)
-     ;(println "solved:")
-     ;(println raw-solution)
-     ;(println C)
      C)))

 ;(sat-reduction (uber/graph [:a :b] [:a :c] [:b :e] [:c :e] [:a :e]) 1)

 (defn compute-conjugate-order
+  "For a given ordered set, computes the conjugate order.
+  This is a transitive orientation on the not-yet oriented pairs.
+  If that is not possible, returns nil.
+
+  See Section 5.2, Dürrschnabel, Hanika, Stumme (2019) https://arxiv.org/abs/1903.00686"
   ([graph]
     (compute-conjugate-order (lg/nodes graph) #(lg/has-edge? graph %1 %2)))
   ([P <=]
@@ -89,7 +99,7 @@
   The coordinates are returned in the form `[[e1 [x1 y1]] [e2 [x2 y2]] ...]`
   where e is the element, and x and y are the corresponding coordinates.

-  See paper of Dominik (2019)"                              ;todo paper name
+  See Section 5.2, Dürrschnabel, Hanika, Stumme (2019) https://arxiv.org/abs/1903.00686"
   ([graph]
    (compute-coordinates (lg/nodes graph) #(lg/has-edge? graph %1 %2)))
   ([P <=]


Corrects brand href.

Corrects brand href.

--- src/cadence/views/common.clj
+++ src/cadence/views/common.clj
@@ -52,7 +52,7 @@
        [:a.btn.btn-navbar
         {:data-toggle "collapse" :data-target ".nav-collapse"}
         [:span.icon-bar] [:span.icon-bar] [:span.icon-bar]]
-       [:a.brand.dropdown-toggle {:href "#"} "Cadence"]
+       [:a.brand.dropdown-toggle {:href "/"} "Cadence"]
        [:div.nav-collapse
         [:ul.nav
          (when (not (friend/anonymous?))


Bump storm version to 1.0.2

Bump storm version to 1.0.2

--- examples/redis/project.clj
+++ examples/redis/project.clj
@@ -3,8 +3,8 @@
   :target-path "_build"
   :min-lein-version "2.0.0"
   :jvm-opts ["-client"]
-  :dependencies  [[org.apache.storm/storm-core "1.0.1"]
-                  [org.apache.storm/flux-core "1.0.1"]]
+  :dependencies  [[org.apache.storm/storm-core "1.0.2"]
+                  [org.apache.storm/flux-core "1.0.2"]]
   :jar-exclusions     [#"log4j\.properties" #"org\.apache\.storm\.(?!flux)" #"trident" #"META-INF" #"meta-inf" #"\.yaml"]
   :uberjar-exclusions [#"log4j\.properties" #"org\.apache\.storm\.(?!flux)" #"trident" #"META-INF" #"meta-inf" #"\.yaml"]
-  )+  )


Enable branch switching and current branch visualization in branch-vis

--- src-cljs/cljs_workspace/om_branch_vis.cljs
+++ src-cljs/cljs_workspace/om_branch_vis.cljs
@@ -5,6 +5,7 @@
               :as morphic
               :refer [morph set-position set-fill set-extent add-morph remove-morph]]))

+(enable-console-print!)
 ;; utilities to render a branching unrolled linked list
 ;; into a visual tree view. Similar to the visualization
 ;; of branches in a git repository (ala Github)
@@ -29,43 +30,101 @@
 ;                                   V
 ;                                  {:id ... :data [ . . . . . { . . }]}

+(def current-branch-ref (atom nil)) ;; supplied by the user of the module
+(def branch-callback-fn (atom (fn [branch] (prn "Clicked on me!"))))
+
+(defn is-on-current [branch]
+  (if @current-branch-ref
+    (or (when (contains? branch :id)
+            (= (@current-branch-ref :id) (branch :id)))
+        (when (contains? branch :root)
+            (= @current-branch-ref (branch :root))))
+    false))
+
 (defn scale-branch-model [model max-width] model)

-(defn render-stub [start-point]
+(defn render-stub [branch start-point]
   [{ ; id nessecary? not for now... we do not alter the morph structure but just rerender it completely
     :morph {:MorphClass "Path"
-            :Position start-point}
+            :Position start-point
+            :onClick (fn [e]
+                        (prn "switching via stub click to branch " (branch :id))
+                        (@branch-callback-fn branch)
+                        false)}
     :shape {:ShapeClass "Path"
-            :StrokeWidth 10
-            :Fill "black"
+            :StrokeWidth 5
+            :Fill (if (is-on-current branch) "green" "black")
             :PathElements [{:x 0 :y 0}]}
             :submorphs []},
-            10])
+            20])
+
+(defn render-bubble [origin r fill]
+  {:morph {:Position origin}
+   :shape {:ShapeClass "Ellipse"
+           :Extent {:x r :y r}
+           :Fill fill}})

 (defn render-leaf [cont start-point]
-  [{ ; id nessecary? not for now... we do not alter the morph structure but just rerender it completely
-    :morph {:MorphClass "Path"
-            :Position start-point}
+  (let [fill (if (is-on-current cont) "green" "black")]
+    [{ ; id nessecary? not for now... we do not alter the morph structure but just rerender it completely
+      :morph {:MorphClass "Path"
+              :Position start-point
+              :onClick (fn [e]
+                          (if (contains? cont :root)
+                            (let [b (cont :root)]
+                              (prn "switching via leaf click to branch: " (b :id))
+                              (@branch-callback-fn b))
+                            (let [b cont]
+                              (prn "switching via stub leaf click to branch: " (b :id))
+                              (@branch-callback-fn b)))
+                          false)}
+      :shape {:ShapeClass "Path"
+              :StrokeWidth 5
+              :Fill fill
+              :PathElements [{:x 0 :y 0} {:x (count @(cont :data)) :y 0}]}
+              :submorphs [(render-bubble {:x (count @(cont :data)) :y -1} 10 fill)]}, ; place a cute bubble at the end :-)
+              20]))
+
+(defn smoothen [vertices]
+  ; interpolate last 2 edges,
+  ; by substituting the last 2 points with an arc
+  (prn "smoothening: " vertices)
+  (let [[middle end] (take-last 2 vertices)
+        half-point (- (end :x) (middle :x))
+        rounded-edge {:type :arc
+                      :anchors [(assoc middle :y (- (middle :y) half-point)) middle end]}]
+        (conj (into [] (drop-last 2 vertices)) rounded-edge)))
+
+(defn translat [op p1 p2]
+  {:x (op (p1 :x) (p2 :x)) :y (op (p1 :y) (p2 :y))})
+
+(defn create-arc [start end fill]
+  { :morph {:MorphClass "Path"
+            :Position start}
     :shape {:ShapeClass "Path"
-            :StrokeWidth 10
-            :Fill "black"
-            :PathElements [{:x 0 :y 0} {:x (count cont) :y 0}]}
-            :submorphs []},
-            10])
+            :StrokeWidth 5
+            :Fill fill
+            :PathElements (smoothen (map #(translat - % start) [start (assoc end :x (start :x)) end]))}})

 (defn render-fork [branch cont fork start-point]
-  (let [end-point {:x (count branch) :y 0} ; based on start-point and number of entries
-        [cont-path cont-space] (render-branch @cont end-point) ; we have a fork, return a path that visualizes branching
-        fork-start-point {:x (end-point :x) :y cont-space} ; based on end-point and space occupation of the cont
-        [fork-path fork-space] (render-branch @(fork :data) fork-start-point)]
+  (let [fill (if (is-on-current cont) "green" "black")
+        end-point {:x (count branch) :y 0} ; based on start-point and number of entries
+        [cont-path cont-space] (render-branch cont end-point) ; we have a fork, return a path that visualizes branching
+        fork-start-point {:x (+ (end-point :x) 10) :y cont-space} ; based on end-point and space occupation of the cont
+        [fork-path fork-space] (render-branch fork fork-start-point)
+        arc-path (create-arc end-point fork-start-point (get-in fork-path [:shape :Fill]))]
             [{; id nessecary? not for now... we do not alter the morph structure but just rerender it completely
              :morph {:MorphClass "Path"
-                     :Position start-point}
+                     :Position start-point
+                     :onClick (fn [e]
+                                (prn "switching via fork click to branch " (get-in cont [:root :id]))
+                                (@branch-callback-fn (cont :root))
+                                false)}
              :shape {:ShapeClass "Path"
-                     :StrokeWidth 10
-                     :Fill "black"
-                     :PathElements [{:x 0 :y 0} end-point fork-start-point]}
-             :submorphs [cont-path fork-path]},
+                     :StrokeWidth 5
+                     :Fill fill
+                     :PathElements [{:x 0 :y 0} end-point]}
+             :submorphs [cont-path arc-path fork-path]},
               (+ cont-space fork-space)]))

 (defn render-branch
@@ -74,32 +133,32 @@
      (render-branch branch {:x 0 :y 0}))
   ([branch start-point]
      ; check if the current branch has any entries
-     (if-let [end (last branch)]
+     (if-let [end (last @(branch :data))]
         (if-let [cont (end :cont)] ; check for fork
           (let [fork (end :fork)]
-            (render-fork branch cont fork start-point))
+            (render-fork @(branch :data) cont fork start-point))
           (render-leaf branch start-point))
-        (render-stub start-point) ; this brunch has no entries yet
+        (render-stub branch start-point) ; this brunch has no entries yet
       )
   ))

-(defn render-tree [tree div-id]
+(defn render-tree [tree branch branch-callback]
   ; idea, walk to the leaves of the tree, and then start traversing
   ; from there and end at the root. This way we can make sure, that we
   ; reserve enough space such that all branches are neatly spaced apart)
-  (let [[model space] (render-branch tree)
-      ; make the wrapper large enough to fit the whole tree
-         container {:id "branchView"
-                    :shape {:Extent {:x 400 :y space}}
-                    :morph {:Position {:x 50 :y 600} :isDraggable true}
-                    :submorphs [(scale-branch-model model 400)]}]
+  (when (not= @current-branch-ref branch) (prn "have to recolor!"))
+  (reset! current-branch-ref branch)
+  (reset! branch-callback-fn branch-callback)
+  (let [[model space] (render-branch tree)]
       ; render stuff with om...
       (prn container)
-      (reset! branch-view container)))
+      (swap! branch-view assoc :submorphs [(scale-branch-model model 400)])))

 (def branch-view (atom
-  {:id "branchView", :shape {:Extent {:x 400, :y 10}}, :morph {:Position {:x 50 :y 600} :isDraggable true}, :submorphs [{:morph {:MorphClass "Path", :Position {:x 0, :y 0}}, :shape {:ShapeClass "Path", :PathElements [{:x 0, :y 0} {:x 57, :y 0}] :Fill "black" :StrokeWidth 10}, :submorphs []}]}
-  ))
+  {:id "branchView"
+   :shape {:Extent {:x 400 :y 100}}
+   :morph {:Position {:x 50 :y 50} :isDraggable true}
+   :submorphs []}))

 (om/root
   (fn [app owner]


Timer text.

Timer text.

--- ui/src/ui/core.cljs
+++ ui/src/ui/core.cljs
@@ -98,6 +98,38 @@
                                  :strokeWidth "4px"}
                      :transform (str "rotate(-90," x "," y")")}))))

+(defn timer-text [data owner]
+  (reify
+    IDisplayName
+    (display-name [_]
+      "The time text")
+    IInitState
+    (init-state [_]
+      {:elapsed-seconds 0
+       :elapsed-minutes 0
+       :elapsed-hours 0})
+    IWillMount
+    (will-mount [_]
+      (go-loop []
+        (let [start (om/get-state owner :start)
+              interval-seconds (/ (time/in-millis (time/interval start (time/now))) 1000)]
+          (om/update-state! owner :elapsed-minutes #(mod (/ interval-seconds 60) 60))
+          (om/update-state! owner :elapsed-hours #(mod (/ interval-seconds 60 60) 24)))
+        (<! (async/timeout 1000))
+        (recur)))
+    IRenderState
+    (render-state [_ {x :x y :y sec :elapsed-seconds min :elapsed-minutes hr :elapsed-hours}]
+      (let [min-only (= 0 (int hr))]
+        (dom/text #js {:x (if min-only
+                            (- x 50)
+                            (- x 130))
+                       :y (+ y 25)
+                       :fill "blue"
+                       :style #js {:fontSize "90px"}}
+                  (if min-only
+                    (str (int min) "m")
+                    (str (int hr) "h " (int min) "m")))))))
+
 (defn timer-view [data owner]
   (reify
     IDisplayName
@@ -120,7 +152,8 @@
                  (circle x y r "white")
                  (om/build timer-minutes nil {:init-state timer-dim})
                  (om/build timer-hours nil {:init-state timer-dim})
-                 (om/build timer-seconds nil {:init-state timer-dim}))))))
+                 (om/build timer-seconds nil {:init-state timer-dim})
+                 (om/build timer-text nil {:init-state timer-dim}))))))

 (defn menu-view [data owner]
   (reify


fix typo in last commit

fix typo in last commit

--- src/babel/english/morphology.cljc
+++ src/babel/english/morphology.cljc
@@ -335,8 +335,9 @@
    (let [number (get-in word '(:agr :number))
          person (get-in word '(:agr :person))]
      (and (= (get-in word [:infl]) :imperfect)
-          (string? (get-in word [:imperfect :3plur]))
-          (and (= person :3rd) (= number :plur))))
+          (string? (get-in word [:imperfect :3sing]))
+          (and (= person :3rd) (= number :sing))))
+
    (get-in word [:imperfect :3plur])
    (let [number (get-in word '(:agr :number))
          person (get-in word '(:agr :person))]


plural of 'company','army': y->ies

plural of 'company','army': y->ies

--- src/babel/english/morphology.cljc
+++ src/babel/english/morphology.cljc
@@ -771,7 +771,7 @@
          english-verb-phrase)))))

 (defn plural-en [english]
-  (if (re-find #"[rt][y]$" english) ;; city => cities
+  (if (re-find #"[mnrt][y]$" english) ;; city => cities
     (replace english #"[y]$" "ies")
     (if (re-find #"[cs][hsx]$" english) ;; brush => brushes; beach => beaches
       (str english "es")


analyze 2nd person singular present

analyze 2nd person singular present

--- src/babel/francais/morphology.clj
+++ src/babel/francais/morphology.clj
@@ -557,6 +557,17 @@
                                                          :person :3rd}}}
                                       :infl :present}}}
                 ]
+
+   ;; -er and -ir type verbs
+   #"^(\S+)es$" [{:replace-with "er" ;; parle -> parler
+                  :structure {:synsem {:subcat {:1 {:agr {:number :sing
+                                                          :person :2nd}}}
+                                       :infl :present}}}
+                 {:replace-with "ir" ;; dorme -> dormir
+                  :structure {:synsem {:subcat {:1 {:agr {:number :sing
+                                                          :person :2nd}}}
+                                       :infl :present}}}]
+
    }
   )


Board view is now freely placeable on the terminal

- added also an initialization routine

Signed-off-by: Stefan Marr <46f1a0bd5592a2f9244ca321b129902a06b53e03@stefan-marr.de>

--- Clojure/src/snake/board_view.clj
+++ Clojure/src/snake/board_view.clj
@@ -5,36 +5,42 @@

 (defn create-view
   "Create a new board view"
-  [{width :width height :height}]
+  [{width :width height :height} & {:keys [x y]}]
   (start-agent-and-initialize {:width  width
-                               :height height}))
+                               :height height
+                               :x x
+                               :y y}))
+
+(defn initialize-view
+  "Will just clean the terminal for now"
+  [agent-state]
+
+  (clean-terminal)
+  agent-state)

 (defn draw-borders
   "Draws the surrounding border of the board."
   [board-view]
   (let [{width  :width
-         height :height} board-view]
-    (println width)
-    (println height)
-    ; (println board-view)
-    (set-cursor 0 0)
+         height :height
+         x      :x
+         y      :y} board-view]
+
+    (set-cursor x y)
     (put "/")
     (put (string/repeat width "-"))
     (put "\\")

     (dotimes [i height]
-      (set-cursor 0           (+ i 1))
+      (set-cursor x             (+ y i 1))
       (put "|")
-      (set-cursor (+ width 1) (+ i 1))
+      (set-cursor (+ x width 1) (+ y i 1))
       (put "|"))

-    (put "\n")
-
+    (set-cursor x  (+ y height 1))
     (put "\\")
     (put (string/repeat width "-"))
-    (put "/"))
-  (flush)
-  (println "down with borders"))
+    (put "/")))

 (defmulti add-element :type)
   (defmethod add-element :apple


Eliminate sh unit tests

Eliminate sh unit tests

Can't run these across Win and OS X

--- Clojure/test/ambly/core_test.clj
+++ Clojure/test/ambly/core_test.clj
@@ -4,14 +4,6 @@
             [clojure.java.io :as io])
   (:import (java.net URL)
            (java.io File)))
-
-(deftest sh-test
-  (testing "Zero return value"
-    (is (= 0 (sh 1000 -1 "/bin/test" "a" "=" "a"))))
-  (testing "One return value"
-    (is (= 1 (sh 1000 -1 "/bin/test" "a" "=" "b"))))
-  (testing "Timeout"
-    (is (= :timeout (sh 10 :timeout "/bin/sleep" "1")))))

 (defn- form-ambly-bonjour-name
   [suffix]


Added :max-threads option to Jetty adapter (fixes #48)

--- ring-jetty-adapter/src/ring/adapter/jetty.clj
+++ ring-jetty-adapter/src/ring/adapter/jetty.clj
@@ -4,6 +4,7 @@
            (org.mortbay.jetty Server Request Response)
            (org.mortbay.jetty.bio SocketConnector)
            (org.mortbay.jetty.security SslSocketConnector)
+           (org.mortbay.thread QueuedThreadPool)
            (javax.servlet.http HttpServletRequest HttpServletResponse))
   (:require [ring.util.servlet :as servlet]))

@@ -59,13 +60,15 @@
   :keystore     - the keystore to use for SSL connections
   :key-password - the password to the keystore
   :truststore   - a truststore to use for SSL connections
-  :trust-password - the password to the truststore"
+  :trust-password - the password to the truststore
+  :max-threads  - the maximum number of threads to use (default 250)"
   [handler options]
   (let [^Server s (create-server (dissoc options :configurator))]
     (when-let [configurator (:configurator options)]
       (configurator s))
     (doto s
       (.addHandler (proxy-handler handler))
+      (.setThreadPool (QueuedThreadPool. (options :max-threads 250)))
       (.start))
     (when (:join? options true)
       (.join s))


Fixed bug causing a divide-by-zero error.

--- src/blutwurst/tuple_generator.clj
+++ src/blutwurst/tuple_generator.clj
@@ -33,8 +33,8 @@
         (find-generator-by-name override-name generators)))))

 (defn- build-dependency-selector-fn [generated-data dependency]
-  (let [targeted-table (first (filter #(and (= (-> % :table :schema) (:target-schema dependency))
-                                            (= (-> % :table :name) (:target-name dependency)))
+  (let [targeted-table (first (filter #(and (= (-> % :entity :schema) (:target-schema dependency))
+                                            (= (-> % :entity :name) (:target-name dependency)))
                                       generated-data))
         tuple-count (count (:tuples targeted-table))]
     (fn []


use the same null value "NOBODY" for *_token_document

also try to reduce duplication a bit

--- src/brainbot/nozzle/esconnect.clj
+++ src/brainbot/nozzle/esconnect.clj
@@ -14,35 +14,34 @@
             [clojurewerkz.elastisch.rest :as esr]
             [clojurewerkz.elastisch.rest.index :as esi]))

+(def ^:private token-document-null-value "NOBODY")
+
 ;; (esr/connect! "http://127.0.0.1:9200")
-
-(def mapping-types
-  {"doc" {:_all {:enabled false},
-          :properties
-          {:parent {:index "not_analyzed", :type "string", :store "yes"},
-           :tags {:index "not_analyzed",
-                  :type "string",
-                  :index_options "docs",
-                  :store true,
-                  :omit_norms true},
-           :lastmodified {:type "date", :store "yes"},
-           :content {:type "string", :store "yes"},
-           :title   {:type "string", :store "yes"},
-
-           :deny_token_document {:index "not_analyzed",
-                                 :type "string",
-                                 :store true,
-                                 :null_value "UNAUTHENTICATED"},
-           :allow_token_document {:index "not_analyzed",
-                                  :type "string",
-                                  :store true,
-                                  :null_value "NOBODY"}},
-          :_source {:enabled false}},
-   "dir" {:_all {:enabled false},
-          :properties
-          {:lastmodified {:type "date", :store "yes"},
-           :parent {:index "not_analyzed", :type "string", :store "yes"}},
-          :_source {:enabled false}}})
+(let [parent {:index "not_analyzed", :type "string", :store "yes"}
+      token {:index "not_analyzed",
+             :type "string",
+             :store true,
+             :null_value token-document-null-value}]
+  (def mapping-types
+    {"doc" {:_all {:enabled false},
+            :_source {:enabled false},
+            :properties
+            {:parent parent
+             :tags {:index "not_analyzed",
+                    :type "string",
+                    :index_options "docs",
+                    :store true,
+                    :omit_norms true},
+             :lastmodified {:type "date", :store "yes"},
+             :content {:type "string", :store "yes"},
+             :title   {:type "string", :store "yes"},
+             :deny_token_document token,
+             :allow_token_document token}},
+     "dir" {:_all {:enabled false},
+            :_source {:enabled false}
+            :properties
+            {:lastmodified {:type "date", :store "yes"},
+             :parent parent}}}))

 ;;; when sending around messages via rabbitmq we pass the lastmodified
 ;;; date as unix time (as integer). the field is called mtime while in
@@ -159,13 +158,13 @@
              {:lastmodified (mtime->lastmodified (:mtime e))
               :parent parent-id})))

-(defn simplify-permissions-for-es
-  [permissions]
-  (let [{allowed true denied false}
-            (misc/remap #(sort (set (map :sid %)))
-                        (group-by :allow permissions))]
-    {true (or allowed '("NOBODY"))
-     false (or denied '("UNAUTHENTICATED"))}))  ;; XXX why can't we have the same default values
+(let [default-value (list token-document-null-value)]
+  (defn simplify-permissions-for-es
+    [permissions]
+    (let [allow->sids (misc/remap #(sort (set (map :sid %)))
+                                  (group-by :allow permissions))]
+      {:allow (allow->sids true default-value)
+       :deny  (allow->sids false default-value)})))

 (defn get-tags-from-path
   [s]
@@ -186,8 +185,8 @@
               :content (get-in body [:extract :tika-content :text])
               :title title
               :tags (get-tags-from-path directory)
-              :allow_token_document (simple-perms true)
-              :deny_token_document (simple-perms false)
+              :allow_token_document (simple-perms :allow)
+              :deny_token_document (simple-perms :deny)
               :lastmodified (mtime->lastmodified (get-in entry [:stat :mtime]))})))


removed extra function

removed extra function

--- src/clj/forma/trends/analysis.clj
+++ src/clj/forma/trends/analysis.clj
@@ -10,13 +10,6 @@
             [incanter.core :as i]
             [incanter.stats :as s]
             [forma.schema :as schema]))
-
-(defn element-sum
-  "returns a vector of sums of each respective element in a vector of vectors,
-  i.e., a vector with the first element being the sum of the first
-  elements in each sub-vector."
-  [coll]
-  (apply (partial map +) coll))

 (defn ols-trend
   "returns the OLS trend coefficient from the input vector; an


Fix SEA Source and Midseason trace messages

--- src/clj/game/cards-operations.clj
+++ src/clj/game/cards-operations.clj
@@ -285,7 +285,9 @@

    "Midseason Replacements"
    {:req (req (:stole-agenda runner-reg))
-    :trace {:base 6 :msg "give the Runner X tags"
+    :trace {:base 6
+            :msg "give the Runner X tags"
+            :label "Give the Runner X tags"
             :effect (effect (tag-runner :runner (- target (second targets)))
                             (system-msg (str "gives the Runner " (- target (second targets)) " tags")))}}

@@ -450,7 +452,10 @@

    "SEA Source"
    {:req (req (:successful-run runner-reg))
-    :trace {:base 3 :msg "give the Runner 1 tag" :effect (effect (tag-runner :runner 1))}}
+    :trace {:base 3
+            :msg "give the Runner 1 tag"
+            :label "Give the Runner 1 tag"
+            :effect (effect (tag-runner :runner 1))}}

    "Shipment from Kaguya"
    {:choices {:max 2 :req can-be-advanced?}


Purring does not always indicate that a cat is happy. Cats will also purr loudly when they are distressed or in pain.

--- src/clj/quiz_site/routes/quiz.clj
+++ src/clj/quiz_site/routes/quiz.clj
@@ -82,8 +82,7 @@
 (defn create-quiz
   [& {:keys[params headers] :as args}]
   (log/debug "create-quiz")
-  (push-quiz params (:host headers))
-  )
+  (push-quiz params (:host (keywordize-keys headers))))

 (defn submit-answers
   [& {:keys[params] :as args}]


sort top level accounts in nested structure

--- src/clj_money/models/accounts.clj
+++ src/clj_money/models/accounts.clj
@@ -187,7 +187,13 @@
                       (remove :parent-id)
                       (map #(append-children % all))
                       (group-by :type))]
-     (map #(hash-map :type % :accounts (or (% grouped) [])) types))))
+     (map #(hash-map :type % :accounts (or
+                                         (->> grouped
+                                              %
+                                              (sort-by :name)
+                                              vec)
+                                         []))
+          types))))

 (defn update
   "Updates the specified account"


CLJS-452: clojure.browser.net, enable WebSockets

This does not add any new functionality it just cleans
up and exposes the WebSocket code should someone
want to leverage it.

--- src/cljs/clojure/browser/net.cljs
+++ src/cljs/clojure/browser/net.cljs
@@ -12,9 +12,9 @@
   clojure.browser.net
   (:require [clojure.browser.event :as event]
             [goog.json :as gjson])
-  (:import (goog.net XhrIo EventType)
-           (goog.net.xpc CfgFields CrossPageChannel)
-           goog.Uri))
+  (:import [goog.net XhrIo EventType WebSocket]
+           [goog.net.xpc CfgFields CrossPageChannel]
+           [goog Uri]))

 (def *timeout* 10000)

@@ -140,11 +140,10 @@
 ;; WebSocket is not supported in the 3/23/11 release of Google
 ;; Closure, but will be included in the next release.

-#_(defprotocol IWebSocket
-    (open? [this]))
+(defprotocol IWebSocket
+  (open? [this]))

-#_(extend-type goog.net.WebSocket
-
+(extend-type WebSocket
   IWebSocket
   (open? [this]
     (.isOpen this ()))
@@ -152,9 +151,9 @@
   IConnection
   (connect
     ([this url]
-       (connect this url nil))
+     (connect this url nil))
     ([this url protocol]
-       (.open this url protocol)))
+     (.open this url protocol)))

   (transmit [this message]
     (.send this message))
@@ -162,20 +161,20 @@
   (close [this]
     (.close this ()))

-  event/EventType
+  event/IEventType
   (event-types [this]
     (into {}
-          (map
-           (fn [[k v]]
-             [(keyword (. k (toLowerCase)))
-              v])
-           (merge
-            (js->clj goog.net.WebSocket/EventType))))))
+      (map
+        (fn [[k v]]
+          [(keyword (. k (toLowerCase)))
+           v])
+        (merge
+          (js->clj WebSocket.EventType))))))

-#_(defn websocket-connection
+(defn websocket-connection
   ([]
      (websocket-connection nil nil))
   ([auto-reconnect?]
      (websocket-connection auto-reconnect? nil))
   ([auto-reconnect? next-reconnect-fn]
-     (goog.net.WebSocket. auto-reconnect? next-reconnect-fn)))
+     (WebSocket. auto-reconnect? next-reconnect-fn)))


fix issue with missing card image in gameboard

--- src/cljs/netrunner/gameboard.cljs
+++ src/cljs/netrunner/gameboard.cljs
@@ -150,12 +150,13 @@
                                                 (put! zoom-channel cursor))
                              :on-mouse-leave #(put! zoom-channel false)
                              :on-click #(handle-card-click @cursor owner)}
-       (when-let [url (image-url cursor)]
-         (if flipped
-           [:img.card.bg {:src "/img/corp.png"}]
-           [:div
-            [:span.cardname title]
-            [:img.card.bg {:src url :onError #(-> % .-target js/$ .hide)}]]))
+       (if flipped
+         [:img.card.bg {:src "/img/corp.png"}]
+         [:div
+          [:span.cardname title]
+          (when-let [url (image-url cursor)]
+            [:img.card.bg {:src url :onError #(-> % .-target js/$ .hide)
+                           :onLoad #(-> % .-target js/$ .show)}])])
        [:div.counters
         (when (> counter 0) [:div.darkbg.counter counter])
         (when (> advance-counter 0) [:div.darkbg.advance.counter advance-counter])]


Make job management visible by default

Make job management visible by default

--- src/cljs/onyx_dashboard/core.cljs
+++ src/cljs/onyx_dashboard/core.cljs
@@ -23,6 +23,7 @@
          ; Component state will also handle lifecycle stuff inc default
          ; state when new job is loaded (assuming they're keyed differently)
          :visible {:job true
+                   :job-management true
                    :catalog true
                    :workflow true
                    :task false


Fix test name.

Fix test name.

--- test/cli4clj/test/cli.clj
+++ test/cli4clj/test/cli.clj
@@ -79,7 +79,7 @@
         out-string (test-cli-stdout #(start-cli cli-opts) test-cmd-input)]
     (is (= (expected-string ["3" "7" "11"]) out-string))))

-(deftest add-cmd-cli-interaction-cmd-error-test
+(deftest div-cmd-cli-interaction-cmd-error-test
   (let [cli-opts {:cmds {:div {:fn #(/ %1 %2)}}}
         test-cmd-input ["div 1 0"]
         out-string (test-cli-stderr #(start-cli cli-opts) test-cmd-input)]


cleanup

cleanup

--- src/clj/just_married/css.clj
+++ src/clj/just_married/css.clj
@@ -1,10 +1,6 @@
 (ns just-married.css
   (:require [garden.def :refer [defstyles defcssfn]]
             [garden.core :refer [css]]))
-
-;; for some reason this is not already available but at least it's
-;; very easy to define
-(defcssfn url)

 (def COLOR-PALLETTE
   {:amaranth "#E52B50"
@@ -71,8 +67,7 @@
                         :margin-right ".25em"
                         :vertical-align "-0.4em"}]

-   [:blockquote {;;:display "inline" ;; TODO: check if we need this as well
-                 :background (:quote-background COLOR-PALLETTE)lock
+   [:blockquote {:background (:quote-background COLOR-PALLETTE)
                  :padding "0.5em 10px"
                  :font-size "1em"
                  :font-family (:open-sans FONT-FAMILIES)


Add simple create-arg-hint-completers test.

--- test/cli4clj/test/cli.clj
+++ test/cli4clj/test/cli.clj
@@ -154,3 +154,10 @@
     (is (= "My Custom Argument Description" (get-in result [:cmds :a :fn-args])))
     (is (= '[[summand1 summand2]] (get-in result [:cmds :b :fn-args])))))

+(deftest simple-create-arg-hint-completers-test
+  (let [cmd-map {:a {:fn-args [['x 'y 'z]]}
+                 :b {:fn-args "Test hint"}}
+        completers (create-arg-hint-completers cmd-map)]
+    (is (vector? completers))
+    (is (= 2 (count completers)))))
+


added predicate for record type

added predicate for record type

--- src/clj_ns_browser/utils.clj
+++ src/clj_ns_browser/utils.clj
@@ -213,6 +213,12 @@
   "Predicate that returns true when object o refers to a deftype, and false otherwise."
   [o]
   (isa? o clojure.lang.IType))
+
+
+(defn record?
+  "Predicate that returns true when object o refers to a defrecord, and false otherwise."
+  [o]
+  (isa? o clojure.lang.IRecord))

 (defn protocol-fn?
@@ -619,6 +625,7 @@
     (when (symbol? v) "<symbol> " )
     (when (var? v) "<var> " )
     (when (deftype? v) "<deftype> " )
+    (when (record? v) "<record> " )
     (when (class? v) "<class> " )
     (when (keyword? v) "<keyword> " )
     (when (coll? v) "<coll> " )


fixed utils.cljc

fixed utils.cljc

--- src/cljc/swarmpit/utils.cljc
+++ src/cljc/swarmpit/utils.cljc
@@ -14,16 +14,18 @@
               [(last p) (get-in m p)]))
        (into {})))

-(defn parse-int
-  [value]
-  "Return value if integer representation otherwise nil"
-  (let [parsed (js/parseInt value)]
-    (when (not (js/isNaN parsed))
-      parsed)))
+#?(:cljs
+   (defn parse-int
+     [value]
+     "Return value if integer representation otherwise nil"
+     (let [parsed (js/parseInt value)]
+       (when (not (js/isNaN parsed))
+         parsed))))

-(defn parse-float
-  [value]
-  "Return value if float representation otherwise nil"
-  (let [parsed (js/parseFloat value)]
-    (when (not (js/isNaN parsed))
-      parsed)))+#?(:cljs
+   (defn parse-float
+     [value]
+     "Return value if float representation otherwise nil"
+     (let [parsed (js/parseFloat value)]
+       (when (not (js/isNaN parsed))
+         parsed))))


fix bug with updating land count

fix bug with updating land count

--- src/cljs/mana_calc/core.cljs
+++ src/cljs/mana_calc/core.cljs
@@ -62,8 +62,8 @@
         [:input {:type "number"
                   :value (:lands @app-state)
                   :on-change (fn [e]
-                              (swap! app-state assoc :lands (int (.-target.value e))
-                                (mana-base-update!)))}]]]))
+                              (swap! app-state assoc :lands (int (.-target.value e)))
+                              (mana-base-update!))}]]]))

 (defn display-basic [color]
   (str


chat code refactoring

chat code refactoring

--- src/cljs/netrunner/chat.cljs
+++ src/cljs/netrunner/chat.cljs
@@ -7,8 +7,7 @@

 (def app-state
   (atom
-   {:active-channel [:general]
-    :channels {:general ["foobar" "spam eggs"]
+   {:channels {:general ["foobar" "spam eggs"]
                :belgium ["Vive la frite !" "On aime la biere ici."]
                :france ["Vive le pinard" "Et le petit jaune!"]}}))

@@ -38,38 +37,44 @@
      [:button {:on-click #(send-msg cursor owner)} "Send"]])))

 (defn channel-view [{:keys [channel active-channel]} owner]
-  (om/component
-   (sab/html
-    [:div {:class (if (= (first active-channel) channel) "active" "")
-           :on-click #(om/update! active-channel [channel])}
-     (str "#" (name channel))])))
-
-(defn channel-list-view [{:keys [channels active-channel]} owner]
-  (om/component
-   (sab/html
-    [:div.blue-shade.panel.channel-list {}
-     [:button.add {} "+"]
-     [:h4 {} "Channels"]
-     (for [ch (keys channels)]
-       (om/build channel-view {:channel ch :active-channel active-channel}))])))
+  (reify
+    om/IRenderState
+    (render-state [this state]
+      (sab/html
+       [:div {:class (if (= active-channel channel) "active" "")
+              :on-click #(put! (:channel-ch state) channel)}
+        (str "#" (name channel))]))))

 (defn message-view [message owner]
   (om/component
-   (sab/html [:div {} (str message)])))
+   (sab/html [:div (str message)])))

-(defn message-list-view [messages owner]
-  (om/component
-   (sab/html
-    [:div.blue-shade.panel.message-list
-     (om/build-all message-view messages)])))
+(defn chat [cursor owner]
+  (reify
+    om/IInitState
+    (init-state [this]
+      {:channel :general
+       :channel-ch (chan)})

-(defn chat-app [cursor owner]
-  (om/component
-   (sab/html
-    [:div.chat-app
-     (om/build channel-list-view cursor)
-     [:div.chat-box
-      (om/build message-list-view (get-in cursor [:channels (first (:active-channel cursor))]))
-      (om/build msg-input-view cursor)]])))
+    om/IWillMount
+    (will-mount [this]
+      (go (while true
+            (let [ch (<! (om/get-state owner :channel-ch))]
+              (om/set-state! owner :channel ch)))))

-(om/root chat-app app-state {:target (. js/document (getElementById "chat"))})
+    om/IRenderState
+    (render-state [this state]
+      (sab/html
+       [:div.chat-app
+        [:div.blue-shade.panel.channel-list
+         [:button.add "+"]
+         [:h4 "Channels"]
+         (for [ch (keys (:channels cursor))]
+           (om/build channel-view {:channel ch :active-channel (:channel state)}
+                     {:init-state {:channel-ch (:channel-ch state)}}))]
+        [:div.chat-box
+         [:div.blue-shade.panel.message-list
+          (om/build-all message-view (get-in cursor [:channels (:channel state)]))]
+         (om/build msg-input-view cursor)]]))))
+
+(om/root chat app-state {:target (. js/document (getElementById "chat"))})


ideas

ideas

--- src/cljs/triboard/ai/ai.cljs
+++ src/cljs/triboard/ai/ai.cljs
@@ -92,7 +92,7 @@
         hard-mode? (is-player-first? (:scores turn))
         ai ((if hard-mode? make-cheating-ai make-ai) (:player turn))]
     (game/play-at game
-      (time (best-move ai turn)) ;; TODO - Remove time
+      (time (best-move ai turn)) ;; TODO - Remove time + find a way to correlate with moves + sort then and take best
       )))


Only perform selection actions when the tree selection actually changes

--- src/clojure/nightcode/ui.clj
+++ src/clojure/nightcode/ui.clj
@@ -184,9 +184,8 @@
   ([^JTree tree ^String new-selection]
    ; put new data in the tree
    (.setModel tree (create-project-tree))
-   ; wipe out the in-memory expansion/selection
+   ; wipe out the in-memory expansions
    (reset! tree-expansions #{})
-   (reset! tree-selection nil)
    ; get the expansion/selection and apply them to the tree
    (let [expansion-set (utils/read-pref :expansion-set)
          selection (or new-selection (utils/read-pref :selection))]
@@ -200,5 +199,5 @@
          (when (= selection str-path)
            (.setSelectionPath tree tree-path)))))
    ; select the first project if there is nothing selected
-   (when (nil? @tree-selection)
+   (when (nil? (.getSelectionPath tree))
      (.setSelectionRow tree 0))))


Refactoring continuation-lines and datetimes.

They have a lot in common.

--- src/ahnentafel/gedcom/reading/semantic.clj
+++ src/ahnentafel/gedcom/reading/semantic.clj
@@ -20,52 +20,48 @@
                       (gedcom-zipper {:level -1 :tag "__ROOT__"})
                       records))))

+(defn- combine-locs
+  "Concatenate the value of LOC2 to that of LOC1 separated by SEPARATOR.
+Removes LOC2. Returns updated location."
+  [loc1 loc2 separator]
+  (let [node1 (zip/node loc1)
+        node2 (zip/node loc2)]
+    (-> loc1
+        (zip/replace (assoc node1
+                            :value (str (:value node1)
+                                        separator
+                                        (:value node2))))
+        zip/next
+        zip/remove)))
+
 (defn continuation-lines [tree]
   (letfn [(loc-tag [loc] (:tag (zip/node loc)))
           (continuation? [loc]
             (or (= (loc-tag loc) "CONC") (= (loc-tag loc) "CONT")))
           (continuation-connector [loc]
-            (if (= (loc-tag loc) "CONT") "\n" ""))
-          (add-continuation [loc cont-loc]
-            (let [node (zip/node loc)
-                  node-value (:value node)
-                  cont-value (:value (zip/node cont-loc))
-                  connector (continuation-connector cont-loc)]
-              (zip/replace loc
-                           (assoc node
-                                  :value (str node-value
-                                              connector
-                                              cont-value)))))]
+            (if (= (loc-tag loc) "CONT") "\n" ""))]
     (let [zip (gedcom-zipper tree)]
       (zip/root
        (loop [z zip]
          (cond (zip/end? z) z

                (continuation? (zip/next z))
-               (let [new-loc (add-continuation z (zip/next z))]
-                 (recur (-> new-loc zip/next zip/remove)))
+               (recur (combine-locs z (zip/next z)
+                                    (continuation-connector (zip/next z))))

                :otherwise
                (recur (zip/next z))))))))

+
+
 (defn datetimes [tree]
-  (letfn [(loc-tag [loc] (:tag (zip/node loc)))
-          (concat-locs [loc1 loc2]
-            (let [node1 (zip/node loc1)
-                  node2 (zip/node loc2)]
-              (-> loc1
-                  (zip/replace (assoc node1
-                                      :value (str (:value node1)
-                                                  " "
-                                                  (:value node2))))
-                  zip/next
-                  zip/remove)))]
+  (letfn [(loc-tag [loc] (:tag (zip/node loc)))]
     (loop [z (gedcom-zipper tree)]
       (cond (zip/end? z) (zip/root z)

             (and (= (loc-tag z) "DATE")
                  (= (loc-tag (zip/next z)) "TIME"))
-            (recur (concat-locs z (zip/next z)))
+            (recur (combine-locs z (zip/next z) " "))

             :otherwise
             (recur (zip/next z))))))


Revert "Use :envelope and :rel when showing resource/action"

This reverts commit 325e6b4d113588b9149409084b34cc182d24c76d.

--- src/cljs/gc_api_browser/schema_select.cljs
+++ src/cljs/gc_api_browser/schema_select.cljs
@@ -33,7 +33,7 @@
 (defn schema->resource-node [schema resource]
   (->> (:definitions schema)
        vals
-       (filter #(= (:envelope %) resource))
+       (filter #(= (:title %) resource))
        first))

 (defn format-example [example]
@@ -43,7 +43,7 @@
 (defn schema->action-node [schema resource action]
   (let [action (->> (schema->resource-node schema resource)
                     :links
-                    (filter #(= (:rel %) action))
+                    (filter #(= (:title %) action))
                     first)]
     (update-in action [:example] format-example)))

@@ -78,12 +78,12 @@
 (defn resource->actions [schema resource]
   (->> (schema->resource-node schema resource)
        :links
-       (map :rel)
+       (map :title)
        sort))

 (defn schema->resources [schema]
   (->> (vals (:definitions schema))
-       (map :envelope)
+       (map :title)
        sort))

 (defn read-as-text [file c]


refer-clojure :exclude count in cljs

refer-clojure :exclude count in cljs

--- src/cljx/jamesmacaulay/zelkova/signal.cljx
+++ src/cljx/jamesmacaulay/zelkova/signal.cljx
@@ -11,7 +11,7 @@

 #+cljs
 (ns jamesmacaulay.zelkova.signal
-  (:refer-clojure :exclude [merge])
+  (:refer-clojure :exclude [merge count])
   (:require [cljs.core :as core]
             [clojure.zip :as zip]
             [cljs.core.async :as async :refer [chan <! >!]]