coop/rose-ash
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

apl: reduce f/ and f⌿ (last+first axis); 110/110 tests
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Has been cancelled
Details

Browse Source 
Co-Authored-By: Claude Sonnet 4.6 <noreply@anthropic.com>
This commit is contained in:
giles
2026-05-06 19:39:11 +00:00
parent e42aec8957
commit c5ceb9c718
3 changed files with 164 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

78
lib/apl/runtime.sx
View File

@@ -795,3 +795,81 @@
(let
((result (filter (fn (x) (not (index-of b-ravel x))) a-ravel)))
(make-array (list (len result)) result)))))
(define
apl-reduce
(fn
(f arr)
(let
((shape (get arr :shape)) (ravel (get arr :ravel)))
(if
(= (len shape) 0)
arr
(if
(= (len shape) 1)
(let
((n (first shape)))
(if
(= n 0)
(apl-scalar 0)
(apl-scalar
(reduce
(fn (a b) (disclose (f (apl-scalar a) (apl-scalar b))))
(first ravel)
(rest ravel)))))
(let
((last-dim (last shape))
(pre-shape (take shape (- (len shape) 1)))
(pre-size (reduce * 1 (take shape (- (len shape) 1)))))
(make-array
pre-shape
(map
(fn
(i)
(let
((start (* i last-dim))
(elems
(map
(fn (j) (nth ravel (+ start j)))
(range 0 last-dim))))
(if
(= last-dim 0)
0
(reduce
(fn
(a b)
(disclose (f (apl-scalar a) (apl-scalar b))))
(first elems)
(rest elems)))))
(range 0 pre-size)))))))))
(define
apl-reduce-first
(fn
(f arr)
(let
((shape (get arr :shape)) (ravel (get arr :ravel)))
(if
(< (len shape) 2)
(apl-reduce f arr)
(let
((first-dim (first shape))
(inner-shape (rest shape))
(inner-size (reduce * 1 (rest shape))))
(if
(= first-dim 0)
(make-array inner-shape (map (fn (i) 0) (range 0 inner-size)))
(make-array
inner-shape
(map
(fn
(j)
(let
((col (map (fn (i) (nth ravel (+ j (* i inner-size)))) (range 0 first-dim))))
(reduce
(fn
(a b)
(disclose (f (apl-scalar a) (apl-scalar b))))
(first col)
(rest col))))
(range 0 inner-size)))))))))