Recursive macro.

Discussion of Common Lisp

Recursive macro.

Postby Ajschylos » Thu Mar 19, 2009 1:56 am

Hi,
for last several weeks I've tried to understand macros, especially their arguments evaluation.

I need such construct in my project:

(n-mapcar #'(lambda ( <variables-list> ) (<and-body-of-function-to-execute>)) '(<over-several-lists-of-arguments>))

Why I call this n-mapcar?

Simply because it acts like applying a lambda function to each element of cartesian product of sets.

For example I would like this function to do following:
(n-mapcar #'(lambda (x y) (* x y)) '((1 2 3) (4 5 6))) --> (4 5 6 8 10 12 12 15 18); or

(n-mapcar #'(lambda (x y z) (sqrt (+ (* x x) (* y y) (* z z)))) '((2 3 5) (7 11 13) (17 19 23))) --> (18.493243 20.34699 24.124676 20.34699 22.045409 25.573424 21.494185 23.10844 26.495284 18.627936 20.46949 24.228083 20.46949 22.15852 25.670996 21.610184 23.216374 26.589472 19.052559 20.856654 24.556059 20.856654 22.51666 25.980763 21.97726 23.558438 26.888659)

and so on ...


I wrote recursive macro to do most of work:
Code: Select all
(defmacro ncr (params form lst)
"ncr wraps form with adequate (mapcan #'(lambda parameter from params) applied to list of arguments from lst"
  (let ((p-car (car params))
        (p-cdr (cdr params))
        (l-cdr (cdr lst))
        (l-car (car lst)))
    (if (null p-cdr)
        `(mapcar #'(lambda (,p-car) ,form) ',l-car)
        `(mapcan #'(lambda (,p-car) (ncr ,p-cdr ,form ,l-cdr )) ',l-car))))


so in call (ncr (x y) (* x y) ((1 2 3) (4 5 6))) following expansion is expected:

Code: Select all
(MAPCAN (FUNCTION (LAMBDA (X)
        (MAPCAR (FUNCTION (LAMBDA (Y) (* X Y))) (QUOTE (4 5 6)))))
                                             (QUOTE (1 2 3)))


What I needed else was to extract parameters and form to execute from lambda function, and I did it following way:

Code: Select all
(defmacro n-mapcar ((f (l p f)) (q lst))
   `(ncr ,p ,f ,lst))

where f stands for FUNCTION, l for LAMBDA, p for parameters list, f for the formula to be executed, q for quote and lst for the list of lists of arguments.

Looks complicated, but works the way I want:


(n-mapcar #'(lambda (x y) (* x y)) '((1 2 3) (4 5 6))) --> (4 5 6 8 10 12 12 15 18)

What is my question?

I would like to pass to the macro not only list itself: '((1 2 3)(4 5 6)), but also a variable (setf thelist '((9 8 7)(6 5 4)(3 2 1)))

(n-mapcar #'(lambda (x y z) (* x y z)) thelist)

and I tried hundred different ways and can't do that.

The ncr macro must stay as is because it makes recursive nesting of mapcans and mapcar, so it's structure should be clear.
It seems there is a need for another macro which passes arguments to ncr, and part of them stays unevaluated, and rest part is (lst).

In one of previous experiments I successfully used an EVAL, but all big people (Norvig, Seibel, Graham) suggest to avoid it especially
in such constructs as mine.

Thanks in advance, A.
Ajschylos
 
Posts: 18
Joined: Wed Jan 07, 2009 12:44 pm

Re: Recursive macro.

Postby Jasper » Thu Mar 19, 2009 6:47 am

You should nearly always use functions, not macros, i basically see macros as little decorations to make code look better and have less parenthesis. (An exception being simple iteration constructs, like dolist) The rest is to be done with taking functions as arguments.

In this case, there is a simple -but not so simple to find- recursive way to get this using functions. I had to muck about a little before finding it.
Code: Select all
(defun n-mapcar (fn list &optional got)
  "Funcalls fn for every conbination of elements in sublists of list."
  (if (null list)
    (list (funcall fn (reverse got)))
    (mapcan (lambda (el)
               (n-mapcar fn (cdr list) (cons el got)))
            (car list))))

(n-mapcar (lambda (list) list) '((1 2 3 4 5) (a b c d) (q r s t u v)))

I tried to explain how it works in words, i failed to produce anything good. Basically got keeps track on the arguments gathered so-far, when list runs out, you know we have all that we need to call funcall with it, if the list did not run out yet, call n-mapcar for each element from the first element of the list (car list), and the rest of the list, while adding the elements to what we got.

If you did this iteratively you would have to keep a list storing the positions where you are on the different lists. You would have to increment the position for the different lists one by one, and funcall the function for each combination. Recursively, keeping track of the list storing the positions is easier. (Lisp does it for you, not a special lisp feature, though; C and such would too.)

I don't know how to make that funcall with multiple elements, but the following might help:
Code: Select all
(defmacro lambda-list ((&rest arguments) &body body)
  (let ((list (gensym)))
    `(lambda (,list)
        (destructuring-bind (,@arguments) ,list
           ,@body))))))
Basically destructuring bind yanks the arguments from the list, in the order the arguments are. (Also supports arguments like macros get them, &rest, &optional, etc.)
Last edited by Jasper on Thu Mar 19, 2009 6:54 am, edited 2 times in total.
Jasper
 
Posts: 209
Joined: Fri Oct 10, 2008 8:22 am
Location: Eindhoven, The Netherlands

Re: Recursive macro.

Postby Harleqin » Thu Mar 19, 2009 6:49 am

I think that this is not the place for a macro. You should make it a function. The mapping constructs in the language standard are also functions, this could be a hint.

A quick hack:

Code: Select all
(defun n-mapcar (func lists)
  (if (null (cdr lists))
      (car lists)
      (let ((acc ()))
        (dolist (x (car lists))
          (dolist (y (cadr lists))
            (push (funcall func x y) acc)))
        (n-mapcar func (cons (nreverse acc) (cddr lists))))))


Trying it out:

Code: Select all
CL-USER> (n-mapcar #'* '((1 2 3) (4 5 6)))
(4 5 6 8 10 12 12 15 18)
CL-USER> (n-mapcar #'* '((1 2 3) (4 5 6) (7 8 9)))
(28 32 36 35 40 45 42 48 54 56 64 72 70 80 90 84 96 108 84 96 108 105 120
 135 126 144 162)
"Just throw more hardware at it" is the root of all evil.
Svante
Harleqin
 
Posts: 71
Joined: Wed Dec 17, 2008 5:18 am
Location: Bonn, Germany

Re: Recursive macro.

Postby gugamilare » Thu Mar 19, 2009 7:19 am

Jasper wrote:I don't know how to make that funcall with multiple elements, but the following might help:

Are you looking for apply?

Code: Select all
(apply #'+ '(1 2 3)) => 6

Harleqin wrote:A quick hack:

Code: Select all
(defun n-mapcar (func lists)
  (if (null (cdr lists))
      (car lists)
      (let ((acc ()))
        (dolist (x (car lists))
          (dolist (y (cadr lists))
            (push (funcall func x y) acc)))
        (n-mapcar func (cons (nreverse acc) (cddr lists))))))

Your "quick hack" only works for commutative operators, I would call it "n-reduce". It doesn't work for, e.g., #'list. I believe using curry (it is easy to implement, metatilities has it) is also a good solution, and it will make it work the way it's intended to.

@Ajschylos: Don't destroy the code you made for the macro, you can use it to create a compiler macro if you want. Anyway, making it is interesting to learn how to write compiler macros at least.
gugamilare
 
Posts: 406
Joined: Sat Mar 07, 2009 6:17 pm
Location: Brazil

Re: Recursive macro.

Postby Harleqin » Thu Mar 19, 2009 7:41 am

Yes, gugamilare, I noticed the second example now. Here is a version with recursively mapped currying:

Code: Select all
(defun n-mapcar (func lists)
  (if (null (cdr lists))
      (mapcar func (car lists))
      (mapcan (lambda (f)
                (n-mapcar f (cdr lists)))
              (mapcar (lambda (x)
                        #'(lambda (&rest args)
                            (apply func x args)))
                      (car lists)))))


Trying it out:

Code: Select all
CL-USER> (n-mapcar #'(lambda (x y z) (sqrt (+ (* x x) (* y y) (* z z)))) '((2 3 5) (7 11 13) (17 19 23)))
(18.493242 20.34699 24.124676 20.34699 22.045408 25.573423 21.494184
 23.10844 26.495283 18.627935 20.46949 24.228083 20.46949 22.15852
 25.670996 21.610184 23.216373 26.589472 19.052559 20.856653 24.556059
 20.856653 22.51666 25.980762 21.97726 23.558437 26.888659)
"Just throw more hardware at it" is the root of all evil.
Svante
Harleqin
 
Posts: 71
Joined: Wed Dec 17, 2008 5:18 am
Location: Bonn, Germany

Re: Recursive macro.

Postby Ajschylos » Thu Mar 19, 2009 8:12 am

Hi again,

I know perfectly well how to do this using functions ( the dolist construct was my first idea)
I want to do it using macros, and especially NCR macro I wrote from many purposes, mainly training.

So I am very obliged for Your time spent convincing me that macro is not good solution,
I am looking for the answer how to wrap NCR macro to do my job.

Thanks for Your time, A.
Ajschylos
 
Posts: 18
Joined: Wed Jan 07, 2009 12:44 pm

Re: Recursive macro.

Postby Jasper » Thu Mar 19, 2009 2:11 pm

I don't entirely understand what NCR is supposed to do.

If you want to optimize by finding if the number of arguments is fixed, you can, for some cases, with a compiler macro.
Code: Select all
(require :iterate)
(in-package #:iterate)

(defun n-mapcar (fn list &optional got)
  "Funcalls fn for every combination of elements in sublists of list."
  (if (null list)
    (list (apply fn (reverse got)))
    (iter (for el in (car list))
     (appending (n-mapcar fn (cdr list) (cons el got))))))

(defmacro with-gensyms ((&rest vars)&body body)
"Makes you some variables with gensyms output in them."
  `(let (,@(iter (for el in vars)
       (collect `(,el (gensym)))))
     ,@body))

(defmacro iter-once (&body body)
  "Iter, stops after one go, useful for collecting and such inside callbacks."
  `(iter ,@body (finish)))

(defun n-mapcar-compiler-internal (list list-manner got-vars expr-fn)
  "Internal bit for compiler macro for n-mapcar. Makes a bunch of dolists."
  (if (null list)
    (funcall expr-fn got-vars)
    (with-gensyms (el)
      `(dolist (,el (, list-manner ,(car list)))
    ,(n-mapcar-compiler-internal (cdr list) list-manner
                  (cons el got-vars)
                  expr-fn)))))

(define-compiler-macro n-mapcar (fn list &optional got)
  "Mapcar. (You can test it as a macro, but don't let it infinite loop.)"
  (case (car list)
    ((list quote) ;We can detect length.
     (print (cadr list)) ;On purpose, why doesn't it print?
     (with-gensyms (the-fun)
       `(iter-once
     (with ,the-fun = ,fn)
     ,(n-mapcar-compiler-internal (cadr list) (car list) nil
      (lambda (vars)
        `(collect (funcall ,the-fun ,@vars)))))))
;   (backq-list ;Dunno how, if i can recognize ',' and there are no ,@
;it could convert it to list itself.(Or find CLs function for it.)
;   (....   ;Could do more if you knew some functions gave some size list.
    (t
     `(n-mapcar ,fn ,list ,got))))

(n-mapcar-compiler-internal '((1 2 3 4 5) (q r s t) (a b c))
             'quote nil (lambda (x) x))

(n-mapcar (lambda (x y z) (list x y z))
     '((a b c d) (q r s t) (u v w)))
This is the first time i made a compiler macro. It works if you convert it into a ordenary macro. (Watch out for infinite loops though!) If i run the last it doesn't print (cadr list), so i am not entirely sure if it is correct. Have no clue why it doesn't print it, the compiler macro should be triggered.
Jasper
 
Posts: 209
Joined: Fri Oct 10, 2008 8:22 am
Location: Eindhoven, The Netherlands


Return to Common Lisp

Who is online

Users browsing this forum: No registered users and 3 guests

cron