🚀 go-pugleaf

Based on the Code of Bill St.Clair for faster-climits I tried to write a
general map-array function,
both a mcl specific and a portable version.

Then I compared this construct to mapc for sequences

To my surprise, the mapping an array was slower than mapping over a list.
Am I missing something ?

Ps I know, that       
(setq min (min min wert))
(setq max (max max wert))
is not necessary, but I want to speed up map-array, not the operation

;environment sys 7.01, 16Mb partition on a quadra 700 mcl 2.0p1.1

(defmacro map-array-ccl (function array1)
  (let ((av (gensym))
        (offset (gensym))
        (asiz (gensym))
        (index (gensym))
        (array (gensym))
        )
    `(let ((,array ,array1))
       (multiple-value-bind
       (,av ,offset) 
       (ccl::array-data-and-offset ,array)
       (let ((,asiz (array-total-size ,array))
             (,index ,offset))
         (declare (fixnum ,asiz ,index)
                  (optimize (speed 3) (safety 0)))
         (if (simple-vector-p ,av)
           (locally 
             (declare (simple-vector ,av))
             (dotimes (,(gensym) ,asiz)
               (funcall ,function (aref ,av ,index))
               (incf ,index)))
           (dotimes (,(gensym) ,asiz)
               (funcall ,function (aref ,av ,index))
               (incf ,index))))))))


(defmacro map-array-portable (function array1)
  (let ((asiz (gensym))
        (array (gensym))
        (temparray (gensym))
        (index (gensym))
        )
    `(let* ((,temparray ,array1)
            (,asiz (array-total-size ,temparray))
            (,array (make-array ,asiz
	                        :displaced-to ,temparray
	                        :element-type (array-element-type ,temparray)))
            )
       (declare (fixnum ,asiz)
                (optimize (speed 3) (safety 0)))
       (dotimes (,index ,asiz)
         (funcall ,function (aref ,array ,index))
         ))))

;test it
(defparameter *long-sequence* nil)

(defparameter *array-like-sequence* nil)

(defun initialize (n)
  (setq *long-sequence* nil)
  (setq *array-like-sequence* (make-array (list n n) :element-type
'fixnum))
  (dotimes (y n)
    (dotimes (x n)
      (let ((wert (random 2000)))
        (push wert *long-sequence*)
        (setf (aref *array-like-sequence* y x) wert))))
 )

(defun test-sequence ()
  (let* ((min (first *long-sequence*))
         (max min))
    (mapc #'(lambda(wert)
              (setq min (min min wert))
              (setq max (max max wert)))
          *long-sequence*)
    `(min ,min max ,max)))

(defun test-array-ccl ()
  (let* ((min (aref *array-like-sequence* 0 0))
         (max min))
    (map-array-ccl #'(lambda(wert)
                       (setq min (min min wert))
                       (setq max (max max wert))
                       )
                   *array-like-sequence*)
    `(min ,min max ,max))
  )

(defun test-array-portable ()
  (let* ((min (aref *array-like-sequence* 0 0))
             (max min))
        (map-array-portable #'(lambda(wert)
                           (setq min (min min wert))
                           (setq max (max max wert))
                           )
                       *array-like-sequence*)
        `(min ,min max ,max)))

#|
(initialize 200)

(time (test-sequence))
(TEST-SEQUENCE) took 432 milliseconds (0.432 seconds) to run.
Of that, 5 milliseconds (0.005 seconds) were spent in The Cooperative
Multitasking Experience.
 32 bytes of memory allocated.
(MIN 0 MAX 1999)

(time (TEST-ARRAY-CCL))
 took 502 milliseconds (0.502 seconds) to run.
Of that, 7 milliseconds (0.007 seconds) were spent in The Cooperative
Multitasking Experience.
 32 bytes of memory allocated.
(MIN 0 MAX 1999)

(time (test-array-portable))
(TEST-ARRAY-PORTABLE) took 563 milliseconds (0.563 seconds) to run.
Of that, 2 milliseconds (0.002 seconds) were spent in The Cooperative
Multitasking Experience.
 64 bytes of memory allocated.
(MIN 0 MAX 1999)
|#
   

Karsten Poeck
Universitaet  Wuerzburg
Lehrstuhl fuer Informatik VI