Author Topic: ==={ Challenge }=== General dyadic operation  (Read 8253 times)

0 Members and 1 Guest are viewing this topic.

Jeremy

  • Guest
==={ Challenge }=== General dyadic operation
« on: March 14, 2014, 10:28:41 PM »
A dyadic function is nothing more than a function that typically takes two arguments such as addition i.e. (+ 2 3). If we want to generalize for lists of arguments (vectors) we can write something like (mapcar '+ X Y) where X and Y are our two vectors. With more fiddling we can advance + to operate on matrices. Typically the vectors and matrices must be of the same order. But what do we do if we want to generalize the dyadic function to any two listings of any depth of any number of arguments? Suppose we want to add (+ '((a b) c (d e)) '((A B) C (D E))) ? Our only requirement is that X and Y have the same number of arguments in the same nested structure. I want a function DYADIC that has the form (dyadic func X Y) so that I can use ANY dyadic function in the described manner on arbitrary nested lists. My previous example would look something like (dyadic '+ X Y). This would be a very useful higher order function to have. I have no solution myself but I trust our local crew will come up with something. Let the programs begin!

irneb

  • Water Moccasin
  • Posts: 1794
  • ACad R9-2016, Revit Arch 6-2016
Re: ==={ Challenge }=== General dyadic operation
« Reply #1 on: March 15, 2014, 01:20:21 AM »
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?
Common sense - the curse in disguise. Because if you have it, you have to live with those that don't.

ribarm

  • Gator
  • Posts: 3180
  • Marko Ribar, architect
Re: ==={ Challenge }=== General dyadic operation
« Reply #2 on: March 15, 2014, 01:47:33 AM »
Your example :

Code: [Select]
(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))
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

gile

  • Water Moccasin
  • Posts: 2493
  • Marseille, France
Re: ==={ Challenge }=== General dyadic operation
« Reply #3 on: March 15, 2014, 02:59:53 AM »
Hi,

My 2 cents

Code - Auto/Visual Lisp: [Select]
  1. (defun dyadic (fun a b)
  2.   (cond
  3.     ((or (null a) (null b)) nil)
  4.     ((and (atom a) (atom b)) ((eval fun) a b))
  5.     (T (cons (dyadic fun (car a) (car b)) (dyadic fun (cdr a) (cdr b))))
  6.   )
  7. )

or in a more efficient way (eval fun only once and tail recursion)

Code - Auto/Visual Lisp: [Select]
  1. (defun dyadic (fun x y / loop)
  2.   (defun loop (f a b r)
  3.     (cond
  4.       ((or (null a) (null b)) (reverse r))
  5.       ((and (atom a) (atom b)) (f a b))
  6.       (T (loop f (cdr a) (cdr b) (cons (loop f (car a) (car b) nil) r)))
  7.     )
  8.   )
  9.   (loop (eval fun) x y nil)
  10. )
Speaking English as a French Frog

gile

  • Water Moccasin
  • Posts: 2493
  • Marseille, France
Re: ==={ Challenge }=== General dyadic operation
« Reply #4 on: March 15, 2014, 03:13:16 AM »
A safer way, returns nil and print an error message in case of unbalanced arguments.

Code - Auto/Visual Lisp: [Select]
  1. (defun dyadic (fun x y / loop)
  2.   (defun loop (f a b r)
  3.     (cond
  4.       ((and (null a) (null b)) (reverse r))
  5.       ((and a b (atom a) (atom b)) (f a b))
  6.       ((and (vl-consp a) (vl-consp b))
  7.        (loop f (cdr a) (cdr b) (cons (loop f (car a) (car b) nil) r))
  8.       )
  9.       (T (prompt "\nError: unbalanced arguments"))
  10.     )
  11.   )
  12.   (loop (eval fun) x y nil)
  13. )

Speaking English as a French Frog

Kerry

  • Mesozoic relic
  • Seagull
  • Posts: 11654
  • class keyThumper<T>:ILazy<T>
