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

76
frontend/README.md Normal file
View file

@ -0,0 +1,76 @@
# frontend
The ClojureScript half. See `docs/port-plan.md` for what is being built and in
what order; this file is only how to run it.
## Once
```sh
mise install # from the REPO ROOT: java 21+, node 20, clojure, python
cd frontend && npm install
```
`java` must be 21+. On an older JDK shadow-cljs fails with "CompilerOptions has
been compiled by a more recent version of the Java Runtime", which reads like a
shadow-cljs bug and is not one. `mise install` is what prevents it.
## The tests
```sh
cd frontend && npm test
```
That is three things in order: regenerate the JS oracle's answers, compile the
`:test` build, run it under node.
```
node test/parity/oracle.mjs # drives js/ and writes test/parity/oracle.json
shadow-cljs compile test
node out/node-tests.js
```
Run them separately if a compile error is in the way. The oracle JSON is
generated, not committed.
## The app
```sh
cd frontend && npx shadow-cljs watch app
```
Then open **<http://localhost:8778/index.html>** — with the `/index.html`, not
bare `/`. This shadow-cljs does no directory-index resolution, so `/` is a 404
whatever the roots are.
Through step 1 the page is a placeholder on purpose: there is nothing to render
until the data model exists, and a shell built before the model is a shell built
around a guess. Something moves on screen at step 2.
Port 8778 is deliberately not 8777. `python3 serve.py` from the repo root still
runs the old JS tool on 8777, and the two are meant to run side by side — that is
the whole reason `js/` is still in the tree.
From step 9 Django serves the page and `:dev-http` goes away.
## The oracle
`js/` is the numeric oracle, not dead weight. `test/parity/` runs both
implementations on the same synthetic track and diffs them: `fit-similarity` and
`procrustes-mean` agree to 1e-9, the raster pixel-for-pixel.
Both sides get the identical track because `js/synth.js` reads `Math.random` at
call time, so `oracle.mjs` stubs it to a constant and the CLJS side passes
`:rand-fn (constantly 0.5)`. `js/` itself is never modified.
**`test/parity/` and `arthur.parity-test` get deleted in one commit at step 5.**
A parity test pins behaviour while code moves; keeping it afterwards would bake
the prototype's mistakes into the rewrite and make them permanent.
## Layout
```
src/arthur/domain/ pure. No re-frame, no DOM, no flow/.
test/arthur/synth.cljs the synthetic track — test infrastructure, not src
test/parity/ the JS oracle harness. Deletable at step 5.
public/index.html dev host page. Django replaces it at step 9.
```

1624
frontend/package-lock.json generated Normal file
View file

File diff suppressed because it is too large Load diff

17
frontend/package.json Normal file
View file

@ -0,0 +1,17 @@
{
"name": "arthur-frontend",
"private": true,
"version": "0.0.1",
"scripts": {
"watch": "shadow-cljs watch app",
"release": "shadow-cljs release app",
"test": "node test/parity/oracle.mjs && shadow-cljs compile test && node out/node-tests.js"
},
"dependencies": {
"react": "^18.3.1",
"react-dom": "^18.3.1"
},
"devDependencies": {
"shadow-cljs": "^2.28.21"
}
}

24
frontend/public/index.html Normal file
View file

