coop/rose-ash
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

artdag: Phase 7 opt-reduce bridges maude normal form back to a runnable DAG + 8 tests

Browse Source 
artdag/opt-reduce: encode a DAG cone -> opt-term, mau/creduce against the
optimisation module, decode the normal form back to build-entries and rebuild.
Result-preserving: a 5-node blur;blur;id;bright0 chain collapses to 2 nodes and an
over(I,I) dedup 3->2, both executing identically to the original; non-optimisable
DAGs round-trip their radius faithfully (unary 1+1+1 -> 3). Completes Phase 7's
bridge-back + equivalence boxes. maude-optimize 33/33, total 191/191.

Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
This commit is contained in:
giles
2026-06-19 13:54:06 +00:00
parent 1fd3aea81b
commit 55ce2a86c5
5 changed files with 254 additions and 16 deletions
Download Patch File Download Diff File Expand all files Collapse all files

125
lib/artdag/optimize-rules.sx
View File

@@ -7,8 +7,8 @@
; successor rules (s M + N = s(M+N), 0 + N = N) are NOT confluent here (the symbolic
; critical pairs M + 0 and (A+B)+C vs A+(B+C) stick), whereas [assoc comm id: 0]
; joins them via canonical form. maude (lib/maude) is a READ-ONLY consumed substrate:
; mau/parse-module, mau/creduce-term, mau/creduce->str, mau/ccanon, mau/confluent?,
; mau/non-joinable-pairs, mau/cp->str.
; mau/parse-module, mau/creduce, mau/creduce->str, mau/ccanon, mau/confluent?,
; mau/non-joinable-pairs, mau/cp->str, mau/app/const/op/args/app?.
(define
artdag/opt-module-src
@@ -34,7 +34,12 @@
(define artdag/opt-module (mau/parse-module artdag/opt-module-src))
; ---- reduce a surface pipeline to its optimised normal form ----
; ops whose last term arg is the radius (Num); other args are image inputs.
(define artdag/opt-radius-ops (list "blur" "bright"))
; commutative ops (mirror the content-id's order-insensitivity).
(define artdag/opt-comm-ops (list "over"))
; ---- reduce a surface pipeline (source string) to its optimised normal form ----
(define
artdag/opt-reduce-term
@@ -67,3 +72,117 @@
(map
(fn (cp) (mau/cp->str artdag/opt-module cp))
(artdag/opt-non-joinable))))
; ---- radius <-> unary Num term ----
(define
artdag/num->unary
(fn
(n)
(if
(<= n 0)
(mau/const "0")
(reduce
(fn (acc i) (mau/app "_+_" (list acc (mau/const "1"))))
(mau/const "1")
(range 1 n)))))
(define
artdag/unary->num
(fn
(t)
(let
((op (mau/op t)))
(cond
((= op "1") 1)
((= op "_+_")
(reduce
(fn (a x) (+ a (artdag/unary->num x)))
0
(mau/args t)))
(else 0)))))
; ---- dag cone -> opt-term ----
; leaves -> nullary const (op name); a :radius node -> op(inputs..., unary radius);
; any other op -> op(inputs...). over (commutative) maps to the module's comm op.
(define
artdag/dag->opt-term
(fn
(dag id)
(let
((node (artdag/dag-get dag id)))
(let
((op (artdag/node-op node))
(ins
(map
(fn (i) (artdag/dag->opt-term dag i))
(artdag/node-inputs node)))
(params (artdag/node-params node)))
(if
(empty? ins)
(mau/const op)
(if
(artdag/member? op artdag/opt-radius-ops)
(mau/app
op
(concat ins (list (artdag/num->unary (get params :radius)))))
(mau/app op ins)))))))
; ---- opt-term -> build entries (synthesized names; build recomputes content-ids) ----
(define
artdag/opt-last
(fn
(xs)
(if (empty? (rest xs)) (first xs) (artdag/opt-last (rest xs)))))
(define
artdag/opt-but-last
(fn
(xs)
(if
(empty? (rest xs))
(list)
(cons (first xs) (artdag/opt-but-last (rest xs))))))
(define
artdag/opt-term->build
(fn
(t counter acc)
(if
(not (mau/app? t))
(let ((nm (str "ob" counter))) {:name nm :acc (concat acc (list (list nm (mau/op t) (list) {}))) :counter (+ counter 1)})
(let
((op (mau/op t))
(radius? (artdag/member? (mau/op t) artdag/opt-radius-ops)))
(let
((in-terms (if radius? (artdag/opt-but-last (mau/args t)) (mau/args t)))
(params (if radius? {:radius (artdag/unary->num (artdag/opt-last (mau/args t)))} {}))
(comm? (artdag/member? op artdag/opt-comm-ops)))
(let
((built (reduce (fn (st ct) (let ((r (artdag/opt-term->build ct (get st :counter) (get st :acc)))) {:acc (get r :acc) :counter (get r :counter) :names (concat (get st :names) (list (get r :name)))})) {:acc acc :counter counter :names (list)} in-terms)))
(let ((nm (str "ob" (get built :counter)))) {:name nm :acc (concat (get built :acc) (list (list nm op (get built :names) params comm?))) :counter (+ (get built :counter) 1)})))))))
(define
artdag/opt-term->entries
(fn (t) (get (artdag/opt-term->build t 0 (list)) :acc)))
; ---- optimise a DAG via maude: encode -> creduce -> decode -> rebuild ----
; result-preserving: the optimised DAG executes to the same result as the original.
(define
artdag/opt-reduce
(fn
(dag id)
(artdag/build
(artdag/opt-term->entries
(mau/creduce artdag/opt-module (artdag/dag->opt-term dag id))))))
; content-id of the optimised sink (the head of the reduced term's rebuilt DAG).
(define
artdag/opt-reduce-sink
(fn
(dag id)
(let
((o (artdag/opt-reduce dag id)))
(artdag/opt-last (artdag/dag-order o)))))

6
lib/artdag/scoreboard.json
View File

@@ -10,9 +10,9 @@
"serialize": {"pass": 13, "fail": 0},
"stats": {"pass": 12, "fail": 0},
"fault": {"pass": 14, "fail": 0},
"maude-optimize": {"pass": 25, "fail": 0}
"maude-optimize": {"pass": 33, "fail": 0}
},
"total_pass": 183,
"total_pass": 191,
"total_fail": 0,
"total": 183
"total": 191
}

