apl: ⊆ partition — mask-driven split (+8)
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 56s
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 56s
- apl-partition: new partition where M[i]>M[i-1] (init prev=0); continue where M[i]≤prev∧M[i]≠0; drop cells where M[i]=0 - Returns apl-vector of apl-vector parts - pipeline 140/140
This commit is contained in:
@@ -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
|
||||
|
||||
@@ -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))
|
||||
|
||||
@@ -97,6 +97,7 @@
|
||||
((= g "∩") apl-intersect)
|
||||
((= g "⊥") apl-decode)
|
||||
((= g "⊤") apl-encode)
|
||||
((= g "⊆") apl-partition)
|
||||
(else (error "no dyadic fn for glyph")))))
|
||||
|
||||
(define
|
||||
|
||||
Reference in New Issue
Block a user