├── .gitignore ├── README.md ├── project.clj └── src └── everything_will_flow ├── core.clj └── viz.clj /.gitignore: -------------------------------------------------------------------------------- 1 | /target 2 | /classes 3 | /checkouts 4 | pom.xml 5 | pom.xml.asc 6 | *.jar 7 | *.class 8 | /.lein-* 9 | /.nrepl-port 10 | .hgignore 11 | .hg/ 12 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | talk-driven development 2 | 3 | ## License 4 | 5 | Copyright © 2015 Zachary Tellman 6 | 7 | Distributed under the MIT License -------------------------------------------------------------------------------- /project.clj: -------------------------------------------------------------------------------- 1 | (defproject everything-will-flow "0.1.0-SNAPSHOT" 2 | :description "FIXME: write description" 3 | :url "http://example.com/FIXME" 4 | :license {:name "Eclipse Public License" 5 | :url "http://www.eclipse.org/legal/epl-v10.html"} 6 | :dependencies [[org.clojure/clojure "1.7.0-alpha5"] 7 | [incanter/incanter-charts "1.5.6"]] 8 | :jvm-opts ["-Xmx10g" "-server" "-XX:+UseG1GC"]) 9 | -------------------------------------------------------------------------------- /src/everything_will_flow/core.clj: -------------------------------------------------------------------------------- 1 | (ns everything-will-flow.core 2 | (:refer-clojure 3 | :exclude [take]) 4 | (:require 5 | [everything-will-flow.viz :as viz] 6 | [incanter.core :refer [view]] 7 | [incanter.charts :as charts])) 8 | 9 | ;;; 10 | 11 | (defn pareto 12 | "Returns a Pareto-distributed value in [min,max], with the tail size specified by `alpha`." 13 | [alpha min max] 14 | (let [r (rand)] 15 | (if (or (zero? r) (== 1 r)) 16 | (recur alpha min max) 17 | (let [ha (Math/pow max alpha) 18 | la (Math/pow min alpha)] 19 | (Math/pow 20 | (- 21 | (/ 22 | (- (* r ha) (* r la) ha) 23 | (* ha la))) 24 | (- (/ 1 alpha))))))) 25 | 26 | (defn next-arrival 27 | "An exponentially distributed arrival time" 28 | [rate] 29 | (double (/ (- (Math/log (rand))) rate))) 30 | 31 | (defn lerp [a b t] 32 | (+ a (* (- b a) (max 0 (min 1 t))))) 33 | 34 | ;;; 35 | 36 | (def ^:dynamic *event-accumulator* (atom [])) 37 | 38 | (defmacro with-accumulator [acc & body] 39 | `(binding [*event-accumulator* ~acc] 40 | ~@body)) 41 | 42 | (defn execute-at! [timestamp event] 43 | (swap! *event-accumulator* conj [timestamp event])) 44 | 45 | ;;; 46 | 47 | (defn event-heap [] 48 | (sorted-map)) 49 | 50 | (defn push-event [heap timestamp event] 51 | (update heap timestamp #(if % (conj % event) [event]))) 52 | 53 | (defn first-event [heap] 54 | (let [[timestamp events] (first heap)] 55 | (if (empty? events) 56 | (recur (dissoc heap timestamp)) 57 | [timestamp (last events)]))) 58 | 59 | (defn pop-event [heap] 60 | (let [[timestamp events] (first heap)] 61 | (if (empty? events) 62 | (recur (dissoc heap timestamp)) 63 | (update heap timestamp pop)))) 64 | 65 | ;;; 66 | 67 | (defn empty-queue [] 68 | clojure.lang.PersistentQueue/EMPTY) 69 | 70 | (defprotocol IMessageQueue 71 | (put-msg [_ timestamp msg]) 72 | (take-msg [_ timestamp f])) 73 | 74 | (defrecord MessageQueue 75 | [max-queue-length 76 | takes 77 | messages 78 | arrivals 79 | rejections 80 | queue-lengths 81 | queue-latencies] 82 | IMessageQueue 83 | (put-msg [this timestamp msg] 84 | (let [this (update this :arrivals conj timestamp)] 85 | (cond 86 | (peek takes) 87 | (let [[t f] (peek takes)] 88 | (execute-at! timestamp (partial f msg timestamp)) 89 | (-> this 90 | (update :takes pop) 91 | (update :queue-latencies conj [timestamp 0]))) 92 | 93 | (<= max-queue-length (count messages)) 94 | (-> this 95 | (update :rejections conj timestamp)) 96 | 97 | :else 98 | (-> this 99 | (update :queue-lengths conj [timestamp (inc (count messages))]) 100 | (update :messages conj [timestamp msg]))))) 101 | 102 | (take-msg [this timestamp f] 103 | (if-let [[t msg] (peek messages)] 104 | (do 105 | (execute-at! timestamp (partial f msg t)) 106 | (-> this 107 | (update :messages pop) 108 | (update :queue-lengths conj [timestamp (dec (count messages))]) 109 | (update :queue-latencies conj [timestamp (- timestamp t)]))) 110 | (-> this 111 | (update :takes conj [timestamp f]))))) 112 | 113 | (defn queue [max-queue-length] 114 | (MessageQueue. max-queue-length (empty-queue) (empty-queue) [] [] [] [])) 115 | 116 | ;;; 117 | 118 | (defrecord Simulation 119 | [events 120 | state]) 121 | 122 | (defn advance [^Simulation s] 123 | (if-let [[t f] (first-event (.events s))] 124 | (let [acc (atom [])] 125 | (with-accumulator acc 126 | (let [state' (f t (.state s))] 127 | (Simulation. 128 | (reduce 129 | (fn [h [t e]] (push-event h t e)) 130 | (pop-event (.events s)) 131 | @acc) 132 | state')))) 133 | s)) 134 | 135 | (defn advance-until [s timestamp] 136 | (->> (iterate advance s) 137 | (drop-while #(< (-> % :events ffirst) timestamp)) 138 | first)) 139 | 140 | ;;; 141 | 142 | (defn producer [queue-fn rate-fn task-lengths task-length-fn] 143 | (fn this [timestamp state] 144 | (execute-at! 145 | (+ timestamp (next-arrival (rate-fn timestamp))) 146 | this) 147 | (let [len (task-length-fn timestamp)] 148 | (-> state 149 | (update-in task-lengths conj [timestamp len]) 150 | (update-in (queue-fn) put-msg timestamp len))))) 151 | 152 | (defn consumer [queue latencies] 153 | (fn this [timestamp state] 154 | (update-in state queue take-msg timestamp 155 | (fn [task-length initial-time timestamp' state] 156 | (let [t' (+ timestamp' task-length)] 157 | (execute-at! t' this) 158 | (update-in state latencies conj [initial-time (- t' initial-time)])))))) 159 | 160 | (defn simulation [state fs] 161 | (Simulation. 162 | (reduce 163 | #(push-event %1 0 %2) 164 | (event-heap) 165 | fs) 166 | state)) 167 | 168 | (def sim 169 | (simulation 170 | {:queue (queue 1e9), :latencies [], :task-lengths []} 171 | [(producer (constantly [:queue]) (constantly 4) [:task-lengths] 172 | (fn [t] (pareto (lerp 5 2 (/ t 1e6)) 0.5 100))) 173 | (consumer [:queue] [:latencies]) 174 | (consumer [:queue] [:latencies]) 175 | (consumer [:queue] [:latencies]) 176 | (consumer [:queue] [:latencies]) 177 | (consumer [:queue] [:latencies])])) 178 | 179 | (defn multi-consumer-grid [counts directory] 180 | (doseq [[rate consumers] counts] 181 | (let [s (advance-until 182 | (simulation 183 | {:queue (queue 1e9), :latencies [], :task-lengths []} 184 | (list* 185 | (producer (constantly [:queue]) (constantly rate) [:task-lengths] 186 | (fn [t] (pareto (lerp 4 1.5 (/ t 1e6)) 0.5 100))) 187 | (repeat consumers (consumer [:queue] [:latencies])))) 188 | 1e6)] 189 | (->> s 190 | :state 191 | :latencies 192 | viz/log10 193 | (viz/spectrogram 5e3 0.05 3 55) 194 | (viz/save-image (str directory "/multi-consumer-rate-" rate "-consumers-" consumers ".png")))))) 195 | -------------------------------------------------------------------------------- /src/everything_will_flow/viz.clj: -------------------------------------------------------------------------------- 1 | (ns everything-will-flow.viz 2 | (:require 3 | [clojure.java.io :as io]) 4 | (:import 5 | [java.awt 6 | Toolkit 7 | Dimension 8 | Color] 9 | [java.awt.event 10 | KeyEvent] 11 | [java.awt.image 12 | BufferedImage] 13 | [javax.imageio 14 | ImageIO] 15 | [javax.swing 16 | AbstractAction JComponent JFrame JLabel JScrollPane ImageIcon KeyStroke] 17 | [javax.script 18 | ScriptEngineManager])) 19 | 20 | (def ^:private shortcut-mask 21 | (.. Toolkit getDefaultToolkit getMenuShortcutKeyMask)) 22 | 23 | (def ^:private close-key 24 | (KeyStroke/getKeyStroke KeyEvent/VK_W (int shortcut-mask))) 25 | 26 | (defn create-frame 27 | "Creates a frame for viewing graphviz images. Only useful if you don't want to use the default frame." 28 | [name] 29 | (delay 30 | (let [frame (JFrame. ^String name) 31 | image-icon (ImageIcon.) 32 | pane (-> image-icon JLabel. JScrollPane.)] 33 | (doto pane 34 | (.. (getInputMap JComponent/WHEN_IN_FOCUSED_WINDOW) 35 | (put close-key "closeWindow")) 36 | (.. getActionMap (put "closeWindow" 37 | (proxy [AbstractAction] [] 38 | (actionPerformed [e] 39 | (.setVisible frame false)))))) 40 | (doto frame 41 | (.setContentPane pane) 42 | (.setSize 1024 768) 43 | (.setDefaultCloseOperation javax.swing.WindowConstants/HIDE_ON_CLOSE)) 44 | [frame image-icon pane]))) 45 | 46 | (defn- send-to-front 47 | "Makes absolutely, completely sure that the frame is moved to the front." 48 | [^JFrame frame] 49 | (doto frame 50 | (.setExtendedState JFrame/NORMAL) 51 | (.setAlwaysOnTop true) 52 | .repaint 53 | .toFront 54 | .requestFocus 55 | (.setAlwaysOnTop false)) 56 | 57 | ;; may I one day be forgiven 58 | (when-let [applescript (.getEngineByName (ScriptEngineManager.) "AppleScript")] 59 | (try 60 | (.eval applescript "tell me to activate") 61 | (catch Throwable e 62 | )))) 63 | 64 | (def default-frame (create-frame "flow")) 65 | 66 | (defn view-image 67 | "Takes an `image`, and displays it in a window. If `frame` is not specified, then the default frame will be used." 68 | ([image] 69 | (view-image default-frame image)) 70 | ([frame image] 71 | (let [[^JFrame frame ^ImageIcon image-icon ^JLabel pane] @frame] 72 | (.setImage image-icon image) 73 | (.setVisible frame true) 74 | (java.awt.EventQueue/invokeLater 75 | #(send-to-front frame))))) 76 | 77 | (defn save-image 78 | [filename image] 79 | (ImageIO/write image "png" (io/file filename))) 80 | 81 | (defn ->hsv [t] 82 | (let [t (-> t (max 0) (min 1))] 83 | (Color/getHSBColor 84 | (- 0.75 (* 0.7 t)) 85 | 1 86 | (max 0.4 87 | (cond 88 | #_(zero? t) 89 | #_0.0 90 | 91 | (< t 0.05) 92 | (/ t 0.05) 93 | 94 | :else 95 | 1))))) 96 | 97 | (defn create-image [w h f] 98 | (let [image (BufferedImage. w h BufferedImage/TYPE_INT_RGB)] 99 | (dotimes [x w] 100 | (dotimes [y h] 101 | (.setRGB image x y (.getRGB ^Color (f x (- h y)))))) 102 | image)) 103 | 104 | ;;; 105 | 106 | (defn rate-seq [resolution timestamps] 107 | (let [bucket->timestamps (group-by #(int (/ % resolution)) timestamps)] 108 | (->> (->> bucket->timestamps keys (apply max) inc range) 109 | (mapv #(vector % (-> % bucket->timestamps count)))))) 110 | 111 | (defn distribution-seq [resolution values] 112 | (let [bucket->values (group-by #(int (/ (first %) resolution)) values)] 113 | (->> (->> bucket->values keys (apply max) inc range) 114 | (mapv #(vector % (->> % bucket->values (map second))))))) 115 | 116 | ;;; 117 | 118 | (defn normalize-distribution [y-res values] 119 | (let [cnt (count values)] 120 | (->> (rate-seq y-res values) 121 | (mapv #(/ (second %) cnt))))) 122 | 123 | (defn log10 [values] 124 | (map (fn [[k v]] [k (Math/log10 (+ v 1))]) values)) 125 | 126 | (defn log [values] 127 | (map (fn [[k v]] [k (Math/log (+ v 1))]) values)) 128 | 129 | (defn spectrogram [x-res y-res magnify height values] 130 | (let [slices (->> (distribution-seq x-res values) 131 | (map second) 132 | (mapv (partial normalize-distribution y-res))) 133 | w (count slices) 134 | h (max height (->> slices (map count) (apply max))) 135 | ;;max (->> slices (apply concat) (apply max)) 136 | ] 137 | (create-image (* magnify w) (* magnify h) 138 | (fn [x y] 139 | (let [y (int (/ y magnify)) 140 | x (int (/ x magnify))] 141 | (->hsv 142 | (/ (-> slices (nth x) (nth y 0)) 143 | (apply max (nth slices x))))))))) 144 | --------------------------------------------------------------------------------