apl: ⊥ decode / ⊤ encode (mixed-radix; +11)
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 54s

- 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
This commit is contained in:
2026-05-08 22:49:11 +00:00
parent ef53232314
commit a074ea9e98
4 changed files with 77 additions and 1 deletions

View File

@@ -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

View File

@@ -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⊥(BN) = 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)))

View File

@@ -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

View File

@@ -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