Move map-array from num-utils

Lisp-Stat · Jul 14, 2023 · 0a8ef6c · 0a8ef6c
1 parent 6dbe6a6
commit 0a8ef6c
Show file tree

Hide file tree

Showing 5 changed files with 20 additions and 7 deletions.
diff --git a/array-operations.asd b/array-operations.asd
@@ -1,10 +1,10 @@
 ;;; -*- Mode: LISP; Base: 10; Syntax: ANSI-Common-lisp; Package: ASDF -*-
 ;;; Copyright (c) 2012-2018 by Tamas Papp. All rights reserved.
 ;;; Copyright (c) 2019-2022 by Ben Dudson. All rights reserved.
-;;; Copyright (c) 2021-2022 by Symbolics Pte. Ltd. All rights reserved.
+;;; Copyright (c) 2021-2023 by Symbolics Pte. Ltd. All rights reserved.
 
 (defsystem #:array-operations
-  :version "1.0.0"
+  :version "1.1.0"
   :description "Array operations library for Common Lisp"
   :long-description  #.(uiop:read-file-string
 			(uiop:subpathname *load-pathname* "description.text"))

diff --git a/docs/array-operations.epub b/docs/array-operations.epub
diff --git a/docs/array-operations.texi b/docs/array-operations.texi
@@ -14,7 +14,7 @@
 @c Commentary:
 
 @c Generated automatically by Declt version 4.0 beta 2 "William Riker"
-@c on Wed Jul 20 11:08:35 2022 GMT+8.
+@c on Wed Jul 20 11:53:52 2022 GMT+8.
 
 
 @c ====================================================================

diff --git a/src/transforming.lisp b/src/transforming.lisp
@@ -1,7 +1,7 @@
 ;;; -*- Mode: LISP; Base: 10; Syntax: ANSI-Common-lisp; Package: ARRAY-OPERATIONS/TRANSFORMING -*-
 ;;; Copyright (c) 2012-2018 by Tamas Papp. All rights reserved.
 ;;; Copyright (c) 2018-2022 by Ben Dudson. All rights reserved.
-;;; Copyright (c) 2021-2022 by Symbolics Pte. Ltd. All rights reserved.
+;;; Copyright (c) 2021-2023 by Symbolics Pte. Ltd. All rights reserved.
 
 (defpackage :array-operations/transforming
   (:use :cl :array-operations/generic
@@ -27,6 +27,7 @@
            :permutation-incompatible-rank
            :permute
            :recycle
+	   :map-array
            :turn)
   (:documentation "Functions for transforming arrays in various ways."))
 
@@ -344,8 +345,7 @@ Array element type is preserved."
 (deftype array-rank-element () `(integer 0 (,array-rank-limit)))
 
 (defun turn (array nturns &optional (rank-1 0) (rank-2 1))
-  "Turns an array by a specified number of clockwise 90° rotations. The axis of
-rotation is specified by RANK-1 (defaulting to 0) and RANK-2 (defaulting to 1)."
+  "Turns an array by a specified number of clockwise 90° rotations. The axis of rotation is specified by RANK-1 (defaulting to 0) and RANK-2 (defaulting to 1)."
   (declare (optimize speed))
   (check-type array array)
   (check-type nturns integer)
@@ -393,3 +393,11 @@ rotation is specified by RANK-1 (defaulting to 0) and RANK-2 (defaulting to 1)."
               (locally (declare #+sbcl (sb-ext:muffle-conditions
                                         sb-ext:compiler-note))
                 (row-major-aref array i)))))))
+
+(defmethod map-array (array function
+			   &optional (retval (make-array (array-dimensions array))))
+  "Apply FUNCTION to each element of ARRAY
+Return a new array, or write into the optional 3rd argument."
+  (dotimes (i (array-total-size array) retval)
+    (setf (row-major-aref retval i)
+          (funcall function (row-major-aref array i)))))
diff --git a/tests/tests.lisp b/tests/tests.lisp
@@ -1,7 +1,7 @@
 ;;; -*- Mode: LISP; Base: 10; Syntax: ANSI-Common-lisp; Package: ASDF -*-
 ;;; Copyright (c) 2012-2018 by Tamas Papp. All rights reserved.
 ;;; Copyright (c) 2018-2022 by Ben Dudson. All rights reserved.
-;;; Copyright (c) 2021-2022 by Symbolics Pte. Ltd. All rights reserved.
+;;; Copyright (c) 2021-2023 by Symbolics Pte. Ltd. All rights reserved.
 
 (defpackage :array-operations/tests
   (:use :cl :alexandria :clunit)
@@ -714,3 +714,8 @@
 		#2A((0 1)
                     (2 3))
 		#2A((5) (9)))))
+
+(deftest map-array (transformations)
+  (let ((a #2A((1 2) (3 4))))
+    (assert-equalp #2A((2 3) (4 5))
+      (aops:map-array a #'1+))))