From b955a2fc68e9397f600ac4299d25ec618bdc71a2 Mon Sep 17 00:00:00 2001 From: "alonso.torres" Date: Fri, 9 Oct 2026 17:07:49 +0200 Subject: [PATCH] :sparkles: 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%. --- .serena/memories/common/testing.md | 11 + common/dev/bench/component_sync.clj | 335 +++++++++++++++++++ common/dev/bench/component_sync_baseline.edn | 23 ++ common/scripts/bench-components | 8 + 4 files changed, 377 insertions(+) create mode 100644 common/dev/bench/component_sync.clj create mode 100644 common/dev/bench/component_sync_baseline.edn create mode 100755 common/scripts/bench-components diff --git a/.serena/memories/common/testing.md b/.serena/memories/common/testing.md index a9876e673f..0cd0ad5eea 100644 --- a/.serena/memories/common/testing.md +++ b/.serena/memories/common/testing.md @@ -53,6 +53,17 @@ as the backend does (validate + `cfr/repair-file` until valid, at most 10 passes `tm/known-failure`. A deleted component's objects are reached with `ctkl/get-component data id true` (`thc/get-component` skips deleted ones). +## Component sync benchmark + +`common/dev/bench/component_sync.clj` times component sync on fixed-size worlds (one main into +10/100/1000 copies, 3 nesting levels, a chain of dependents, a variant switch, a library update). +Each world checks its result (how many rects end red) so it never times a no-op. Run from +`common/`: `scripts/bench-components` compares with `dev/bench/component_sync_baseline.edn` and +exits 1 when a world's lower quantile is more than 10% slower; `scripts/bench-components record` +rewrites the baseline (only on purpose, saying why). It takes about 4 minutes. Every commit that +touches sync, swap or change application runs it and quotes the table in its message. The lower +quantile is compared because the mean moves with background load (devenv watchers) and GC. + ## Geometry setup caution For geometry-sensitive tests, read `mem:common/geometry-invariants` before positioning shapes. Use geometry-preserving helpers or production change helpers rather than direct single-field edits. diff --git a/common/dev/bench/component_sync.clj b/common/dev/bench/component_sync.clj new file mode 100644 index 0000000000..28a36e255d --- /dev/null +++ b/common/dev/bench/component_sync.clj @@ -0,0 +1,335 @@ +;; 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-`." + [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)))) diff --git a/common/dev/bench/component_sync_baseline.edn b/common/dev/bench/component_sync_baseline.edn new file mode 100644 index 0000000000..3a6ec50fb1 --- /dev/null +++ b/common/dev/bench/component_sync_baseline.edn @@ -0,0 +1,23 @@ +;; Component sync benchmark baseline, written by `scripts/bench-components record`. +{:commit "1e6615a132", + :date "2026-10-09", + :machine + {:cpu "Intel(R) Core(TM) i7-9750H CPU @ 2.60GHz", + :cores 12, + :os "Linux amd64", + :jvm "26.0.2"}, + :results + {:deepest-edit-through-three-levels + {:mean-ms 36.343, :lower-q-ms 35.215, :passes 4}, + :edit-through-a-chain-of-dependents + {:mean-ms 75.119, :lower-q-ms 68.931, :passes 3}, + :library-update-into-copies + {:mean-ms 89.295, :lower-q-ms 83.083, :passes 1}, + :main-edit-into-10-copies + {:mean-ms 1.847, :lower-q-ms 1.79, :passes 1}, + :main-edit-into-100-copies + {:mean-ms 16.234, :lower-q-ms 15.415, :passes 1}, + :main-edit-into-1000-copies + {:mean-ms 158.728, :lower-q-ms 153.086, :passes 1}, + :variant-switch-into-copies + {:mean-ms 33.1, :lower-q-ms 32.052, :passes 1}}} diff --git a/common/scripts/bench-components b/common/scripts/bench-components new file mode 100755 index 0000000000..dfb0d43f9d --- /dev/null +++ b/common/scripts/bench-components @@ -0,0 +1,8 @@ +#!/usr/bin/env bash +# Runs the component sync benchmark (`dev/bench/component_sync.clj`). +# scripts/bench-components compare against the recorded baseline +# scripts/bench-components record record a new baseline +# Exits 1 when a world is more than 10% slower than its baseline. +set -euo pipefail +cd "$(dirname "$0")/.." +exec clojure -M:dev -m bench.component-sync "${1:-compare}"