On Dec 11, 7:33 pm, "metaperl.com" <········@gmail.com> wrote:
> array-iota is something I wrote in Chicken Scheme:http://hg.metaperl.com/redick?f=cb48388212ef;file=scheme/util/array-i...
>
> and now I want to port it to Lisp.
>
> Basically all it does it create an n-dimensional array and fill it
> with increasing integers. But one neat thing about it is that if a
> given dimension is negative, then the values along that axis are
> reversed... and this can be done for any axis.
>
> Before I implement this in Lisp, I would like to know if it has
> already been done. Examples of the Scheme version follow:
*snip*
Probably not, can't really see much use for it...
Ok just off the cuff,
(defun inverse-array-row-major-index(a index)
(reverse (loop for i in (reverse (array-dimensions a))
collect (mod index i)
do (setf index (floor index i)))))
(defun create-value(position indicies)
(apply #'+ (maplist #'(lambda (x y)
(* (if (plusp (car y))
(car x)
(- (abs (car y)) (car x) 1))
(apply #'* (mapcar #'abs (cdr y)))))
position
indicies)))
(defun array-iota (&rest rest)
(let ((array (make-array (mapcar #'abs rest))))
(dotimes (x (array-total-size array) array)
(setf (row-major-aref array x)
(create-value (inverse-array-row-major-index array x))
rest))))
----
Geoff
On Dec 12, 4:33 pm, Geoffrey Summerhayes <·······@gmail.com> wrote:
> On Dec 11, 7:33 pm, "metaperl.com" <········@gmail.com> wrote:
>
> > array-iota is something I wrote in Chicken Scheme:http://hg.metaperl.com/redick?f=cb48388212ef;file=scheme/util/array-i...
>
> Ok just off the cuff,
on win32 sbcl 1.0.12 i got an error with your code:
This is SBCL 1.0.12, an implementation of ANSI Common Lisp.
More information about SBCL is available at <http://www.sbcl.org/>.
SBCL is free software, provided as is, with absolutely no warranty.
It is mostly in the public domain; some portions are provided under
BSD-style licenses. See the CREDITS and COPYING files in the
distribution for more information.
This is experimental prerelease support for the Windows platform: use
at your own risk. "Your Kitten of Death awaits!"
*
INVERSE-ARRAY-ROW-MAJOR-INDEX
*
CREATE-VALUE
* ; in: LAMBDA NIL
; (SETF (ROW-MAJOR-AREF ARRAY X)
; (CREATE-VALUE (INVERSE-ARRAY-ROW-MAJOR-INDEX ARRAY X))
; REST)
;
; caught ERROR:
; (in macroexpansion of (SETF # # ...))
; (hint: For more precise location, try *BREAK-ON-SIGNALS*.)
; odd number of args to SETF
; (DOTIMES (X (ARRAY-TOTAL-SIZE ARRAY) ARRAY)
; (SETF (ROW-MAJOR-AREF ARRAY X)
; (CREATE-VALUE (INVERSE-ARRAY-ROW-MAJOR-INDEX ARRAY X))
; REST))
; --> DO BLOCK LET TAGBODY PSETQ PSETF LET* MULTIPLE-VALUE-BIND LET 1+
+
; ==>
; X
;
; note: deleting unreachable code
;
; compilation unit finished
; caught 1 ERROR condition
; printed 1 note
ARRAY-IOTA
*
debugger invoked on a SB-INT:COMPILED-PROGRAM-ERROR:
Execution of a form compiled with errors.
Form:
(SETF (ROW-MAJOR-AREF ARRAY X)
(CREATE-VALUE (INVERSE-ARRAY-ROW-MAJOR-INDEX ARRAY X))
REST)
Compile-time error:
(in macroexpansion of (SETF # # ...))
(hint: For more precise location, try *BREAK-ON-SIGNALS*.)
odd number of args to SETF
Type HELP for debugger help, or (SB-EXT:QUIT) to exit from SBCL.
restarts (invokable by number or by possibly-abbreviated name):
0: [ABORT] Exit debugger, returning to top level.
(ARRAY-IOTA 2 3 4)
0]
On Dec 12, 4:33 pm, Geoffrey Summerhayes <·······@gmail.com> wrote:
>
> Probably not, can't really see much use for it...
It is useful for "tagging" the elements of an array. Then, when you
transform the array, you know what-went-where, because each array
position was ordinated.
It wasnt off the cuff for me. It has been a whole-day affair. I
finally have it working with all positive indexes:
(defun most-inner (offset length)
(loop for i from 0 to (1- length) collect (+ offset i)))
(defun array-iota* (offset shape)
(if (null (cdr shape))
(most-inner offset (car shape))
(let ((my-offset (apply #'* (cdr shape))))
(loop for i from 0 to (1- (car shape))
collect (array-iota* (+ offset (* i my-offset))
(cdr shape))))))
(defun array-iota (&rest shape)
(array-iota* 0 shape))
(array-iota 2 3 4)
On 2007-12-12 19:48:11 -0500, "metaperl.com" <········@gmail.com> said:
> It wasnt off the cuff for me. It has been a whole-day affair. I
> finally have it working with all positive indexes:
All positive indices is pretty straightforward - just use row-major-aref:
(defun array-positive-iota (&rest dims)
(loop
with array = (make-array dims)
with size = (array-total-size array)
for i from 0 below size
do (setf (row-major-aref array i) i)
finally (return array)))
You can do the same for the negative indices, but you need both an
inverse for row-major-aref (as Geoff pointed out) and a way to permute
an index if the corresponding dimension is negative:
(defun rmi-to-indices (array rmi)
(loop for dim in (reverse (array-dimensions array))
collect (mod rmi dim) into indices
do (setf rmi (floor rmi dim))
finally (return (reverse indices))))
(defun permute-indices (indices dims)
(loop
for index in indices
for counter from 0 below (length indices)
for dim in dims
when (minusp dim) do
(setf (nth counter indices) (- (abs dim) (1+ index)))
finally (return indices)))
(defun array-iota (&rest dims)
(loop with array = (make-array (mapcar #'abs dims))
for i from 0 below (array-total-size array)
do (setf (row-major-aref array i)
(apply #'array-row-major-index array
(permute-indices
(rmi-to-indices array i) dims)))
finally (return array)))
This works for all your tests in both OpenMCL and SBCL
Den Tue, 11 Dec 2007 16:33:48 -0800 skrev metaperl.com:
> Before I implement this in Lisp, I would like to know if it has already
> been done. Examples of the Scheme version follow:
Rob Warnock mentioned having a iota in his library, in the J thread a
couple posts back.
Cheers,
Maciej
Maciej Katafiasz <········@gmail.com> wrote:
+---------------
| skrev metaperl.com:
| > Before I implement this in Lisp, I would like to know if it has already
| > been done. Examples of the Scheme version follow:
|
| Rob Warnock mentioned having a iota in his library,
| in the J thread a couple posts back.
+---------------
Thanks, but it's not relevant to metaperl's request.
Mine is just the naive list-valued version:
> (defun iota (count &optional (start 0) (step 1))
(loop repeat count for i from start by step collect i))
IOTA
> (iota 20)
(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19)
> (iota 20 13)
(13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32)
> (iota 20 13 5)
(13 18 23 28 33 38 43 48 53 58 63 68 73 78 83 88 93 98 103 108)
>
-Rob
p.s. Although I must admit the IOTA/MOD/STRIDE I ended up with
in the "SETF...Self Similar" thread was kinda interesting... ;-}
[But still not applicable to metaperl's request.]
-----
Rob Warnock <····@rpw3.org>
627 26th Avenue <URL:http://rpw3.org/>
San Mateo, CA 94403 (650)572-2607