noe/arthur
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Port step 5: freeze measured mouth into playable channels

Browse source
This commit is contained in:
Olive Vaughn 2026-09-27 19:01:39 -04:00
parent 942e2f38ab
commit 8a06835895
24 changed files with 1625 additions and 506 deletions
Download patch file Download diff file Expand all files Collapse all files

463
frontend/test/arthur/flow/freeze_test.cljs Normal file
View file

@ -0,0 +1,463 @@
(ns arthur.flow.freeze-test
"The freeze is where the model's central claim is either true or false:
measurement and a hand produce THE SAME DATA, and the only difference is a flag
nothing in the renderer reads. Most of what is asserted here is that claim,
taken apart into the pieces that could quietly stop holding.
It is also the first step whose done-criterion is a PICTURE, so nothing in here
is the proof that step 5 is done — a take that resolves to the right numbers and
draws nothing would pass every assertion below. See test/browser/take.mjs, which
drives a real Chrome."
(:require [cljs.test :refer [deftest is testing]]
[arthur.demo.take :as take]
[arthur.domain.channel :as ch]
[arthur.domain.geom :as geom]
[arthur.domain.node :as node]
[arthur.domain.palette :as pal]
[arthur.domain.raster :as raster]
[arthur.domain.ring :as ring]
[arthur.domain.scene :as scene]
[arthur.flow.freeze :as freeze]))
(def ^:private W 320)
(def ^:private H 200)
;; The whole vertical slice, exactly as the page builds it. Asserting against the
;; page's own clip rather than against a fixture built here is deliberate: a
;; fixture is a second scene nobody looks at, and the one that renders is the one
;; that has to be right.
(def clip (delay @take/frozen))
(def scene* (delay (:scene @clip)))
(def store (delay (:store @clip)))
(defn- node [id] (get-in @scene* [:nodes id]))
(defn- chan [id path] (get-in (node id) [:channels path]))
(defn- pts-at
"The mouth's [:geom :pts] at frame f, as a flat CLJS vector."
[id f]
(let [v (ch/value-at (chan id [:geom :pts]) f @store)]
(mapv #(ch/component v %) (range (.-length v)))))
(defn- ops-at [sc f]
((scene/resolver sc @store pal/index-of) f))
(defn- render
"One frame of a scene into a byte buffer. The stage's size comes off the clip,
because project dimensions are the project's and not the footage's."
[sc f]
(let [r (raster/make (:width sc) (:height sc))]
(raster/clear! r (get pal/index-of :bg))
(raster/draw-ops! r (ops-at sc f))
(vec (array-seq (:buf r)))))
(defn- drawn
"How many pixels are not background."
[buf]
(count (remove #(= % (get pal/index-of :bg)) buf)))
;; ---------------------------------------------------------------------------
;; the shape of what came out
(deftest the-frozen-take-is-a-valid-scene-in-every-head-mode
;; `scene/problems` is total by construction, so this is safe to run over data
;; before the data is trusted — which is what it is for.
(doseq [mode [:as-filmed :locked]]
(let [sc (freeze/head-mode {:mode mode} @clip)]
(is (empty? (scene/problems sc)) (str mode ": " (pr-str (scene/problems sc))))))
(let [sc (freeze/head-mode {:mode :per-plate :kept #{0 12 40 88 150}} @clip)]
(is (empty? (scene/problems sc)) (pr-str (scene/problems sc)))))
(deftest the-tree-is-the-one-the-model-specifies
;; :face is AUTHORED and :head is MEASURED, and they are two nodes because two
;; different things want that transform. A group node is free; keeping the
;; hand-placed and the measured transform apart is the whole reason the
;; transform is decomposed in the first place.
(is (= [:face :root] (scene/lineage (:nodes @scene*) :face)))
(is (= [:head :face :root] (scene/lineage (:nodes @scene*) :head)))
(is (= [:mouth :head :face :root] (scene/lineage (:nodes @scene*) :mouth)))
(is (= [:mouth-in :mouth :head :face :root]
(scene/lineage (:nodes @scene*) :mouth-in)))
;; Exposure lives on the clip root and inherits strictly.
(is (= {:mode :map :expose 2} (:time (node :root))))
(is (every? #(nil? (:time (node %))) [:face :head :mouth :mouth-in])))
(deftest geometry-is-flat-and-dense-and-the-interior-shares-the-outline-s-block
(doseq [id [:mouth :mouth-in]]
(is (= :dense (ch/describe (chan id [:geom :pts])))))
;; ONE block, two tracks, node-major. offset(track 1) = frames · stride, which
;; is the layout demo/swarm holds and the reason a frame is a rectangular slice
;; at an arithmetic offset rather than a lookup into a table.
(let [a (:dense (chan :mouth [:geom :pts]))
b (:dense (chan :mouth-in [:geom :pts]))]
(is (= (:store a) (:store b)))
(is (zero? (:offset a)))
(is (= (* (:frames a) (:stride a)) (:offset b))))
;; Flat: [x0 y0 x1 y1 …], so stride is twice the vertex budget and a value reads
;; the same way an authored vector does.
(is (= (* 2 8) (:stride (:dense (chan :mouth [:geom :pts])))))
(is (= (* 2 8) (count (pts-at :mouth 0)))))
(deftest the-fixed-point-block-round-trips-to-within-its-own-quantum
;; The one thing fixed point can cost is precision, so it is measured rather
;; than assumed. `rings->flat` is re-run here against the same measured rings,
;; which is what the block was written from.
(let [want (freeze/rings->flat (:outer @take/measured) 8)
q (/ 1.0 freeze/geom-scale)
gap (reduce max (for [f (range 0 take/frames 7)
[a b] (map vector (pts-at :mouth f) (nth want f))]
(abs (- a b))))]
(is (<= gap (/ q 2))
(str "worst quantisation error " gap " against a quantum of " q))
;; And in stage pixels, which is the unit anyone can judge. `:face`'s scale is
;; stage px per image height, so the whole quantum is q·k — a twentieth of a
;; pixel at this placement, two orders below anything the rasteriser can
;; express, which is the argument for Int16 geometry stated as a measurement.
(let [k (first (:value (chan :face [:xform :scale])))]
(is (< (* q k) 0.1)
(str "the quantum is " (* q k) " stage pixels at " k " px per image height"))
(is (< (* gap k) (* q k))))))
(deftest the-scale-is-in-the-header-and-not-agreed-by-convention
;; A block in image-height units and a block in stage pixels want different
;; scales, which is why it is a field. Transform blocks carry none at all: they
;; are Float32, because an angle and a scale factor have no natural fixed point
;; and there are four numbers a frame of them rather than forty.
(is (= freeze/geom-scale (:scale (:dense (chan :mouth [:geom :pts])))))
(doseq [path [[:xform :pos] [:xform :rot] [:xform :scale]]]
(is (nil? (:scale (:dense (get-in (node :head) [:measured path]))))
(str path " should be plain Float32")))
(is (instance? js/Int16Array (:data (get @store "take/geom"))))
(is (instance? js/Float32Array (:data (get @store "take/head-pos")))))
(deftest a-value-past-the-block-s-range-is-refused-rather-than-saturated
;; Saturating reads as articulation flattening off at the extremes — a bad
;; detection, not a bad scale — so it has to be loud. A ring three image heights
;; wide cannot be real, and that is the point: if it happens, the block's space
;; is wrong and there is nothing to be gained by drawing something.
(is (thrown-with-msg?
ExceptionInfo #"does not fit the block's fixed point"
(freeze/clip (assoc take/params :name "huge")
(update @take/measured :outer
(fn [rings] (mapv (fn [r] (mapv #(update % :x + 3) r)) rings)))))))
;; ---------------------------------------------------------------------------
;; the anchor: three channels, and the inverse
(deftest the-similarity-inverse-undoes-the-fit-exactly
;; The fit takes the head's motion OUT and geometry is stored in the space it
;; produces, so putting the motion back — "as filmed" — is the fit's inverse.
;; Still factored, because the three components land on three independently
;; keyframable channels.
(let [gap (reduce max
(for [tf (:transforms @take/measured)
p [{:x 0.5 :y 0.6} {:x 0.0 :y 0.0} {:x -0.3 :y 1.2}]]
(let [q (geom/apply-sim (freeze/invert tf) (geom/apply-sim tf p))]
(js/Math.hypot (- (:x q) (:x p)) (- (:y q) (:y p))))))]
(is (< gap 1e-12) (str "invert ∘ fit is off by " gap))))
(deftest the-head-carries-the-inverse-fit-split-into-its-three-components
;; Float32 storage, so this is a tolerance and not equality — four bytes a
;; number is the spec's choice for transform blocks and it costs about seven
;; decimal digits, which at 850 stage pixels per image height is far below a
;; pixel.
(let [measured (get-in (node :head) [:measured])
at (fn [path f] (ch/value-at (get measured path) f @store))]
(doseq [f (range 0 take/frames 11)]
(let [want (freeze/invert (nth (:transforms @take/measured) f))
pos (at [:xform :pos] f)]
(is (< (abs (- (ch/component pos 0) (:tx want))) 1e-5))
(is (< (abs (- (ch/component pos 1) (:ty want))) 1e-5))
(is (< (abs (- (at [:xform :rot] f) (:theta want))) 1e-6))
(is (< (abs (- (ch/component (at [:xform :scale] f) 0) (:s want))) 1e-6))))))
(deftest head-local-geometry-composed-through-head-and-face-lands-on-the-stage
;; The end-to-end claim of the split, asserted against the OPS the resolver
;; actually emits rather than against an intermediate: stored head-local, put
;; back through `:head`, placed by `:face`, the mouth is where the composition
;; of the two says it is. A test that recomputed the chain would only be
;; checking arithmetic against itself; this checks `node/local!`, `node/world!`
;; and `emit` as well.
(let [sc (freeze/head-mode {:mode :as-filmed} @clip)
res (scene/resolver sc @store pal/index-of)
k (first (:value (chan :face [:xform :scale])))
anc (:value (chan :face [:xform :anchor]))
pos (:value (chan :face [:xform :pos]))
tfs (:transforms @take/measured)]
(doseq [f (range 0 take/frames 13)]
(let [ops (res f)
op (first (filter #(= :mouth (:node %)) ops))
;; EXPOSURE FIRST. The clip root is on 2s and exposure inherits
;; strictly, so frame 13 shows frame 12's pose — which is also the
;; cheapest place to assert that the grid is actually being applied,
;; since reading the unexposed frame here misses by half a pixel and
;; looks like a rounding problem.
ef (node/expose f 2)
;; The frozen, quantised vertex — so the fixed point is not part of
;; what is being asserted here; it has its own test.
flat (pts-at :mouth ef)
g {:x (nth flat 0) :y (nth flat 1)}
;; Where the anchor fit says that head-local point was in the image:
;; the fit removed the head's motion, so putting it back is the fit's
;; inverse. Node :head carries exactly this.
im (geom/apply-sim (freeze/invert (nth tfs ef)) g)
;; And where :face puts it: scaled about the anchor, then translated,
;; which is p ↦ k(p - anchor) + anchor + pos.
wx (+ (* k (- (:x im) (nth anc 0))) (nth anc 0) (nth pos 0))
wy (+ (* k (- (:y im) (nth anc 1))) (nth anc 1) (nth pos 1))]
(is (some? op) (str "frame " f " emitted no mouth op"))
;; Tolerance is the Float32 transform block's, scaled to stage pixels, and
;; it is three orders below a pixel.
(is (< (js/Math.hypot (- (aget (:pts op) 0) wx)
(- (aget (:pts op) 1) wy))
0.01)
(str "frame " f ": op has ["
(aget (:pts op) 0) " " (aget (:pts op) 1)
"], the composition says [" wx " " wy "]"))))))
;; ---------------------------------------------------------------------------
;; the three modes are the three channel shapes
(deftest the-three-head-modes-are-the-three-channel-shapes
(let [kept #{0 12 40 88 150}
of (fn [sc path] (get-in sc [:nodes :head :channels path]))]
(testing "locked is framed identity"
(let [sc (freeze/head-mode {:mode :locked} @clip)]
(is (= [:framed :framed :framed]
(mapv #(ch/describe (of sc %))
[[:xform :pos] [:xform :rot] [:xform :scale]])))
(is (= [0.0 0.0] (:value (of sc [:xform :pos]))))
(is (= 0.0 (:value (of sc [:xform :rot]))))
(is (= [1.0 1.0] (:value (of sc [:xform :scale]))))))
(testing "as filmed is dense"
(let [sc (freeze/head-mode {:mode :as-filmed} @clip)]
(is (= [:dense :dense :dense]
(mapv #(ch/describe (of sc %))
[[:xform :pos] [:xform :rot] [:xform :scale]])))))
(testing "per plate is keyed at exactly the kept frames"
(let [sc (freeze/head-mode {:mode :per-plate :kept kept} @clip)]
(doseq [path [[:xform :pos] [:xform :rot] [:xform :scale]]]
(is (= :keyed (ch/describe (of sc path))))
(is (= (sort kept) (sort (keys (:keys (of sc path))))))
;; A dense read is a VIEW into tier 2. Storing one in the document would
;; be storing a value that changes when a re-freeze rewrites the array
;; under it, so the keys hold plain data.
(doseq [[_ v] (:keys (of sc path))]
(is (or (number? v) (vector? v)) (str path " key is " (pr-str v)))))
;; And the keys are the dense track sampled at those frames, which is the
;; whole of what "per plate" means.
(is (= (mapv #(ch/value-at (get-in (node :head) [:measured [:xform :rot]]) % @store)
(sort kept))
(mapv (:keys (of sc [:xform :rot])) (sort kept))))))))
(deftest switching-modes-rewrites-the-head-and-nothing-else
;; It has to be impossible for the toggle to move something a hand placed, and
;; it has to be a DOCUMENT edit: tier 1, undoable, syncable, instant, and not a
;; reason to re-analyse.
(let [a (freeze/head-mode {:mode :as-filmed} @clip)
b (freeze/head-mode {:mode :locked} @clip)
c (freeze/head-mode {:mode :per-plate :kept #{0 40}} @clip)]
(doseq [sc [b c]]
(is (= (get-in a [:nodes :face]) (get-in sc [:nodes :face]))
":face moved")
(is (= (dissoc (:nodes a) :head) (dissoc (:nodes sc) :head))
"a node other than :head changed")
;; The measurement does not go away when the head is locked: always measure,
;; always store factored, toggle the parent.
(is (= (get-in a [:nodes :head :measured]) (get-in sc [:nodes :head :measured]))))))
(deftest a-head-mode-that-is-not-one-of-the-three-is-refused
(is (thrown-with-msg? ExceptionInfo #"not one of the three channel shapes"
(freeze/head-mode {:mode :stabilised} @clip)))
;; The kept-frame set belongs to the plate strip, not to measurement, so freeze
;; cannot invent one.
(is (thrown-with-msg? ExceptionInfo #"kept-frame set"
(freeze/head-mode {:mode :per-plate} @clip))))
;; ---------------------------------------------------------------------------
;; the face: authored, and what makes makeXform deletable
(deftest the-face-is-authored-and-carries-no-provenance
;; The difference from `makeXform` in one assertion: the placement is a FRAMED
;; transform on a node, which a hand can revise, and it claims no generator that
;; would offer to overwrite it.
(doseq [path [[:xform :pos] [:xform :rot] [:xform :scale] [:xform :anchor]]]
(let [c (get (node/channels (get-in @scene* [:nodes :face])) path)]
(is (= :framed (ch/describe c)) (str path " is not framed"))
(is (nil? (:generated c)) (str path " claims provenance")))))
(deftest the-face-puts-the-head-s-centre-where-it-says-it-does
;; anchor + pos is where the anchor lands in the parent, which is what makes
;; `:anchor` the registration point: scale and rotation happen about the head's
;; centre rather than about the corner of the footage, where MediaPipe's
;; normalised space has its origin.
(let [anc (:value (chan :face [:xform :anchor]))
pos (:value (chan :face [:xform :pos]))
c (geom/centroid (:ref @take/measured))]
(is (< (abs (- (nth anc 0) (:x c))) 1e-12))
(is (< (abs (- (nth anc 1) (:y c))) 1e-12))
(is (< (abs (- (+ (nth anc 0) (nth pos 0)) (/ W 2))) 1e-9))
(is (< (abs (- (+ (nth anc 1) (nth pos 1)) (* 0.25 H))) 1e-9))))
(deftest the-stage-is-the-clip-s-and-not-the-footage-s
;; Project dimensions are independent of the footage, which is precisely what
;; dropping makeXform buys. Nothing below the freeze knows the frame size, so
;; asking for a different stage moves and rescales the same geometry rather than
;; re-measuring anything.
(let [big (freeze/clip (assoc take/params :stage [640 480] :name "big")
@take/measured)]
(is (= [640 480] [(:width (:scene big)) (:height (:scene big))]))
(is (= (vec (array-seq (:data (get @store "take/geom"))))
(vec (array-seq (:data (get (:store big) "big/geom")))))
"the geometry is the same numbers at either stage size")
(is (not= (:value (get-in (:scene big) [:nodes :face :channels [:xform :scale]]))
(:value (chan :face [:xform :scale]))))))
;; ---------------------------------------------------------------------------
;; the aperture, as [:vis]
(deftest the-mouth-interior-is-hidden-below-the-aperture-cut
(let [c (chan :mouth-in [:vis])
ap (:aperture @take/measured)
peak (reduce max ap)
want (mapv #(>= (/ % peak) 0.12) ap)]
(is (= :keyed (ch/describe c)))
(is (= want (mapv #(ch/value-at c %) (range take/frames)))
"the held keys do not reproduce the threshold")
;; The reason it is keyed: a threshold crossing is a handful of transitions,
;; hold is the default, and keys are the shape a human can correct. A dense
;; block would be 229 bytes in tier 2 to say the same thing, un-editable.
(is (< (count (:keys c)) 40)
(str (count (:keys c)) " keys for " take/frames " frames"))
(is (contains? (:keys c) 0) "the first key is the pose the part starts in")
;; It really does both, or the assertion above is vacuous.
(is (some true? want))
(is (some false? want))))
(deftest the-mouth-outline-is-never-hidden
;; The dark band OUTSIDE the interior is what makes a flat shape read as an
;; opening rather than a blob, so the outline keeps every frame; only the
;; interior comes and goes.
(is (nil? (chan :mouth [:vis])))
(doseq [f (range 0 take/frames 9)]
(is (some #(= :mouth (:node %)) (ops-at @scene* f))
(str "frame " f " drew no mouth outline"))))
;; ---------------------------------------------------------------------------
;; provenance
(deftest every-generated-channel-says-who-generated-it-and-under-which-knobs
;; `:generated` is what lets the UI offer a parameter panel and a re-freeze
;; instead of raw keys, and which knobs it names is the invalidation table
;; written where a re-freeze can read it.
(is (= :roto/lips-outer (:by (:generated (chan :mouth [:geom :pts])))))
(is (= :roto/lips-inner (:by (:generated (chan :mouth-in [:geom :pts])))))
(is (= :roto/mouth-aperture (:by (:generated (chan :mouth-in [:vis])))))
(is (= :anchor/similarity
(:by (:generated (get-in (node :head) [:measured [:xform :pos]])))))
(is (= {:anchor-avg 2 :contour-avg 1 :verts 8}
(:params (:generated (chan :mouth [:geom :pts])))))
;; The aperture does NOT depend on `contour avg`: measure reports the inner
;; ring's own height and nothing smooths it.
(is (= {:anchor-avg 2 :aperture-cut 0.12}
(:params (:generated (chan :mouth-in [:vis])))))
(is (every? #(some? (:analysis (:generated %)))
[(chan :mouth [:geom :pts]) (chan :mouth-in [:vis])])))
(deftest the-renderer-never-reads-provenance
;; The load-bearing claim, asserted rather than trusted: strip every
;; `:generated` out of the document and the frame is the same bytes. If this
;; ever fails, a rotoscoped part and a hand-drawn one have stopped being the
;; same data.
(let [stripped (update @scene* :nodes
(fn [ns] (into {} (map (fn [[id n]]
[id (update n :channels
#(into {} (map (fn [[p c]] [p (dissoc c :generated)])) %))]))
ns)))]
(doseq [f (range 0 take/frames 17)]
(is (= (render @scene* f) (render stripped f))
(str "frame " f " differs with provenance removed")))))
;; ---------------------------------------------------------------------------
;; presence is not visibility
(deftest an-undetected-frame-has-no-pose-at-all
;; A subject that was not on the frame has NO VALUE, which is different from a
;; part being switched off. The mask lands on every block of the freeze, so an
;; absent frame takes the head's transform with it — and a node with no
;; transform gives its children nowhere to be, so the whole face goes.
(let [gap (set (range 40 60))
det (mapv #(not (contains? gap %)) (range take/frames))
c (freeze/clip (assoc take/params :name "gappy")
(assoc @take/measured :detected det))
sc (:scene c)
res (scene/resolver sc (:store c) pal/index-of)]
(doseq [f [39 40 50 59 60]]
(let [ops (res f)]
(if (contains? gap f)
(is (empty? ops) (str "frame " f " is absent and drew " (count ops) " ops"))
(is (seq ops) (str "frame " f " is present and drew nothing")))))
;; And it is the MASK doing it, not a hidden flag: `[:vis]` on :mouth-in is
;; unchanged across the gap, because hiding and absence are different
;; questions with different answers.
(is (= (mapv #(ch/value-at (get-in sc [:nodes :mouth-in :channels [:vis]]) %)
(range take/frames))
(mapv #(ch/value-at (chan :mouth-in [:vis]) %) (range take/frames))))))
;; ---------------------------------------------------------------------------
;; the rings are still rings
(deftest a-frozen-ring-is-simple-at-every-vertex-budget
;; Because hold parts CUT between poses rather than interpolating, a ring whose
;; vertex order is wrong renders as blocks meeting at corners rather than as an
;; error. It is invisible at odd vertex counts and obvious at even ones, so it
;; needs an assertion rather than an eyeball — and the subsample is the one
;; operation in the freeze that could reorder a traversal.
(doseq [verts [4 6 8 10 16 20]
which [:outer :inner]]
(let [flat (freeze/rings->flat (get @take/measured which) verts)
bad (first (for [f (range 0 take/frames 3)
:let [r (mapv (fn [k] {:x (nth (nth flat f) (* 2 k))
:y (nth (nth flat f) (inc (* 2 k)))})
(range verts))
hits (ring/self-intersections r)]
:when (seq hits)]
{:verts verts :ring which :frame f :edges (first hits)}))]
(is (nil? bad) (str "self-intersection: " (pr-str bad))))))
(deftest an-odd-vertex-budget-is-refused
;; It lands off the cardinal slots, and it is the one setting at which the
;; simplicity assertion above stops protecting anything.
(doseq [bad [3 5 7 2 22 8.5]]
(is (thrown-with-msg? ExceptionInfo #"vertex budget"
(freeze/rings->flat (:outer @take/measured) bad))
(str bad " was accepted"))))
;; ---------------------------------------------------------------------------
;; it draws, and it moves
(deftest the-take-draws-something-on-every-frame
(doseq [f (range 0 take/frames 5)]
(let [n (drawn (render @scene* f))]
(is (> n 200) (str "frame " f " drew only " n " pixels")))))
(deftest the-mouth-moves
;; The synth holds each pose for nine frames in a four-beat cycle, so frames
;; from different beats are genuinely different mouths and frames inside one
;; beat are not. This is the numeric half of step 5's done-criterion; the other
;; half is a picture and lives in test/browser/take.mjs.
(let [locked (freeze/head-mode {:mode :locked} @clip)
shot (fn [f] (render locked f))
differ (fn [a b] (count (remove true? (map = a b))))]
;; Beat 1 is wide open and beat 3 is shut. Rendered with the head LOCKED, so
;; what differs is articulation and not the head wandering across the stage.
(is (> (differ (shot 10) (shot 28)) 300)
"the open and the shut mouth rasterise the same")
;; And within a beat, on the exposure grid, it holds.
(is (= (shot 10) (shot 10)))
(is (< (differ (shot 10) (shot 12)) 200)
"a held pose is moving more than the detector noise it should have lost"))
;; As filmed, the head carries it around the stage as well.
(let [filmed (freeze/head-mode {:mode :as-filmed} @clip)]
(is (> (count (remove true? (map = (render filmed 10) (render filmed 120)))) 300)
"the head does not move across the take")))