apl: each f¨ monadic + dyadic (+14 tests, 139/139)

lib/apl/runtime.sx

@@ -961,3 +961,38 @@
                           (rest col))))
                     (range 0 inner-size)))
                 (range 0 first-dim)))))))))
+
+(define
+  apl-each
+  (fn
+    (f arr)
+    (let
+      ((shape (get arr :shape)) (ravel (get arr :ravel)))
+      (make-array
+        shape
+        (map (fn (x) (disclose (f (apl-scalar x)))) ravel)))))
+
+(define
+  apl-each-dyadic
+  (fn
+    (f a b)
+    (cond
+      ((and (scalar? a) (scalar? b)) (apl-scalar (disclose (f a b))))
+      ((scalar? a)
+        (make-array
+          (get b :shape)
+          (map (fn (x) (disclose (f a (apl-scalar x)))) (get b :ravel))))
+      ((scalar? b)
+        (make-array
+          (get a :shape)
+          (map (fn (x) (disclose (f (apl-scalar x) b))) (get a :ravel))))
+      (else
+        (if
+          (equal? (get a :shape) (get b :shape))
+          (make-array
+            (get a :shape)
+            (map
+              (fn (x y) (disclose (f (apl-scalar x) (apl-scalar y))))
+              (get a :ravel)
+              (get b :ravel)))
+          (error "length error: shape mismatch"))))))

lib/apl/tests/operators.sx

@@ -157,4 +157,91 @@
 (apl-test
   "scan-first max\\ matrix col-wise running max"
   (rv (apl-scan-first apl-max (make-array (list 3 2) (list 3 1 4 1 5 9))))
-  (list 3 1 4 1 5 9))
+  (list 3 1 4 1 5 9))
+
+(apl-test
+  "each negate vector"
+  (rv (apl-each apl-neg-m (make-array (list 3) (list 1 2 3))))
+  (list -1 -2 -3))
+
+(apl-test
+  "each negate vector preserves shape"
+  (sh (apl-each apl-neg-m (make-array (list 3) (list 1 2 3))))
+  (list 3))
+
+(apl-test
+  "each reciprocal vector"
+  (rv (apl-each apl-recip (make-array (list 3) (list 1 2 4))))
+  (list 1 (/ 1 2) (/ 1 4)))
+
+(apl-test
+  "each abs vector"
+  (rv (apl-each apl-abs (make-array (list 4) (list -1 2 -3 4))))
+  (list 1 2 3 4))
+
+(apl-test "each scalar" (rv (apl-each apl-neg-m (apl-scalar 5))) (list -5))
+
+(apl-test
+  "each scalar shape"
+  (sh (apl-each apl-neg-m (apl-scalar 5)))
+  (list))
+
+(apl-test
+  "each negate matrix shape"
+  (sh (apl-each apl-neg-m (make-array (list 2 3) (list 1 2 3 4 5 6))))
+  (list 2 3))
+
+(apl-test
+  "each negate matrix values"
+  (rv (apl-each apl-neg-m (make-array (list 2 3) (list 1 2 3 4 5 6))))
+  (list -1 -2 -3 -4 -5 -6))
+
+(apl-test
+  "each-dyadic scalar+scalar"
+  (rv (apl-each-dyadic apl-add (apl-scalar 3) (apl-scalar 4)))
+  (list 7))
+
+(apl-test
+  "each-dyadic scalar+vector"
+  (rv
+    (apl-each-dyadic
+      apl-add
+      (apl-scalar 10)
+      (make-array (list 3) (list 1 2 3))))
+  (list 11 12 13))
+
+(apl-test
+  "each-dyadic vector+scalar"
+  (rv
+    (apl-each-dyadic
+      apl-add
+      (make-array (list 3) (list 1 2 3))
+      (apl-scalar 10)))
+  (list 11 12 13))
+
+(apl-test
+  "each-dyadic vector+vector"
+  (rv
+    (apl-each-dyadic
+      apl-add
+      (make-array (list 3) (list 1 2 3))
+      (make-array (list 3) (list 10 20 30))))
+  (list 11 22 33))
+
+(apl-test
+  "each-dyadic mul matrix+matrix shape"
+  (sh
+    (apl-each-dyadic
+      apl-mul
+      (make-array (list 2 2) (list 1 2 3 4))
+      (make-array (list 2 2) (list 5 6 7 8))))
+  (list 2 2))
+
+(apl-test
+  "each-dyadic mul matrix+matrix values"
+  (rv
+    (apl-each-dyadic
+      apl-mul
+      (make-array (list 2 2) (list 1 2 3 4))
+      (make-array (list 2 2) (list 5 6 7 8))))
+  (list 5 12 21 32))