Re: Aref on steroids

On Jun 11, 1:33 am, p...@xxxxxxxxxxxxxxxxx (Pascal J. Bourguignon)
wrote:
Slobodan Blazeski <slobodan.blaze...@xxxxxxxxx> writes:
On Jun 10, 12:24 pm, p...@xxxxxxxxxxxxxxxxx (Pascal J. Bourguignon)
wrote:

If you don't need to extract the slice,
I must return a new array as a result of slicing.

Then you will have to copy the slice to an array, which you can easily
do by generating a copier function like the reader.

Here is again the code with added a copier function.

(defun argument-list (indices)
  (mapcar (lambda (i)
            (if (integerp  i)
                i
                (gensym)))
          indices))

(defun parameter-list (argument-list)
  (remove-if (function integerp) argument-list))

(defun make-reader (indices)
  (let ((args (argument-list indices)))
    (compile nil `(lambda (array ,@(parameter-list args))
                    (aref array ,@args)))))

(defun make-writer (indices)
  (let ((args (argument-list indices)))
    (compile nil `(lambda (new-value array ,@(parameter-list args))
                    (setf (aref array ,@args) new-value)))))

(defmacro popn (n stack &environment env)
  (multiple-value-bind (vars vals store-vars writer-form reader-form)
            (get-setf-expansion stack env)
    (when (cdr store-vars) (error "Can't expand this."))
    (let ((vstore   (car store-vars)))
      `(let* (,@(mapcar (function list) vars vals)
              (,vstore ,reader-form))
         (progn
           ,@(if (integerp n)
                 (let ((vn (1- n)))
                   (cond
                     ((zerop vn)  '())
                     ((= 1 vn)    `((setf ,vstore (cdr ,vstore))))
                     (t           `((setf ,vstore (nthcdr ,vn ,vstore))))))
                 `((setf ,vstore (nthcdr (1- ,n) ,vstore))))
           (prog1 (pop ,vstore)
             ,writer-form))))))

(defun slice-indices-offsets (indices)
  (loop
     :for offset = (position-if-not (function integerp) indices)
     :while offset
     :collect offset
     :do (popn (1+ offset) indices)))

(defun make-project-list (indices)
  (compile nil `(lambda (list)
                  (list ,@(mapcar (lambda (offset) `(popn ,(1+ offset) list))
                                  (slice-indices-offsets indices))))))

(defun make-copier (indices dimensions)
  (let* ((args (argument-list indices))
         (pars (parameter-list args)))
    (compile nil  `(lambda (array)
                     (let ((copy (make-array ',dimensions)))
                       ,(loop
                           :with form = `(setf (aref copy ,@pars) (aref array ,@args))
                           :for index :in (reverse pars)
                           :for maxim :in (reverse dimensions)
                           :do (setf form `(loop :for ,index :below ,maxim :do ,form))
                           :finally (return form))
                       copy)))))

(defclass slice ()  
   ((array  :initarg :array)
    (reader :initarg :reader)
    (writer :initarg :writer)
    (copier :initarg :copier)))

(defun slice (array &rest indices)
   (make-instance 'slice :array array
                         :reader (make-reader indices)
                         :writer (make-writer indices)
                         :copier (make-copier indices
                                              (funcall (make-project-list indices)
                                                       (array-dimensions array)))))

(defmethod copy-to-array ((self slice))
  (funcall (slot-value self 'copier) (slot-value self 'array)))

(defmethod ref ((self slice) &rest indices)
   (apply (slot-value self 'reader) (slot-value self 'array) indices))

(defmethod (setf ref) (new-value (self slice) &rest indices)
   (apply (slot-value self 'writer) new-value (slot-value self 'array) indices))

(let* ((a #4A((((1101 1102 1103)
                (1111 1112 1113)
                (1121 1122 1123))
               ((1201 1202 1203)
                (1211 1212 1213)
                (1221 1222 1223))
               ((1301 1302 1303)
                (1311 1312 1313)
                (1321 1322 1323)))
              (((2101 2102 2103)
                (2111 2112 2113)
                (2121 2122 2123))
               ((2201 2202 2203)
                (2211 2212 2213)
                (2221 2222 2223))
               ((2301 2302 2303)
                (2311 2312 2313)
                (2321 2322 2323)))))
       (s (slice a 1 t 2 t)))
  (copy-to-array s))

--> #2A((2121 2122 2123) (2221 2222 2223) (2321 2322 2323))

(let* ((a #4A((((1101 1102 1103)
[...]
       (s (slice a 1 t 2 t)))
  (setf (ref s 1 1) 0)
  (loop for i from 0 to 2
     do (loop for j from 0 to 2
           do (princ (ref s i j)) (princ " ")
           finally (terpri)))
  a)
This is the problem of manually specifying the loops

Well obviously, you may add slots to the slice class to be able to
implement all the nice functions like the one we have on arrays, such
as rank, dimensions, row-major reference, etc.

--
__Pascal Bourguignon__
Great this is just what I needed, many thanks:
(defun slice (array &rest indices)
(copy-to-array
(make-instance 'slice :array array
:reader (make-reader indices)
:writer (make-writer indices)
:copier (make-copier indices
(funcall (make-project-
list indices)
(array-
dimensions array))))))



cheers
bobi
.

Quantcast