Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

Added RECYCLE, with tests.

  • Loading branch information...
commit 395fe27a06c93a0f0c768c5d3cb92f5ac62de8ac 1 parent 566ba4c
@tpapp authored
Showing with 43 additions and 1 deletion.
  1. +2 −1  src/package.lisp
  2. +31 −0 src/transformations.lisp
  3. +10 −0 tests/tests.lisp
View
3  src/package.lisp
@@ -34,7 +34,8 @@
#:each*
#:each
#:margin*
- #:margin)
+ #:margin
+ #:recycle)
(:export ; stack
#:stack*
#:stack))
View
31 src/transformations.lisp
@@ -168,3 +168,34 @@ given ELEMENT-TYPE."
(array-rank array))))
"Like MARGIN*, with ELEMENT-TYPE T."
(margin* t function array inner outer))
+
+
+
+;;; recycle
+
+(defun recycle (object &key inner outer
+ (element-type (if (arrayp object)
+ (array-element-type object)
+ t)))
+ "Recycle elements of object, extending the dimensions by outer (repeating
+OBJECT) and inner (repeating each element of OBJECT). When both INNER and
+OUTER are nil, the OBJECT is returned as is. Non-array objects are intepreted
+as rank 0 arrays, following the usual semantics."
+ (if (or inner outer)
+ (let ((inner (ensure-list inner))
+ (outer (ensure-list outer)))
+ (if (arrayp object)
+ (let ((dimensions (array-dimensions object)))
+ (aprog1 (make-array (append outer dimensions inner)
+ :element-type element-type)
+ (let* ((outer-size (product outer))
+ (size (product dimensions))
+ (inner-size (product inner))
+ (reshaped (reshape it (list outer-size size inner-size))))
+ (loop for outer-index below outer-size
+ do (loop for index below size
+ do (fill (sub reshaped outer-index index)
+ (row-major-aref object index)))))))
+ (make-array (append outer inner) :initial-element object
+ :element-type element-type)))
+ object))
View
10 tests/tests.lisp
@@ -148,6 +148,16 @@ SUBSCRIPTS-MAPPING, should return the permuted arguments as a list."
(ensure-same (ao:margin (curry #'reduce #'+) a 1) #(10 35 60))
(ensure-same (ao:margin (curry #'reduce #'*) a 0) #(0 66 168 312 504))))
+(addtest recycle
+ (ensure-same (ao:recycle 1 :inner '(2 1) :outer '(3 4))
+ (make-array '(3 4 2 1) :initial-element 1))
+ (let ((a (ao:generate #'identity '(2 3) :position)))
+ (ensure-same (ao:recycle a) a)
+ (ensure-same (ao:recycle a :inner 2)
+ (ao:generate (lambda (p) (floor p 2)) '(2 3 2) :position))
+ (ensure-same (ao:recycle a :inner 1 :outer 2)
+ (ao:generate (lambda (p) (rem p 6)) '(2 2 3 1) :position))))
+
;;; stack
Please sign in to comment.
Something went wrong with that request. Please try again.