(defun foo ( l1 l2 )
(mapcar '(lambda ( a b ) (if (and (listp a) (listp b)) (mapcar '(lambda ( c d ) (+ c d)) a b) (+ a b))) l1 l2)
)
(foo '((2 5) 6 (1 3)) '((4 3) 1 (2 3)))
=> ((6 8) 7 (3 6))
A safer way, returns nil and print an error message in case of unbalanced arguments.
< .. >
(map2 '+ '((1 2 3) 4 (5 6 7)) '((3 2 1) 0 (-1 -2 -3)))
((4 4 4) 4 (4 4 4))
(map2 '- '((1 2 3) 4 (5 6 7)) '((3 2 1) 0 (-1 -2 -3)))
((-2 0 2) 4 (6 8 10))
(map2 'strcat '(("A" "B" ("C") ("D"))) '(("C" "D" ("E") ("F"))))
(("AC" "BD" ("CE") ("DF")))
;; multi-mapcar
;; _map_fun ---- function , it can be (lambda (x) ...)
;; _map_typ ---- Type , REAL FILE STR INT SYM LIST SUBR EXSUBR PICKSET ENAME PAGETB
;; _map_lst ---- a list
;;
;; e.g
;; (ss-mapcar (lambda (x) (vl-string-trim " " x)) (quote STR) '(( " 1 " " 22 ") (" aA " "bB ")))
;; --> (("1" "22") ("aA" "bB"))
;; Use for Excel string: (ss-mapcar (lambda (x)(vl-string-trim "`\t" x)) (quote STR) lst)
;;
;; by GSLS(SS) 2013-10-25
(defun ss-mapcar (_map_fun _map_typ _map_lst)
(mapcar (function (lambda (_lambda_x)
(cond ((= (type _lambda_x) _map_typ)
(_map_fun _lambda_x))
((= (type _lambda_x) (quote List))
(ss-mapcar _map_fun _map_typ _lambda_x))
(t _lambda_x))
)
)
_map_lst))
(defun mapinX (fun lst / loop R err)
(defun loop (fun lst / c)
(cond
((apply 'and (setq c (mapcar 'null lst))) nil)
((apply 'or c) (setq err 'T) nil)
((apply 'and (setq c (mapcar 'atom lst))) (apply fun lst))
((apply 'or c) (setq err 'T) nil)
((apply 'and (mapcar 'listp lst))
(cons
(loop fun (mapcar 'car lst))
(loop fun (mapcar 'cdr lst))
)
)
('default (setq err 'T) nil)
)
)
(setq R (loop fun lst))
(if err
(prompt "\nError: unbalanced arguments\n")
R
)
)
(mapinX
'+
(list
'((1 2 3) (4 . 5) (1 2 3 . 6) ((5 6) . 10))
'((5 6 12) (1 . 2) (2 3 12 . 12) ((1 2) . 4))
'((10 34 12) (2 . 3) (4 5 1 . 2) ((3 1) . 20))
)
)
;=> ((16 42 27) (7 . 10) (7 10 16 . 20) ((9 9) . 34))
(defun MapinX (Expr Lst / Stack Result Dim c err raiseErr nilAsList)
(setq nilAsList nil)
(setq lst (mapcar 'list lst)
raiseErr (lambda (m / )
(setq err m)
)
)
(while (or Lst Stack)
(cond
((apply 'and (setq c (mapcar 'null Lst)))
(setq Lst (car Stack)
Stack (cdr Stack)
)
(if Dim
(setq Result (cons
( (lambda ( / O)
(cond
((apply '= (caar Dim))
(repeat (caaar Dim)
(setq O (cons (car Result) O)
Result(cdr Result)
)
)
(if (apply '= (cdar Dim))
(cond
((= (cadar Dim) 0)
O
)
((= (cadar Dim) 1)
(apply 'vl-list* O)
)
)
(progn
(setq Lst nil)
(raiseErr "Structural Mismatch: dotted Pair")
)
)
)
('default
(setq Lst nil)
(raiseErr "Structural Mismatch: length")
)
)
)
)
Result
)
Dim (cdr Dim)
)
)
)
((apply 'or c) (setq Lst nil))
( (and
nilAsList
(apply
'and
(setq c
(mapcar
'(lambda (a / )
(not (listp (car a)))
)
lst
)
)
)
)
(setq Result (cons (apply Expr (mapcar 'car Lst)) Result)
Lst (mapcar 'cdr Lst)
)
)
( (and
(not nilAsList)
(apply
'and
(setq c
(mapcar
'(lambda (a / )
(atom (car a))
)
lst
)
)
)
)
(setq Result (cons (apply Expr (mapcar 'car Lst)) Result)
Lst (mapcar 'cdr Lst)
)
)
((apply 'or c)
(setq Lst nil)
(raiseErr "Structural Mismatch: list/atom")
)
('T
(setq Stack (cons (mapcar 'cdr Lst) Stack))
(apply
'(lambda (L D / )
(setq Lst L
Dim (cons (cons (mapcar 'length Lst) D) Dim)
)
)
( (lambda (a / F)
(list
(mapcar
'(lambda (a / lst s)
(setq s a)
(while (not (atom (cdr a)))
(setq lst (cons (car a) lst)
a (cdr a)
)
)
(cond
((cdr a)
(setq F (cons 1 F))
(reverse (vl-list* (cdr a) (car a) lst))
)
('default
(setq F (cons 0 F))
s
)
)
)
a
)
F
)
)
(mapcar 'car Lst)
)
)
)
)
)
(if err
err
(car (reverse Result))
)
)
Just a question: Does the function always take 2 atomic values as argument? I.e. it never expects a list? If so I think it's quite possible.
And then what should happen if one list is smaller than the other: nil values filled in or should the shorter list be repeated, or some other?
And 3rd: what if one of the arguments is already an atom? Should it be applied to all members of the list argument? I.e. something like vector operations?
(defun dyadic (fun x y)
(cond ((null (or x y)) nil)
((or (atom x) (atom y)) ((eval fun) x y))
((cons (dyadic fun (car x) (car y)) (dyadic fun (cdr x) (cdr y))))
)
)
_$ (dyadic '+ '((1 2) 3 (4 3 5)) '((1 2) 3 (4 3 5)))
((2 4) 6 (8 6 10))
_$ (dyadic '+ '((1 2) 3 (4 5)) '((1 2) 3 (4 3 5)))
; erreur: type d'argument incorrect: numberp: nil
_$ (dyadic '+ '((1 2) 3 (4 3 5)) '((1 2) 3 (4 5)))
; erreur: type d'argument incorrect: numberp: (5)
or in a more efficient way (eval fun only once and tail recursion)
(defun dyadic (f x y / loop)
(defun loop (x y)
(cond ((null (or x y)) nil)
((or (atom x) (atom y)) (f x y))
((cons (loop (car x) (car y)) (loop (cdr x) (cdr y))))
)
)
(setq f (eval f))
(loop x y)
)
(defun mapTree (f l)
(cond ((null (apply 'or l)) nil)
((apply 'or (mapcar 'atom l)) (apply f l))
((cons (mapTree f (mapcar 'car l)) (mapTree f (mapcar 'cdr l))))
)
)
_$ (mapTree 'strcat '((("a" "b") "c" ("d" "e" "f")) (("a" "b") "c" ("d" "e" "f")) (("a" "b") "c" ("d" "e" "f"))))
(("aaa" "bbb") "ccc" ("ddd" "eee" "fff"))
_$ (mapTree '+ '(((1 2) 3 (4 3 5)) ((1 2) 3 (4 3 5)) ((1 2) 3 (4 3 5))))
((3 6) 9 (12 9 15))
(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)
)
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))
(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)
)
Command: (maptree + '(((1 2) 3 (4 5)) ((1 2) 3 (4 5)) ((1 2) 3 (4 5))))
((3 6) 9 (12 15))
(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)
)
_$ (dyadic + '((1 2) 3 (4 5)) '((1 2) 3 (4 5)))
((2 4) 6 (8 10))
Regards,_$ (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. :roll:
(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)
)
_$ (dyadic + '((1 2) 3 (4 5)) '((1 2) 3 (4 5)))
((2 4) 6 (8 10))
(defun dyadic ( f a b )
(mapcar '(lambda ( x y ) (if (atom x) (f x y) (dyadic f x y))) a b)
)
_$ (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))
; error: bad list: 4
@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)
)
_$ (eval +)
#<SUBR @0000000031458ba8 +>
_$ (eval '+)
#<SUBR @0000000031458ba8 +>
@Lee, is a writing is prettier, the choice of the name lambda (loop= lambda) is explained by the factorization (eval f) for more flexibility:
(defun dyadic (f a b)
(mapcar '(lambda ( x y ) (if (atom x) (eval (cons f '(x y))) (dyadic f x y))) a b)
)
(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))))
)
)
_$ (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))
(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))))
)
)
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)
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?
Bruno, I've modified your mapTree for symbols and operands...
(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))))
)
)
_$ (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)
(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))))
)
)
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)
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]:-)
) )
Command: (maptree 'and '(((1 2) (3 . 4) 5) ((1 2) (3 . 4) 5) ((1 2) (3 . 4) 5)))
((T T) (T . T) T)
Command: (maptree and '(((1 2) (3 . 4) 5) ((1 2) (3 . 4) 5) ((1 2) (3 . 4) 5)))
; error: cannot apply special form: AND
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)
(defun mapTree (f l)
(cond ((null (apply 'or l)) nil)
((atom (car l)) (eval (cons f l)))
((cons (mapTree f (mapcar 'car l)) (mapTree f (mapcar 'cdr l))))
)
)
(defun dyadic (fun x y)
(cond ((null (or x y)) nil)
((atom x) (eval (cons fun '(x y))))
((cons (dyadic fun (car x) (car y)) (dyadic fun (cdr x) (cdr y))))
)
)
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).