I have a list of lists of integers l (example: ((3 5) (1 2 3))), and I want
to generate a function that takes an array arr and returns a new array
whose i'th element is the product of the elements of arr indexed by the
i'th element of l.  So for instance, given l as above, I want
to return a function such as

(lambda (arr)
  (let ((new (make-array 2)))
    (setf (aref new 0) (* (aref arr 3) (aref arr 5)))
    (setf (aref new 1) (* (aref arr 1) (aref arr 2) (aref arr 3)))
    new))

The reason I want to do this is that the same list of lists of integers gets
used many many millions of times, so I'd like to avoid going over the list of
lists each time I do so.  Also, the list of lists of integers is several
hundred elements long, so I don't much want to type it out by hand.

I do have a solution:

(defun gen-array-prods-fun (prod)
    (do* ((pl prod (cdr pl))
          (pc (car pl) (car pl))
          (i 0 (+ i 1))
          (l (list (array-prods-fun i pc))
             (cons (array-prods-fun i pc)
                   l)))
        ((null (cdr pl))
         (eval `(lambda (arr)
                  (let ((new (make-array ,(length prod))))
                    ,@(nreverse l)
                    new))))))

(defun array-prods (i prodlist)
  `(setf (aref new ,i)
         (* ,@(mapcar #'(lambda (e)
                          `(aref arr ,e))
                      prodlist))))

Which I use as follows:

* (setf (symbol-function 'f) (gen-array-prods-fun '((3 5) (1 2 3))))
#<Interpreted Function (LAMBDA (ARR)
                               (LET #
                                #
                                #
                                NEW))
{497F14F1}>
* a
#(0 1 2 3 4 5 6 7)
* (f a)
#(15 6)

I can also compile the function using (compile 'f), but I can't help but
feel that I'm missing something.  Is there a better way to do this?  More
elegant, cleaner, more idiomatic, more LISPy?  Is it possible to avoid
using eval?  Is there any reason to use macros here instead of functions?
Any advice is appreciated.

Cheers,

(defun array-prods (i prodlist arr new)
  `(setf (aref ,new ,i)
         (* ,@(mapcar (lambda (e)
                        `(aref ,arr ,e))
                      prodlist))))

(defmacro def-array-prods (f prod)
  (let ((arr (gensym))
        (new (gensym))
        (length (length prod)))
    `(defun ,f (,arr)
       (let ((,new (make-array ,length)))
         ,@(loop for i from 0
                 for list in prod
                 collect (array-prods i list arr new))
         ,new))))

CL-USER 5 > (def-array-prods f ((3 5) (1 2 3)))
F

CL-USER 6 > (f #(0 1 2 3 4 5 6 7))
#(15 6)

However, you might run into problems with CALL-ARGUMENTS-LIMIT,
which might be as small as 50!  You might also try to generate
code that uses something like

(let ((arr #(0 1 2 3 4 5 6 7)))
  (reduce #'* '(3 5) :key (lambda (i) (aref arr i))
                     :initial-value 1))

Where you generate list literals like '(3 5).

Regards,
--
Nils Goesche
Ask not for whom the <CONTROL-G> tolls.

Regards,
--
Nils Goesche
Ask not for whom the <CONTROL-G> tolls.

[...]

(defun make-new-array (old-array integer-list)
  (loop with new-array = (make-array (length integer-list))
      for elem in integer-list
      and i from 0
      do (setf (aref new-array i)
           (reduce #'* (map 'list (lambda (index)
                                    (aref old-array index))
                            elem)))
      finally (return new-array)))

Or using a lexical closure:

(let ((integer-list '((3 5) (1 2 3))))
               (defun make-new-array (old-array)
                 (loop with new-array = (make-array (length integer-list))
                     for elem in integer-list
                     and i from 0
                     do (setf (aref new-array i)
                          (reduce #'* (map 'list (lambda (index)
                                                   (aref old-array index))
                                           elem)))
                     finally (return new-array))))

My suspicion is that this is premature optimization.  Iterating over lists
is pretty efficient in Lisp, and contorting your design to avoid it is
usually wasted effort.  It will make your code harder to read and maintain,
and is not likely to buy you significant performance.  Have you profiled
your code and found that this list iteration is really a bottleneck?  How
big are these lists in practice?

(defun make-new-array (old-array integer-list)
  (declare (type (simple-array single-float (28)) old-array))
  (loop with new-array = (make-array 434 :element-type 'single-float)
        for elem in integer-list
        and i from 0
        do (setf (aref new-array i)
                 (reduce #'* (map 'list (lambda (index)
                                          (aref old-array index))
                                  elem)))
        finally (return new-array)))

(Note that I've hard coded in the size of the new array and the old
array for speed.  I'm compiling with (speed 3) and (safety 0).  If
there are any other obvious ways to optimize this function, I'm
definitely interested.)

In the other corner, we have the open-coded function generator:

(defun gen-array-prods-fun (name prod alen)
  (do* ((pl prod (cdr pl))
        (pc (car pl) (car pl))
        (i 0 (+ i 1))
        (l (list (array-prods-fun i pc))
           (cons (array-prods-fun i pc)
                 l)))
      ((null (cdr pl))
       (eval `(setf (symbol-function ',name)
                    #'(lambda (arr)
                        (declare (type (simple-array single-float (,alen))
                                       arr))
                        (let ((new (make-array ,(length prod)
                                               :element-type 'single-float)))
                          ,@(nreverse l)
                          new)))))))

I generate the function using (this is under CMUCL), starting from the
length-434 vector pls:

(progn
  (gen-array-prods-fun 'genned-f pls 28)
  (with-compilation-unit (:optimize '(optimize (speed 3) (safety 0) (debug 0)))
                         (compile 'genned-f)))

We'll also make use of a function to create random arrays:

(defun make-random-vector (l)
  (let ((a (make-array l :element-type 'single-float)))
    (dotimes (i l)
      (setf (aref a i) (random 1.0)))
    a))

(let ((a (make-random-vector 28)))
  (equalp (genned-f a)
          (make-new-array a pls)))

return T, indicating to me that the two approaches generate identical
results.

Now we compare them in speed:
* (time (dotimes (i 10000) (make-new-array (make-random-vector 28) pls)))
Evaluation took:
  4.55 seconds of real time
  3.75 seconds of user run time
  0.79 seconds of system run time
  [Run times include 0.1 seconds GC run time]
  0 page faults and
  391666344 bytes consed.

* (time (dotimes (i 10000) (genned-f (make-random-vector 28))))
Compiling LAMBDA NIL:
Compiling Top-Level Form:

Evaluation took:
  0.17 seconds of real time
  0.14 seconds of user run time
  0.03 seconds of system run time
  0 page faults and
  20960192 bytes consed.

indicating that the open-coding approach seems to be much faster.
Given that this code actually has to be executed millions of times, it
seems that this optimization is worth doing.

The bad (confusing) news is that the compilation time for the
open-coded functions seems quite long --- for size 434, it took about
15 seconds to compile the function, and for size 4494, it didn't
compile in 15 minutes, when I killed it.  It seems that the
compilation time of a function, even a function that just contains a
whole bunch of open-coded setf's of aref's, is superlinear in the size
of the function?  Is this normal?  Certainly, my compiler seems to
compile several hundred line .lisp files that are much more
complicated than this in under a second, so I'm not clear why this is
compiling so slow.  Any thoughts?

I'm still left with my original question to some extent.  Nils Goesche
suggested an alternate implementation where gen-array-prods-fun was a
macro instead of a function.  What are the advantages/disadvantages of
this?  Is my gen-array-prods-fun reasonable lisp, or is there
something gross about it?  Is this a good use of eval --- I was
"taught" by books that using eval almost always indicates you're doing
something wrong, but I'm not sure what it is I'm doing wrong here.  

Thanks for the replies so far.

Cheers,

(reduce #'* elem :key (lambda (index)
                        (declare (fixnum index))
                        (aref old-array index)))

should cons much less than the original call to REDUCE.

Regards,
--
Nils Goesche
"Don't ask for whom the <CTRL-G> tolls."

(defun make-new-array (old-array integer-list)
  (declare (type (simple-array single-float (28)) old-array))
  (loop with new-array = (make-array 434 :element-type 'single-float)
        for elem in integer-list
        and i from 0
        do (setf (aref new-array i)
                 (reduce #'* elem :key (lambda (index)
                                         (declare (fixnum index))
                                         (aref old-array index))))
        finally (return new-array)))

The performance is much better now, but still far from the open-coded
version:

Evaluation took:
  3.09 seconds of real time
  2.53 seconds of user run time
  0.53 seconds of system run time
  [Run times include 0.12 seconds GC run time]
  0 page faults and
  255027984 bytes consed.

Any other ideas for improving the function?

Thanks for the comments on the macro version vs. the function version.
I have to reread my "On Lisp" and try to grok macros better.

Cheers,

Or just declare types like hell as in

(defun make-new-array (old-array integer-list)
  (declare (type (simple-array single-float (28)) old-array)
           (list integer-list)
           (optimize speed (safety 0) (debug 0) (space 0)
                     (compilation-speed 0)))
  (loop with new-array of-type (simple-array single-float (434)) =
             (make-array 434 :element-type 'single-float)
        for elem of-type cons in integer-list
        and i fixnum from 0
        do (setf (aref new-array i)
                 (reduce #'* elem :key (lambda (index)
                                         (declare (fixnum index))
                                         (aref old-array index))))
        finally (return new-array)))

and you might also write your own specialized REDUCE:

(defun make-new-array (old-array integer-list)
  (declare (type (simple-array single-float (28)) old-array)
           (list integer-list)
           (optimize speed (safety 0) (debug 0) (space 0)
                     (compilation-speed 0)))
  (loop with new-array of-type (simple-array single-float (434)) =
             (make-array 434 :element-type 'single-float)
        for elem of-type cons in integer-list
        and i fixnum from 0
        do (setf (aref new-array i)
                 (loop with ret of-type single-float = 1.0
                       for x fixnum in elem do
                       (setq ret
                             (the single-float (* ret (aref old-array x))))
                       finally (return ret)))
        finally (return new-array)))

You seem to be using CMUCL.  CMUCL issues a lot of performance
hints when you compile with high optimization settings.  Those
are usually very helpful.  And use DISASSEMBLE.

If all this /still/ is slower than the macro version,
congratulations: You have written a cool compiler for your type
of problem :-) Peter Norvig's ``Paradigms of Artificial
Intelligence Programming'' contains lots of examples for how to
write little compilers with macros.

Regards,
--
Nils Goesche
Ask not for whom the <CONTROL-G> tolls.

Cheers,

(defun gen-array-prods-fun (l-l-int)
    (let ((funvec
            (map 'vector
                 (lambda (l-int)
                    (labels ((build-prod (afl)
                                (cond ((null afl)
                                       (lambda (a)
                                          (declare (ignore a))
                                          1))
                                      (t
                                       (let ((df (build-prod
                                                     (cdr afl))))
                                          (lambda (a)
                                             (* (aref a (car afl))
                                                (funcall df a))))))))
                       (build-prod l-int)))
                 l-l-int))
         (new-d (length l-l-int)))
       (lambda (a)
         (let ((new (make-array new-d)))
            (do ((i 0 (+ i 1)))
                ((= i new-d))
              (setf (aref new i)
                    (funcall (aref funvec i) a)))
            new))))

The idea is to create a vector of functions, the i'th of which computes
the i'th
element of the new array given the old array.  Carrying things to
extremes, each such function is defined so as to embody the structure of
the integer list, so it never consults the list at run time.  For
instance, the 0'th function constructed for your example would be
    (lambda (a)
        (* (aref a 3)
           (funcall (lambda (a)
                       (* (aref a 5)
                          (funcall (lambda (a) 1)
                                   a)))
                     a)))

A bit more source-level optimization is possible here, but wouldn't
enlighten the issues any further.

Note that if you compile gen-array-prods-fun, the lambda expression
produced is already compiled, and in fact inaccessible.  The result of
gen-array-prods-fun looks like
  #<Closure (:internal gen-array-prods-fun 1) @ #x206ff452>
or some other implementation-dependent thing.  (This one is from Allegro
6.2)

The reason some (most?) compilers will have trouble optimizing the
returned function is that it's not obvious that the result is equivalent to

      (lambda (a)
        (* (aref a 3)
           ((lambda (a)
               (* (aref a 5)
                  ((lambda (a) 1)
                   a)))
            a)))

which would be easy to optimize.

  To make a new vector that contains the values of some function applied to
  each element of a list in order, you can use (map 'vector <function> ...).

  To produce a product of all values in a list, you can use (reduce #'* ...).

  To extract the nth item from a vector and use it instead of n, use an
  accessor function and specify this function as the key to reduce.

(map 'vector (lambda (l) (reduce #'* l :key (lambda (n) (aref v n)))))

  If this is not fast enough, you may want to optimize only some components
  instead of writing the whole thing out in full by hand.

--
Erik Naggum, Oslo, Norway