From a074ea9e9815107b0e3186f25829123d06fac87e Mon Sep 17 00:00:00 2001 From: giles Date: Fri, 8 May 2026 22:49:11 +0000 Subject: [PATCH] =?UTF-8?q?apl:=20=E2=8A=A5=20decode=20/=20=E2=8A=A4=20enc?= =?UTF-8?q?ode=20(mixed-radix;=20+11)?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit - apl-decode: Horner reduce; scalar base broadcasts to digit length - apl-encode: right-to-left modulo + floor-div - 24 60 60 ⊥ 2 3 4 → 7384, 24 60 60 ⊤ 7384 → 2 3 4 - pipeline 132/132 --- lib/apl/runtime.sx | 27 +++++++++++++++++++++++ lib/apl/tests/pipeline.sx | 46 +++++++++++++++++++++++++++++++++++++++ lib/apl/transpile.sx | 2 ++ plans/apl-on-sx.md | 3 ++- 4 files changed, 77 insertions(+), 1 deletion(-) diff --git a/lib/apl/runtime.sx b/lib/apl/runtime.sx index a92fe0e9..fba1fddd 100644 --- a/lib/apl/runtime.sx +++ b/lib/apl/runtime.sx @@ -886,6 +886,33 @@ (b-ravel (if (scalar? b) (list (disclose b)) (get b :ravel)))) (apl-vector (filter (fn (x) (index-of b-ravel x)) a-ravel))))) +(define + apl-decode + (fn + (base digits) + (let + ((d-ravel (if (scalar? digits) (list (disclose digits)) (get digits :ravel)))) + (let + ((d-len (len d-ravel))) + (let + ((b-ravel (if (scalar? base) (let ((b (disclose base))) (map (fn (i) b) (range 0 d-len))) (get base :ravel)))) + (let + ((result (reduce (fn (acc i) (if (= i 0) (nth d-ravel 0) (+ (* acc (nth b-ravel i)) (nth d-ravel i)))) 0 (range 0 d-len)))) + (apl-scalar result))))))) + +(define + apl-encode + (fn + (base val) + (let + ((b-ravel (if (scalar? base) (list (disclose base)) (get base :ravel))) + (n (if (scalar? val) (disclose val) (first (get val :ravel))))) + (let + ((b-len (len b-ravel))) + (let + ((result (reduce (fn (acc-and-n i) (let ((acc (first acc-and-n)) (rem (nth acc-and-n 1))) (let ((b (nth b-ravel (- (- b-len 1) i)))) (if (= b 0) (list (cons rem acc) 0) (list (cons (modulo rem b) acc) (floor (/ rem b))))))) (list (list) n) (range 0 b-len)))) + (apl-vector (first result))))))) + (define apl-primes (fn diff --git a/lib/apl/tests/pipeline.sx b/lib/apl/tests/pipeline.sx index a7be5716..2b645f0a 100644 --- a/lib/apl/tests/pipeline.sx +++ b/lib/apl/tests/pipeline.sx @@ -544,3 +544,49 @@ "∪/∩ identity: A ∪ A = ∪A" (mkrv (apl-run "1 2 1 ∪ 1 2 1")) (list 1 2))) + +(begin + (apl-test + "⊥ decode: 2 2 2 ⊥ 1 0 1 → 5" + (mkrv (apl-run "2 2 2 ⊥ 1 0 1")) + (list 5)) + (apl-test + "⊥ decode: 10 10 10 ⊥ 1 2 3 → 123" + (mkrv (apl-run "10 10 10 ⊥ 1 2 3")) + (list 123)) + (apl-test + "⊥ decode: 24 60 60 ⊥ 2 3 4 → 7384 (mixed-radix HMS)" + (mkrv (apl-run "24 60 60 ⊥ 2 3 4")) + (list 7384)) + (apl-test + "⊥ decode: scalar base 2 ⊥ 1 0 1 0 → 10" + (mkrv (apl-run "2 ⊥ 1 0 1 0")) + (list 10)) + (apl-test + "⊥ decode: 16 16 ⊥ 15 15 → 255" + (mkrv (apl-run "16 16 ⊥ 15 15")) + (list 255)) + (apl-test + "⊤ encode: 2 2 2 ⊤ 5 → 1 0 1" + (mkrv (apl-run "2 2 2 ⊤ 5")) + (list 1 0 1)) + (apl-test + "⊤ encode: 24 60 60 ⊤ 7384 → 2 3 4 (HMS)" + (mkrv (apl-run "24 60 60 ⊤ 7384")) + (list 2 3 4)) + (apl-test + "⊤ encode: 2 2 2 2 ⊤ 13 → 1 1 0 1" + (mkrv (apl-run "2 2 2 2 ⊤ 13")) + (list 1 1 0 1)) + (apl-test + "⊤ encode: 10 10 ⊤ 42 → 4 2" + (mkrv (apl-run "10 10 ⊤ 42")) + (list 4 2)) + (apl-test + "⊤ encode: round-trip B⊥(B⊤N) = N" + (mkrv (apl-run "24 60 60 ⊥ 24 60 60 ⊤ 7384")) + (list 7384)) + (apl-test + "⊥ decode: round-trip B⊤(B⊥V) = V" + (mkrv (apl-run "2 2 2 ⊤ 2 2 2 ⊥ 1 0 1")) + (list 1 0 1))) diff --git a/lib/apl/transpile.sx b/lib/apl/transpile.sx index 722f58f1..fce38cb0 100644 --- a/lib/apl/transpile.sx +++ b/lib/apl/transpile.sx @@ -95,6 +95,8 @@ ((= g "⍸") apl-interval-index) ((= g "∪") apl-union) ((= g "∩") apl-intersect) + ((= g "⊥") apl-decode) + ((= g "⊤") apl-encode) (else (error "no dyadic fn for glyph"))))) (define diff --git a/plans/apl-on-sx.md b/plans/apl-on-sx.md index a7f72ab6..f06d591c 100644 --- a/plans/apl-on-sx.md +++ b/plans/apl-on-sx.md @@ -244,7 +244,7 @@ still need work to run as-written. Phase 10 closes both. union; `A ∩ B` is intersection (members of A that are also in B). Add `apl-unique`, `apl-union`, `apl-intersect`. Tests cover empty, single, repeats, mixed numerics. -- [ ] **`⊥` decode / `⊤` encode** — `B ⊥ V` evaluates digits `V` in +- [x] **`⊥` decode / `⊤` encode** — `B ⊥ V` evaluates digits `V` in base(s) `B` (Horner-style); `B ⊤ N` is the inverse, returning the digits of `N` in base(s) `B`. Both broadcast `B` as scalar or conformable vector. Add `apl-decode` and `apl-encode`. Tests: @@ -288,6 +288,7 @@ data; format for string templating. _Newest first._ +- 2026-05-08: Phase 10 step 3 — `⊥` decode / `⊤` encode. apl-decode (Horner reduce over indices, base[i]>0; scalar base broadcasts to digit length); apl-encode (right-to-left modulo+floor-div via reduce). Mixed-radix HMS works: `24 60 60 ⊥ 2 3 4 → 7384`, `24 60 60 ⊤ 7384 → 2 3 4`. Round-trips exact. Wired ⊥ ⊤ into apl-dyadic-fn. +11 tests; pipeline 132/132 - 2026-05-08: Phase 10 step 2 — `∪` unique / `∩` intersection. apl-unique (monadic, dedup keeping first-occurrence order via reduce+index-of), apl-union (dyadic, dedup'd A then B-elements-not-in-A), apl-intersect (dyadic, A elements that are also in B, preserves left order). Wired ∪ into both apl-monadic-fn and apl-dyadic-fn cond chains; ∩ into apl-dyadic-fn. +12 tests; pipeline 121/121 - 2026-05-08: Phase 10 step 1 — `⍸` where. apl-where (monadic, indices of truthy cells, ⎕IO-respecting) + apl-interval-index (dyadic, count of breaks ≤ y; broadcasts over Y vector or scalar). Wired into apl-monadic-fn / apl-dyadic-fn (cond clauses inserted as proper siblings via sx_insert_child after sx_insert_near silently wrapped multi-form sources in `(begin …)`). +10 tests; pipeline 109/109 - 2026-05-08: Phase 10 added — fill runtime gaps (⍸ ∪ ∩ ⊥ ⊤ ⊆ ⍎) + life.apl and quicksort.apl as-written