4
lib/artdag/scoreboard.md
View File

@@ -14,5 +14,5 @@ _Generated by `lib/artdag/conformance.sh`_
| serialize | 13 | 0 | 13 |
| stats | 12 | 0 | 12 |
| fault | 14 | 0 | 14 |
| maude-optimize | 25 | 0 | 25 |
| **Total** | **183** | **0** | **183** |
| maude-optimize | 33 | 0 | 33 |
| **Total** | **191** | **0** | **191** |

101
lib/artdag/tests/maude-optimize.sx
View File

@@ -167,3 +167,104 @@
"distinct pipelines stay distinct"
(artdag/opt-same-form? "blur(src, 1)" "bright(src, 1)")
false)
; ---- bridge the normal form back to a runnable DAG (opt-reduce) ----
; result-preserving: the maude-optimised DAG executes to the same result as the
; original, with fewer nodes. Runner is a numeric op model (blur/bright additive in
; radius, id pass-through, over idempotent) so the pipeline algebra holds concretely.
(define
mo-eq-runner
(artdag/op-table-runner
{:src (fn (params inputs) 0)
:blur (fn (params inputs) (+ (first inputs) (get params :radius)))
:bright (fn (params inputs) (+ (first inputs) (* 100 (get params :radius))))
:id (fn (params inputs) (first inputs))
:over (fn (params inputs) (if (= (nth inputs 0) (nth inputs 1)) (nth inputs 0) (+ (nth inputs 0) (nth inputs 1))))}))
(define
mo-eq-result
(fn (dag id) (artdag/result-of (artdag/run dag mo-eq-runner (persist/open)) id)))
(define
mo-eq-opt-result
(fn
(dag id)
(let
((o (artdag/opt-reduce dag id)))
(artdag/result-of (artdag/run o mo-eq-runner (persist/open)) (artdag/opt-last (artdag/dag-order o))))))
; fixture: blur;blur chain + id + zero-radius bright (all collapse to one blur)
(define
mo-chain5
(artdag/build
(list
(list "s" "src" (list) {})
(list "b1" "blur" (list "s") {:radius 1})
(list "b2" "blur" (list "b1") {:radius 1})
(list "i" "id" (list "b2") {})
(list "z" "bright" (list "i") {:radius 0}))))
(define mo-chain5-id (artdag/dag-id mo-chain5 "z"))
(define mo-chain5-opt (artdag/opt-reduce mo-chain5 mo-chain5-id))
(define mo-chain5-sink (artdag/opt-last (artdag/dag-order mo-chain5-opt)))
(artdag-test
"opt-reduce: 5-node chain collapses to 2 nodes"
(artdag/node-count mo-chain5-opt)
2)
(artdag-test
"opt-reduce: fused sink op is blur"
(artdag/node-op (artdag/dag-get mo-chain5-opt mo-chain5-sink))
"blur")
(artdag-test
"opt-reduce: fused sink radius is the sum"
(artdag/node-params (artdag/dag-get mo-chain5-opt mo-chain5-sink))
{:radius 2})
(artdag-test
"opt-reduce: result-preserving on chain"
(= (mo-eq-result mo-chain5 mo-chain5-id) (mo-eq-opt-result mo-chain5 mo-chain5-id))
true)
; fixture: over of identical subpipelines (idempotent dedup)
(define
mo-dedup
(artdag/build
(list
(list "s" "src" (list) {})
(list "b" "blur" (list "s") {:radius 2})
(list "o" "over" (list "b" "b") {} true))))
(define mo-dedup-id (artdag/dag-id mo-dedup "o"))
(artdag-test
"opt-reduce: over dedup collapses to 2 nodes"
(artdag/node-count (artdag/opt-reduce mo-dedup mo-dedup-id))
2)
(artdag-test
"opt-reduce: result-preserving on dedup"
(= (mo-eq-result mo-dedup mo-dedup-id) (mo-eq-opt-result mo-dedup mo-dedup-id))
true)
; non-optimisable DAG: opt-reduce is a faithful round-trip (no laws fire)
(define
mo-plain
(artdag/build
(list
(list "s" "src" (list) {})
(list "b" "blur" (list "s") {:radius 3}))))
(define mo-plain-id (artdag/dag-id mo-plain "b"))
(define mo-plain-opt (artdag/opt-reduce mo-plain mo-plain-id))
(artdag-test
"opt-reduce: untouched DAG keeps its node count"
(artdag/node-count mo-plain-opt)
2)
(artdag-test
"opt-reduce: untouched DAG keeps its radius (unary round-trip)"
(artdag/node-params
(artdag/dag-get mo-plain-opt (artdag/opt-last (artdag/dag-order mo-plain-opt))))
{:radius 3})