artdag: Phase 7 opt-reduce bridges maude normal form back to a runnable DAG + 8 tests
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:
@@ -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)))))
|
||||
|
||||
Reference in New Issue
Block a user