From 4eb1899a57b7d7c7a1cbcc727e0f45254caee092 Mon Sep 17 00:00:00 2001
From: Miikka Koskinen <miikka@metosin.fi>
Date: Thu, 28 Feb 2019 13:12:05 +0200
Subject: [PATCH] Print a histogram for each benchmark suite

---
 .../clj/reitit/opensensors_perf_test.clj      |  2 +-
 perf-test/clj/reitit/perf_utils.clj           | 73 +++++++++++++++----
 2 files changed, 61 insertions(+), 14 deletions(-)

diff --git a/perf-test/clj/reitit/opensensors_perf_test.clj b/perf-test/clj/reitit/opensensors_perf_test.clj
index c00a89a6..7a252918 100644
--- a/perf-test/clj/reitit/opensensors_perf_test.clj
+++ b/perf-test/clj/reitit/opensensors_perf_test.clj
@@ -1,5 +1,5 @@
 (ns reitit.opensensors-perf-test
-  (:require [reitit.perf-utils :refer :all]
+  (:require [reitit.perf-utils :refer [bench bench!! handler valid-urls]]
             [cheshire.core :as json]
             [clojure.string :as str]
             [reitit.core :as reitit]
diff --git a/perf-test/clj/reitit/perf_utils.clj b/perf-test/clj/reitit/perf_utils.clj
index be7b8839..56113dc0 100644
--- a/perf-test/clj/reitit/perf_utils.clj
+++ b/perf-test/clj/reitit/perf_utils.clj
@@ -1,12 +1,49 @@
 (ns reitit.perf-utils
   (:require [criterium.core :as cc]
+            [criterium.stats :as stats]
             [clojure.string :as str]
             [reitit.core :as reitit]))
 
+;;
+;; Histograms
+;;
+
+(def +sparks+ "▁▂▃▄▅▆▇█")
+
+(defn sparkline [xs]
+  (let [min- (reduce min xs)
+        max- (reduce max xs)
+        d    (- max- min-)
+        sc   (dec (count +sparks+))
+        c    #(nth +sparks+ (int (* sc (/ (- % min-) d))))]
+    (str/join (map c xs))))
+
+(defn bin
+  ([xs] (bin xs nil))
+  ([xs {:keys [bin-count min-x max-x] :or {bin-count 10, min-x :auto max-x :auto}}]
+   (let [min- (if (= :auto min-x) (reduce min xs) min-x)
+         max- (if (= :auto max-x) (reduce max xs) max-x)
+         d    (double (- max- min-))
+         bins (vec (repeat bin-count 0))
+         bc   (dec (count bins))]
+     (reduce (fn [bins x]
+               (let [bin (int (Math/round (* bc (/ (- x min-) d))))]
+                 (if (<= 0 bin bc)
+                   (update bins bin inc)
+                   bins)))
+             bins
+             xs))))
+
+;;
+;; Benchmarking
+;;
+
 (defn raw-title [color s]
-  (println (str color (apply str (repeat (count s) "#")) "\u001B[0m"))
-  (println (str color s "\u001B[0m"))
-  (println (str color (apply str (repeat (count s) "#")) "\u001B[0m")))
+  (let [line-length (transduce (map count) max 0 (str/split-lines s))
+        banner      (apply str (repeat line-length "#"))]
+    (println (str color banner "\u001B[0m"))
+    (println (str color s"\u001B[0m"))
+    (println (str color banner "\u001B[0m"))))
 
 (def title (partial raw-title "\u001B[35m"))
 (def suite (partial raw-title "\u001B[32m"))
@@ -28,17 +65,21 @@
 
 (defrecord Request [uri path-info request-method])
 
+(defn- s->ns [x] (int (* x 1e9)))
+(defn- get-mean-ns [results] (int (* (first (:sample-mean results)) 1e9)))
+(defn- get-lower-q-ns [results] (int (* (first (:lower-q results)) 1e9)))
+
 (defn bench-routes [routes req f]
   (let [router (reitit/router routes)
         urls (valid-urls router)]
     (mapv
       (fn [path]
         (let [request (map->Request (req path))
-              results (cc/quick-benchmark (dotimes [_ 1000] (f request)) {})
-              mean (int (* (first (:sample-mean results)) 1e6))
-              lower (int (* (first (:lower-q results)) 1e6))]
+              results (cc/quick-benchmark (f request) {})
+              mean (get-mean-ns results)
+              lower (get-lower-q-ns results)]
           (println path "=>" lower "/" mean "ns")
-          [path [mean lower]]))
+          [path results]))
       urls)))
 
 (defn bench [routes req no-paths?]
@@ -47,8 +88,8 @@
                          [(str/replace path #"\:" "") name]
                          [path name])) routes)
         router (reitit/router routes)]
-    (doseq [[path [mean lower]] (bench-routes routes req #(reitit/match-by-path router %))]
-      (println path "\t" mean lower))))
+    (doseq [[path results] (bench-routes routes req #(reitit/match-by-path router %))]
+      (println path "\t" (get-mean-ns results) (get-lower-q-ns results)))))
 
 ;;
 ;; Perf tests
@@ -60,8 +101,14 @@
   (println)
   (suite name)
   (println)
-  (let [times (for [[path [mean lower]] (bench-routes routes req f)]
+  (let [times (for [[path results] (bench-routes routes req f)]
                 (do
-                  (when verbose? (println (format "%7s\t%7s" mean lower) "\t" path))
-                  [mean lower]))]
-    (title (str "average, mean: " (int (/ (reduce + (map first times)) (count times)))))))
+                  (when verbose? (println (format "%7s\t%7s" (get-mean-ns results) (get-lower-q-ns results)) "\t" path))
+                  results))
+        ;; The samples are of equal size, so mean of means is okay.
+        mean-ns (s->ns (stats/mean (map (comp first :mean) times)))
+        samples (mapcat (fn [x] (map #(/ % (:execution-count x)) (:samples x))) times)
+        min-ns  (int (reduce min samples))
+        max-ns  (int (reduce max samples))]
+    (title (str "mean of means: " (format "%4d" mean-ns) "\n"
+                "distribution:  " (format "%4d"  min-ns) " " (sparkline (bin samples {:bin-count 20})) " " (format "%4d" max-ns)))))