Topic: ==={ Challenge }=== General dyadic operation

[ribarm]

Code: [Select]

(defun dyadic ( f l1 l2 / loop )
  (defun loop ( x y )
    (cond
      ( (or (null x) (null y)) nil)
      ( (and (atom x) (atom y)) (f x y))
      ( (and (listp x) (listp y)) (mapcar '(lambda ( a b ) (loop a b)) x y))
    )
  )
  (mapcar '(lambda ( a b ) (loop a b)) l1 l2)
)


Code: [Select]

Command: (dyadic + '((1 2) 3 (4 5)) '((1 2) 3 (4 5)))
((2 4) 6 (8 10))

Command: (dyadic + '((1 2 3) 3 (4 5)) '((1 2) 3 (4 5)))
((2 4) 6 (8 10))

Command: (dyadic + '(1 3 (4 5)) '((1 2) 3 (4 5)))
(nil 6 (8 10))


Code: [Select]

(defun mapTree ( f l / k args nullargs atomargs listpargs loop )
  (setq k 0)
  (setq args (mapcar '(lambda ( x ) (read (strcat "arg" (itoa (setq k (1+ k)))))) l))
  (setq k 0)
  (setq nullargs (mapcar '(lambda ( x ) (read (strcat "(null arg" (itoa (setq k (1+ k))) ")"))) l))
  (setq k 0)
  (setq atomargs (mapcar '(lambda ( x ) (read (strcat "(atom arg" (itoa (setq k (1+ k))) ")"))) l))
  (setq k 0)
  (setq listpargs (mapcar '(lambda ( x ) (read (strcat "(listp arg" (itoa (setq k (1+ k))) ")"))) l))
  (eval
    (list 'defun 'loop args
      (list 'cond
        (list (cons 'or nullargs) nil)
        (list (cons 'and atomargs) (cons 'f args))
        (list (cons 'and listpargs) (cons 'mapcar (cons (list 'function (list 'lambda args (cons 'loop args))) args)))
      )
    )
  )
  (apply 'loop l)
)


Code: [Select]

Command: (maptree + '(((1 2) 3 (4 5)) ((1 2) 3 (4 5)) ((1 2) 3 (4 5))))
((3 6) 9 (12 15))

Regards, M.R.

[bruno_vdh]

Hello,

For a journey across the width, it is possible to simplify and remove the anonymous function

Code: [Select]

(defun dyadic (f l1 l2 / loop)
  (defun loop (x y)
    (cond ((or (null x) (null y)) nil)
          ((or (atom x) (atom y)) (f x y))
          ((mapcar 'loop x y))
    )
  )
  (loop  l1 l2)
)


Code: [Select]

_$ (dyadic + '((1 2) 3 (4 5)) '((1 2) 3 (4 5)))
((2 4) 6 (8 10))
Regards,

[irneb]

Another version, which allows for things like (* scalar vector):

Code - Auto/Visual Lisp: [Select]

1. (defun dyadic (func a b / do-dyadic do-dyadic-al do-dyadic-la)
2.   (if (= (type func) 'SYM) (setq func (eval func)))
3.   (defun do-dyadic (a b)
4.     (cond ((atom a)
5.            (cond ((atom b) (func a b))
6.                  (t (mapcar 'do-dyadic-al b))))
7.           ((atom b) (mapcar 'do-dyadic-la a))
8.           (t (mapcar 'do-dyadic a b))))
9.   (defun do-dyadic-al (b) (do-dyadic a b))
10.   (defun do-dyadic-la (a) (do-dyadic a b))
11.   (do-dyadic a b))

Though it does so even within lists, e.g.

Code: [Select]

_$ (dyadic + '(1 2 4 5 (6 (7))) '(2 3 (4 5) 6 (7 (8))))
(3 5 (8 9) 11 (13 (15)))Not too sure if that's a "good" thing. 

[ElpanovEvgeniy]

my variant 1:

Code - Auto/Visual Lisp: [Select]

1. (defun eea-map1 (a b)
2.   (cond ((listp a) (mapcar (function eea-map1) a b))
3.         (+ a b)
4.   )
5. )

[bruno_vdh]

A shorter version with mapcar, but less good as mapcar does not return an error if arguments asymmetric..

Code: [Select]

(defun dyadic (f a b / loop)
  (defun loop (x y) (if (atom x) (f x y) (mapcar 'loop x y)))
  (setq f (eval f))
  (loop a b)
)

Code: [Select]

_$ (dyadic + '((1 2) 3 (4 5)) '((1 2) 3 (4 5)))
((2 4) 6 (8 10))


[Lee Mac]

@bruno, how about simply:

Code: [Select]

(defun dyadic ( f a b )
    (mapcar '(lambda ( x y ) (if (atom x) (f x y) (dyadic f x y))) a b)
)

Code: [Select]

_$ (dyadic + '((1 2) 3 (4 5)) '((1 2) 3 (4 5)))
((2 4) 6 (8 10))

[ribarm]

Lee, it's better to use tail recursion than mapcar... My codes also fail in dotted pair cases... Test it and you'll see :

Code: [Select]

Command: (dyadic + '((1 2) (3 . 4) 5) '((1 2) (3 . 4) 5))
; error: bad list: 4

Bruno's and Gilles's codes firstly posted are better...

[Lee Mac]

I know - mapcar cannot process dotted pairs.

[bruno_vdh]

@bruno, how about simply:

Code: [Select]

(defun dyadic ( f a b )
    (mapcar '(lambda ( x y ) (if (atom x) (f x y) (dyadic f x y))) a b)
)

@Lee, is a writing is prettier, the choice of the name lambda (loop= lambda) is explained by the factorization (eval f) for more flexibility:

Code: [Select]

_$ (eval +)
#<SUBR @0000000031458ba8 +>
_$ (eval '+)
#<SUBR @0000000031458ba8 +>


[bruno_vdh]

Hello,

@Lee, is a writing is prettier, the choice of the name lambda (loop= lambda) is explained by the factorization (eval f) for more flexibility:
 

I take this opportunity to remind a small grammar point to the flexibility of the syntax ((eval f) x y) is not the best, it excludes the use of special forms.
Finally, I think this  (eval (cons f '(x y))), (eval (list f x y))  or this (apply f '(x y)) is preferable ..

To summarize:

Code: [Select]

(defun dyadic (f a b)
    (mapcar '(lambda ( x y ) (if (atom x) (eval (cons f '(x y))) (dyadic f x y))) a b)
 )
My preference is the latter

Code: [Select]

(defun dyadic (fun x y)
  (cond ((null (or x y)) nil)
        ((or (atom x) (atom y)) (eval (cons fun '(x y))))
        ((cons (dyadic fun (car x) (car y)) (dyadic fun (cdr x) (cdr y))))
  )
)

Examples

Code: [Select]

_$ (dyadic + '((1 2) 3 (4 5)) '((1 2) 3 (4 5)))
((2 4) 6 (8 10))
_$ (dyadic 'and '((nil T) T (T T)) '((nil nil) T (nil T)))
((nil nil) T (nil T))

Regards,

[ribarm]

Bruno, I've modified your mapTree for symbols and operands...

Code: [Select]

(defun mapTree (f l)
  (cond ((apply 'or (mapcar 'null l)) nil)
        ((apply 'and (mapcar 'atom l)) (if (eq (type f) 'SYM) (apply f l) (apply 'f l)))
        ((cons (mapTree f (mapcar 'car l)) (mapTree f (mapcar 'cdr l))))
  )
)


Code: [Select]

Command: (maptree + '(((1 2) (3 . 4) 5) ((1 2) (3 . 4) 5) ((1 2) (3 . 4) 5)))
((3 6) (9 . 12) 15)

Command: (maptree '+ '(((1 2) (3 . 4) 5) ((1 2) (3 . 4) 5) ((1 2) (3 . 4) 5)))
((3 6) (9 . 12) 15)


[irneb]

Just a question: Does the function always take 2 atomic values as argument? I.e. it never expects a list?

Still not answered. Similar to the dotted pair problem, this makes the generalized function very different. E.g. what if you're using a function like distance to obtain the distances between 2 lists of points?

Same type of thing applies for the dotted pair. Should such even be allowed? I mean, this is a form of mapcar, and since mapcar doesn't allow dotted pairs, should this allow it?

As for recursion (or even tail-call) over mapcar, that is a bit dangerous to use as iteration loop over the list. I think it should be fine to use recursion to iterate over the tree's depth, but it's length might become too long for AutoLisp's stack (i.e. around 15000 iterations).

[bruno_vdh]

Bruno, I've modified your mapTree for symbols and operands...
 

@ribarm thank you, it was also possible to do like this  :

Code: [Select]

(defun mapTree (f l)
  (cond ((null (apply 'or l)) nil)
        ((apply 'or (mapcar 'atom l)) (eval (cons f l)))
        ((cons (mapTree f (mapcar 'car l)) (mapTree f (mapcar 'cdr l))))
  )
)


Code: [Select]

_$ (maptree 'and '(((1 2) (3 . 4) 5) ((1 2) (3 . 4) 5) ((1 2) (3 . 4) 5)))
((T T) (T . T) T)
_$ (maptree + '(((1 2) (3 . 4) 5) ((1 2) (3 . 4) 5) ((1 2) (3 . 4) 5)))
((3 6) (9 . 12) 15)


[ribarm]

Bruno, it was also possible to do it like this :

Code: [Select]

(defun dyadic (f x y)
  (cond ((or (null x) (null y)) nil)
        ((and (atom x) (atom y)) (if (eq (type f) 'SYM) (apply f (list x y)) (f x y)))
        ((cons (dyadic f (car x) (car y)) (dyadic f (cdr x) (cdr y))))
  )
)


Code: [Select]

Command: (dyadic + '((1 2) (3 . 4) 5) '((1 2) (3 . 4) 5))
((2 4) (6 . 8) 10)

Command: (dyadic '+ '((1 2) (3 . 4) 5) '((1 2) (3 . 4) 5))
((2 4) (6 . 8) 10)


[ElpanovEvgeniy]

Bruno, it was also possible to do it like this :

Code: [Select]

(defun dyadic (f x y)
  (cond ((or (null x) (null y)) nil)
        ((and (atom x) (atom y)) (if (eq (type f) 'SYM) (apply f (list x y)) (f x y)))
        ((cons (dyadic f (car x) (car y)) (dyadic f (cdr x) (cdr y))))
  )
)


Code: [Select]

Command: (dyadic + '((1 2) (3 . 4) 5) '((1 2) (3 . 4) 5))
((2 4) (6 . 8) 10)

Command: (dyadic '+ '((1 2) (3 . 4) 5) '((1 2) (3 . 4) 5))
((2 4) (6 . 8) 10)


maybe:

Code - Auto/Visual Lisp: [Select]

1. (defun dyadic (f x y)
2.   (cond ((or (null x) (null y)) nil)
3.         ((atom x) ((eval f)  x y))
4.         ((cons (dyadic f (car x) (car y)) (dyadic f (cdr x) (cdr y))))
5.   )
6. )