From ef532323147f429509c49f31e0c825e8f05a41ef Mon Sep 17 00:00:00 2001 From: giles Date: Fri, 8 May 2026 22:42:29 +0000 Subject: [PATCH] =?UTF-8?q?apl:=20=E2=88=AA=20unique=20/=20=E2=88=AA=20uni?= =?UTF-8?q?on=20/=20=E2=88=A9=20intersection=20(+12)?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit - apl-unique: dedup keeping first-occurrence order - apl-union: dedup'd A then B-elements-not-in-A - apl-intersect: A elements that are in B, preserves left order - ∪ wired both monadic and dyadic; ∩ wired dyadic - pipeline 121/121 --- lib/apl/runtime.sx | 34 ++++++++++++++++++++++++++++ lib/apl/tests/pipeline.sx | 47 +++++++++++++++++++++++++++++++++++++++ lib/apl/transpile.sx | 3 +++ plans/apl-on-sx.md | 3 ++- 4 files changed, 86 insertions(+), 1 deletion(-) diff --git a/lib/apl/runtime.sx b/lib/apl/runtime.sx index e96fb0a5..a92fe0e9 100644 --- a/lib/apl/runtime.sx +++ b/lib/apl/runtime.sx @@ -852,6 +852,40 @@ (apl-scalar (first result)) (make-array (get vals :shape) result)))))) +(define + apl-unique + (fn + (arr) + (let + ((ravel (if (scalar? arr) (list (disclose arr)) (get arr :ravel)))) + (let + ((dedup (reduce (fn (acc x) (if (index-of acc x) acc (append acc (list x)))) (list) ravel))) + (apl-vector dedup))))) + +(define + apl-union + (fn + (a b) + (let + ((a-ravel (if (scalar? a) (list (disclose a)) (get a :ravel))) + (b-ravel (if (scalar? b) (list (disclose b)) (get b :ravel)))) + (let + ((a-dedup (reduce (fn (acc x) (if (index-of acc x) acc (append acc (list x)))) (list) a-ravel))) + (let + ((b-extra (filter (fn (x) (not (index-of a-dedup x))) b-ravel))) + (let + ((b-extra-dedup (reduce (fn (acc x) (if (index-of acc x) acc (append acc (list x)))) (list) b-extra))) + (apl-vector (append a-dedup b-extra-dedup)))))))) + +(define + apl-intersect + (fn + (a b) + (let + ((a-ravel (if (scalar? a) (list (disclose a)) (get a :ravel))) + (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-primes (fn diff --git a/lib/apl/tests/pipeline.sx b/lib/apl/tests/pipeline.sx index 1e857498..a7be5716 100644 --- a/lib/apl/tests/pipeline.sx +++ b/lib/apl/tests/pipeline.sx @@ -497,3 +497,50 @@ "⍸ interval-index: y above all → len breaks" (mkrv (apl-run "10 20 30 ⍸ 100")) (list 3))) + +(begin + (apl-test + "∪ unique: dedup keeps first-occurrence order" + (mkrv (apl-run "∪ 1 2 1 3 2 1 4")) + (list 1 2 3 4)) + (apl-test + "∪ unique: already-unique unchanged" + (mkrv (apl-run "∪ 5 4 3 2 1")) + (list 5 4 3 2 1)) + (apl-test "∪ unique: scalar" (mkrv (apl-run "∪ 7")) (list 7)) + (apl-test + "∪ unique: string mississippi → misp" + (mkrv (apl-run "∪ 'mississippi'")) + (list "m" "i" "s" "p")) + (apl-test + "∪ union: 1 2 3 ∪ 3 4 5 → 1 2 3 4 5" + (mkrv (apl-run "1 2 3 ∪ 3 4 5")) + (list 1 2 3 4 5)) + (apl-test + "∪ union: dedups left side too" + (mkrv (apl-run "1 2 1 ∪ 1 3 2")) + (list 1 2 3)) + (apl-test + "∪ union: disjoint → catenated" + (mkrv (apl-run "1 2 ∪ 3 4")) + (list 1 2 3 4)) + (apl-test + "∩ intersection: 1 2 3 4 ∩ 2 4 6 → 2 4" + (mkrv (apl-run "1 2 3 4 ∩ 2 4 6")) + (list 2 4)) + (apl-test + "∩ intersection: disjoint → empty" + (mkrv (apl-run "1 2 3 ∩ 4 5 6")) + (list)) + (apl-test + "∩ intersection: preserves left order" + (mkrv (apl-run "(⍳5) ∩ 5 3 1")) + (list 1 3 5)) + (apl-test + "∩ intersection: identical" + (mkrv (apl-run "1 2 3 ∩ 1 2 3")) + (list 1 2 3)) + (apl-test + "∪/∩ identity: A ∪ A = ∪A" + (mkrv (apl-run "1 2 1 ∪ 1 2 1")) + (list 1 2))) diff --git a/lib/apl/transpile.sx b/lib/apl/transpile.sx index ce7575cd..722f58f1 100644 --- a/lib/apl/transpile.sx +++ b/lib/apl/transpile.sx @@ -47,6 +47,7 @@ ((= g "⎕FMT") apl-quad-fmt) ((= g "⎕←") apl-quad-print) ((= g "⍸") apl-where) + ((= g "∪") apl-unique) (else (error "no monadic fn for glyph"))))) (define @@ -92,6 +93,8 @@ ((= g "⊢") (fn (a b) b)) ((= g "⊣") (fn (a b) a)) ((= g "⍸") apl-interval-index) + ((= g "∪") apl-union) + ((= g "∩") apl-intersect) (else (error "no dyadic fn for glyph"))))) (define diff --git a/plans/apl-on-sx.md b/plans/apl-on-sx.md index be407957..a7f72ab6 100644 --- a/plans/apl-on-sx.md +++ b/plans/apl-on-sx.md @@ -239,7 +239,7 @@ still need work to run as-written. Phase 10 closes both. `apl-interval-index`; wire both into `apl-monadic-fn` / `apl-dyadic-fn`. Tests: `⍸ 0 1 0 1 1 → 2 4 5`, `⍸ ⍳5 = ¯1+⍳5 → empty`, `2 4 6 ⍸ 5 → 2`. -- [ ] **`∪` unique / `∩` intersection** — monadic `∪ V` returns V with +- [x] **`∪` unique / `∩` intersection** — monadic `∪ V` returns V with duplicates removed (first-occurrence order); dyadic `A ∪ B` is union; `A ∩ B` is intersection (members of A that are also in B). Add `apl-unique`, `apl-union`, `apl-intersect`. Tests cover empty, @@ -288,6 +288,7 @@ data; format for string templating. _Newest first._ +- 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 - 2026-05-07: Phase 9 step 6 — glyph audit. Wired ⍉ → apl-transpose/apl-transpose-dyadic, ⊢ → monadic+dyadic identity-right, ⊣ → identity-left, ⍕ → apl-quad-fmt. +6 tests; **Phase 9 complete, all unchecked items ticked**; pipeline 99/99