Re: ==={ Challenge }=== General dyadic operation
« Reply #5 on: March 15, 2014, 03:59:12 AM »
A safer way, returns nil and print an error message in case of unbalanced arguments.

< .. >

A thing of beauty ...
kdub, kdub_nz in other timelines.
Perfection is not optional.
Everything will work just as you expect it to, unless your expectations are incorrect.
Discipline: None at all.

Stefan

  • Bull Frog
  • Posts: 319
  • The most I miss IRL is the Undo button
Re: ==={ Challenge }=== General dyadic operation
« Reply #6 on: March 15, 2014, 04:47:24 AM »
The recursive way, using mapcar...
Code - Auto/Visual Lisp: [Select]
  1. (defun map2 (func arg1 arg2)
  2.   (mapcar
  3.     (function
  4.       (lambda (a b)
  5.         (cond
  6.           ((and (listp a) (listp b))
  7.            (map2 func a b)
  8.            )
  9.           ((and a b (eq (type a) (type b)))
  10.            (apply func (list a b))
  11.            )
  12.           (T (vl-exit-with-error "Invalid arguments: "))
  13.           )
  14.         )
  15.       )
  16.     arg1 arg2
  17.     )  
  18.   )
Code: [Select]
(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")))

chlh_jd

  • Guest
Re: ==={ Challenge }=== General dyadic operation
« Reply #7 on: March 15, 2014, 12:09:01 PM »
does the 'fun only deal atom ? if the function is deal with lists like 'distance ?
here's my function for deal arg-type
Code: [Select]
;; 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))
« Last Edit: March 15, 2014, 12:13:52 PM by chlh_jd »

reltro

  • Guest
Re: ==={ Challenge }=== General dyadic operation
« Reply #8 on: March 16, 2014, 07:07:54 AM »
Hey...
Whats about this?
Works also for three and more InputLists:

Code: [Select]
(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
    )
)


Code: [Select]
(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))


Im not sure about how to check if the lists are balanced in the best manner.
normally i would say with (length ...) but on dotted pairs this one will fail...

Greets
« Last Edit: March 16, 2014, 07:15:08 AM by reltro »

reltro

  • Guest
Re: ==={ Challenge }=== General dyadic operation
« Reply #9 on: March 16, 2014, 04:29:24 PM »
iterative code

Code: [Select]
(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))
    )
)

Same Input as above

Note: Change Variable 'nilAsList' in the code to
             - 'nil -> 'nil is interpreted as an atom
             - a value other than 'nil -> 'nil is interpreted as a list

reltro
« Last Edit: March 16, 2014, 04:42:07 PM by reltro »

Jeremy

  • Guest
Re: ==={ Challenge }=== General dyadic operation
« Reply #10 on: March 16, 2014, 06:23:23 PM »
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?

1. Both arguments should be of the same type i.e. two atoms or two lists of atoms.
2. If both lists are not of the same length or of the same nesting structure the function should throw an error of some kind.
3. I hadn't originally envisioned that but that sounds like a useful default, go for it!

bruno_vdh

  • Guest
Re: ==={ Challenge }=== General dyadic operation
« Reply #11 on: March 17, 2014, 05:47:06 AM »
Hello,
My variant going easier, only symmetrical arguments are supported.
 

Code: [Select]
(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))))
  )
)

Code: [Select]
_$ (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)

Cordially
« Last Edit: March 17, 2014, 06:03:52 AM by bruno_vdh »

gile

  • Water Moccasin
  • Posts: 2493
  • Marseille, France
Re: ==={ Challenge }=== General dyadic operation
« Reply #12 on: March 17, 2014, 06:55:50 AM »
Hi,

I think you're right bruno, it's a better way to let AutoCAD throw the errors.
Speaking English as a French Frog

bruno_vdh

  • Guest
Re: ==={ Challenge }=== General dyadic operation
« Reply #13 on: March 17, 2014, 07:24:13 AM »
Thank (gile)

