diff --git a/lib/apl/runtime.sx b/lib/apl/runtime.sx index 7f6ba879..cff8957d 100644 --- a/lib/apl/runtime.sx +++ b/lib/apl/runtime.sx @@ -1108,3 +1108,47 @@ (make-array (append frame-shape (get (first results) :shape)) (flatten (map (fn (r) (get r :ravel)) results)))))))))))) + +(define + apl-at-replace + (fn + (vals idxs arr) + (let + ((vals-ravel (get vals :ravel)) + (idxs-ravel (get idxs :ravel)) + (arr-ravel (get arr :ravel)) + (arr-shape (get arr :shape)) + (vals-scalar? (= (len (get vals :shape)) 0))) + (make-array + arr-shape + (map + (fn + (i) + (let + ((pos (index-of idxs-ravel (+ i apl-io)))) + (if + pos + (if vals-scalar? (first vals-ravel) (nth vals-ravel pos)) + (nth arr-ravel i)))) + (range 0 (len arr-ravel))))))) + +(define + apl-at-apply + (fn + (f idxs arr) + (let + ((idxs-ravel (get idxs :ravel)) + (arr-ravel (get arr :ravel)) + (arr-shape (get arr :shape))) + (make-array + arr-shape + (map + (fn + (i) + (let + ((pos (index-of idxs-ravel (+ i apl-io)))) + (if + pos + (disclose (f (apl-scalar (nth arr-ravel i)))) + (nth arr-ravel i)))) + (range 0 (len arr-ravel))))))) diff --git a/lib/apl/tests/operators.sx b/lib/apl/tests/operators.sx index 39115a70..afd21895 100644 --- a/lib/apl/tests/operators.sx +++ b/lib/apl/tests/operators.sx @@ -698,4 +698,94 @@ apl-tally 1 (make-array (list 3 4) (list 1 2 3 4 5 6 7 8 9 10 11 12)))) - (list 4 4 4)) \ No newline at end of file + (list 4 4 4)) + +(apl-test + "at-replace single index" + (rv + (apl-at-replace + (apl-scalar 99) + (make-array (list 1) (list 2)) + (make-array (list 5) (list 1 2 3 4 5)))) + (list 1 99 3 4 5)) + +(apl-test + "at-replace multiple indices vector vals" + (rv + (apl-at-replace + (make-array (list 2) (list 99 88)) + (make-array (list 2) (list 2 4)) + (make-array (list 5) (list 1 2 3 4 5)))) + (list 1 99 3 88 5)) + +(apl-test + "at-replace scalar broadcast" + (rv + (apl-at-replace + (apl-scalar 0) + (make-array (list 3) (list 1 3 5)) + (make-array (list 5) (list 10 20 30 40 50)))) + (list 0 20 0 40 0)) + +(apl-test + "at-replace preserves shape" + (sh + (apl-at-replace + (apl-scalar 99) + (make-array (list 1) (list 2)) + (make-array (list 5) (list 1 2 3 4 5)))) + (list 5)) + +(apl-test + "at-replace last index" + (rv + (apl-at-replace + (apl-scalar 99) + (make-array (list 1) (list 5)) + (make-array (list 5) (list 1 2 3 4 5)))) + (list 1 2 3 4 99)) + +(apl-test + "at-replace on matrix linear-index" + (rv + (apl-at-replace + (apl-scalar 99) + (make-array (list 1) (list 3)) + (make-array (list 2 3) (list 1 2 3 4 5 6)))) + (list 1 2 99 4 5 6)) + +(apl-test + "at-apply negate at indices" + (rv + (apl-at-apply + apl-neg-m + (make-array (list 3) (list 1 3 5)) + (make-array (list 5) (list 1 2 3 4 5)))) + (list -1 2 -3 4 -5)) + +(apl-test + "at-apply double at index 1" + (rv + (apl-at-apply + (fn (a) (apl-mul a (apl-scalar 2))) + (make-array (list 1) (list 1)) + (make-array (list 2) (list 5 10)))) + (list 10 10)) + +(apl-test + "at-apply preserves shape" + (sh + (apl-at-apply + apl-neg-m + (make-array (list 2) (list 1 3)) + (make-array (list 2 3) (list 1 2 3 4 5 6)))) + (list 2 3)) + +(apl-test + "at-apply on matrix linear-index" + (rv + (apl-at-apply + apl-neg-m + (make-array (list 2) (list 1 6)) + (make-array (list 2 3) (list 1 2 3 4 5 6)))) + (list -1 2 3 4 5 -6)) \ No newline at end of file diff --git a/plans/apl-on-sx.md b/plans/apl-on-sx.md index e22d3695..de380cf4 100644 --- a/plans/apl-on-sx.md +++ b/plans/apl-on-sx.md @@ -82,7 +82,7 @@ Core mapping: - [x] Compose `f∘g` — applies `g` first then `f` - [x] Power `f⍣n` — apply f n times; `f⍣≡` until fixed point - [x] Rank `f⍤k` — apply f at sub-rank k -- [ ] At `@` — selective replace +- [x] At `@` — selective replace - [ ] 40+ tests in `lib/apl/tests/operators.sx` ### Phase 5 — dfns + tradfns + control flow @@ -118,6 +118,7 @@ data; format for string templating. _Newest first._ +- 2026-05-07: Phase 4 step 10 — at @ (apl-at-replace + apl-at-apply); linear-index lookup, scalar-vals broadcast; 211/211 tests - 2026-05-07: Phase 4 step 9 — rank f⍤k (apl-rank); cell decomposition + reassembly via frame/cell shapes; 201/201 tests - 2026-05-06: Phase 4 step 8 — power f⍣n (apl-power) + fixed-point f⍣≡ (apl-power-fixed); 191/191 tests - 2026-05-06: Phase 4 step 7 — compose f∘g (apl-compose monadic f∘g x, apl-compose-dyadic dyadic f x (g y)); 182/182 tests