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

Port steps 0-1: scaffold, the oracle, and the pure bottom

Browse source 
Scaffolds frontend/ (shadow-cljs, reagent 1.2.0, re-frame 1.4.3) and ports
everything below the data model, with the JS kept as a numeric oracle.

  domain/landmarks  index tables, verbatim
  domain/ring       subsample, offset, simplicity
  domain/geom       similarity fit, procrustes, moving average
  domain/raster     indexed scanline fill, stencil, disc, rect
  domain/palette    the ramp, and the no-sampled-RGB rule

58 tests, 166 assertions. Parity with js/ on the identical 72-frame synthetic
track: fit-similarity, procrustes-mean, fit-residual, moving-average,
smooth-transforms, offset-ring and subsample-slots to 1e-9; the raster
pixel-for-pixel over the whole buffer.

Three deviations from the JS, each for a reason:

- synth.cljs jitters from a SEEDED generator, not Math.random. Parity is only
  checkable if both sides can be handed the same track, and a failing assertion
  has to be reproducible. `:rand-fn` takes the generator over, so oracle.mjs
  stubs js/Math.random and js/ itself stays untouched.

- raster/->rgba replaces toImageData. ImageData is a DOM type and domain/ may
  not touch the DOM; returning plain bytes also lets the
  no-intermediate-colours assertion run in node. ui/canvas wraps it later.

- offset-ring lives in domain/ring, not domain/geom, per architecture.md: it is
  an operation on an ordered traversal, not on a transform.

Step 1's "done" also names the swapped-iris vote, but pairIrises is in
pipeline.js and belongs to step 7. The precondition is asserted instead --
`:swap-iris` really does move both blocks -- so the vote will have a track that
disagrees with it when it arrives.

One finding, recorded in full in the test that measures it: smooth-transforms
buys nothing on the synthetic track. Against jitter-free ground truth, radius 1
helps by 17% on one noise realisation and hurts by 0.5% on another, so its
benefit is within noise; from radius 2 up the cost is unambiguous, and by radius
5 the filter is below the true motion's own high-frequency energy, i.e.
smoothing away performance. The test pins the shape of the knob rather than a
preferred value. This may say more about the synth's jitter being unrealistically
small (+/-0.001 normalised) than about the knob; step 6 settles it on real
footage.

Co-Authored-By: Claude Opus 5 <noreply@anthropic.com>
This commit is contained in:
Olive Vaughn 2026-09-27 14:43:34 -04:00
parent 082d8561d2
commit eb06be005c
25 changed files with 4932 additions and 0 deletions
Download patch file Download diff file Expand all files Collapse all files

157
frontend/test/arthur/domain/geom_test.cljs Normal file
View file