And with the following idea: 
or in a more efficient way (eval fun only once and tail recursion)

Code: [Select]
(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)
)

I think we get a good solution ...
« Last Edit: March 17, 2014, 07:28:01 AM by bruno_vdh »

bruno_vdh

  • Guest
Re: ==={ Challenge }=== General dyadic operation
« Reply #14 on: March 17, 2014, 10:18:53 AM »
Hi,

My alternative for second-order functions that accept multiple arguments (type atom)…
Code: [Select]
(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))))
  )
)

Example:
Code: [Select]
_$ (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))
« Last Edit: March 17, 2014, 10:32:23 AM by bruno_vdh »

ribarm

  • Gator
  • Posts: 3180
  • Marko Ribar, architect
Re: ==={ Challenge }=== General dyadic operation
« Reply #15 on: March 17, 2014, 06:59:13 PM »
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.
« Last Edit: March 18, 2014, 03:35:35 AM by ribarm »
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

bruno_vdh

  • Guest
Re: ==={ Challenge }=== General dyadic operation
« Reply #16 on: March 18, 2014, 04:06:38 AM »
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,
« Last Edit: March 18, 2014, 04:27:09 AM by bruno_vdh »

irneb

  • Water Moccasin
  • Posts: 1794
  • ACad R9-2016, Revit Arch 6-2016
Re: ==={ Challenge }=== General dyadic operation
« Reply #17 on: March 18, 2014, 05:00:21 AM »
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.  :roll:
Common sense - the curse in disguise. Because if you have it, you have to live with those that don't.

ElpanovEvgeniy

  • Water Moccasin
  • Posts: 1569
  • Moscow (Russia)
Re: ==={ Challenge }=== General dyadic operation
« Reply #18 on: March 18, 2014, 10:17:40 AM »
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

  • Guest
Re: ==={ Challenge }=== General dyadic operation
« Reply #19 on: March 18, 2014, 11:10:33 AM »
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

  • Seagull
  • Posts: 12892
  • London, England
Re: ==={ Challenge }=== General dyadic operation
« Reply #20 on: March 18, 2014, 01:17:36 PM »
@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

  • Gator
  • Posts: 3180
  • Marko Ribar, architect
Re: ==={ Challenge }=== General dyadic operation
« Reply #21 on: March 18, 2014, 01:27:10 PM »
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...
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

Lee Mac

  • Seagull
  • Posts: 12892
  • London, England
Re: ==={ Challenge }=== General dyadic operation
« Reply #22 on: March 18, 2014, 03:52:57 PM »
I know - mapcar cannot process dotted pairs.

bruno_vdh

  • Guest
Re: ==={ Challenge }=== General dyadic operation
« Reply #23 on: March 18, 2014, 06:07:58 PM »
@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

  • Guest
Re: ==={ Challenge }=== General dyadic operation
« Reply #24 on: March 19, 2014, 06:28:23 AM »
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,
« Last Edit: March 19, 2014, 07:03:00 AM by bruno_vdh »

ribarm

  • Gator
  • Posts: 3180
  • Marko Ribar, architect
Re: ==={ Challenge }=== General dyadic operation
« Reply #25 on: March 19, 2014, 09:12:56 AM »
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)
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

irneb

  • Water Moccasin
  • Posts: 1794
  • ACad R9-2016, Revit Arch 6-2016
Re: ==={ Challenge }=== General dyadic operation
« Reply #26 on: March 19, 2014, 09:50:44 AM »
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).
Common sense - the curse in disguise. Because if you have it, you have to live with those that don't.

bruno_vdh

  • Guest
Re: ==={ Challenge }=== General dyadic operation
« Reply #27 on: March 19, 2014, 10:11:58 AM »
Bruno, I've modified your mapTree for symbols and operands...
 

@ribarm thank you, it was also possible to do like this  :wink::
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

  • Gator
  • Posts: 3180
  • Marko Ribar, architect
