Internal dashboard code being used in yakread.com

dashboard.clj

(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"}]]])

example-usage.clj

(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)}]})

report.css

th, td {
  border: 1px solid;
  padding: 0.25rem 0.5rem;
  white-space: nowrap;
  text-align: right;
}

table {
  border-collapse: collapse;
  margin: 1rem 0;
}

report.js

document.querySelectorAll('[data-tooltip]').forEach(el => {
  tippy("#" + el.id, {
    content: el.getAttribute('data-tooltip')
  });
});