Print a histogram for each benchmark suite

This commit is contained in:
Miikka Koskinen 2019-02-28 13:12:05 +02:00
parent 6ef78b6238
commit 4eb1899a57
2 changed files with 61 additions and 14 deletions

View file

@ -1,5 +1,5 @@
(ns reitit.opensensors-perf-test (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] [cheshire.core :as json]
[clojure.string :as str] [clojure.string :as str]
[reitit.core :as reitit] [reitit.core :as reitit]

View file

@ -1,12 +1,49 @@
(ns reitit.perf-utils (ns reitit.perf-utils
(:require [criterium.core :as cc] (:require [criterium.core :as cc]
[criterium.stats :as stats]
[clojure.string :as str] [clojure.string :as str]
[reitit.core :as reitit])) [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] (defn raw-title [color s]
(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 s"\u001B[0m"))
(println (str color (apply str (repeat (count s) "#")) "\u001B[0m"))) (println (str color banner "\u001B[0m"))))
(def title (partial raw-title "\u001B[35m")) (def title (partial raw-title "\u001B[35m"))
(def suite (partial raw-title "\u001B[32m")) (def suite (partial raw-title "\u001B[32m"))
@ -28,17 +65,21 @@
(defrecord Request [uri path-info request-method]) (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] (defn bench-routes [routes req f]
(let [router (reitit/router routes) (let [router (reitit/router routes)
urls (valid-urls router)] urls (valid-urls router)]
(mapv (mapv
(fn [path] (fn [path]
(let [request (map->Request (req path)) (let [request (map->Request (req path))
results (cc/quick-benchmark (dotimes [_ 1000] (f request)) {}) results (cc/quick-benchmark (f request) {})
mean (int (* (first (:sample-mean results)) 1e6)) mean (get-mean-ns results)
lower (int (* (first (:lower-q results)) 1e6))] lower (get-lower-q-ns results)]
(println path "=>" lower "/" mean "ns") (println path "=>" lower "/" mean "ns")
[path [mean lower]])) [path results]))
urls))) urls)))
(defn bench [routes req no-paths?] (defn bench [routes req no-paths?]
@ -47,8 +88,8 @@
[(str/replace path #"\:" "") name] [(str/replace path #"\:" "") name]
[path name])) routes) [path name])) routes)
router (reitit/router routes)] router (reitit/router routes)]
(doseq [[path [mean lower]] (bench-routes routes req #(reitit/match-by-path router %))] (doseq [[path results] (bench-routes routes req #(reitit/match-by-path router %))]
(println path "\t" mean lower)))) (println path "\t" (get-mean-ns results) (get-lower-q-ns results)))))
;; ;;
;; Perf tests ;; Perf tests
@ -60,8 +101,14 @@
(println) (println)
(suite name) (suite name)
(println) (println)
(let [times (for [[path [mean lower]] (bench-routes routes req f)] (let [times (for [[path results] (bench-routes routes req f)]
(do (do
(when verbose? (println (format "%7s\t%7s" mean lower) "\t" path)) (when verbose? (println (format "%7s\t%7s" (get-mean-ns results) (get-lower-q-ns results)) "\t" path))
[mean lower]))] results))
(title (str "average, mean: " (int (/ (reduce + (map first times)) (count times))))))) ;; 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)))))