Skip to content

Instantly share code, notes, and snippets.

@jacobobryant
Last active December 16, 2023 15:17
Show Gist options
  • Save jacobobryant/99f2db7f1cba7e60d7258c87cf1ebfaf to your computer and use it in GitHub Desktop.
Save jacobobryant/99f2db7f1cba7e60d7258c87cf1ebfaf to your computer and use it in GitHub Desktop.
Internal dashboard code being used in yakread.com
(ns com.yakread.report.dashboards
(:require [com.biffweb :as biff]
[clojure.string :as str]
[cheshire.core :as cheshire]))
(defn debug [x]
[:pre (with-out-str (biff/pprint x))])
;; slight modification of clojure.core/distinct
(defn distinct-by
"Returns a lazy sequence of the elements of coll with duplicates removed.
Returns a stateful transducer when no collection is provided."
{:added "1.0"
:static true}
([f]
(fn [rf]
(let [seen (volatile! #{})]
(fn
([] (rf))
([result] (rf result))
([result input]
(let [y (f input)]
(if (contains? @seen y)
result
(do (vswap! seen conj y)
(rf result input)))))))))
([f coll]
(let [step (fn step [xs seen]
(lazy-seq
((fn [[input :as xs] seen]
(when-let [s (seq xs)]
(let [y (f input)]
(if (contains? seen y)
(recur (rest s) seen)
(cons input (step (rest s) (conj seen y)))))))
xs seen)))]
(step coll #{}))))
(defn by-type [type events]
(filter #(= type (:type %)) events))
(defn mean [xs]
(/ (apply + xs) (count xs)))
(defn add-days [t n]
(biff/add-seconds t (* 60 60 24 n)))
(defn yesterday [t]
(biff/add-seconds t (* -60 60 24)))
(defn past-n-days [t n]
(take n (iterate yesterday t)))
(defn currency [cents]
(format "$%.2f" (/ cents 100.0)))
(defn fmt-percent [percent]
(str (Math/round (* percent 100.0)) "%"))
(defn background [{:keys [base max value]
:or {base "#22c55e"
max 0.5}}]
(let [alpha (min (int (* (/ value max) 256)) 255)]
(format (str base "%02x") alpha)))
(defn match? [event match]
(= match (select-keys event (keys match))))
(defn match-label [match]
(str (when-some [type (not-empty (str (:type match)))]
(str (subs type 1) " "))
(->> (dissoc match :type)
sort
(map second)
(str/join " "))))
(defn segment-by [segment events]
(let [users (set (keep (fn [event]
(when (match? event segment)
(:user event)))
events))]
(filter (comp users :user) events)))
;; BUSINESS HEALTH =============================================================
(defn business-health [{:keys [events]}]
[:<>
[:h1 "Business health"]
[:div {:style {:display "flex"
:gap "2rem"}}
(for [source-type [:organic :paid]]
(let [today (biff/crop-day (apply max-key inst-ms (map :timestamp events)))
users (->> (by-type :signup events)
(filter (comp #{source-type} :source-type))
(map :user)
set)
events (->> events
(filter (comp users :user))
(map #(assoc % :day (biff/crop-day (:timestamp %)))))
day->metrics (update-vals
(group-by :day events)
(fn [events]
{:value (apply + (map #(:value % 0) events))
:active (->> events
(filter :active)
(map :user)
distinct
count)}))
metric-avg (fn [day k]
(->> (past-n-days day 7)
(map #(get-in day->metrics [% k] 0))
mean
double
(Math/round)
int))
rows (for [day (past-n-days today 21)]
{:day day
:value-avg (metric-avg day :value)
:active-avg (metric-avg day :active)
:value (get-in day->metrics [day :value] 0)
:active (get-in day->metrics [day :active] 0)})
max-vals (into {} (for [k [:value-avg :active-avg :value :active]]
[k (apply max 1 (map k rows))]))]
[:div
[:div (name source-type)]
[:table
[:thead
[:tr
[:th "Day"]
[:th "Revenue (7-day avg)"]
[:th "Active (7-day avg)"]
[:th "Revenue"]
[:th "Active"]]]
(for [{:keys [day] :as row} rows
:let [cell (fn [k fmt]
[:td {:style {:background-color
(background {:value (get row k)
:max (get max-vals k)})}}
(if fmt
(fmt (get row k))
(get row k))])]]
[:tr
[:td (biff/format-date day "dd MMM")]
(cell :value-avg currency)
(cell :active-avg nil)
(cell :value currency)
(cell :active nil)])]]))]])
;; FUNNELS =====================================================================
(defn funnels [{:keys [events funnels]}]
(let [user->events (update-vals
(group-by :user events)
#(sort-by :timestamp %))
user->start-day (update-vals
user->events
(comp biff/crop-day :timestamp first))
weekly-cohorts (->> user->start-day
(group-by #(biff/crop-date (val %) "YYYY-w"))
(map (fn [[cohort pairs]]
{:cohort cohort
:label (str (biff/format-date cohort "yyyy-MM-dd") " (week)")
:users (set (map key pairs))}))
(sort-by :cohort #(compare %2 %1))
(take 3))
monthly-cohorts (->> user->start-day
(group-by #(biff/crop-date (val %) "yyyy-MM"))
(map (fn [[cohort pairs]]
{:cohort cohort
:label (str (biff/format-date cohort "yyyy-MM-dd") " (month)")
:users (set (map key pairs))}))
(sort-by :cohort #(compare %2 %1))
(take 3))
cohorts (concat weekly-cohorts monthly-cohorts)]
[:<>
[:h1 "Funnels"]
(for [funnel funnels]
[:table
[:thead
[:tr
[:th "Cohort"]
(for [step (:steps funnel)]
[:th (match-label step)])]]
(for [[i {:keys [label users]}] (map-indexed vector cohorts)
:let [style (when (= 0 (mod i 3))
{:border-top-width "2px"})]]
[:tr
[:td {:style style} label]
(first
(reduce (fn [[cells event-seqs] step]
(let [total (count event-seqs)
event-seqs (->> event-seqs
(map (fn [events]
(drop-while #(not (match? % step))
events)))
(filter not-empty))
n (count event-seqs)
p (/ n (max 1 total))]
[(conj cells [:td {:style (merge style
{:background-color
(background {:value p :max 1})})}
n " (" (fmt-percent p) ")"])
event-seqs]))
[[:<>]
(map user->events users)]
(:steps funnel)))])])]))
;; RETENTION ===================================================================
(defn fill-in [t1 t2]
(->> (iterate #(java.util.Date. (+ (inst-ms %)
(* 1000 60 60 24)))
t1)
(take-while #(< (inst-ms %) (inst-ms t2)))
(drop 1)))
(defn retention [{:keys [events
date->cohort
period-days
rolling]}]
(let [day-ms (* 1000 60 60 24)
now (apply max (map (comp inst-ms :timestamp) events))
period-finished? (fn [signup-ms period]
(< (+ signup-ms (* (inc period) day-ms period-days))
now))
period-for (fn [signup-ms event-ms]
(quot (- event-ms signup-ms)
(* day-ms period-days)))
events (sort-by :timestamp (filter :active events))
user->signup-ms (->> events
(distinct-by :user)
(map (juxt :user (comp inst-ms :timestamp)))
(into {}))
events (concat events
(when rolling
(for [{:keys [user timestamp]} (distinct-by :user (reverse events))
t (fill-in (java.util.Date. (user->signup-ms user))
timestamp)]
{:user user
:timestamp t})))
user->cohort (update-vals user->signup-ms #(date->cohort (java.util.Date. %)))
cohort+period->active (->> events
(keep (fn [event]
(let [signup-ms (user->signup-ms (:user event))
period (period-for signup-ms
(inst-ms (:timestamp event)))]
(when (period-finished? signup-ms period)
{:cohort (user->cohort (:user event))
:period period
:user (:user event)}))))
distinct
(map (juxt :cohort :period))
frequencies)
cohort+period->value (->> events
(keep (fn [event]
(let [signup-ms (user->signup-ms (:user event))
period (period-for signup-ms
(inst-ms (:timestamp event)))]
(when (and (period-finished? signup-ms period)
(< 0 (:value event 0)))
{:cohort (user->cohort (:user event))
:period period
:value (:value event)}))))
(group-by (juxt :cohort :period))
(map (fn [[k events]]
[k (apply + (map :value events))]))
(into {}))
cohort+period->total (frequencies
(for [[user signup-ms] user->signup-ms
:let [cohort (user->cohort user)]
period (range (period-for signup-ms now))]
[cohort period]))]
(->> (map ffirst cohort+period->total)
distinct
(map (fn [cohort]
[cohort (into {} (for [period (->> (keys cohort+period->total)
(keep (fn [[_cohort period]]
(when (= cohort _cohort)
period))))
:let [active (get cohort+period->active [cohort period] 0)
total (get cohort+period->total [cohort period] 0)
value (get cohort+period->value [cohort period] 0)]]
[period {:active active
:total total
:percent (/ active total 1.0)
:value value
:value-per-user (/ value total 1.0)}]))]))
(into {}))))
(defn date->quarter [date]
(let [year (biff/format-date date "yyyy")
month (-> (biff/format-date date "M")
parse-long
dec
(quot 3)
(* 3)
inc)]
(biff/parse-date (str year "-" month) "yyyy-M")))
(defn retention-section [{:keys [retention-segments events rolling color-max]}]
[:<>
[:h1 "Retention " (if rolling
"(rolling)"
"(n-day)")]
[:table {:style {:font-size "0.85rem"}}
[:thead
[:tr
[:th {:style {:text-align "left"}} "Cohort"]
[:th "# Users"]
(for [day (range 1 61)]
[:th day])]]
(for [segment retention-segments
:let [events (segment-by segment events)
retention (retention {:events events
:period-days 1
:date->cohort date->quarter
:rolling rolling})
n-cohorts 4]]
[:<>
[:tr [:th {:colspan "62"
:style {:text-align "left"}}
"Segment: " (match-label segment)]]
(for [cohort (->> (keys retention)
(sort #(compare %2 %1))
(take n-cohorts))]
[:tr
[:td (biff/format-date cohort "dd MMM yyyy")]
(for [day (range 0 61)
:let [{:keys [active total percent]} (get-in retention [cohort day])]
:when total]
[:td {:id (str "id-" (random-uuid))
:data-tooltip (str active " / " total)
:style (when (not= day 0)
{:background-color (background {:value percent
:max color-max})})}
(if (= day 0)
total
(str (Math/round (* percent 100)) "%"))])])])]])
;; TRAFFIC SOURCES =============================================================
(defn traffic-sources [{:keys [events traffic-segments]}]
(let [all-cohorts (->> events
(map #(biff/crop-date (:timestamp %) "yyyy-MM"))
distinct
(sort #(compare %2 %1))
(take 4)
set)]
[:<>
[:h1 "Traffic sources"]
[:table
[:thead
[:tr
[:th "Cohort"]
[:th "Visits"]
[:th "Signups"]
[:th "Activated"]
[:th "Rev/signups"]
[:th "Active days/signups"]]]
[:tbody
(for [segment traffic-segments
:let [events (segment-by segment events)
user->events (update-vals
(group-by :user events)
#(sort-by :timestamp %))
user->start (update-vals user->events (comp :timestamp first))
cohorts (->> user->start
(group-by #(biff/crop-date (val %) "yyyy-MM"))
(keep (fn [[cohort pairs]]
(when (all-cohorts cohort)
{:cohort cohort
:label (biff/format-date cohort "yyyy-MM")
:users (set (map key pairs))})))
(sort-by :cohort #(compare %2 %1))
(take 4))]]
[:<>
[:tr [:th {:colspan "3"
:style {:text-align "left"}}
"Segment: " (match-label segment)]]
(for [{:keys [label users cohort]} cohorts
:let [events (mapcat user->events users)
revenue (apply + (map #(:value % 0) events))
active-days (->> events
(map (juxt :user (comp biff/crop-day :timestamp)))
distinct
count)
n-signups (->> events
(keep (fn [event]
(when (= :signup (:type event))
(:user event))))
distinct
count)
n-activated (->> events
(keep (fn [event]
(when (:activated event)
(:user event))))
distinct
count)]]
[:tr
[:td label]
[:td (->> events
(keep (fn [event]
(when (= :visit (:type event))
(:user event))))
distinct
count)]
[:td n-signups]
[:td n-activated]
[:td (currency (/ revenue (max 1 n-signups) 1.0))]
[:td (format "%.2f" (/ active-days (max 1 n-signups) 1.0))]])])]]]))
;; RECENT TRAFFIC ==============================================================
(defn recent-traffic [{:keys [events]}]
(let [now (apply max (map (comp inst-ms :timestamp) events))
today (biff/crop-day now)
yesterday (biff/add-seconds today (* -60 60 24))
two-days-ago (biff/add-seconds yesterday (* -60 60 24))
events (for [{:keys [timestamp type] :as event} events
:when (and (= type :signup)
(< (- now (inst-ms timestamp))
(* 1000 60 60 24 3)))]
(assoc event :day (biff/crop-day timestamp)))
]
[:<>
[:h1 "Recent signups"]
[:table
[:thead
[:tr
[:th "Source"]
[:th (biff/format-date today "dd MMM")]
[:th (biff/format-date yesterday "dd MMM")]
[:th (biff/format-date two-days-ago "dd MMM")]]]
[:tbody
(for [[source events] (->> events
(group-by :source)
(sort-by (comp count val) >))
:when (< 1 (count events))
:let [day->signups (update-vals (group-by :day events) count)]]
[:tr
[:td (or source "Organic")]
[:td (day->signups today)]
[:td (day->signups yesterday)]
[:td (day->signups two-days-ago)]])]]]))
;; =============================================================================
(defn main-report [opts]
[:html
[:head
[:meta {:charset "utf-8"}]
[:meta {:name "viewport" :content "width=device-width, initial-scale=1"}]
[:link {:rel "stylesheet" :href "/css/report.css"}]
[:script {:src "https://cdnjs.cloudflare.com/ajax/libs/Chart.js/3.9.1/chart.min.js"
:integrity "sha512-ElRFoEQdI5Ht6kZvyzXhYG9NqjtkmlkfYk0wr6wHxU9JEHakS7UJZNeml5ALk+8IKlU6jDgMabC3vkumRokgJA=="
:crossorigin "anonymous",
:referrerpolicy "no-referrer"}]
[:script {:src "https://unpkg.com/@popperjs/core@2"}]
[:script {:src "https://unpkg.com/tippy.js@6"}]]
[:body {:style {:font-family "sans-serif"}}
(recent-traffic opts)
(business-health opts)
(funnels opts)
(retention-section (assoc opts :color-max 0.5))
;;(retention-section (assoc opts :rolling true :color-max 1))
(traffic-sources opts)
[:script {:src "/js/report.js"}]]])
(defn apply-source-aliases [source]
(or ({["browser" "The Browser-newsletter"] "browser"} source)
source))
(defn visit->source [{:event.params/keys [ref utm_source referrer_url]}]
(apply-source-aliases
(or ref
(some-> utm_source (str/replace #"/.*" ""))
referrer_url)))
(defn user->source [{:user/keys [signup-href referrer]}]
(let [params (some-> signup-href
uri/uri
:query
uri/query-string->map)]
(apply-source-aliases
(or (:ref params)
(:utm_source params)
referrer))))
(def paid-sources
#{"browser"
"refind"
["browser" "The Browser-newsletter"]
"smartr-podr"
"Tedium"})
(defn paid-source? [source]
(or (paid-sources source)
(some->> source str (re-find #"202\d\d\d"))))
(defn query-events [db]
(let [users (q db
'{:find (pull user [*
{:user/signup-event [*]}
{:conn/_user [*]}
{:user/referred-by [*]}])
:where [[user :user/email]]})
referral-codes (set (map :user/referral-code users))
user->auto-subbed-at (into {} (q db
'{:find [user joined-at]
:where [[user :user/auto-subbed true]
[user :user/joined-at joined-at]]}))
exclude-sources #{"Gfevhz"}
exclude-users (->> users
(filter (fn [{:keys [user/email] :as user}]
(or (some #(str/ends-with? email %)
["@jacobobryant.com"
"@thesample.ai"])
(exclude-sources (user->source user)))))
(map :xt/id)
set)
exclude-ip #{"50.34.170.107"
"50.34.168.226"
"50.34.168.155"}
cookie-uid->real-uid (->> users
(map (juxt (comp :event/cookie-uid :user/signup-event)
:xt/id))
(into {}))
events (concat
;; Visit
(for [event (q db
'{:find (pull event [*])
:where [[event :event/type :page-view]]})
:when (not (exclude-ip (:event/ip event)))
:let [source (visit->source event)]]
{:user (or (:event/user event)
(get cookie-uid->real-uid
(:event/cookie-uid event)
(:event/cookie-uid event)))
:timestamp (:event/timestamp event)
:type :visit
:source source
#_#_:source-type (if (or (paid-source? source)
(referral-codes source))
:paid
:organic)
})
;; Signup
(for [user users
:let [source (user->source user)]]
{:user (:xt/id user)
:timestamp (:user/joined-at user #inst "2022-08-01")
:type :signup
:active true
:source source
:source-type (if (or (paid-source? source)
(referral-codes source))
:paid
:organic)})
;; Navigate
(for [event (q db
'{:find (pull event [*])
:where [[event :event/type :navigate]]})]
{:user (:event/user event)
:timestamp (:event/timestamp event)
:type :navigate
:page (:event.navigate/page event)
:device-type (when-some [width (:event.navigate/inner-width event)]
(if (< width 640)
:mobile
:desktop))
:screen-width (:event.navigate/inner-width event)
:display-mode (if (= (:event.navigate/display-mode event) :standalone)
:pwa
:browser)})
;; Set username
(for [[t conn] (q db
'{:find [t (pull conn [*])]
:where [[conn :conn.email/username]
[(get-start-valid-time conn) t]]})]
{:user (:conn/user conn)
:timestamp t
:type :set-username})
;; Subscribe newsletter
(->> (q db
'{:find [user from timestamp]
:keys [user from timestamp]
:order-by [[timestamp :asc]]
:where [[item :item.email/user user]
[item :item/author-name from]
[item :item/fetched-at timestamp]]})
(util/distinct-by (juxt :user :from))
(group-by :user)
(mapcat (fn [[_ events]]
(->> events
(sort-by :timestamp)
(map-indexed (fn [i event]
{:user (:user event)
:timestamp (:timestamp event)
:type :sub-newsletter
:sub-newsletter/n (inc i)
:activated true}))))))
;; Read article
(for [{:rec/keys [user
viewed-at
source
flags
rating]} (q db
'{:find (pull rec [*])
:where [[rec :rec/viewed-at]]
:timeout 180000})]
(biff/assoc-some
{:user user
:timestamp viewed-at
:type :read-article
:active true}
:clicked-from source
:rating rating))
;; Ad clicks
(for [{:ad.click/keys [user
created-at
cost
source]} (q db
'{:find (pull click [*])
:where [[click :ad.click/user]]})]
{:user user
:timestamp created-at
:type :ad-click
:active true
:value cost
:clicked-from (or ({:web :home} source) source)})
;; Subscribe RSS
(for [[user timestamp n] (q db
'{:find [user timestamp (count conn)]
:where [[conn :conn.rss/subscribed-at timestamp]
[conn :conn/user user]]})
:let [auto-subbed-at (user->auto-subbed-at user)]]
(merge {:user user
:timestamp timestamp}
(cond
(= auto-subbed-at timestamp)
{:type :import-opml-auto
:opml-feeds n}
(< 1 n)
{:type :import-opml
:opml-feeds n}
:else
{:type :sub-rss})))
;; Activation emails
(for [user users
[k event-type] [[:user/activation-username-sent :activation/username]
[:user/activation-import-gmail-sent :activation/gmail]
[:user/activation-suggestions-sent :activation/suggestions]]
:when (contains? user k)]
{:user (:xt/id user)
:timestamp (get user k)
:type event-type}))
events (remove (some-fn (comp exclude-users :user)
(comp exclude-sources :source))
events)]
events))
(defn save-events! [{:keys [biff/db] :as ctx}]
(log/info "save-events! start")
(let [events (query-events db)]
;; serializes the data with nippy and stores on filesystem
(util/kv-put "nippy-singletons" ::events events))
(log/info "save-events! done"))
(defn main-page [{:keys [params] :as ctx}]
(let [events (util/kv-get "nippy-singletons" ::events)
opts {:events events
:funnels [{:name "main"
:steps [{:type :visit}
{:type :signup}
{:type :navigate}
{:type :set-username}
{:type :sub-newsletter
:sub-newsletter/n 1}
{:type :sub-newsletter
:sub-newsletter/n 3}
{:type :sub-newsletter
:sub-newsletter/n 5}]}
{:name "activation-username"
:steps [{:type :activation/username}
{:type :set-username}]}
{:name "activation-gmail"
:steps [{:type :activation/gmail}
{:type :sub-newsletter}]}
{:name "activation-suggestions"
:steps [{:type :activation/suggestions}
{:type :sub-newsletter}]}]
:retention-segments [{:type :signup}
{:type :sub-newsletter}
{:type :sub-newsletter
:sub-newsletter/n 3}
{:type :sub-newsletter
:sub-newsletter/n 5}
{:display-mode :pwa}
{:source-type :organic}
{:source-type :paid}]
:traffic-segments (into [{:source-type :organic}
{:source-type :paid}]
(->> events
(filter (comp #{:paid} :source-type))
(map :source)
frequencies
(sort-by val >)
(map (fn [[source _]]
{:source source}))))}]
(dash/main-report opts)))
(def features
{:routes [["" {:middleware [mid/wrap-signed-in
;; only people with analyst role can see the report
mid/wrap-analyst]}
["/report" {:get #(main-page %)}]]]
:tasks [{:task #'save-events!
:schedule (util/every-n-minutes 30)}]})
th, td {
border: 1px solid;
padding: 0.25rem 0.5rem;
white-space: nowrap;
text-align: right;
}
table {
border-collapse: collapse;
margin: 1rem 0;
}
document.querySelectorAll('[data-tooltip]').forEach(el => {
tippy("#" + el.id, {
content: el.getAttribute('data-tooltip')
});
});
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment