apl: ∪ unique / ∪ union / ∩ intersection (+12)
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 49s
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 49s
- 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
This commit is contained in:
@@ -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
|
||||
|
||||
@@ -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)))
|
||||
|
||||
@@ -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
|
||||
|
||||
Reference in New Issue
Block a user