github/penpot
1
0
Fork 0
mirror of https://github.com/penpot/penpot.git synced 2026-10-29 14:00:37 +00:00
Code Issues Packages Projects Releases Wiki Activity
penpot/common/dev/bench/component_sync.clj
alonso.torres 124b799a63 ✨ Add a component sync benchmark with a recorded baseline 
The coming refactors and fixes change sync code, and a slowdown must be
seen and explained in the commit that causes it. A JVM benchmark now
times component sync on fixed-size worlds:
- one main into 10, 100 and 1000 copies;
- a change in the deepest of three nesting levels;
- a chain of dependents (a in b in c, with copies of each);
- a variant switch in a main with 100 copies;
- a library update into a file with 500 copies.

Each world is built once; only the sync an edit causes is timed, run
to a fixpoint as the frontend watcher does. Each checks its result, so
a world that synced nothing fails instead of timing nothing.

`scripts/bench-components record` writes the baseline, recorded here on
the code before this commit; `scripts/bench-components` compares against
it and exits 1 when a world is more than 10% slower. It compares the lower
quantile: with the devenv running, the mean of the same code moved
from 0.41 to 1.13 of the baseline, the lower quantile by under 12%.
2026-10-16 11:05:19 +02:00

336 lines
14 KiB
Clojure
Raw Blame History

