diff --git a/lib/apl/runtime.sx b/lib/apl/runtime.sx index fba1fddd..c020634c 100644 --- a/lib/apl/runtime.sx +++ b/lib/apl/runtime.sx @@ -913,6 +913,20 @@ ((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-partition + (fn + (mask val) + (let + ((m-ravel (if (scalar? mask) (list (disclose mask)) (get mask :ravel))) + (v-ravel + (if (scalar? val) (list (disclose val)) (get val :ravel)))) + (let + ((n (len m-ravel))) + (let + ((built (reduce (fn (acc-and-prev i) (let ((acc (first acc-and-prev)) (prev (nth acc-and-prev 1))) (let ((mi (nth m-ravel i)) (vi (nth v-ravel i))) (cond ((= mi 0) (list acc 0)) ((> mi prev) (list (append acc (list (list vi))) mi)) (else (let ((idx (- (len acc) 1))) (list (append (slice acc 0 idx) (list (append (nth acc idx) (list vi)))) mi))))))) (list (list) 0) (range 0 n)))) + (apl-vector (map (fn (part) (apl-vector part)) (first built)))))))) + (define apl-primes (fn diff --git a/lib/apl/tests/pipeline.sx b/lib/apl/tests/pipeline.sx index 2b645f0a..24991bf7 100644 --- a/lib/apl/tests/pipeline.sx +++ b/lib/apl/tests/pipeline.sx @@ -590,3 +590,40 @@ "⊥ decode: round-trip B⊤(B⊥V) = V" (mkrv (apl-run "2 2 2 ⊤ 2 2 2 ⊥ 1 0 1")) (list 1 0 1))) + +(begin + (define + mk-parts + (fn (s) (map (fn (p) (get p :ravel)) (get (apl-run s) :ravel)))) + (apl-test + "⊆ partition: 1 1 0 1 1 ⊆ 'abcde' → ('ab' 'de')" + (mk-parts "1 1 0 1 1 ⊆ 'abcde'") + (list (list "a" "b") (list "d" "e"))) + (apl-test + "⊆ partition: 1 0 0 1 1 ⊆ ⍳5 → ((1) (4 5))" + (mk-parts "1 0 0 1 1 ⊆ ⍳5") + (list (list 1) (list 4 5))) + (apl-test + "⊆ partition: all-zero mask → empty" + (len (get (apl-run "0 0 0 ⊆ 1 2 3") :ravel)) + 0) + (apl-test + "⊆ partition: all-one mask → single partition" + (mk-parts "1 1 1 ⊆ 7 8 9") + (list (list 7 8 9))) + (apl-test + "⊆ partition: strict increase 1 2 starts new" + (mk-parts "1 2 ⊆ 10 20") + (list (list 10) (list 20))) + (apl-test + "⊆ partition: same level continues 2 2 → one partition" + (mk-parts "2 2 ⊆ 10 20") + (list (list 10 20))) + (apl-test + "⊆ partition: 0 separates" + (mk-parts "1 1 0 0 1 ⊆ 1 2 3 4 5") + (list (list 1 2) (list 5))) + (apl-test + "⊆ partition: outer length matches partition count" + (len (get (apl-run "1 0 1 0 1 ⊆ ⍳5") :ravel)) + 3)) diff --git a/lib/apl/transpile.sx b/lib/apl/transpile.sx index fce38cb0..be7c989f 100644 --- a/lib/apl/transpile.sx +++ b/lib/apl/transpile.sx @@ -97,6 +97,7 @@ ((= g "∩") apl-intersect) ((= g "⊥") apl-decode) ((= g "⊤") apl-encode) + ((= g "⊆") apl-partition) (else (error "no dyadic fn for glyph"))))) (define diff --git a/plans/apl-on-sx.md b/plans/apl-on-sx.md index f06d591c..01d9c48b 100644 --- a/plans/apl-on-sx.md +++ b/plans/apl-on-sx.md @@ -250,7 +250,7 @@ still need work to run as-written. Phase 10 closes both. conformable vector. Add `apl-decode` and `apl-encode`. Tests: `2 ⊥ 1 0 1 → 5`, `10 ⊥ 1 2 3 → 123`, `2 2 2 ⊤ 5 → 1 0 1`, `24 60 60 ⊤ 7384 → 2 3 4`. -- [ ] **`⊆` partition** — dyadic `M ⊆ V` partitions `V` into vectors +- [x] **`⊆` partition** — dyadic `M ⊆ V` partitions `V` into vectors driven by mask `M`: a new partition starts wherever `M[i] > M[i-1]`, and 0 cells are dropped. Returns a vector of (boxed) partitions. Add `apl-partition`. Tests: `1 1 0 1 1 ⊆ 'abcde' → ('ab' 'de')`, @@ -288,6 +288,7 @@ data; format for string templating. _Newest first._ +- 2026-05-08: Phase 10 step 4 — `⊆` partition. apl-partition: walk M and V together via reduce, opening a new partition where M[i]>M[i-1] (initial prev=0), continuing where M[i]≤prev∧M[i]≠0, dropping cells where M[i]=0. Returns apl-vector of apl-vector parts. `1 1 0 1 1 ⊆ 'abcde' → ('ab' 'de')`, `1 0 0 1 1 ⊆ ⍳5 → ((1) (4 5))`, strict-increase `1 2` opens new, constant `2 2` continues. Wired into apl-dyadic-fn. +8 tests; pipeline 140/140 - 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