apl: ⊥ decode / ⊤ encode (mixed-radix; +11)
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 54s
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:
@@ -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
|
||||
|
||||
@@ -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)))
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
Reference in New Issue
Block a user