;; This Source Code Form is subject to the terms of the Mozilla Public
;; License, v. 2.0. If a copy of the MPL was not distributed with this
;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
;;
;; Copyright (c) KALEIDOS SUBSIDIARY SL
(ns bench.component-sync
"Benchmark of component sync on fixed-size worlds, with a recorded
baseline to compare against.
Each world is built once; only the work a user edit causes is timed: the
sync of the changed components, then of the components each sync changed,
until none is left (the frontend watcher does one pass per sync commit),
with every change applied to the file.
Run from `common/` with `scripts/bench-components` (`record` writes the
baseline, `compare`, the default, checks against it)."
(:require
[app.common.files.changes :as ch]
[app.common.files.changes-builder :as pcb]
[app.common.logic.libraries :as cll]
[app.common.logic.shapes :as cls]
[app.common.logic.variants :as clv]
[app.common.test-helpers.components :as thc]
[app.common.test-helpers.compositions :as tho]
[app.common.test-helpers.files :as thf]
[app.common.test-helpers.ids-map :as thi]
[app.common.test-helpers.shapes :as ths]
[app.common.test-helpers.variants :as thv]
[clojure.edn :as edn]
[clojure.java.io :as io]
[clojure.java.shell :as shell]
[clojure.pprint :as pp]
[clojure.string :as str]
[criterium.core :as cri]))
(def ^:private baseline-path "dev/bench/component_sync_baseline.edn")
;; A world slower than its baseline by more than this ratio is flagged.
(def ^:private tolerance 1.10)
(def ^:private bench-opts
{:samples 20
:target-execution-time (* 500 1000 1000)
:warmup-jit-period (* 3 1000 1000 1000)})
;; How long each world runs untimed before any is measured, in ms, so the
;; code they share is compiled before the first measurement.
(def ^:private warmup-ms 3000)
;; ---- Sync
(defn- apply-changes
[file changes]
(thf/apply-changes file changes :validate? false))
(defn- changed-components
"Ids of the components whose main `changes` modified, judged against
`old-data`, the file data before them."
[old-data changes]
(into #{} (mapcat (partial ch/components-changed old-data)) (:redo-changes changes)))
(defn- sync-cascade
"Sync the copies of `component-ids` in `file`, then those of the components
each sync changed, until none is left. `libraries` are the other files.
Returns `[file passes]`."
[file libraries component-ids]
(loop [file file
pending (vec component-ids)
passes 0]
(if (empty? pending)
[file passes]
(let [file-id (:id file)
changes (cll/generate-sync-file-changes (pcb/empty-changes)
nil
:components
file-id
(first pending)
file-id
(assoc libraries file-id file)
file-id)
file' (apply-changes file changes)
more (remove (set pending) (changed-components (:data file) changes))]
(recur file' (into (subvec pending 1) more) (inc passes))))))
(defn- edit
"`file` after `f` changed the shape `label` through the production path,
and the ids of the components that changed."
[file label f]
(let [page (thf/current-page file)
changes (cls/generate-update-shapes (pcb/empty-changes nil (:id page))
#{(thi/id label)}
f
(:objects page)
{})]
[(apply-changes file changes) (changed-components (:data file) changes)]))
(defn- red
[shape]
(assoc shape :fills (ths/sample-fills-color :fill-color "#ff0000")))
;; ---- Worlds
;;
;; A world is `{:key :describe :run :reds}`; `run` is the timed work, a
;; function of no arguments returning `[file passes]`, and `reds` how many
;; rects the resulting file must have red, so a world that synced nothing
;; fails instead of timing nothing.
(defn- red-rects
[file]
(->> (vals (:objects (thf/current-page file)))
(filter #(and (= :rect (:type %))
(= "#ff0000" (-> % :fills first :fill-color))))
(count)))
(defn- instantiate-many
"`file` with `n` copies of the component `label`, labelled `prefix-<i>`."
[file label prefix n & {:as params}]
(reduce (fn [file i]
(thc/instantiate-component file label (keyword (str prefix "-" i)) params))
file
(range n)))
(defn- nest
"`file` with a new component `label`, whose main `root-label` holds a copy
of the component `inner-label`."
[file label root-label inner-label]
(-> file
(tho/add-frame root-label)
(thc/instantiate-component inner-label (keyword (str (name root-label) "-inner"))
:parent-label root-label)
(thc/make-component label root-label)))
(defn- main-edit-into-copies
"One main whose child changes, synced into `n` copies."
[n]
(let [[file ids] (-> (thf/sample-file :file1)
(tho/add-simple-component :c0 :root0 :child0)
(instantiate-many :c0 "copy" n)
(edit :child0 red))]
{:key (keyword (str "main-edit-into-" n "-copies"))
:describe (str "a main child changes; " n " copies sync")
:run #(sync-cascade file {} ids)
:reds (inc n)}))
(defn- deepest-edit-through-three-levels
"Components c1 ⊃ c0, c2 ⊃ c1, c3 ⊃ c2, 100 copies of c3; c0's child
changes."
[]
(let [[file ids] (-> (thf/sample-file :file1)
(tho/add-simple-component :c0 :root0 :child0)
(nest :c1 :root1 :c0)
(nest :c2 :root2 :c1)
(nest :c3 :root3 :c2)
(instantiate-many :c3 "copy" 100)
(edit :child0 red))]
{:key :deepest-edit-through-three-levels
:describe "the deepest of 3 nesting levels changes; 100 copies of the top sync"
:run #(sync-cascade file {} ids)
;; the main, its images in the three outer mains, and the copies
:reds 104}))
(defn- edit-through-a-chain-of-dependents
"Components a, b ⊃ a, c ⊃ b, with 100 copies of each; a's child changes."
[]
(let [[file ids] (-> (thf/sample-file :file1)
(tho/add-simple-component :a :root-a :child-a)
(nest :b :root-b :a)
(nest :c :root-c :b)
(instantiate-many :a "copy-a" 100)
(instantiate-many :b "copy-b" 100)
(instantiate-many :c "copy-c" 100)
(edit :child-a red))]
{:key :edit-through-a-chain-of-dependents
:describe "a changes in the chain a ⊂ b ⊂ c; 100 copies of each sync"
:run #(sync-cascade file {} ids)
;; the main, its images in b and c, and the copies
:reds 303}))
(defn- variant-switch-into-copies
"A component whose main holds a copy of variant member v1, with 100 copies;
the copy in the main switches to member v2."
[]
(let [file (-> (thf/sample-file :file1)
(thv/add-variant-with-child :vset :v1 :v1-root :v2 :v2-root :v1-child :v2-child
:child2-params {:fills (ths/sample-fills-color :fill-color "#ff0000")})
(nest :t :root-t :v1)
(instantiate-many :t "copy" 100))
page (thf/current-page file)
shape (ths/get-shape file :root-t-inner)
libs {(:id file) file}
target (clv/find-switch-target libs shape 0 "Value2")
switch (fn []
(let [[_ changes _] (clv/generate-component-swap-in-place
(pcb/empty-changes nil (:id page))
page libs (:data file) shape (:id target) true)]
(sync-cascade (apply-changes file changes)
{}
(changed-components (:data file) changes))))]
{:key :variant-switch-into-copies
:describe "a variant copy in a main switches; 100 copies of the main sync"
:run switch
;; member v2's rect, the switched copy in the main, and the copies
:reds 102}))
(defn- library-update-into-copies
"A library component with 500 copies in a consuming file; the library main
changed and the file accepts the update."
[]
(let [library (-> (thf/sample-file :library :is-shared true)
(tho/add-simple-component :lc :lroot :lchild))
file (-> (thf/sample-file :file1)
(instantiate-many :lc "copy" 500 :library library))
[library _] (edit library :lchild red)
libraries {(:id library) library (:id file) file}
update (fn []
(let [changes (cll/generate-sync-file-changes (pcb/empty-changes)
nil
:components
(:id file)
nil
(:id library)
libraries
(:id file))]
[(apply-changes file changes) 1]))]
{:key :library-update-into-copies
:describe "a library main changed; a file with 500 copies updates"
:run update
:reds 500}))
(defn- worlds
[]
[(main-edit-into-copies 10)
(main-edit-into-copies 100)
(main-edit-into-copies 1000)
(deepest-edit-through-three-levels)
(edit-through-a-chain-of-dependents)
(variant-switch-into-copies)
(library-update-into-copies)])
;; ---- Measuring
(defn- ms
[seconds]
(/ (Math/round (* seconds 1e6)) 1e3))
(defn- measure
[{:keys [key describe run reds]}]
(println (str " " (name key) ": " describe))
(let [[file passes] (run)
_ (when-not (= reds (red-rects file))
(throw (ex-info (str (name key) " did not sync: " (red-rects file)
" red rects, expected " reds)
{:world key})))
result (cri/benchmark* run bench-opts)]
[key {:mean-ms (ms (first (:mean result)))
:lower-q-ms (ms (first (:lower-q result)))
:passes passes}]))
(defn- warm-up!
[worlds]
(doseq [{:keys [run]} worlds]
(let [end (+ (System/currentTimeMillis) warmup-ms)]
(while (< (System/currentTimeMillis) end)
(run)))))
(defn- run-all
[]
(let [worlds (worlds)]
(println " warming up")
(warm-up! worlds)
(into (sorted-map) (map measure) worlds)))
(defn- sh-out
[& args]
(try
(let [{:keys [exit out]} (apply shell/sh args)]
(when (zero? exit) (str/trim out)))
(catch Exception _ nil)))
(defn- machine
[]
{:cpu (some-> (sh-out "sh" "-c" "grep -m1 'model name' /proc/cpuinfo | cut -d: -f2")
(str/trim))
:cores (.availableProcessors (Runtime/getRuntime))
:os (str (System/getProperty "os.name") " " (System/getProperty "os.arch"))
:jvm (System/getProperty "java.version")})
(defn- record!
[results]
(let [baseline {:commit (or (sh-out "git" "rev-parse" "--short" "HEAD") "unknown")
:date (str (java.time.LocalDate/now))
:machine (machine)
:results results}]
(with-open [w (io/writer baseline-path)]
(binding [*out* w]
(println ";; Component sync benchmark baseline, written by `scripts/bench-components record`.")
(pp/pprint baseline)))
(println "Baseline written to" baseline-path)
true))
(defn- compare!
"Print each world's time against the baseline. Returns false when a world
is slower than its baseline by more than the tolerance. The lower
quantile is compared: background load and GC pauses move it far less
than the mean."
[results]
(let [{:keys [commit] recorded :machine :as baseline} (edn/read-string (slurp baseline-path))
rows (for [[key {:keys [lower-q-ms mean-ms]}] results
:let [base (get-in baseline [:results key :lower-q-ms])
ratio (when base (/ lower-q-ms base))]]
{:world (name key)
:baseline base
:now lower-q-ms
:mean mean-ms
:ratio (some-> ratio (* 100) Math/round (/ 100.0))
:flag (cond (nil? ratio) "new"
(> ratio tolerance) "SLOWER"
:else "")})]
(println "Baseline from commit" commit "on" (:cpu recorded))
(when (not= recorded (machine))
(println "Warning: the baseline was recorded on another machine or JVM; ratios are rough."))
(println "Times are the lower quantile (2.5%) of each world, in ms.")
(pp/print-table [:world :baseline :now :mean :ratio :flag] rows)
(not-any? #(= "SLOWER" (:flag %)) rows)))
(defn -main
[& [mode]]
(println "Component sync benchmark")
(let [results (run-all)
ok? (case (or mode "compare")
"record" (record! results)
"compare" (compare! results))]
(shutdown-agents)
(System/exit (if ok? 0 1))))
Reference in New Issue View Git Blame Copy Permalink