Re: ==={ Challenge }=== General dyadic operation
« Reply #28 on: March 19, 2014, 10:39:03 AM »
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)
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

ElpanovEvgeniy

  • Water Moccasin
  • Posts: 1569
  • Moscow (Russia)
Re: ==={ Challenge }=== General dyadic operation
« Reply #29 on: March 19, 2014, 11:05:02 AM »
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. )
:-)

ribarm

  • Gator
  • Posts: 3180
  • Marko Ribar, architect
Re: ==={ Challenge }=== General dyadic operation
« Reply #30 on: March 19, 2014, 11:21:28 AM »
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. )
:-)

maybe:
Code - Auto/Visual Lisp: [Select]
  1. (defun mapTree (f l)
  2.   (cond ((apply 'or (mapcar 'null l)) nil)
  3.         ((apply 'and (mapcar 'atom l)) (eval (cons (eval f) l)))
  4.         ((cons (mapTree f (mapcar 'car l)) (mapTree f (mapcar 'cdr l))))
  5.   )
  6. )
  7.  
:-)
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

bruno_vdh

  • Guest
Re: ==={ Challenge }=== General dyadic operation
« Reply #31 on: March 19, 2014, 12:02:37 PM »
@ribarm
_$ (mapTree 'and '(((1 2) (3 . 4) 5) ((1 2) (3 . 4) 5))); form special
; erreur: Impossible d'appliquer la feuille spéciale: AND

@ElpanovEvgeniy
_$ (dyadic '+ '((1 2) (3 . 4) 5) '((1 2 3) (3 . 4) 5)); case of unbalanced arguments
((2 4) (6 . 8 ) 10); Not too sure if that's a "good" thing.
« Last Edit: March 19, 2014, 12:20:55 PM by bruno_vdh »

ribarm

  • Gator
  • Posts: 3180
  • Marko Ribar, architect
Re: ==={ Challenge }=== General dyadic operation
« Reply #32 on: March 19, 2014, 12:17:18 PM »
You're right Bruno, my prvious version was OK...

Code: [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)
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

bruno_vdh

  • Guest
Re: ==={ Challenge }=== General dyadic operation
« Reply #33 on: March 19, 2014, 12:26:48 PM »
maybe:

Code: [Select]
(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))))
  )
)


Code: [Select]
(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))))
  )
)

chlh_jd

  • Guest
Re: ==={ Challenge }=== General dyadic operation
« Reply #34 on: March 20, 2014, 11:44:31 AM »
All of yours about Maptree and Dyadic function are very good . Cheers  :-)

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).

1+
"Maptree"  is the work of VLIDE . Why do not Vlide give "Maptree" function , we don't know . But we know it has a lot problems to solve .
        1. What the 'fun want , a beautiful girl or a barbecue or a group of dudes ? It must be detected before execution , it's difficult such as write a check-engine of GPU .
       
Code - Auto/Visual Lisp: [Select]
  1.  (append 4 '(1 2 3));_must be pre-checked fuction append want not a atom .
  2.                               (distance '(1 2) '(2 2))-->1.0;_two single lists are not atom
  3.                               (matrix-fun '((...)...) '((...)...))-->?;_double-linked list .
        2.  Can give the result like (+ Man Woman)--> New child . It's clear, if the varients are not same will give the same result ,  Errors . It may Crash AutoCAD programe .
       
Code - Auto/Visual Lisp: [Select]
  1.  (while (not (+ 1 "2."));_would you like working with a lot of error or interruption tips ?
  2.                             (progn ...))
        3.  How to select the size of the shoes, some one like smaller , some one feel comfortable when he catch bigger ,but some one like both.
         
Code - Auto/Visual Lisp: [Select]
  1.  (+  '(1 2) (1 2 3)) -->(2 4) or (2 4 3);_They are all right ,depends on what you need .
  2.          (distance '(1 2) '(1 2 3))-->0.0

        So take the girl or the suitable shoes you like .
 
        Thank you .