apl: scan f\ + f⍀ (+15 tests, 125/125)

2026-05-06 20:46:16 +00:00
parent c63c0d26e8
commit c56f400403
3 changed files with 166 additions and 2 deletions
--- a/lib/apl/runtime.sx
+++ b/lib/apl/runtime.sx
@@ -873,3 +873,91 @@
                      (first col)
                      (rest col))))
                (range 0 inner-size)))))))))
+
+(define
+  apl-scan
+  (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)))
+            (make-array
+              shape
+              (map
+                (fn
+                  (i)
+                  (let
+                    ((slice (take ravel (+ i 1))))
+                    (reduce
+                      (fn
+                        (a b)
+                        (disclose (f (apl-scalar a) (apl-scalar b))))
+                      (first slice)
+                      (rest slice))))
+                (range 0 n))))
+          (let
+            ((last-dim (last shape))
+              (pre-size (reduce * 1 (take shape (- (len shape) 1)))))
+            (make-array
+              shape
+              (flatten
+                (map
+                  (fn
+                    (i)
+                    (let
+                      ((start (* i last-dim))
+                        (row
+                          (map
+                            (fn (j) (nth ravel (+ start j)))
+                            (range 0 last-dim))))
+                      (map
+                        (fn
+                          (k)
+                          (let
+                            ((slice (take row (+ k 1))))
+                            (reduce
+                              (fn
+                                (a b)
+                                (disclose (f (apl-scalar a) (apl-scalar b))))
+                              (first slice)
+                              (rest slice))))
+                        (range 0 last-dim))))
+                  (range 0 pre-size))))))))))
+
+(define
+  apl-scan-first
+  (fn
+    (f arr)
+    (let
+      ((shape (get arr :shape)) (ravel (get arr :ravel)))
+      (if
+        (< (len shape) 2)
+        (apl-scan f arr)
+        (let
+          ((first-dim (first shape))
+            (inner-size (reduce * 1 (rest shape))))
+          (make-array
+            shape
+            (flatten
+              (map
+                (fn
+                  (i)
+                  (map
+                    (fn
+                      (j)
+                      (let
+                        ((col (map (fn (k) (nth ravel (+ j (* k inner-size)))) (range 0 (+ i 1)))))
+                        (reduce
+                          (fn
+                            (a b)
+                            (disclose (f (apl-scalar a) (apl-scalar b))))
+                          (first col)
+                          (rest col))))
+                    (range 0 inner-size)))
+                (range 0 first-dim)))))))))