An experiment with collection updates

bendlas.clj

(ns user.bendlas
  (:require [criterium.core :as crit]))

;; # Overview

;; ## Two new core operations

;; ### pretial -- partial for the first param

;; This is the main proposition: introduce an operation that lets one
;; partially bind clojure's collection functions

(defn pretial* [f & args]
  (fn [o] (apply f o args)))

;; ### apply-to -- start chains of pretials

;; This is the entry point for update functions
;; it's like a reverse comp, that fits in the update-fn slot:
;; (update-in x [y z] apply-to
;;            (pretial assoc :a :b)
;;            (pretial dissoc :c))

(defn apply-to* [x & fs]
  (reduce #(%2 %1) x fs))

;; ### rcomp seems to naturally fall out

(defn rcomp* [& fs]
  (apply pretial apply-to fs))

;; # Real World Implementation (tm)

;; ## defunrolled -- unroll varags

;; So this is a pretty cool macro, that I had wanted to write for some time

(defmacro defunrolled
  "Ever get that itch to unroll vararg functions for performance?
   Usage:
    (defunrolled comp*
      :unroll 3
      :more-arities ([args] `(apply comp* (for [as# (partition-all 3 ~args)]
                                            (apply comp* as#))))
      ([] identity)
      ([f] f)
      ([f & fs] (let [arg (gensym \"arg-\")]
                  `(fn* [~arg] ~(reduce #(list %2 %1) arg (reverse (cons f fs)))))))
   "
  [self & flags+arities]
  (let [{:keys [min unroll more-arities doc gen-fn]
         :or {min 0 unroll 8}}
        (loop [flags {} [f v :as fas] flags+arities]
          (cond
            (string? f)
            (recur (assoc flags :doc f) (next fas))
            (keyword? f)
            (recur (assoc flags f v) (nnext fas))
            :else
            (assoc flags :gen-fn (eval (cons 'fn* fas)))))
        fixed (vec (repeatedly min #(gensym "a-")))
        vars (repeatedly unroll #(gensym "v-"))]
    `(defn ~self ~@(when doc [doc])
       ~@(for [n-v (range (inc unroll))
               :let [args (into fixed (take n-v vars))]]
           (list args (apply gen-fn args)))
       ~@(when-let [gen (and more-arities
                             (eval (cons 'fn* more-arities)))]
           (let [vararg (gensym "va-")
                 args (into fixed vars)]
             [(list (into args ['& vararg])
                    `(let [~vararg (list* ~@args ~vararg)]
                       ~(gen vararg)))])))))

;; Look how it makes performance unrolls easy to define

(defunrolled pretial
  :min 1
  :more-arities ([args] `(apply pretial* ~args))
  ([f] f)
  ([f & args] `(fn* [o#] (~f o# ~@args))))

(defunrolled apply-to
  ;; yes, apply-to is in cljs already, please advise
  :min 1
  :more-arities ([args] `(apply apply-to* ~args))
  ([x & fs] (reduce #(list %2 %1) x fs)))

(defunrolled rcomp
  :more-arities ([args] `(apply rcomp* ~args))
  ([& fs] `(pretial apply-to ~@fs)))

;; OK, so now we should have pretty performant versions of
;; pretial, apply-to and rcomp, but what do they actually buy us?

;; See for yorself: Here is a nested tree update, of the like
;; that is pretty common:

(defn bench-base []
  (let [a (atom {:toplevel {:counter 2
                            :tree {:tag :root :content [{:tag :a}]}}})]
    (crit/quick-bench
     (swap! a
            (fn [r]
              (update r :toplevel
                      (fn [tl]
                        (-> tl
                            (update :counter inc)
                            (update-in [:tree :attrs] assoc
                                       :updater "was here"
                                       :added "attributes")
                            (update-in [:tree :content]
                                       (fn [c]
                                         (-> c
                                             (update 0 assoc-in [:attrs :updated] "attr")
                                             (conj {:tag :b :content ["Auto Inserted"]}))))))))))))

;; notice, how the indentation almost over-emphasizes the nested nature of the update
;; also, those nested fn's + -> are pretty useless information in and of themselves

;; Here is the same update in terms of pretial and apply-to

(defn bench-pretial [pretial apply-to rcomp]
  (let [a (atom {:toplevel {:counter 2
                            :tree {:tag :root :content [{:tag :a}]}}})]
    (crit/quick-bench
     (swap! a update :toplevel apply-to
            (pretial update :counter inc)
            (pretial update-in [:tree :attrs] assoc
                     :updater "was here"
                     :added "attributes")
            (pretial update-in [:tree :content] apply-to
                     (pretial update 0 assoc-in [:attrs :updated] "attr")
                     (pretial conj {:tag :b :content ["Auto Inserted"]}))))))

;; Notice, how here everything keeps being a value, as opposed to the (->) syntax
;; You can get the effect of cond-> with (if ... (prt) identity)

;; ## Comparative Runtimes

;; What does that reification cost to use:

(defn main []
  (println "==== Benchmarking ====")
  (println "Benchmark Base")
  (bench-base)
  (println)
  (println "Benchmark Normal Fns")
  (bench-pretial pretial* apply-to* rcomp*)
  (println)
  (println "Benchmark Unrolled Fns")
  (bench-pretial pretial apply-to rcomp)
  (println "----------------------"))

;; Here is the output `$ lein trampoline run -m user.bendlas/main` on my machine
;; Notice, how the unrolling soaks up a bit more than half of the overhead
;; added by the reification. This ratio seems to be a consistent trend
;; over multiple benchmaks.

;; ==== Benchmarking ====
;; Benchmark Base
;; WARNING: Final GC required 12.94054345545196 % of runtime
;; Evaluation count : 261120 in 6 samples of 43520 calls.
;;              Execution time mean : 2.305967 µs
;;     Execution time std-deviation : 10.649470 ns
;;    Execution time lower quantile : 2.300484 µs ( 2.5%)
;;    Execution time upper quantile : 2.324382 µs (97.5%)
;;                    Overhead used : 2.017137 ns

;; Found 1 outliers in 6 samples (16.6667 %)
;; 	low-severe	 1 (16.6667 %)
;;  Variance from outliers : 13.8889 % Variance is moderately inflated by outliers

;; Benchmark Normal Fns
;; WARNING: Final GC required 28.95022864812921 % of runtime
;; Evaluation count : 151536 in 6 samples of 25256 calls.
;;              Execution time mean : 4.014889 µs
;;     Execution time std-deviation : 30.160260 ns
;;    Execution time lower quantile : 3.997047 µs ( 2.5%)
;;    Execution time upper quantile : 4.066262 µs (97.5%)
;;                    Overhead used : 2.017137 ns

;; Found 1 outliers in 6 samples (16.6667 %)
;; 	low-severe	 1 (16.6667 %)
;;  Variance from outliers : 13.8889 % Variance is moderately inflated by outliers

;; Benchmark Unrolled Fns
;; WARNING: Final GC required 27.69790498806564 % of runtime
;; Evaluation count : 204966 in 6 samples of 34161 calls.
;;              Execution time mean : 2.994725 µs
;;     Execution time std-deviation : 104.767331 ns
;;    Execution time lower quantile : 2.925202 µs ( 2.5%)
;;    Execution time upper quantile : 3.141147 µs (97.5%)
;;                    Overhead used : 2.017137 ns
;; ----------------------