@ -0,0 +1,157 @@
(ns arthur.domain.geom-test
(:require [cljs.test :refer [deftest is testing]]
[arthur.domain.geom :as geom]
[arthur.domain.landmarks :as lm]
[arthur.synth :as synth]))
(defn- close? [a b] (< (abs (- a b)) 1e-9))
(deftest fit-similarity-recovers-a-known-transform
(let [src [{:x 0 :y 0} {:x 1 :y 0} {:x 0 :y 1} {:x 2 :y 3}]
truth {:s 1.7 :theta 0.6 :tx 4 :ty -2}
dst (mapv #(geom/apply-sim truth %) src)
got (geom/fit-similarity src dst)]
(is (close? (:s got) (:s truth)) (str "s = " (:s got)))
(is (close? (:theta got) (:theta truth)) (str "theta = " (:theta got)))
(is (close? (:tx got) (:tx truth)) (str "tx = " (:tx got)))
(is (close? (:ty got) (:ty truth)) (str "ty = " (:ty got)))))
(deftest fit-residual-is-zero-on-an-exact-fit
(let [src [{:x 0 :y 0} {:x 1 :y 0} {:x 0 :y 1} {:x 2 :y 3}]
truth {:s 1.7 :theta 0.6 :tx 4 :ty -2}
dst (mapv #(geom/apply-sim truth %) src)]
(is (close? 0 (geom/fit-residual (geom/fit-similarity src dst) src dst)))))
(deftest fit-similarity-survives-a-degenerate-configuration
;; All points coincident: the norm is zero and the scale has nothing to
;; recover. It must fall back to 1 rather than divide by zero, or one bad
;; detection frame poisons the Procrustes mean and therefore every frame.
(let [p (vec (repeat 4 {:x 0.5 :y 0.5}))
tf (geom/fit-similarity p p)]
(is (close? 1 (:s tf)) (str "s = " (:s tf)))
(is (not (js/isNaN (:tx tf))))))
(deftest procrustes-mean-is-the-mean-not-frame-zero
;; The reference is the MEAN rigid configuration over the shot, so no single
;; frame's idiosyncrasies get baked into every other frame. Asserted as a
;; CONTRAST against the design it replaced — a frame-zero reference — because
;; the absolute number alone would not show the invariant has any teeth.
;;
;; Corrupting ONE landmark, not the whole frame: displacing every point of a
;; frame is a pure translation, which fit-similarity removes exactly, so it
;; would prove nothing. And the comparison is a similarity residual rather
;; than a per-point distance, because a Procrustes reference is only defined up
;; to a similarity — the initial reference fixes the gauge, and measuring the
;; gauge instead of the shape is the trap here.
(let [dense (synth/synth-dense 72)
rigid (mapv (fn [fr] (mapv #(nth fr %) lm/RIGID)) dense)
;; 0.05 is roughly the whole sway amplitude: a gross detection error on
;; one landmark of one frame.
broken (assoc rigid 0 (update-in (nth rigid 0) [3 :x] + 0.05))
;; Gauge-free shape distance: align a onto b, report what is left.
shape-gap (fn [a b] (geom/fit-residual (geom/fit-similarity a b) a b))
mean-gap (shape-gap (geom/procrustes-mean rigid)
(geom/procrustes-mean broken))
;; The design it replaced: frame zero IS the reference, so the same
;; corruption lands in the reference at full strength.
frame0-gap (shape-gap (nth rigid 0) (nth broken 0))]
(is (< mean-gap (* 0.1 frame0-gap))
(str "one corrupt landmark moved the mean reference by " mean-gap
" but a frame-zero reference by " frame0-gap))
(is (> frame0-gap 0.005)
(str "the corruption has to actually register somewhere, or the contrast "
"above is vacuous; frame-zero gap was " frame0-gap))))
(deftest moving-average-radius-semantics
;; 0 is off, 1 averages over 3 frames, 2 over 5. Expressed as a radius rather
;; than a window so that "off" is 0 and every value is symmetric.
(let [v [0 0 9 0 0]]
(is (= v (geom/moving-average v 0)) "radius 0 is identity")
(is (close? 3 (nth (geom/moving-average v 1) 2)) "radius 1 averages over 3")
(is (close? 1.8 (nth (geom/moving-average v 2) 2)) "radius 2 averages over 5"))
(testing "edges clamp rather than shorten the window"
(is (= 5 (count (geom/moving-average [1 2 3 4 5] 2))))
(is (close? 1.6 (first (geom/moving-average [1 2 3 4 5] 2))))))
(deftest smooth-transforms-cannot-spike-at-the-angle-wrap
;; Angles are smoothed as (cos, sin) so wrapping cannot produce a spike.
;; Averaging theta directly across the +/-pi seam gives ~0 - a transform
;; rotated a half turn from both neighbours.
(let [near-pi (- js/Math.PI 0.01)
tfs [{:s 1 :theta near-pi :tx 0 :ty 0}
{:s 1 :theta (- near-pi) :tx 0 :ty 0}
{:s 1 :theta near-pi :tx 0 :ty 0}]
out (geom/smooth-transforms tfs 1)]
(is (every? #(> (abs (:theta %)) 3.0) out)
(str "thetas stayed near the seam: " (pr-str (mapv :theta out))))))
(deftest smooth-transforms-leaves-a-steady-track-alone
(let [tfs (vec (repeat 5 {:s 1.2 :theta 0.3 :tx 4 :ty -2}))]
(is (every? (fn [t] (and (close? 1.2 (:s t)) (close? 0.3 (:theta t))
(close? 4 (:tx t)) (close? -2 (:ty t))))
(geom/smooth-transforms tfs 2)))))
(deftest smoothing-the-transform-buys-less-than-it-costs-on-this-track
;; MEASURED, not assumed, on two independent noise realisations. The synthetic
;; track can be generated WITHOUT jitter, so the real head motion is available
;; as ground truth. error = mean distance of (tx,ty) from the truth; hf = mean
;; |second difference| of tx, the high-frequency energy a low-pass removes.
;;
;; radius error (seeded) error (Math.random) hf
;; 0 6.96e-4 7.36e-4 1.24e-3
;; 1 7.00e-4 6.15e-4 9.19e-4
;; 2 1.49e-3 1.39e-3 8.76e-4
;; 3 2.77e-3 2.66e-3 8.35e-4
;; 5 6.43e-3 6.34e-3 7.67e-4
;; truth 0 0 8.08e-4
;;
;; Read the first two columns together. Radius 1 helps by 17% on one jitter
;; realisation and hurts by 0.5% on another, so its benefit is WITHIN NOISE and
;; asserting it would be asserting a coin flip. From radius 2 up the cost is
;; unambiguous and grows fast. The floor is the last column: the true motion has
;; its own high-frequency content, 8.08e-4, and by radius 5 the filter is below
;; it — buying a smoother number by destroying performance, which is the entire
;; asset.
;;
;; So "smooth the transform" is not a law, and docs/port-plan.md already says as
;; much: it was broken by a bounded exception once keys went dense. On this
;; track the head motion is fast enough and the detector jitter small enough
;; that the low-pass has no useful range at all. That is a fact about THIS
;; synthetic track — real detector noise is larger — so the knob stays, and
;; these assertions pin the shape of it rather than a preferred value.
(let [rigid-of (fn [dense] (mapv (fn [fr] (mapv #(nth fr %) lm/RIGID)) dense))
;; Both fitted against the SAME reference — the clean track's — so tx and
;; ty are in one gauge. Fitting each against its own Procrustes mean would
;; put them in different frames and the difference would be mostly gauge.
clean (rigid-of (synth/synth-dense 72 {:rand-fn (constantly 0.5)}))
noisy (rigid-of (synth/synth-dense 72))
ref (geom/procrustes-mean clean)
truth (mapv #(geom/fit-similarity % ref) clean)
measured (mapv #(geom/fit-similarity % ref) noisy)
err (fn [tfs]
(/ (reduce + (map (fn [a b] (js/Math.hypot (- (:tx a) (:tx b))
(- (:ty a) (:ty b))))
tfs truth))
(count truth)))
hf (fn [tfs]
(let [tx (mapv :tx tfs) n (count tx)]
(/ (reduce + (map (fn [i] (abs (+ (- (nth tx (inc i))
(* 2 (nth tx i)))
(nth tx (dec i)))))
(range 1 (dec n))))
(- n 2))))
at (fn [r] (geom/smooth-transforms measured r))]
(is (pos? (err measured)) "the jittered track has to differ from the clean one at all")
(testing "radius 1 is a wash — within noise of not smoothing at all"
(is (< (abs (- (err (at 1)) (err measured))) (* 0.2 (err measured)))
(str "radius 0 " (err measured) " vs radius 1 " (err (at 1)))))
(testing "and past that the cost is unambiguous, so more is not better"
(is (> (err (at 5)) (* 5 (err measured)))
(str "radius 0 " (err measured) " vs radius 5 " (err (at 5)))))
(testing "it is a low-pass, so high-frequency energy falls monotonically"
(let [es (mapv #(hf (at %)) [0 1 2 3 5])]
(is (apply >= es) (str "hf energy by radius: " (pr-str es)))))
(testing "and eventually through the floor: the true motion's own hf energy"
(is (and (> (hf (at 2)) (hf truth)) (< (hf (at 5)) (hf truth)))
(str "truth hf " (hf truth) ", radius 2 " (hf (at 2))
", radius 5 " (hf (at 5)))))))

73
frontend/test/arthur/domain/landmarks_test.cljs Normal file
View file

@ -0,0 +1,73 @@
(ns arthur.domain.landmarks-test
"Assertions over the index tables themselves. Every one of these is a contract
some later stage reads off the table without re-deriving it."
(:require [cljs.test :refer [deftest is testing]]
[arthur.domain.landmarks :as lm]
[clojure.set :as set]))
(deftest table-sizes
(is (= 20 (count (set lm/LIPS-OUTER))) "LIPS-OUTER has 20 distinct ids")
(is (= 20 (count (set lm/LIPS-INNER))) "LIPS-INNER has 20 distinct ids")
(is (= 36 (count (set lm/FACE-OVAL))) "FACE-OVAL has 36 distinct ids")
(is (= 16 (count (set lm/EYE-R-RING))) "eye rings have 16 distinct ids each")
(is (= 16 (count (set lm/EYE-L-RING))))
(is (= 10 (count (set lm/BROW-A-RING))) "brow rings have 10 distinct ids each")
(is (= 10 (count (set lm/BROW-B-RING)))))
(deftest rigid-set-holds-nothing-that-performs
(testing "a moving feature in the rigid set bleeds performance into stabilisation"
(is (empty? (set/intersection (set lm/RIGID)
(into (set lm/LIPS-OUTER) lm/LIPS-INNER)))
"RIGID excludes every lip vertex")
(is (empty? (set/intersection (set lm/RIGID)
(into (set lm/BROW-A-RING) lm/BROW-B-RING)))
"a brow in RIGID would bleed expression into the stabilisation")))
(deftest rings-are-disjoint
(is (empty? (set/intersection (set lm/EYE-R-RING) (set lm/EYE-L-RING)))
"the two eye rings share no landmark")
(is (empty? (set/intersection (set lm/BROW-A-RING) (set lm/BROW-B-RING)))
"the two brow rings share no landmark")
(is (empty? (set/intersection (into (set lm/BROW-A-RING) lm/BROW-B-RING)
(into (set lm/EYE-R-RING) lm/EYE-L-RING)))
"no brow landmark is also a lid landmark"))
(deftest eye-ring-cardinals
;; The cardinal contract, asserted rather than trusted: on a 16-slot ring the
;; quarter slots must be the four anatomical cardinals, which is what makes
;; every even vertex budget land on real landmarks instead of between them.
(is (= [(nth lm/EYE-R-RING 0) (nth lm/EYE-R-RING 4)
(nth lm/EYE-R-RING 8) (nth lm/EYE-R-RING 12)]
[(first lm/EYE-R-CORNERS) (first lm/EYE-R-LIDS)
(second lm/EYE-R-CORNERS) (second lm/EYE-R-LIDS)])
"right eye slot 0/4/8/12 are outer, upper, inner, lower")
(is (= [(nth lm/EYE-L-RING 0) (nth lm/EYE-L-RING 4)
(nth lm/EYE-L-RING 8) (nth lm/EYE-L-RING 12)]
[(first lm/EYE-L-CORNERS) (first lm/EYE-L-LIDS)
(second lm/EYE-L-CORNERS) (second lm/EYE-L-LIDS)])
"left eye slot 0/4/8/12 are outer, upper, inner, lower"))
(deftest eye-corners-are-rigid
;; The gaze origin and denominator are built from the eye corners, so if a
;; corner were not rigid a blink could move it and fake a glance.
(is (every? (set lm/RIGID) (concat lm/EYE-R-CORNERS lm/EYE-L-CORNERS))
"every eye corner is a rigid landmark"))
(deftest aperture-sits-on-the-inner-ring-cardinals
;; The aperture is the inner ring's own height, not a separately written pair.
;; Writing them twice is what produced the bowtie.
(is (= lm/APERTURE [(nth lm/LIPS-INNER 5) (nth lm/LIPS-INNER 15)])
"APERTURE is slots 5 and 15 of LIPS-INNER"))
(deftest brow-end-slots
;; Both ends land on fixed slots whichever edge of the brow is on top, which
;; is what lets the upper/lower ambiguity go unresolved without consequence.
(is (and (= 2 (count lm/BROW-END-0)) (= 2 (count lm/BROW-END-1))
(empty? (set/intersection (set lm/BROW-END-0) (set lm/BROW-END-1))))
"brow end slots are disjoint and cover both ends"))
(deftest iris-blocks
(is (= 5 (count lm/IRIS-A) (count lm/IRIS-B))
"each iris block is a centre plus four ring points")
(is (= 478 lm/NUM-LANDMARKS)
"the refined mesh emits 468 face landmarks plus two iris blocks"))

133
frontend/test/arthur/domain/raster_test.cljs Normal file
View file

@ -0,0 +1,133 @@
(ns arthur.domain.raster-test
"The rasteriser's contract is: indexed, hard-edged, no blending. Every
assertion here is about a way that could silently stop being true."
(:require [cljs.test :refer [deftest is testing]]
[arthur.domain.raster :as r]
[arthur.domain.palette :as pal]))
(defn- count-index [{:keys [buf]} index]
(count (filter #(= index %) (array-seq buf))))
(defn- bbox
"[minx maxx miny maxy count] of the pixels holding `index`, or nil if none."
[{:keys [w h buf]} index]
(let [hits (for [y (range h) x (range w)
:when (= index (aget buf (+ (* y w) x)))]
[x y])]
(when (seq hits)
[(apply min (map first hits)) (apply max (map first hits))
(apply min (map second hits)) (apply max (map second hits))
(count hits)])))
(deftest only-written-indices-appear
(let [ras (-> (r/make 64 48)
(r/clear! 0)
(r/fill-poly! [{:x 8 :y 8} {:x 56 :y 8} {:x 56 :y 40} {:x 8 :y 40}] 2))
present (set (array-seq (:buf ras)))]
(is (= #{0 2} present) (str "indices present: " (pr-str present)))))
(deftest an-axis-aligned-rect-fills-the-exact-pixel-count
;; Off-by-one at the scanline or span boundary is the whole risk here, and it
;; would read as a one-pixel seam between two parts rather than as an error.
(let [ras (-> (r/make 64 48)
(r/clear! 0)
(r/fill-poly! [{:x 8 :y 8} {:x 56 :y 8} {:x 56 :y 40} {:x 8 :y 40}] 2))]
(is (= (* 48 32) (count-index ras 2))
(str (count-index ras 2) " vs " (* 48 32)))))
(deftest a-degenerate-polygon-draws-nothing
(let [ras (-> (r/make 16 16) (r/clear! 0))]
(r/fill-poly! ras [{:x 2 :y 2} {:x 9 :y 2}] 1)
(is (zero? (count-index ras 1)) "two points are not a polygon")
;; A horizontal edge contributes no crossing. If it were not skipped the
;; division by its zero height would emit Infinity and flood the scanline.
(r/fill-poly! ras [{:x 2 :y 2} {:x 9 :y 2} {:x 5 :y 2}] 1)
(is (zero? (count-index ras 1)) "a flat triangle has no interior")))
(deftest palette-expansion-introduces-no-intermediate-colours
;; Antialiasing anywhere in the chain would show up here as a colour that is in
;; neither palette entry, and it is exactly the thing the preview exists to not
;; do.
(let [ras (-> (r/make 8 8) (r/clear! 0))
_ (r/fill-poly! ras [{:x 1 :y 1} {:x 7 :y 1} {:x 7 :y 7} {:x 1 :y 7}] 4)
{:keys [data]} (r/->rgba ras pal/rgb 2)
seen (set (for [i (range 0 (alength data) 4)]
[(aget data i) (aget data (+ i 1)) (aget data (+ i 2))]))]
(is (every? (set pal/rgb) seen)
(str "colours not in the palette: " (pr-str (remove (set pal/rgb) seen))))
(is (= 2 (count seen)) (str (count seen) " distinct colours, expected 2"))))
(deftest rgba-is-opaque-and-nearest-neighbour
(let [ras (-> (r/make 4 4) (r/clear! 1))
{:keys [width height data]} (r/->rgba ras pal/rgb 3)]
(is (= [12 12] [width height]))
(is (every? #(= 255 (aget data %)) (range 3 (alength data) 4)) "every alpha is 255")
(is (= (* 12 12 4) (alength data)))))
(deftest an-index-with-no-palette-entry-is-loudly-wrong
;; Magenta rather than black or transparent: writing an index the palette does
;; not have is a bug, and it should be impossible to miss.
(let [ras (-> (r/make 2 2) (r/clear! 200))
{:keys [data]} (r/->rgba ras pal/rgb)]
(is (= [255 0 255] [(aget data 0) (aget data 1) (aget data 2)]))))
;; ---- the stencil, which is what keeps the iris inside the eye ----
(deftest a-stencilled-disc-cannot-spill-past-its-clip
(let [ras (-> (r/make 40 40) (r/clear! 0))]
(r/fill-poly! ras [{:x 10 :y 10} {:x 30 :y 10} {:x 30 :y 20} {:x 10 :y 20}] 1)
(r/fill-disc! ras 28 15 9 2 1) ; a disc reaching well past the "lid"
(let [in-lid? (fn [x y] (and (>= x 10) (< x 30) (>= y 10) (< y 20)))
hits (for [y (range 40) x (range 40)
:when (= 2 (aget (:buf ras) (+ (* y 40) x)))]
[x y])]
(is (every? (fn [[x y]] (in-lid? x y)) hits)
(str (count (remove (fn [[x y]] (in-lid? x y)) hits)) " pixels spilled"))
(is (> (count hits) 20) "and the disc actually drew something"))))
(deftest an-unstencilled-disc-still-writes-anywhere
(let [ras (-> (r/make 40 40) (r/clear! 0))]
(r/fill-disc! ras 5 35 3 3)
(is (pos? (count-index ras 3)))))
(deftest the-pupil-inherits-the-iris-clip-transitively
;; The stencil chain: pupil over iris over sclera. A pupil placed where the
;; iris has already been cropped must be cropped the same way.
(let [ras (-> (r/make 40 40) (r/clear! 0))]
(r/fill-poly! ras [{:x 10 :y 10} {:x 30 :y 10} {:x 30 :y 20} {:x 10 :y 20}] 1)
(r/fill-disc! ras 28 15 9 2 1)
(r/fill-rect! ras 28 15 5 4 2)
(let [spill (for [y (range 40) x (range 40)
:when (and (= 4 (aget (:buf ras) (+ (* y 40) x)))
(not (and (>= x 10) (< x 30) (>= y 10) (< y 20))))]
[x y])]
(is (empty? spill) (str "pupil spilled at " (pr-str (vec spill))))
(is (pos? (count-index ras 4)) "and the pupil actually drew something"))))
;; ---- the pupil is the same mark on every frame ----
(deftest a-three-pixel-pupil-is-three-by-three-at-every-centre
;; A square pupil is only worth having if it is the SAME square every frame:
;; exactly its nominal size at any centre, or it breathes as the gaze moves.
(doseq [[cx cy] [[20 20] [20.5 20.5] [20.49 19.51] [21 20] [20.9 20.1]]]
(let [ras (-> (r/make 40 40) (r/clear! 0))]
(r/fill-rect! ras cx cy 3 1)
(let [[x0 x1 y0 y1 n] (bbox ras 1)]
(is (= [3 3 9] [(inc (- x1 x0)) (inc (- y1 y0)) n])
(str "centre " cx "," cy " gave " (inc (- x1 x0)) "x" (inc (- y1 y0)) ":" n))))))
(deftest pupil-size-zero-draws-nothing
(let [ras (-> (r/make 40 40) (r/clear! 0))]
(r/fill-rect! ras 20 20 0 1)
(is (zero? (count-index ras 1)))))
;; ---- the palette itself ----
(deftest palette-indices-are-stable-and-derived
(is (= 0 (:bg pal/index-of)) "bg is index 0, which clear! relies on")
(is (= (count pal/entries) (count pal/index-of) (count pal/rgb)))
(is (apply distinct? (map :name pal/entries)) "no duplicate palette names")
(is (every? #(= 3 (count %)) pal/rgb))
(is (= [18 20 28] (pal/hex->rgb "#12141c")))
(testing "index-of round-trips against the ordered vector"
(is (every? (fn [[k i]] (= k (:name (nth pal/entries i)))) pal/index-of))))

107
frontend/test/arthur/domain/ring_test.cljs Normal file
View file

@ -0,0 +1,107 @@
(ns arthur.domain.ring-test
"The ring-simplicity check exists because \"fixed topology\" is load-bearing in
docs/design.md: because hold parts CUT between poses rather than
interpolating, a ring whose vertex order is wrong self-intersects and renders
as blocks meeting at corners. It is invisible at some vertex counts and obvious
at others, so it needs an assertion rather than an eyeball."
(:require [cljs.test :refer [deftest is testing]]
[arthur.domain.landmarks :as lm]
[arthur.domain.ring :as ring]
[arthur.synth :as synth]))
(def dense (delay (synth/synth-dense 72)))
(defn- first-bad-budget
"The first [budget frame edge] at which `table`'s subsampled ring
self-intersects on the synthetic track, or nil. Reported rather than asserted
per-frame so a failure names the case instead of only the count."
[table budgets]
(first
(for [n budgets
:let [slots (ring/subsample-slots (count table) n)]
[f fr] (map-indexed vector @dense)
:let [pts (mapv #(nth fr (nth table %)) slots)
hits (ring/self-intersections pts)]
:when (seq hits)]
{:verts n :frame f :edges (first hits)})))
(deftest subsample-preserves-order-and-count
(doseq [n (range 4 17 2)]
(let [s (ring/subsample-slots 20 n)]
(is (= n (count s)) (str "subsample-slots(20," n ") returns n slots"))
(is (apply < s) (str "subsample-slots(20," n ") is strictly increasing: " (pr-str s))))))
(deftest subsample-ring-agrees-with-subsample-slots
(is (= (ring/subsample-ring lm/LIPS-OUTER 8)
(mapv #(nth lm/LIPS-OUTER %) (ring/subsample-slots 20 8)))))
(deftest lid-ring-carries-its-own-corners
;; Subsampling a 16-slot ring to any even budget must keep the two corners at
;; output indices 0 and n/2. That is what lets the socket be read back off the
;; drawn polygon instead of measured separately, which is what stops the iris
;; drifting relative to the eye it sits in.
(doseq [n (range 4 13 2)]
(let [sl (ring/subsample-slots 16 n)]
(is (and (= 0 (nth sl 0)) (= 8 (nth sl (quot n 2))))
(str "n=" n " -> " (pr-str sl))))))
(deftest lip-rings-are-simple-at-every-vertex-budget
(doseq [[label table] [["outer" lm/LIPS-OUTER] ["inner" lm/LIPS-INNER]]]
(is (nil? (first-bad-budget table (range 4 17 2)))
(str label " ring self-intersects: "
(pr-str (first-bad-budget table (range 4 17 2)))))))
(deftest face-oval-is-a-simple-ring-on-every-frame
;; A wrong ordering here shows up as a lumpy plate rather than an obvious
;; bowtie, so it needs asserting.
(is (nil? (first-bad-budget lm/FACE-OVAL [(count lm/FACE-OVAL)]))))
(deftest eye-rings-are-simple-at-every-vertex-budget
;; Checked on blink frames too, where the ring is nearly degenerate.
(doseq [[label table] [["right" lm/EYE-R-RING] ["left" lm/EYE-L-RING]]]
(is (nil? (first-bad-budget table (range 4 13 2)))
(str label " eye ring self-intersects: "
(pr-str (first-bad-budget table (range 4 13 2)))))))
(deftest brow-rings-are-simple-at-every-vertex-budget
(doseq [[label table] [["A" lm/BROW-A-RING] ["B" lm/BROW-B-RING]]]
(is (nil? (first-bad-budget table (range 4 11 2)))
(str "brow " label " ring self-intersects: "
(pr-str (first-bad-budget table (range 4 11 2)))))))
(deftest offset-ring-grows-by-a-fixed-amount
;; offset-ring must grow by a FIXED amount and survive a degenerate ring - the
;; shut eyelid is exactly the degenerate case, and it is the frame where the
;; lash line is the entire drawing.
(let [sq [{:x -1 :y 0} {:x 0 :y -1} {:x 1 :y 0} {:x 0 :y 1}]
g (ring/offset-ring sq 2)]
(is (every? true?
(map (fn [p q] (< (abs (- (js/Math.hypot (:x p) (:y p))
(+ (js/Math.hypot (:x q) (:y q)) 2)))
1e-9))
g sq))
"offset-ring pushes every vertex out by exactly d")
(is (identical? sq (ring/offset-ring sq 0)) "offset-ring(0) is identity")))
(deftest offset-ring-survives-a-shut-lid
(let [shut-lid [{:x -10 :y 0} {:x 0 :y -0.02} {:x 10 :y 0} {:x 0 :y 0.02}]
band (ring/offset-ring shut-lid 1.5)
h (- (apply max (map :y band)) (apply min (map :y band)))]
(is (> h 2.9) (str "shut lid gets a visible lash band, height " h))
(is (ring/simple? band) "offset-ring keeps the shut lid simple")))
(deftest offset-ring-tolerates-a-vertex-on-the-centroid
;; A vertex sitting exactly on the centroid has no outward direction. Leave it
;; where it is rather than emitting NaN and poisoning the whole ring.
(let [degenerate [{:x 0 :y 0} {:x 0 :y 0} {:x 0 :y 0}]]
(is (every? #(and (not (js/isNaN (:x %))) (not (js/isNaN (:y %))))
(ring/offset-ring degenerate 3)))))
(deftest a-bowtie-is-detected
;; The detector has to actually fire, or every simplicity assertion above is
;; asserting nothing. Swapping two opposite vertices of a square is exactly
;; the bowtie the lip rings grew.
(let [square [{:x 0 :y 0} {:x 10 :y 0} {:x 10 :y 10} {:x 0 :y 10}]
bowtie [{:x 0 :y 0} {:x 10 :y 0} {:x 0 :y 10} {:x 10 :y 10}]]
(is (ring/simple? square))
(is (not (ring/simple? bowtie)) "a swapped pair of opposite vertices is caught")))

200
frontend/test/arthur/parity_test.cljs Normal file
View file

@ -0,0 +1,200 @@
(ns arthur.parity-test
"Diffs the CLJS port against js/ — the numeric oracle — on the identical
synthetic track.
DELETABLE, and deliberately so. This namespace and test/parity/oracle.mjs go
together, in one commit, once the CLJS player renders the synthetic take
correctly (port-plan step 5).
Parity proves the port is FAITHFUL, not that the answer is RIGHT. The JS is a
prototype and several of its conclusions contradict each other; a parity test
pins behaviour while the code moves, and a correctness test asserts something
that has been decided and stays. Conflating the two bakes the prototype's
mistakes into the rewrite and makes them permanent — so nothing in here is
allowed to outlive the move, and nothing in here is evidence that a number is
the number we want.
Run test/parity/oracle.mjs first; `npm test` does."
(:require [cljs.test :refer [deftest is testing]]
[arthur.domain.geom :as geom]
[arthur.domain.landmarks :as lm]
[arthur.domain.palette :as pal]
[arthur.domain.raster :as raster]
[arthur.domain.ring :as ring]
[arthur.synth :as synth]))
;; The port plan's number. A larger gap than this is a port bug, not float noise.
(def TOL 1e-9)
(def oracle
(delay
(let [fs (js/require "fs")
path (str js/__dirname "/../test/parity/oracle.json")]
(when-not (.existsSync fs path)
(throw (ex-info (str "no oracle at " path
" — run `node test/parity/oracle.mjs` first")
{:path path})))
(js->clj (js/JSON.parse (.readFileSync fs path "utf8")) :keywordize-keys true))))
;; Both sides get jitter of exactly zero, which is what makes the tracks
;; comparable at all: the JS uses Math.random and the CLJS a seeded generator.
(def track (delay (synth/synth-dense (:frames @oracle) {:rand-fn (constantly 0.5)})))
(defn- worst
"The largest absolute difference between two equally-shaped nested numeric
structures, and where it was, so a failure names the case."
[a b]
(let [seen (atom {:d -1 :at nil})]
(letfn [(walk [x y path]
(cond
(number? x)
(let [d (abs (- x y))]
(when (> d (:d @seen)) (reset! seen {:d d :at path :got x :want y})))
(map? x)
(doseq [k (keys x)] (walk (get x k) (get y k) (conj path k)))
(sequential? x)
(do (when (not= (count x) (count y))
(throw (ex-info "shape mismatch" {:at path :got (count x) :want (count y)})))
(dotimes [i (count x)] (walk (nth x i) (nth y i) (conj path i))))
:else nil))]
(walk a b []))
@seen))
(defn- agrees?
"Assert two structures agree to TOL, reporting the worst offender."
[label a b]
(let [{:keys [d at got want]} (worst a b)]
(is (< d TOL)
(str label ": worst gap " d " at " (pr-str at) " (" got " vs " want ")"))))
;; ---- the track itself ----
;;
;; Everything below is meaningless if the two synths disagree, so this is
;; asserted first and separately: a track mismatch would otherwise surface as a
;; dozen numeric failures pointing nowhere near the cause.
(deftest the-two-synths-produce-the-same-track
(let [js-track (:track @oracle)]
(is (= (count js-track) (count @track)))
(is (= (count (first js-track)) (count (first @track))))
(agrees? "synthetic track" @track js-track)))
;; ---- the tables ----
(deftest tables-were-transcribed-without-a-typo
(let [t (:tables @oracle)]
(is (= lm/RIGID (:RIGID t)))
(is (= lm/LIPS-OUTER (:LIPS_OUTER t)))
(is (= lm/EYE-R-RING (:EYE_R_RING t)))
(is (= lm/BROW-A-RING (:BROW_A_RING t)))
(is (= lm/FACE-OVAL (:FACE_OVAL t)))))
;; ---- domain/ring ----
(deftest subsample-slots-agrees
;; The oracle keys are "len/n", which js->clj reads as a NAMESPACED keyword —
;; so the length is the namespace, not the first half of the name.
(doseq [[k want] (:subsampleSlots @oracle)]
(let [len (js/parseInt (namespace k))
n (js/parseInt (name k))]
(is (= want (ring/subsample-slots len n))
(str "subsample-slots(" len "," n ")")))))
(deftest offset-ring-agrees
(doseq [{:keys [d ring shutLid collapsed]} (:offsetRing @oracle)]
(let [src (mapv #(nth (first @track) %) lm/LIPS-OUTER)]
(agrees? (str "offset-ring(lips, " d ")")
(mapv #(select-keys % [:x :y]) (ring/offset-ring src d))
(mapv #(select-keys % [:x :y]) ring)))
(agrees? (str "offset-ring(shut lid, " d ")")
(mapv #(select-keys % [:x :y])
(ring/offset-ring [{:x -10 :y 0} {:x 0 :y -0.02}
{:x 10 :y 0} {:x 0 :y 0.02}] d))
(mapv #(select-keys % [:x :y]) shutLid))
;; A vertex on the centroid has no outward direction. Both sides must leave
;; it alone rather than emit NaN, and NaN != NaN would slip past `worst`.
(let [got (ring/offset-ring [{:x 0 :y 0} {:x 0 :y 0} {:x 0 :y 0}] d)]
(is (every? #(and (not (js/isNaN (:x %))) (not (js/isNaN (:y %)))) got)
(str "offset-ring(collapsed, " d ") is NaN-free"))
(is (every? #(and (not (js/isNaN (:x %))) (not (js/isNaN (:y %)))) collapsed)
"...and the oracle's is too, so this is parity and not a shared bug"))))
;; ---- domain/geom: the two the port plan names ----
(deftest fit-similarity-agrees-on-a-known-transform
(let [{:keys [src dst fit]} (:known @oracle)]
(agrees? "fit-similarity (known transform)"
(geom/fit-similarity src dst)
fit)))
(deftest fit-similarity-agrees-over-the-whole-shot
(let [rigid (mapv (fn [fr] (mapv #(nth fr %) lm/RIGID)) @track)
ref (:rigidRef @oracle)]
;; Fitted against the ORACLE's reference, so this isolates fit-similarity
;; from procrustes-mean instead of compounding the two.
(agrees? "fit-similarity over 72 frames"
(mapv #(geom/fit-similarity % ref) rigid)
(:transforms @oracle))))
(deftest procrustes-mean-agrees
(let [rigid (mapv (fn [fr] (mapv #(nth fr %) lm/RIGID)) @track)]
(agrees? "procrustes-mean"
(mapv #(select-keys % [:x :y]) (geom/procrustes-mean rigid))
(mapv #(select-keys % [:x :y]) (:rigidRef @oracle)))))
(deftest fit-residual-agrees
(let [rigid (mapv (fn [fr] (mapv #(nth fr %) lm/RIGID)) @track)
ref (:rigidRef @oracle)]
(agrees? "fit-residual"
(mapv (fn [r tf] (geom/fit-residual tf r ref))
rigid (:transforms @oracle))
(:residuals @oracle))))
;; ---- domain/geom: the smoothing knobs ----
(deftest moving-average-agrees-at-every-radius
(let [tx (mapv :tx (:transforms @oracle))]
(doseq [{:keys [radius vals]} (:movingAverage @oracle)]
(agrees? (str "moving-average radius " radius)
(geom/moving-average tx radius)
vals))))
(deftest smooth-transforms-agrees-at-every-radius
(doseq [{:keys [radius tfs]} (:smoothed @oracle)]
(agrees? (str "smooth-transforms radius " radius)
(geom/smooth-transforms (:transforms @oracle) radius)
tfs)))
;; ---- domain/raster ----
(deftest raster-agrees-pixel-for-pixel
;; Integer output, so this is EXACT equality and not TOL. The whole buffer is
;; diffed rather than a pixel count: one scanline a pixel wide of the JS would
;; read as a seam between two parts, not as an error, and a count would miss it.
(let [{:keys [w h buf]} (:raster @oracle)
fr (first @track)
ras (-> (raster/make w h) (raster/clear! 0))]
(raster/fill-poly! ras (mapv (fn [i] {:x (- (* (:x (nth fr i)) 320) 100)
:y (- (* (:y (nth fr i)) 200) 40)})
lm/LIPS-OUTER) 2)
(raster/fill-poly! ras [{:x 8.5 :y 8.5} {:x 56.25 :y 8.5}
{:x 56.25 :y 40.75} {:x 8.5 :y 40.75}] 1)
(raster/fill-disc! ras 30.4 24.6 9.2 3 1)
(raster/fill-disc! ras 5.5 44.5 4 4)
(raster/fill-rect! ras 30.49 24.51 3 5 3)
(raster/fill-rect! ras 1 1 0 6)
(let [got (vec (array-seq (:buf ras)))
diff (keep-indexed (fn [i v] (when (not= v (nth buf i))
{:at [(mod i w) (quot i w)]
:got v :want (nth buf i)}))
got)]
(is (empty? diff)
(str (count diff) " of " (* w h) " pixels differ, first few: "
(pr-str (vec (take 5 diff)))))
;; A buffer that agreed because both sides drew nothing would pass the
;; above, so check the drawing actually happened.
(is (> (count (distinct got)) 3)
(str "only " (pr-str (distinct got)) " indices present")))))
(deftest hex-to-rgb-agrees
(agrees? "palette rgb" pal/rgb (:paletteRgb @oracle)))

173
frontend/test/arthur/synth.cljs Normal file
View file

@ -0,0 +1,173 @@
(ns arthur.synth
"Synthetic landmark frames, shaped exactly like FaceLandmarker output.
Exists so the whole chain downstream of detection - Procrustes, smoothing,
stabilisation, key selection, rasterising, take writing - can be exercised and
verified without a video file. A synthetic face is also the only way to test
stabilisation against a KNOWN head motion, since real footage gives no ground
truth to compare against.
Differs from js/synth.js in exactly one way, deliberately: the jitter comes
from a SEEDED generator rather than Math.random. Two reasons. A failing
assertion has to be reproducible to be worth anything, and the JS is the
numeric oracle - parity is only checkable if both sides can be handed the same
track. `:rand-fn` takes the generator over, so stubbing js/Math.random in a
node harness makes the two implementations agree exactly."
(:require [arthur.domain.landmarks :as lm]))
;; mulberry32. Chosen for being four lines of int32 arithmetic that port
;; unambiguously between JS and CLJS, not for its statistics: this is jitter for
;; a smoother to remove, not a source of entropy.
(defn mulberry32 [seed]
(let [a (atom (bit-or seed 0))]
(fn []
(let [x (swap! a (fn [v] (bit-or (+ v 0x6D2B79F5) 0)))
t (js/Math.imul (bit-xor x (unsigned-bit-shift-right x 15)) (bit-or 1 x))
t (bit-xor (+ t (js/Math.imul (bit-xor t (unsigned-bit-shift-right t 7))
(bit-or 61 t)))
t)]
(/ (unsigned-bit-shift-right (bit-xor t (unsigned-bit-shift-right t 14)) 0)
4294967296)))))
;; Half the corner separation, and the lid half-height at full open.
(def ^:private EYE-RX 0.0235)
(def ^:private EYE-RY 0.011)
(def ^:private EYE-Y -0.044)
(defn synth-dense
"`n-frames` of dense landmarks.
`:swap-iris` places the two iris blocks on the opposite eyes. It exists so the
pairing resolver can be tested against a track it actually disagrees with:
a resolver checked only against the convention it was written for is checking
nothing at all."
([] (synth-dense 72 {}))
([n-frames] (synth-dense n-frames {}))
([n-frames {:keys [swap-iris rand-fn seed]
:or {swap-iris false, seed 1}}]
(let [rnd (or rand-fn (mulberry32 seed))]
(vec
(for [t (range n-frames)]
(let [pts (make-array lm/NUM-LANDMARKS)
_ (dotimes [i lm/NUM-LANDMARKS] (aset pts i {:x 0.5 :y 0.5 :z 0}))
;; Known head motion: drift, sway, roll and a slow scale change, plus a
;; little per-frame jitter so transform smoothing has something to remove.
ph (/ t n-frames)
hx (+ 0.5 (* 0.045 (js/Math.sin (* ph js/Math.PI 2))) (* (- (rnd) 0.5) 0.002))
hy (+ 0.5 (* 0.02 (js/Math.cos (* ph js/Math.PI 3))) (* (- (rnd) 0.5) 0.002))
roll (* 0.18 (js/Math.sin (* ph js/Math.PI 2.5)))
scale (+ 1 (* 0.06 (js/Math.sin (* ph js/Math.PI 1.5))))
cr (js/Math.cos roll)
sr (js/Math.sin roll)
place (fn [i lx ly]
(let [sx (* lx scale) sy (* ly scale)]
(aset pts i {:x (- (+ hx (* cr sx)) (* sr sy))
:y (+ hy (* sr sx) (* cr sy))
:z 0})))
;; Mouth opens in four sustained beats with holds between, so key selection
;; has genuine extremes and genuine plateaux to find.
beat (mod (js/Math.floor (/ t 9)) 4)
open-amt (nth [0.004 0.05 0.022 0.0] beat)
wide (+ 0.10 (case beat 1 0.012, 3 -0.008, 0))
;; A blink is ONE frame, which is the honest hard case: at 12fps that is
;; what a real blink costs, and it is exactly the length that reads as a
;; dropped frame rather than as a blink unless `hold` extends it.
blink (and (> t 5) (zero? (mod t 19)))
openness (if blink 0.05 1)
;; Gaze holds and then jumps, the way gaze actually behaves, with a little
;; jitter on top so quantisation has noise to remove and the dwell has
;; something to suppress.
[gx gy] (nth [[0 0] [0.16 0.0] [-0.16 0.05] [0.0 -0.09]]
(mod (js/Math.floor (/ t 11)) 4))
jit (fn [] (* (- (rnd) 0.5) 0.012))
;; Eyes. The corners (RIGID[0..3]) are placed BY the lid rings rather than
;; separately, because they are slots 0 and 8 of those rings: writing them
;; twice is how the mouth grew a bowtie, and a corner that disagrees with
;; its own ring would make the eye self-intersect at some vertex budgets
;; and not others.
eye (fn [ring cx dir iris]
(let [n (count ring)]
(dotimes [k n]
;; dir flips the traversal so each ring runs the direction its real
;; table does: slot 0 outer corner, 4 upper lid, 8 inner, 12 lower.
(let [a (if (pos? dir)
(+ js/Math.PI (* (/ k n) js/Math.PI 2))
(- (* (/ k n) js/Math.PI 2)))]
(place (nth ring k)
(+ cx (* EYE-RX (js/Math.cos a)))
(+ EYE-Y (* EYE-RY openness (js/Math.sin a))))))
;; Iris: centre first, then four ring points, as the refined mesh emits.
(let [ix (+ cx (* (+ gx (jit)) EYE-RX 2))
iy (+ EYE-Y (* (+ gy (jit)) EYE-RX 2))
m (count iris)]
(place (nth iris 0) ix iy)
(doseq [k (range 1 m)]
(let [a (* (/ (dec k) (dec m)) js/Math.PI 2)]
(place (nth iris k)
(+ ix (* 0.008 (js/Math.cos a)))
(+ iy (* 0.008 (js/Math.sin a)))))))))
;; Brows, held in four sustained poses so raise quantisation has genuine
;; plateaux to find: rest, surprise (both ends up), worry (inner up only),
;; anger (inner down). Commanded in eye widths above the eye centre so the
;; measurement can be checked against a number rather than an eyeball.
[b-out b-in] (nth [[0.30 0.30] [0.46 0.46] [0.30 0.44] [0.30 0.18]]
(mod (js/Math.floor (/ t 13)) 4))
EYE-W (* EYE-RX 2)
HALF 0.006 ; ring half-thickness
brow (fn [ring cx outer-sign]
;; Slots 0-4 are one edge outer->inner, 5-9 the other inner->outer, so the
;; ends land on {0,9} and {4,5} exactly as the table promises.
(let [n (count ring) half (/ n 2)]
(dotimes [k n]
(let [along (if (< k half)
(/ k (dec half))
(/ (- n 1 k) (dec half)))
rise (+ b-out (* (- b-in b-out) along))]
(place (nth ring k)
(+ cx (* outer-sign (- EYE-RX (* along EYE-W)) 1.05))
(+ (- EYE-Y (* rise EYE-W))
(if (< k half) (- HALF) HALF)))))))
;; Lip rings as ellipse arcs, traversed so ring ORDER matches the tables:
;; slot 0 = right corner, 5 = top centre, 10 = left corner, 15 = bottom
;; centre, with y growing downward. Getting this convention wrong swaps two
;; opposite vertices and the ring self-intersects into a bowtie - see the
;; ring-simplicity assertion in domain/ring's tests.
ring (fn [table rx ry cy]
(let [n (count table)]
(dotimes [k n]
(let [a (- (* (/ k n) js/Math.PI 2))]
(place (nth table k)
(* rx (js/Math.cos a))
(+ cy (* ry (js/Math.sin a))))))))]
(place (nth lm/RIGID 4) 0.000 -0.050)
(place (nth lm/RIGID 5) 0.000 -0.020)
(place (nth lm/RIGID 6) 0.000 0.012)
(eye lm/EYE-R-RING -0.0515 1 (if swap-iris lm/IRIS-B lm/IRIS-A))
(eye lm/EYE-L-RING 0.0515 -1 (if swap-iris lm/IRIS-A lm/IRIS-B))
(brow lm/BROW-A-RING -0.0515 -1)
(brow lm/BROW-B-RING 0.0515 1)
(ring lm/LIPS-OUTER (/ wide 2) (+ 0.012 (* open-amt 0.6)) 0.075)
;; APERTURE (13, 14) are slots 5 and 15 of the inner ring, so the ring itself
;; places them at the vertical extremes. Writing them again afterwards is what
;; produced the bowtie; the aperture is simply the inner ring's height.
(ring lm/LIPS-INNER (/ wide 2.6) (+ 0.001 open-amt) 0.075)
(let [n (count lm/FACE-OVAL)]
(dotimes [k n]
(let [a (+ (- (/ js/Math.PI 2)) (* (/ k n) js/Math.PI 2))]
(place (nth lm/FACE-OVAL k)
(* 0.105 (js/Math.cos a))
(+ (* 0.145 (js/Math.sin a)) 0.01)))))
(vec pts)))))))

69
frontend/test/arthur/synth_test.cljs Normal file
View file

@ -0,0 +1,69 @@
(ns arthur.synth-test
"The generator is test infrastructure, so it gets its own assertions: a
silently wrong synthetic track would make every stage downstream of it agree
about the wrong answer."
(:require [cljs.test :refer [deftest is testing]]
[arthur.domain.landmarks :as lm]
[arthur.synth :as synth]))
(deftest shape-matches-facelandmarker-output
(let [dense (synth/synth-dense 12)]
(is (= 12 (count dense)))
(is (every? #(= lm/NUM-LANDMARKS (count %)) dense))
(is (every? (fn [fr] (every? #(and (number? (:x %)) (number? (:y %)) (number? (:z %))) fr))
dense))))
(deftest a-seeded-track-is-reproducible
;; A failing assertion has to be reproducible to be worth anything, and the JS
;; is the numeric oracle - parity is only checkable if both sides can be handed
;; the same track.
(is (= (synth/synth-dense 8) (synth/synth-dense 8)))
(is (not= (synth/synth-dense 8 {:seed 1}) (synth/synth-dense 8 {:seed 2}))
"a different seed is a different track, so the jitter is really jittering"))
(deftest rand-fn-takes-the-generator-over
;; This is the hook the JS-parity harness uses: stub js/Math.random on one side
;; and pass the matching constant here, and the two tracks are identical.
(let [zero-jitter (synth/synth-dense 8 {:rand-fn (constantly 0.5)})]
(is (= zero-jitter (synth/synth-dense 8 {:rand-fn (constantly 0.5)})))
(is (not= zero-jitter (synth/synth-dense 8)))))
(deftest the-blink-is-one-frame-every-nineteen
;; At 12fps that is what a real blink costs, and it is exactly the length that
;; reads as a dropped frame rather than as a blink unless `hold` extends it.
(let [dense (synth/synth-dense 72)
lid-gap (fn [fr]
(abs (- (:y (nth fr (first lm/EYE-R-LIDS)))
(:y (nth fr (second lm/EYE-R-LIDS))))))
gaps (mapv lid-gap dense)
open (apply max gaps)
shut (keep-indexed (fn [f g] (when (< g (* 0.2 open)) f)) gaps)]
(is (= [19 38 57] (vec shut))
(str "shut frames were " (pr-str (vec shut))))))
(deftest swap-iris-really-swaps
;; The flag exists so the pairing resolver can be tested against a track it
;; actually disagrees with. If it were a no-op that test would be vacuous.
(let [a (first (synth/synth-dense 4))
b (first (synth/synth-dense 4 {:swap-iris true}))
centre (fn [fr block] (nth fr (first block)))]
(is (= (centre a lm/IRIS-A) (centre b lm/IRIS-B)))
(is (= (centre a lm/IRIS-B) (centre b lm/IRIS-A)))
(is (not= (centre a lm/IRIS-A) (centre b lm/IRIS-A))
"the two iris blocks are on opposite sides of the face, so a swap moves them")))
(deftest the-head-really-moves
;; Stabilisation is tested against a KNOWN head motion, so the motion has to be
;; there. Measured on a rigid landmark, which only the head moves.
(let [dense (synth/synth-dense 72)
xs (map #(:x (nth % (nth lm/RIGID 4))) dense)]
(is (> (- (apply max xs) (apply min xs)) 0.05)
"the nose bridge travels across the frame")))
(deftest the-mouth-really-opens
(let [dense (synth/synth-dense 72)
ap (map (fn [fr] (abs (- (:y (nth fr (first lm/APERTURE)))
(:y (nth fr (second lm/APERTURE))))))
dense)]
(is (> (- (apply max ap) (apply min ap)) 0.05)
"the aperture has genuine extremes for key selection to find")))

4
frontend/test/parity/.gitignore vendored Normal file
View file

@ -0,0 +1,4 @@
# Generated by oracle.mjs on every `npm test`. Not committed: it is 1.2MB of
# derived numbers, and a stale copy would make the parity suite pass against
# yesterday's oracle.
oracle.json

107
frontend/test/parity/oracle.mjs Normal file
View file

@ -0,0 +1,107 @@
// Runs the JS prototype — the numeric oracle — and writes its answers to JSON
// for arthur.parity-test to diff against the CLJS port.
//
// DELETABLE. This file and arthur.parity-test go together, in one commit, once
// the CLJS player renders the synthetic take correctly (port-plan step 5). A
// parity test pins behaviour while the code moves; keeping it afterwards would
// bake the prototype's mistakes into the rewrite and make them permanent.
//
// Math.random is stubbed to a constant so both sides get the IDENTICAL track:
// js/synth.js reads Math.random at call time, not at import time, so assigning
// it here — before synthDense is called below — is enough, and js/ stays
// untouched. 0.5 makes every (Math.random() - 0.5) jitter term exactly zero,
// which is also what `:rand-fn (constantly 0.5)` does on the CLJS side.
Math.random = () => 0.5;
import { writeFileSync } from 'node:fs';
import { fileURLToPath } from 'node:url';
import { dirname, join } from 'node:path';
import { RIGID, LIPS_OUTER, EYE_R_RING, BROW_A_RING, FACE_OVAL,
subsampleSlots } from '../../../js/landmarks.js';
import { fitSimilarity, applySim, fitResidual, procrustesMean,
movingAverage, smoothTransforms, offsetRing } from '../../../js/mathutil.js';
import { synthDense } from '../../../js/synth.js';
import { IndexedRaster, hexToRgb } from '../../../js/raster.js';
const FRAMES = 72;
const track = synthDense(FRAMES);
const rigid = track.map((f) => RIGID.map((i) => f[i]));
// The two the port plan names explicitly, plus everything else in mathutil.js:
// a function nobody diffed is a function nobody ported.
const ref = procrustesMean(rigid);
const tfs = rigid.map((r) => fitSimilarity(r, ref));
const strip = (p) => ({ x: p.x, y: p.y, z: p.z ?? 0 });
const stripTf = (t) => ({ s: t.s, theta: t.theta, tx: t.tx, ty: t.ty });
// A known transform recovered exactly, which is the same case the CLJS unit test
// asserts — here so a disagreement can be localised to the fit rather than to
// the track.
const knownSrc = [{ x: 0, y: 0 }, { x: 1, y: 0 }, { x: 0, y: 1 }, { x: 2, y: 3 }];
const knownTruth = { s: 1.7, theta: 0.6, tx: 4, ty: -2 };
const knownDst = knownSrc.map((p) => applySim(knownTruth, p));
const out = {
frames: FRAMES,
track: track.map((f) => f.map(strip)),
rigidRef: ref.map(strip),
transforms: tfs.map(stripTf),
residuals: rigid.map((r, i) => fitResidual(tfs[i], r, ref)),
smoothed: [0, 1, 2, 5].map((radius) => ({
radius, tfs: smoothTransforms(tfs, radius).map(stripTf),
})),
known: { src: knownSrc, truth: knownTruth, dst: knownDst,
fit: stripTf(fitSimilarity(knownSrc, knownDst)) },
// tx over the shot is the sway; it is the one-dimensional series the smoothing
// knob actually acts on, so it is what movingAverage gets diffed on.
movingAverage: [0, 1, 2, 3, 7].map((radius) => ({
radius, vals: movingAverage(tfs.map((t) => t.tx), radius),
})),
offsetRing: [0, 0.5, 2, -1].map((d) => ({
d,
ring: offsetRing(LIPS_OUTER.map((i) => track[0][i]), d).map(strip),
// The degenerate case: a shut lid is a flat sliver and must still open into
// a band, and a ring collapsed onto its own centroid must not emit NaN.
shutLid: offsetRing([{ x: -10, y: 0 }, { x: 0, y: -0.02 },
{ x: 10, y: 0 }, { x: 0, y: 0.02 }], d).map(strip),
collapsed: offsetRing([{ x: 0, y: 0 }, { x: 0, y: 0 }, { x: 0, y: 0 }], d).map(strip),
})),
subsampleSlots: Object.fromEntries(
[[20, 4], [20, 6], [20, 8], [20, 10], [20, 16], [16, 4], [16, 6], [16, 12],
[10, 4], [10, 6], [10, 10], [36, 8]]
.map(([len, n]) => [`${len}/${n}`, subsampleSlots(len, n)])),
tables: { RIGID, LIPS_OUTER, EYE_R_RING, BROW_A_RING, FACE_OVAL },
// The raster is integer output, so parity here is EXACT equality, not 1e-9.
// One scanline drawn one pixel wide of the JS would read as a seam between two
// parts rather than as an error, which is why the whole buffer is diffed and
// not a pixel count.
//
// toImageData is not exercised: it needs an ImageData, the CLJS side returns
// plain bytes on purpose so domain/ stays DOM-free, and the palette expansion
// is asserted directly in arthur.domain.raster-test instead.
raster: (() => {
const r = new IndexedRaster(64, 48);
r.clear(0);
// A real mouth ring at raster scale, so the scanline fill is diffed on a
// shape with fractional coordinates and non-convex spans rather than on an
// axis-aligned box that would agree even if the rounding were wrong.
r.fillPoly(LIPS_OUTER.map((i) => ({ x: track[0][i].x * 320 - 100,
y: track[0][i].y * 200 - 40 })), 2);
r.fillPoly([{ x: 8.5, y: 8.5 }, { x: 56.25, y: 8.5 },
{ x: 56.25, y: 40.75 }, { x: 8.5, y: 40.75 }], 1);
r.fillDisc(30.4, 24.6, 9.2, 3, 1); // stencilled by the box
r.fillDisc(5.5, 44.5, 4, 4); // unstencilled, clipped by the edge
r.fillRect(30.49, 24.51, 3, 5, 3); // stencilled by the disc
r.fillRect(1, 1, 0, 6); // size 0 draws nothing
return { w: r.w, h: r.h, buf: Array.from(r.buf) };
})(),
paletteRgb: ['#12141c', '#b07a5a', '#7a4f3a', '#24161a', '#d9cfc2',
'#c9c3b4', '#4a5468', '#171a22', '#3a2a22'].map(hexToRgb),
};
const here = dirname(fileURLToPath(import.meta.url));
const path = join(here, 'oracle.json');
writeFileSync(path, JSON.stringify(out));
console.log(`oracle: ${FRAMES} frames -> ${path}`);