From: Pascal Bourguignon
Subject: Re: help executing a list
Date: 
Message-ID: <87k6tsm1c4.fsf@thalassa.informatimago.com>
David Wallis <···@cpom.ucl.ac.uk> writes:

> Hello,
> 
> I have just started to learn lisp, and I'm struggling to understand
> 
> how and when lists are/can be evaluated. I want to add some functions to
> 
> implement array syntax (e.g. like IDL/Matlab) on arithmetic expressions,
> 
> e.g.
> 
> (.exp (.* alpha i 2 pi))
> 
> where .exp and .* are array operators, and alpha is an n-dimensional array.
> 
> The guts of the method is a loop
> 
> (dotimes (i (array-total-size a))
> 
>   (setf (row-major-aref r i) (* (row-major-aref (svref v 0) i) 2 pi)))
> 
> [v is a vector holding my arguments]
> 
> This works fine.
> 
> However, I have a function that will generate, from a list of arguments,
> 
> an arithmetic expression that has either (row-major-aref (svref v n) i)
> 
> for array arguments, or just the argument for scalers, so I can mix them
> 
> freely. I now want to be able to do something like the following:
> 
> (setf f '(* (row-major-aref (svref v 0) i) 2 pi)) ; my arithmetic expression
> 
> (dotimes (i (array-total-size a))                 ; Iterate over the array with my expression
> 
>   (setf (row-major-aref r i) f))
> 
> BUT: I can't figure out how to make lisp fill my array r with the
> 
> result of evaluating f, rather than f itself, [I get an array full of
> 
> the list (* (row-major-aref (svref v 0) i) 2 pi) ]
> 
> How do I go about doing this ?

Perhaps instead of generating the expression (which looks simple) you
could just gather the arguments in a list, and use apply to get the
product:

        (let ((arguments '()))
            (push pi arguments)
            (push 2 arguments)
            (push (row-major-aref (svref v 0) i) arguments)
          (apply (function *) arguments))



If you have free variables in the arguments that are bound only when
you want to "evaluate" f and not when you're building the expression,
perhaps you could build a lambda expression with the free variables
passed as argument, then you could:

    (setf (row-major-aref r i) (funcall (coerce f 'function) v i))


-- 
__Pascal Bourguignon__                     http://www.informatimago.com/

Voting Democrat or Republican is like choosing a cabin in the Titanic.

From: Matthew Danish
Subject: Re: help executing a list
Date: 
Message-ID: <877jprzuw9.fsf@mapcar.org>
Pascal Bourguignon <····@mouse-potato.com> writes:
> If you have free variables in the arguments that are bound only when
> you want to "evaluate" f and not when you're building the expression,
> perhaps you could build a lambda expression with the free variables
> passed as argument, then you could:
> 
>     (setf (row-major-aref r i) (funcall (coerce f 'function) v i))

This is wrong.  The free variables will not be captured in the closure
any more than if you used EVAL.  Also, what you are advocating is
ridiculously inefficient: invoking the compiler in a loop!

The proper solution is to pass around a function and call it with
the values to be bound.

(defun f (...)
  ...)

(defun g (fn ...)
  ...
  (funcall fn ...)
  ...)

(g #'f ...) or (g #'(lambda (...) ...) ...) for anonymous function.

-- 
;; Matthew Danish -- user: mrd domain: cmu.edu
;; OpenPGP public key: C24B6010 on keyring.debian.org
From: David Wallis
Subject: Re: help executing a list
Date: 
Message-ID: <4174EAD6.F4C39EB0@cpom.ucl.ac.uk>
>

(Sorry for long post)

Thanks for the response, but I'm afraid I didn't really understand what
you mean. (This is my first lisp program)
Maybe you could expand a bit?

Also, despite reading all the apropriate bits in Paul Graham's 'Common
Lisp', I'm still stuck.The approach I was taking [based on Svein Ove Aas'
reply] was to pass a function to my argument f and  call it in
(dotimes (i (array-total-size a))
   (setf (row-major-aref r i) f))

I have 2 questions.

1. I have a function that can return a list like (+ (row-major-aref (svref
v 0) i) 2 pi) , or just the argument. However the
function contains a loop. I can't figure out how to build the function
(closure?) in a loop, iterating over my arguments. Or, if  I just return a
list, ((row-major-aref (svref v 0) i) 2 pi) ) and call (apply #'+ ...), it
tells me that (row-major-aref (svref v 0) i)  isn't a number (it hasn't
evaluated the expression, it's just passed it to +). How do I build a
function iteratively? My
code to build the arguments is

(defun make-args (lst)
    (let ((v (list-to-vec lst))  ; list-to-vec could be (coerce lst
'array)
             (r Nil))
       (dotimes (i (length lst))
            (if (arrayp (svref v i))
                   (setf r (append1 r `(row-major-aref (svref v ,i)
i)))        ; append1 is just (append lst (list obj))
                 (setf r (append1 r (svref v i))))) r ))

>(make-args '(#(1 2 3) 2))
((ROW-MAJOR-AREF (SVREF V 0) I) 2)

What I want is the function:

(lambda (v i) (+ ((ROW-MAJOR-AREF (SVREF V 0) I) 2))

2. Will this approach invoke the compiler in the loop? The arguments to my
array operator do not change in the loop.
e.g. if I call (.+  #(1 2 3) 2) [where .+ is my array addition operator),
my function would be
(+ (row-major-aref (svref v 0)) 2). So I hoped I could build the function
before going into the loop that iterates over the array  #(1 2 3) and it
should be fast?

> The proper solution is to pass around a function and call it with
> the values to be bound.
>
> (defun f (...)
>   ...)
>
> (defun g (fn ...)
>   ...
>   (funcall fn ...)
>   ...)
>
> (g #'f ...) or (g #'(lambda (...) ...) ...) for anonymous function.
>
From: Matthew Danish
Subject: Re: help executing a list
Date: 
Message-ID: <87fz4ay2p8.fsf@mapcar.org>
David Wallis <···@cpom.ucl.ac.uk> writes:
> (dotimes (i (array-total-size a))
>    (setf (row-major-aref r i) f))


> 
> I have 2 questions.
> 
> 1. I have a function that can return a list like (+ (row-major-aref (svref
> v 0) i) 2 pi) , or just the argument. However the
> function contains a loop. I can't figure out how to build the function
> (closure?) in a loop, iterating over my arguments. Or, if  I just return a
> list, ((row-major-aref (svref v 0) i) 2 pi) ) and call (apply #'+ ...), it
> tells me that (row-major-aref (svref v 0) i)  isn't a number (it hasn't
> evaluated the expression, it's just passed it to +).

First all, get this straight: Lisp ALWAYS evaluates the arguments to a
function before calling it.  Second, you are returning a LIST, not a
FUNCTION.  Third, if you try to apply non-NUMBERs to the + function,
it will complain, naturally.

> How do I build a function iteratively? My code to build the
> arguments is
> 
> (defun make-args (lst)
>     (let ((v (list-to-vec lst))  ; list-to-vec could be (coerce lst
> 'array)
>              (r Nil))
>        (dotimes (i (length lst))
>             (if (arrayp (svref v i))
>                    (setf r (append1 r `(row-major-aref (svref v ,i)
> i)))        ; append1 is just (append lst (list obj))
>                  (setf r (append1 r (svref v i))))) r ))

Your fundamental confusion here is between code and data.
`(row-major-aref (svref v ,i)) just constructs a list that contains
some values, mostly symbols.  A list is a list, not a function.
Functions are constructed with the FUNCTION operator, also known as #'

(defun make-counter-function ()
  (let ((counter 0))
    #'(lambda () (incf counter))))

(defparameter *fn* (make-counter-fn))
(funcall *fn*) => 1
(funcall *fn*) => 2
(funcall *fn*) => 3 ...

#'(lambda ...) means to construct an anonymous function with the given
parameters and body.  There is a handy macro named LAMBDA which
achieves the same thing, so you can just say (lambda ...) without the
#' if you want.  It is optional.  When you use functions like this,
they are treated just like any other value; they are not special at
all.  Just to make it absolutely clear: CREATING FUNCTIONS USING
LAMBDA IS NOT ANY DIFFERENT FROM CREATING ANY OTHER VALUES, LIKE
ARRAYS.

> 2. Will this approach invoke the compiler in the loop? The arguments to my
> array operator do not change in the loop.

The compiler can only be invoked at run-time by calling one of these
functions,

 EVAL, COMPILE, COMPILE-FILE, or using COERCE to turn a list into a
 function.

You should NEVER be using these in a program, as a newbie.  NEVER.  If
you find yourself using them, YOU ARE DOING SOMETHING WRONG.  Proper
programmatic usage of these operators is something even experts find
tricky.

> e.g. if I call (.+  #(1 2 3) 2) [where .+ is my array addition operator),
> my function would be
> (+ (row-major-aref (svref v 0)) 2). So I hoped I could build the function
> before going into the loop that iterates over the array  #(1 2 3) and it
> should be fast?

I think you are going about this all wrong and confused.  What you
want to do is identify the cases that you have to handle specifically.

Case 1: NUMBER + NUMBER => NUMBER
Case 2: VECTOR + NUMBER => VECTOR
Case 3: NUMBER + VECTOR => VECTOR
Case 4: VECTOR + VECTOR => VECTOR

When you are inside the body of the function +., you don't know
anything about the values of the arguments, initially.  You just know
that you are expecting one of the above situations.  Then you must
learn, from the values, what to do with them.

;; This is an example using Common Lisp OOP
;; Generic functions dispatch based on the class of their arguments
(defgeneric vector+ (a b)
  (:documentation "Add vectors and/or numbers"))

(defmethod vector+ ((a number) (b number))
  (+ a b))

(defmethod vector+ ((a vector) (b number))
  (map 'vector #'(lambda (v) (+ v b)) a))

(defmethod vector+ ((a number) (b vector))
  (vector+ b a))

(defmethod vector+ ((a vector) (b vector))
  ;; create new vector r as large as largest of a or b
  (let ((r (make-array (max (length a) (length b)) 
                       :initial-element 0)))
    ;; add elements of a and b into r
    (map-into r #'(lambda (v1 v2) (+ v1 v2)) r a)
    (map-into r #'(lambda (v1 v2) (+ v1 v2)) r b)))

In CL, the class VECTOR is defined as a single-dimension array.
Handling more complicated arrays I will leave to you, if you wish.

-- 
;; Matthew Danish -- user: mrd domain: cmu.edu
;; OpenPGP public key: C24B6010 on keyring.debian.org
From: David Wallis
Subject: Re: help executing a list
Date: 
Message-ID: <4176464E.4884D0C@cpom.ucl.ac.uk>
> I think you are going about this all wrong and confused.  What you
> want to do is identify the cases that you have to handle specifically.
>
> Case 1: NUMBER + NUMBER => NUMBER
> Case 2: VECTOR + NUMBER => VECTOR
> Case 3: NUMBER + VECTOR => VECTOR
> Case 4: VECTOR + VECTOR => VECTOR

Thanks for the above advice. However, I want to make my operators be more
advanced than the ones you suggest. (I've made some operators that do the
above.)

The goal I am aiming for is as follows:

In CL, you can put as many arguments to '*' as you want:

> (* 1 2 3 4 5)
120

I want to implement the same functionality, but to be able to freely mix scaler
and array values. One limitation is
that the first argument  must be an array, and the function will get the array
shape from this. Obviously, all other array arguments must be the same shape.

So, I want to be able to write things like:

(.* alpha i 2 pi beta)

where alpha and beta are arrays [e.g. #2a((1 2 3)(4 5 6)) ]

It's easy to account for arrays of any number of dimensions using
'row-major-aref'. It's also easy to do array calculations by doing the
following:

(setf ls (#(2a((1 2 3)(4 5 6)) #c(0 1) 2 pi #(2a((2 2 2)(3 3 3)))   ; list
containing  'alpha i 2 pi beta'
(setf v (coerce ls 'array))
(setf r (make-array '(2 3)))           ; for the result
(dotimes (i (array-total-size a))
   (setf (row-major-aref r i) (* (row-major-aref (svref v 0) i)  #c(0 1) 2 pi
(row-major-aref (svref v 4) i) )))

The problem comes with trying to automatically construct:
(* (row-major-aref (svref v 0) i) #c(0 1) 2 pi (row-major-aref (svref v 4) i) )

from my list 'ls', and inserting either the scaler value or a call to
'row-major-aref' where appropriate.
I can create the above as a list, but not as a function. I will also eventually
want to pass '*' as an argument to the
function that I come up with so I can pass +,-,/ etc. I suppose I am writing a
mapping function, say 'map-array'.

Any ideas?

Thanks,
David.
From: Matthew Danish
Subject: Re: help executing a list
Date: 
Message-ID: <87lle1wf76.fsf@mapcar.org>
David Wallis <···@cpom.ucl.ac.uk> writes:
> In CL, you can put as many arguments to '*' as you want:
> 
> > (* 1 2 3 4 5)
> 120
> 
> I want to implement the same functionality, but to be able to freely
> mix scaler and array values. One limitation is that the first
> argument must be an array, and the function will get the array shape
> from this. Obviously, all other array arguments must be the same
> shape.

Learn to walk before you run.  Write a function to add two things,
then you can add more than two.  Now you add more cases:

ARRAY + NUMBER => ARRAY
NUMBER + ARRAY => ARRAY
ARRAY + ARRAY => ARRAY

A way to generalize a 2-parameter operator might go something like this:

(defun nary-add (&rest args)
  (reduce #'2ary-add args :initial-value 0))

this basically does, for example,

(nary-add a b c d) ==> (2ary-add (2ary-add (2ary-add (2ary-add a b) c) d) 0)
(nary-add a) ==> (2ary-add a 0)
(nary-add) ==> 0

-- 
;; Matthew Danish -- user: mrd domain: cmu.edu
;; OpenPGP public key: C24B6010 on keyring.debian.org
From: Pascal Bourguignon
Subject: Re: help executing a list
Date: 
Message-ID: <87hdop1m7i.fsf@thalassa.informatimago.com>
David Wallis <···@cpom.ucl.ac.uk> writes:
> I want to implement the same functionality, but to be able to freely
> mix scaler and array values. One limitation is that the first
> argument  must be an array, and the function will get the array
> shape from this. Obviously, all other array arguments must be the
> same shape.


1-     
(defun .* (&rest args)
  (if (null args)
     (*)
     (let ((arrays  (remove-if-not (function arrayp)  args))
           (scalars (remove-if-not (function numberp) args)))
       (assert (= (length args) (+ (length arrays) (length scalars))))
       (matrix-scalar* (reduce (function matrix-*) arrays) 
                       (apply (function *) scalars)))))


2-
(defmacro addop (name scalar-op matrix-op matrix-scalar-op)
  `(defun ,name (&rest args)
    (if (null args)
       (,scalar-op)
       (let ((arrays  (remove-if-not (function arrayp)  args))
             (scalars (remove-if-not (function numberp) args)))
         (assert (= (length args) (+ (length arrays) (length scalars))))
         (,matrix-scalar-op (reduce (function ,matrix-op) arrays) 
                            (apply (function ,scalar-op) scalars))))))
  
 (addop .+ + matrix+ matrix-scalar+)
 (addop .* * matrix* matrix-scalar*)


Do the same for / and - with the special cases that the first argument
is special, and that when only one argument is passed, negation and
inversions are to be done instead of substraction or division.

  
To know how to implement matrix operations, see for example Wolfram's MathWorld:

    http://mathworld.wolfram.com/MatrixMultiplication.html


One implementation could be:

(defun matrix* (a b)
    (assert (array a))
    (assert (array b))
    (assert (= 2 (array-dimension a) (array-dimension b)))
    (assert (= (elt (array-dimensions a) 1) (elt (array-dimensions b) 0)))
    (let ((result (make-array (list (elt (array-dimensions a) 0)
                                    (elt (array-dimensions b) 1))
                              :element-type (array-element-type a))))
      ;; c_ik=a_ij*b_jk
      (dotimes (i (elt (array-dimensions a) 0) result)
        (dotimes (j (elt (array-dimensions b) 1))
            (setf (aref result i j)
                (let ((sum 0))
                  (dotimes (k (elt (array-dimensions a) 1) sum)
                    (incf sum (* (aref a i k) (aref b k j))))))))))

You don't need to generate no code.

-- 
__Pascal Bourguignon__                     http://www.informatimago.com/

Voting Democrat or Republican is like choosing a cabin in the Titanic.
From: Mario S. Mommer
Subject: Re: help executing a list
Date: 
Message-ID: <fzpt3dwgu0.fsf@germany.igpm.rwth-aachen.de>
David Wallis <···@cpom.ucl.ac.uk> writes:
> 1. I have a function that can return a list like (+ (row-major-aref (svref
> v 0) i) 2 pi) , or just the argument. However the
> function contains a loop. I can't figure out how to build the function
> (closure?) in a loop, iterating over my arguments. Or, if  I just return a
> list, ((row-major-aref (svref v 0) i) 2 pi) ) and call (apply #'+ ...), it
> tells me that (row-major-aref (svref v 0) i)  isn't a number (it hasn't
> evaluated the expression, it's just passed it to +). How do I build a
> function iteratively? My
> code to build the arguments is
>
> (defun make-args (lst)
>     (let ((v (list-to-vec lst))  ; list-to-vec could be (coerce lst
> 'array)
>              (r Nil))
>        (dotimes (i (length lst))
>             (if (arrayp (svref v i))
>                    (setf r (append1 r `(row-major-aref (svref v ,i)
> i)))        ; append1 is just (append lst (list obj))
>                  (setf r (append1 r (svref v i))))) r ))
>
>>(make-args '(#(1 2 3) 2))
> ((ROW-MAJOR-AREF (SVREF V 0) I) 2)
>
> What I want is the function:
>
> (lambda (v i) (+ ((ROW-MAJOR-AREF (SVREF V 0) I) 2))

Very simple.

(eval (list 'lambda '(v i) (make-args '(#(1 2 3) 2))))

There you go.

> 2. Will this approach invoke the compiler in the loop? The arguments to my
> array operator do not change in the loop.
> e.g. if I call (.+  #(1 2 3) 2) [where .+ is my array addition operator),
> my function would be
> (+ (row-major-aref (svref v 0)) 2). So I hoped I could build the function
> before going into the loop that iterates over the array  #(1 2 3) and it
> should be fast?

Well, you can compile it, too. Like in 

(compile nil (list 'lambda '(v i) (make-args '(#(1 2 3) 2))))

which will return a compiled function.

The above of course modulo some other issues, but I guess you get the
point. Be aware that the compiler will also use time, so it all is a
trade-off. You might want to study compiler macros and memoization as
ways to cache the generated lambdas.

Interesting project!

Regards,
        Mario.