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

apl: Phase 3 take ↑ / drop ↓ / rotate ⌽⊖ — 50/50 tests green
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Has been cancelled
Details

Browse Source 
Add apl-take (dyadic ↑, multi-axis, cycling pad), apl-drop (dyadic ↓),
apl-reverse (monadic ⌽), apl-rotate (dyadic ⌽, last axis),
apl-reverse-first (monadic ⊖), apl-rotate-first (dyadic ⊖, first axis),
apl-safe-mod helper for negative rotation arithmetic.

23 new tests in lib/apl/tests/structural.sx.

Co-Authored-By: Claude Sonnet 4.6 <noreply@anthropic.com>
This commit is contained in:
giles
2026-05-06 18:45:12 +00:00
parent 6a6a94e203
commit 3c83985841
2 changed files with 305 additions and 1 deletions
Download Patch File Download Diff File Expand all files Collapse all files

170
lib/apl/runtime.sx
View File

@@ -436,3 +436,173 @@
((old-coords (map (fn (i) (nth new-coords (nth inv-perm i))) (range 0 (len shape)))))
(nth ravel (apl-multi->flat old-coords strides)))))
(range 0 new-size))))))))
(define apl-safe-mod (fn (a m) (mod (+ (mod a m) m) m)))
(define
apl-take
(fn
(n-arr data-arr)
(let
((old-shape (get data-arr :shape))
(old-ravel (get data-arr :ravel))
(ns
(if (scalar? n-arr) (list (disclose n-arr)) (get n-arr :ravel))))
(let
((new-shape (map abs ns)) (old-strides (apl-strides old-shape)))
(let
((new-size (reduce * 1 new-shape))
(new-strides (apl-strides new-shape)))
(make-array
new-shape
(map
(fn
(new-flat)
(let
((new-coords (apl-flat->multi new-flat new-shape new-strides)))
(let
((old-coords (map (fn (i) (let ((ni (nth ns i)) (nc (nth new-coords i)) (od (nth old-shape i))) (if (>= ni 0) nc (+ (- od (- ni)) nc)))) (range 0 (len ns)))))
(if
(every?
(fn
(i)
(and
(>= (nth old-coords i) 0)
(< (nth old-coords i) (nth old-shape i))))
(range 0 (len old-coords)))
(nth old-ravel (apl-multi->flat old-coords old-strides))
0))))
(range 0 new-size))))))))
(define
apl-drop
(fn
(n-arr data-arr)
(let
((old-shape (get data-arr :shape))
(old-ravel (get data-arr :ravel))
(ns
(if (scalar? n-arr) (list (disclose n-arr)) (get n-arr :ravel))))
(let
((new-shape (map (fn (i) (let ((ni (nth ns i)) (od (nth old-shape i))) (let ((d (if (>= ni 0) (- od ni) (+ od ni)))) (if (> d 0) d 0)))) (range 0 (len ns))))
(offsets
(map
(fn (i) (let ((ni (nth ns i))) (if (>= ni 0) ni 0)))
(range 0 (len ns))))
(old-strides (apl-strides old-shape)))
(let
((new-size (reduce * 1 new-shape))
(new-strides (apl-strides new-shape)))
(make-array
new-shape
(map
(fn
(new-flat)
(let
((new-coords (apl-flat->multi new-flat new-shape new-strides)))
(let
((old-coords (map (fn (i) (+ (nth new-coords i) (nth offsets i))) (range 0 (len ns)))))
(nth old-ravel (apl-multi->flat old-coords old-strides)))))
(range 0 new-size))))))))
(define
apl-reverse
(fn
(arr)
(let
((shape (get arr :shape)) (ravel (get arr :ravel)))
(if
(= (len shape) 0)
arr
(let
((last-dim (last shape)) (n (len ravel)))
(make-array
shape
(map
(fn
(flat)
(let
((c-last (mod flat last-dim)))
(nth ravel (+ flat (- last-dim 1) (* -2 c-last)))))
(range 0 n))))))))
(define
apl-reverse-first
(fn
(arr)
(let
((shape (get arr :shape)) (ravel (get arr :ravel)))
(if
(= (len shape) 0)
arr
(let
((first-dim (first shape))
(first-stride (reduce * 1 (rest shape)))
(n (len ravel)))
(make-array
shape
(map
(fn
(flat)
(let
((row (floor (/ flat first-stride))))
(let
((old-row (- first-dim 1 row)))
(nth
ravel
(+ (* old-row first-stride) (mod flat first-stride))))))
(range 0 n))))))))
(define
apl-rotate-first
(fn
(n-arr data-arr)
(let
((shape (get data-arr :shape))
(ravel (get data-arr :ravel))
(rot (disclose n-arr)))
(if
(= (len shape) 0)
data-arr
(let
((first-dim (first shape))
(first-stride (reduce * 1 (rest shape)))
(n (len ravel)))
(make-array
shape
(map
(fn
(flat)
(let
((row (floor (/ flat first-stride))))
(let
((old-row (apl-safe-mod (+ row rot) first-dim)))
(nth
ravel
(+ (* old-row first-stride) (mod flat first-stride))))))
(range 0 n))))))))
(define
apl-rotate
(fn
(n-arr data-arr)
(let
((shape (get data-arr :shape))
(ravel (get data-arr :ravel))
(rot (disclose n-arr)))
(if
(= (len shape) 0)
data-arr
(let
((last-dim (last shape)) (n (len ravel)))
(make-array
shape
(map
(fn
(flat)
(let
((c-last (mod flat last-dim)))
(let
((old-c-last (apl-safe-mod (+ c-last rot) last-dim)))
(nth ravel (+ flat (- old-c-last c-last))))))
(range 0 n))))))))