@ -0,0 +1,24 @@
<!doctype html>
<!-- Host page for the CLJS build, for development only.
In production Django renders this and pulls the same bundle out of
staticfiles, which is why the script src is the /static/ path already. -->
<html lang="en">
<head>
<meta charset="utf-8">
<meta name="viewport" content="width=device-width, initial-scale=1">
<title>arthur</title>
<style>
:root { color-scheme: dark; --bg: #12141c; --fg: #c9c3b4; }
html, body { margin: 0; height: 100%; background: var(--bg); color: var(--fg); }
body { font: 14px/1.5 ui-monospace, SFMono-Regular, Menlo, monospace; }
main { padding: 24px; }
/* The preview is nearest-neighbour everywhere. A browser that smooths the
upscale would misrepresent the look the tool exists to judge. */
canvas { image-rendering: pixelated; }
</style>
</head>
<body>
<div id="app"></div>
<script src="/static/arthur/js/main.js"></script>
</body>
</html>

41
frontend/shadow-cljs.edn Normal file
View file

@ -0,0 +1,41 @@
;; Two builds and no more:
;;
;; app the tool. Output goes straight into the Django staticfiles tree, so
;; `python manage.py runserver` and `shadow-cljs watch app` are the whole
;; dev loop with nothing copying files between them.
;; test :node-test, because everything below `ui/` and `fx/` is pure and has
;; no business needing a browser to be asserted about. The canvas-facing
;; parts get asserted through domain/raster's byte buffer instead, which
;; is what the JS selftest already did.
{:source-paths ["src" "test"]
:dependencies [[reagent "1.2.0"]
[re-frame "1.4.3"]]
;; Dev server for the CLJS half, on a different port from serve.py (8777) so the
;; old tool and the port can run side by side — which is the whole point of
;; keeping js/ around as the numeric oracle.
;;
;; Two roots: `public` holds the host page, `..` is the repo root so the bundle
;; at /static/arthur/js/ resolves, and so manifest.json, audio.wav and frames/
;; are reachable when step 6 needs real footage.
;;
;; THE ORDER IS LOAD-BEARING. The repo root has an index.html too — the old
;; tool's — so with `..` first, /index.html would quietly serve the prototype
;; instead of the port. That would look like the CLJS build having regressed to
;; a suspiciously complete tool rather than like a misconfigured server.
;;
;; Open /index.html, not /. This shadow-cljs does no directory-index resolution,
;; so bare / is a 404 whatever the roots are. Django serves the page from step 9
;; and this whole key goes away.
:dev-http {8778 ["public" ".."]}
:builds
{:app {:target :browser
:output-dir "../static/arthur/js"
:asset-path "/static/arthur/js"
:modules {:main {:init-fn arthur.core/init}}}
:test {:target :node-test
:output-to "out/node-tests.js"
:ns-regexp "-test$"}}}

19
frontend/src/arthur/core.cljs Normal file
View file

@ -0,0 +1,19 @@
(ns arthur.core
"The app's one entry point. Deliberately almost empty until port-plan step 2:
there is nothing to render until the data model exists, and a shell built
before the model would be a shell built around a guess."
(:require [reagent.dom.client :as rdc]))
(defonce root (atom nil))
(defn shell []
[:main
[:h1 "arthur"]
[:p "Scaffold only. The scene renderer arrives with domain/scene."]])
(defn ^:dev/after-load mount []
(rdc/render @root [shell]))
(defn init []
(reset! root (rdc/create-root (js/document.getElementById "app")))
(mount))

130
frontend/src/arthur/domain/geom.cljs Normal file
View file

@ -0,0 +1,130 @@
(ns arthur.domain.geom
"2D similarity transforms and temporal smoothing.
A transform is {:s :theta :tx :ty}; a point is {:x :y}. Both stay maps at this
layer: this is the numeric oracle the JS is diffed against, and a faithful
port is worth more here than a fast one. The dense typed-array
representations appear at the freeze boundary, not below it.")
(defn fit-similarity
"Least-squares similarity (translation + rotation + uniform scale, 4 DOF)
mapping P onto Q. Closed form; no iteration.
Deliberately NOT affine or homography: the extra degrees of freedom absorb
out-of-plane head rotation as shear/perspective and smear it into the mouth.
Four DOF removes exactly translation, roll and depth-scale, and leaves yaw and
pitch as a measurable residual."
[P Q]
(let [n (count P)
[pcx pcy qcx qcy]
(loop [i 0, pcx 0.0, pcy 0.0, qcx 0.0, qcy 0.0]
(if (< i n)
(recur (inc i)
(+ pcx (:x (nth P i))) (+ pcy (:y (nth P i)))
(+ qcx (:x (nth Q i))) (+ qcy (:y (nth Q i))))
[(/ pcx n) (/ pcy n) (/ qcx n) (/ qcy n)]))
[a b norm]
(loop [i 0, a 0.0, b 0.0, norm 0.0]
(if (< i n)
(let [px (- (:x (nth P i)) pcx) py (- (:y (nth P i)) pcy)
qx (- (:x (nth Q i)) qcx) qy (- (:y (nth Q i)) qcy)]
(recur (inc i)
(+ a (+ (* px qx) (* py qy))) ; dot
(+ b (- (* px qy) (* py qx))) ; cross
(+ norm (+ (* px px) (* py py)))))
[a b norm]))
theta (js/Math.atan2 b a)
;; A degenerate configuration has nothing to recover a scale from. Fall
;; back to 1 rather than dividing by zero: one bad detection frame would
;; otherwise poison the Procrustes mean and therefore every frame.
s (if (> norm 1e-12) (/ (js/Math.hypot a b) norm) 1)
c (js/Math.cos theta)
sn (js/Math.sin theta)]
{:s s
:theta theta
:tx (- qcx (* s (- (* c pcx) (* sn pcy))))
:ty (- qcy (* s (+ (* sn pcx) (* c pcy))))}))
(defn apply-sim [tf p]
(let [c (js/Math.cos (:theta tf))
sn (js/Math.sin (:theta tf))]
{:x (+ (* (:s tf) (- (* c (:x p)) (* sn (:y p)))) (:tx tf))
:y (+ (* (:s tf) (+ (* sn (:x p)) (* c (:y p)))) (:ty tf))}))
(defn apply-sim-all [tf pts]
(mapv #(apply-sim tf %) pts))
(defn fit-residual
"Residual RMS after the fit, in the units of Q. Rises with out-of-plane
rotation, so it is the signal for \"this section is not stabilisable\"."
[tf P Q]
(let [n (count P)]
(js/Math.sqrt
(/ (loop [i 0, acc 0.0]
(if (< i n)
(let [m (apply-sim tf (nth P i))
q (nth Q i)]
(recur (inc i)
(+ acc (js/Math.pow (- (:x m) (:x q)) 2)
(js/Math.pow (- (:y m) (:y q)) 2))))
acc))
n))))
(defn procrustes-mean
"Generalised Procrustes: the reference is the MEAN rigid configuration over the
shot, not frame zero, so no single frame's idiosyncrasies get baked into every
other frame. Three passes is plenty."
([frames-rigid] (procrustes-mean frames-rigid 3))
([frames-rigid iters]
(let [n (count frames-rigid)]
(loop [ref (mapv (fn [p] {:x (:x p) :y (:y p)}) (nth frames-rigid 0))
iter 0]
(if (= iter iters)
ref
(recur
(->> frames-rigid
(reduce (fn [acc rig]
(let [moved (apply-sim-all (fit-similarity rig ref) rig)]
(mapv (fn [a m] {:x (+ (:x a) (:x m)) :y (+ (:y a) (:y m))})
acc moved)))
(mapv (constantly {:x 0.0 :y 0.0}) ref))
(mapv (fn [p] {:x (/ (:x p) n) :y (/ (:y p) n)})))
(inc iter)))))))
(defn moving-average
"`radius` is in frames either side: 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 - an even window would be lopsided in time."
[vals radius]
(if (<= radius 0)
(vec vals)
(let [v (vec vals)
n (count v)
half (js/Math.floor radius)]
(mapv (fn [i]
;; Clamped at the ends rather than shortened, so every output is an
;; average of the same COUNT of samples and the first frame is not
;; noisier than the rest.
(let [lo (- i half) hi (+ i half)]
(/ (reduce + (map (fn [j] (nth v (min (dec n) (max 0 j))))
(range lo (inc hi))))
(inc (- hi lo)))))
(range n)))))
(defn smooth-transforms
"Smooth the four transform parameters, NEVER the contour. Landmark jitter of a
pixel is smeared into the mouth by the inverse transform, so the transform is
where the low-pass belongs; smoothing the contour would destroy the
performance, which is the entire asset.
Angles are smoothed as (cos, sin) so wrapping cannot produce a spike."
[tfs radius]
(let [c (moving-average (map #(js/Math.cos (:theta %)) tfs) radius)
sn (moving-average (map #(js/Math.sin (:theta %)) tfs) radius)
s (moving-average (map :s tfs) radius)
tx (moving-average (map :tx tfs) radius)
ty (moving-average (map :ty tfs) radius)]
(mapv (fn [i] {:theta (js/Math.atan2 (nth sn i) (nth c i))
:s (nth s i)
:tx (nth tx i)
:ty (nth ty i)})
(range (count tfs)))))

115
frontend/src/arthur/domain/landmarks.cljs Normal file
View file

@ -0,0 +1,115 @@
(ns arthur.domain.landmarks
"MediaPipe FaceLandmarker index tables.
Ring vectors are ORDERED traversals, not raw connection sets: vertex position
within a ring is the vertex's identity, and every downstream stage depends on
that ordering being stable. See docs/design.md, \"Fixed topology\".
Tables only. The operations over a ring — subsample, offset, simplicity —
live in arthur.domain.ring, because they are about ordered traversals in
general and know nothing about faces.")
;; Rigid landmarks for the similarity fit. Eye corners, nose bridge, nose tip.
;; Nothing here may be a feature that moves under performance: including the
;; mouth or brows bleeds performance into the stabilization.
(def RIGID [33 133 362 263 168 6 1])
;; Outer lip ring, clockwise from the right corner over the top.
;; index 0 = right corner, 5 = top centre, 10 = left corner, 15 = bottom centre.
(def LIPS-OUTER
[61 185 40 39 37 0 267 269 270 409
291 375 321 405 314 17 84 181 91 146])
;; Inner lip ring, same orientation and the same four cardinal positions.
(def LIPS-INNER
[78 191 80 81 82 13 312 311 310 415
308 324 318 402 317 14 87 178 88 95])
;; Inner upper / lower lip centres. Their separation is the aperture signal that
;; decides whether the mouth interior is present at all.
(def APERTURE [13 14])
;; Face oval, used only to derive the placeholder plate in v1.
(def FACE-OVAL
[10 338 297 332 284 251 389 356 454 323 361 288
397 365 379 378 400 377 152 148 176 149 150 136
172 58 132 93 234 127 162 21 54 103 67 109])
;; Eye corners, for the calibration box and for reporting fit residual.
(def EYE-INNER [133 362])
;; ---- eyes ----
;;
;; Eyelid rings, under the same contract as the lip rings: ORDERED traversals
;; where slot position IS vertex identity. Both eyes start at the OUTER corner
;; and go over the UPPER lid first, so slot k means the same anatomy on both
;; sides. On a 16-slot ring that puts the four cardinals exactly on the four
;; quarter slots - 0 outer corner, 4 upper lid centre, 8 inner corner, 12 lower
;; lid centre - so every even vertex budget lands on real landmarks.
;;
;; The two rings traverse opposite directions on screen, because they are
;; mirrored anatomy described the same way. Nothing downstream cares: an
;; even-odd fill has no winding, and ring SIMPLICITY is what is asserted.
(def EYE-R-RING
[33 246 161 160 159 158 157 173
133 155 154 153 145 144 163 7])
(def EYE-L-RING
[263 466 388 387 386 385 384 398
362 382 381 380 374 373 390 249])
;; Outer, inner corner per eye. All four are also in RIGID, and that is the
;; point: the eye's reference frame is built only from landmarks that do not
;; move under performance, so a blink cannot be mistaken for a change of gaze.
(def EYE-R-CORNERS [33 133])
(def EYE-L-CORNERS [263 362])
;; Upper and lower lid centres. Their separation over the corner distance is the
;; openness signal that decides whether the eye is shut - the same shape of
;; measurement as APERTURE is for the mouth, but normalised, so one threshold
;; carries across takes and faces.
(def EYE-R-LIDS [159 145])
(def EYE-L-LIDS [386 374])
;; The two iris blocks the refined mesh appends: centre first, then four ring
;; points. WHICH BLOCK BELONGS TO WHICH EYE IS NOT DECLARED HERE - MediaPipe's
;; own "left"/"right" is viewer-relative in some docs and subject-relative in
;; others, and a swap looks almost right, so it would survive an eyeball and
;; then read as a permanently wall-eyed character. flow/measure/eyes resolves it
;; from the geometry instead.
(def IRIS-A [468 469 470 471 472])
(def IRIS-B [473 474 475 476 477])
;; ---- brows ----
;;
;; Each brow is two five-point chains, an upper edge and a lower edge, which
;; close into a ten-point ring: out along one edge from the outer end to the
;; inner, back along the other.
;;
;; WHICH EDGE IS UPPER IS DELIBERATELY NOT DECLARED, and unlike the iris it does
;; not need to be. Swapping them traverses the same ring the other way round,
;; and an even-odd fill has no winding, so the shape is identical either way.
;; What the ring guarantees instead is that the two ENDS land on fixed slots:
;; 0 and 9 are one end, 4 and 5 the other. Averaging a pair therefore gives the
;; brow's height at that end whichever edge is on top, which is all the raise
;; and tilt measurement needs.
;;
;; Which end is the OUTER one is resolved from geometry in flow/measure/brows,
;; because getting it backwards mirrors the tilt - inner-up "worried" would
;; render as outer-up - and that is an expression error, not a glitch, so it
;; would read as a directed performance choice rather than as a bug.
(def BROW-A-RING
[70 63 105 66 107
55 65 52 53 46])
(def BROW-B-RING
[300 293 334 296 336
285 295 282 283 276])
;; The slots at each end of a brow ring, as pairs to average.
(def BROW-END-0 [0 9])
(def BROW-END-1 [4 5])
;; The number of landmarks the refined mesh emits: 468 face + 10 iris. Dense
;; frames are this long whether or not the iris blocks carry anything.
(def NUM-LANDMARKS 478)

50
frontend/src/arthur/domain/palette.cljs Normal file
View file

@ -0,0 +1,50 @@
(ns arthur.domain.palette
"The indexed palette.
THE RULE, and it is a rule rather than a default: a part carries a palette
INDEX, never a sampled RGB value. Sampling colour off the footage produces a
pixel-art filter, and it does so irrecoverably — once a shape holds a measured
colour there is no way back to an authored one, because the information that it
was ever a choice is gone. Every `[:style :color]` channel holds one of the
keywords below.
Entries are ordered, and the order IS the index the raster writes. Inserting in
the middle renumbers every stored index, so new tones append.")
(def entries
[{:name :bg :hex "#12141c"}
{:name :skin-base :hex "#b07a5a"}
{:name :skin-dark :hex "#7a4f3a"}
{:name :mouth-dark :hex "#24161a"}
{:name :teeth :hex "#d9cfc2"}
;; Sclera is not white, and that is authored, not measured. A true white at
;; 320x200 next to a warm skin ramp reads as a hole punched in the face; the
;; eye sits in a socket, in shadow, so it is a dimmer and cooler tone than the
;; teeth, which catch the light.
{:name :eye-white :hex "#c9c3b4"}
;; Three tones for the eye - sclera, iris, pupil - which is the "two or three
;; tones per part" budget, spent where it buys the most: an eye with no tonal
;; step inside it reads as a hole.
{:name :iris :hex "#4a5468"}
{:name :pupil :hex "#171a22"}
;; Brows get their own entry rather than sharing skin-dark with the lash line.
;; They are hair, not shadow: when hair plates exist they want to match those,
;; and tying them to the lash means you cannot change one without the other.
{:name :brow :hex "#3a2a22"}])
(def hexes (mapv :hex entries))
(def index-of
"Palette keyword -> the index the raster writes. Derived, so the vector above
is the single place an ordering is declared."
(into {} (map-indexed (fn [i e] [(:name e) i]) entries)))
(defn hex->rgb [hex]
(let [s (.replace hex "#" "")]
[(js/parseInt (.slice s 0 2) 16)
(js/parseInt (.slice s 2 4) 16)
(js/parseInt (.slice s 4 6) 16)]))
(def rgb
"Index -> [r g b], precomputed."
(mapv hex->rgb hexes))

150
frontend/src/arthur/domain/raster.cljs Normal file
View file

@ -0,0 +1,150 @@
(ns arthur.domain.raster
"Indexed flat-fill rasteriser.
Canvas2D antialiases path fills, and antialiasing is exactly what the target
idiom does not have: Animator Pro fills polygons into a 256-colour indexed
raster with hard edges (csd_render_poly). A preview that antialiases would
misrepresent the look it exists to judge, so this writes palette indices into
a byte buffer with an even-odd scanline fill and expands to RGBA only at the
very end.
A raster is {:w :h :buf} where :buf is a Uint8Array, and the fill functions
MUTATE it and return it. That is deliberate and it is the one place in domain/
that mutates: a persistent 64000-entry vector rebuilt per draw op per frame is
not a rasteriser. The mutation is confined — a raster is created, filled and
blitted inside one frame, and never stored in app-db.
No DOM here. `->rgba` returns plain bytes; wrapping them in an ImageData is
ui/canvas's job, which is also what lets every assertion below run in node.")
(defn make [w h]
{:w w :h h :buf (js/Uint8Array. (* w h))})
(defn clear! [{:keys [buf] :as r} index]
(.fill buf index)
r)
(defn fill-poly!
"Even-odd scanline fill. Samples at pixel centres (y + 0.5), so a polygon
edge landing exactly on a pixel boundary resolves consistently."
[{:keys [w h buf] :as r} pts index]
(let [n (count pts)]
(when (>= n 3)
(let [ys (map :y pts)
y0 (max 0 (js/Math.ceil (- (apply min ys) 0.5)))
y1 (min (dec h) (inc (js/Math.floor (- (apply max ys) 0.5))))]
(doseq [y (range y0 (inc y1))]
(let [sy (+ y 0.5)
xs (sort
(for [i (range n)
:let [a (nth pts i)
b (nth pts (mod (inc i) n))]
;; A horizontal edge contributes no crossing, and
;; dividing by its zero height would emit Infinity.
:when (not= (:y a) (:y b))
:let [lo (min (:y a) (:y b))
hi (max (:y a) (:y b))]
;; Half-open in y: >= lo and < hi. A vertex shared by
;; two edges is counted exactly once, so the parity
;; cannot flip at a corner and leak a whole scanline.
:when (and (>= sy lo) (< sy hi))]
(+ (:x a) (* (/ (- sy (:y a)) (- (:y b) (:y a)))
(- (:x b) (:x a))))))]
(when (>= (count xs) 2)
(doseq [[xa xb] (partition 2 xs)]
(let [x-from (max 0 (js/Math.ceil (- xa 0.5)))
x-to (min (dec w) (js/Math.floor (- xb 0.5)))
row (* y w)]
(loop [x x-from]
(when (<= x x-to)
(aset buf (+ row x) index)
(recur (inc x)))))))))))
r))
(defn fill-disc!
"`over` is an optional stencil: when given, only pixels that currently hold
that index are written. The indexed buffer is its own clip mask, which is
how Animator Pro would do it - and it is what keeps the iris inside the
eye. A disc clipped by the sclera cannot spill past the lid at any gaze or
any radius, including mid-blink when the opening is a two-pixel sliver, so
the lid crops the iris for free instead of the gaze range needing a
clamp that would flatten the performance at the extremes."
([r cx cy rad index] (fill-disc! r cx cy rad index nil))
([{:keys [w h buf] :as r} cx cy rad index over]
(let [rr (* rad rad)
y0 (max 0 (js/Math.floor (- cy rad)))
y1 (min (dec h) (js/Math.ceil (+ cy rad)))
x0 (max 0 (js/Math.floor (- cx rad)))
x1 (min (dec w) (js/Math.ceil (+ cx rad)))]
(loop [y y0]
(when (<= y y1)
(loop [x x0]
(when (<= x x1)
(let [dx (- (+ x 0.5) cx)
dy (- (+ y 0.5) cy)]
(when (<= (+ (* dx dx) (* dy dy)) rr)
(let [o (+ (* y w) x)]
(when (or (nil? over) (= (aget buf o) over))
(aset buf o index)))))
(recur (inc x))))
(recur (inc y))))
r)))
(defn fill-rect!
"An exactly size x size block of pixels, snapped to the pixel grid, with the
same optional stencil as fill-disc!.
The pupil is a SQUARE because at 320x200 it is three pixels across, and a
circle of radius 1.5 is not a circle - it is a plus sign with the corners
gnawed off, and it changes shape as it moves. A square that size is a
deliberate mark that stays the same mark wherever it lands, which is the
whole argument for flat shapes at this resolution.
The top-left is rounded rather than the centre, so the block is size x size
on every frame. Round the extents instead and a fractional centre gives you
three pixels on one frame and four on the next, which reads as the pupil
breathing."
([r cx cy size index] (fill-rect! r cx cy size index nil))
([{:keys [w h buf] :as r} cx cy size index over]
(when (>= size 1)
(let [x0 (js/Math.round (- cx (/ size 2)))
y0 (js/Math.round (- cy (/ size 2)))]
(loop [y (max 0 y0)]
(when (< y (min h (+ y0 size)))
(loop [x (max 0 x0)]
(when (< x (min w (+ x0 size)))
(let [o (+ (* y w) x)]
(when (or (nil? over) (= (aget buf o) over))
(aset buf o index)))
(recur (inc x))))
(recur (inc y))))))
r))
(defn ->rgba
"Expand indices through the palette at integer zoom. Nearest-neighbour by
construction, so no filtering softens the result.
Returns {:width :height :data} with :data a Uint8ClampedArray, ready to hand to
an ImageData. An index with no palette entry comes out magenta rather than
transparent or black: writing an index the palette does not have is a bug, and
it should be impossible to miss."
([r palette-rgb] (->rgba r palette-rgb 1))
([{:keys [w h buf]} palette-rgb zoom]
(let [W (* w zoom)
H (* h zoom)
d (js/Uint8ClampedArray. (* W H 4))]
(loop [y 0]
(when (< y H)
(let [srow (* (js/Math.floor (/ y zoom)) w)]
(loop [x 0]
(when (< x W)
(let [c (or (nth palette-rgb (aget buf (+ srow (js/Math.floor (/ x zoom)))) nil)
[255 0 255])
o (* (+ (* y W) x) 4)]
(aset d o (nth c 0))
(aset d (+ o 1) (nth c 1))
(aset d (+ o 2) (nth c 2))
(aset d (+ o 3) 255))
(recur (inc x)))))
(recur (inc y))))
{:width W :height H :data d})))

96
frontend/src/arthur/domain/ring.cljs Normal file
View file

@ -0,0 +1,96 @@
(ns arthur.domain.ring
"Operations on an ordered ring of points.
A ring here is a closed traversal: a vector of points where slot k means the
same thing on every frame of a shot. That is what makes temporal
correspondence possible at all, so nothing in here is allowed to reorder,
insert or adaptively decimate — every function is index-preserving or returns
slot positions.")
(defn subsample-slots
"Pick `n` slots from a ring of `len` by even spacing. Returns RING POSITIONS,
not landmark ids: positions are the vertex identity downstream, and mapping ids
back to positions with indexOf would silently pick the wrong slot if a table
ever repeated an id.
For even n this naturally lands on the cardinal positions (corners and lip
centres) of a 20-point ring. Fixed indices, never adaptive decimation: the
vertex at slot k means the same thing on every frame of the shot."
[len n]
(mapv (fn [k] (mod (js/Math.round (/ (* k len) n)) len)) (range n)))
(defn subsample-ring
"`subsample-slots` applied to a table, yielding landmark ids."
[ring n]
(mapv #(nth ring %) (subsample-slots (count ring) n)))
(defn offset-ring
"Push a ring outward from its centroid by a FIXED distance, not by a scale
factor.
Scaling collapses with the shape: a shut eyelid scaled by 1.1 is still a shut
eyelid, so the lash line - the only thing left to draw when the eye is closed
- would vanish exactly on the frames where it is the whole drawing. A fixed
radial offset gives a band of roughly constant thickness that survives the
ring going degenerate, and it keeps a star-shaped ring simple, which
docs/design.md requires of every cut part."
[pts d]
(if (or (nil? d) (zero? d))
pts
(let [n (count pts)
cx (/ (reduce + (map :x pts)) n)
cy (/ (reduce + (map :y pts)) n)]
(mapv (fn [p]
(let [dx (- (:x p) cx)
dy (- (:y p) cy)
m (js/Math.hypot dx dy)]
;; 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.
(if (< m 1e-9)
{:x (:x p) :y (:y p)}
{:x (+ (:x p) (* (/ dx m) d))
:y (+ (:y p) (* (/ dy m) d))})))
pts))))
(defn- orient
"Sign of the cross product (p->q) x (p->r): which side of pq the point r is on."
[p q r]
(js/Math.sign (- (* (- (:x q) (:x p)) (- (:y r) (:y p)))
(* (- (:y q) (:y p)) (- (:x r) (:x p))))))
(defn segments-cross?
"True when ab and cd cross properly. Collinear and touching cases are
deliberately NOT crossings: adjacent ring edges share an endpoint, and a
degenerate ring — the shut eyelid — has collinear ones. Reporting those would
make the simplicity assertion fire on exactly the shapes it has to allow."
[a b c d]
(let [o1 (orient a b c) o2 (orient a b d)
o3 (orient c d a) o4 (orient c d b)]
(and (not= o1 o2) (not= o3 o4)
(not (zero? o1)) (not (zero? o2))
(not (zero? o3)) (not (zero? o4)))))
(defn self-intersections
"Every pair of non-adjacent edges of the closed ring that cross, as [i j].
This exists because \"fixed topology\" is load-bearing: 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
odd vertex counts and obvious at even ones, so it needs an assertion rather
than an eyeball."
[pts]
(let [n (count pts)
at (fn [i] (nth pts (mod i n)))]
(vec
(for [i (range n)
j (range (inc i) n)
:when (and (not= (mod (inc j) n) i)
(not= (mod (inc i) n) j))
:when (segments-cross? (at i) (at (inc i)) (at j) (at (inc j)))]
[i j]))))
(defn simple?
"True when no pair of non-adjacent edges crosses."
[pts]
(empty? (self-intersections pts)))

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}`);