Author Topic: ==={ Challenge }=== General dyadic operation  (Read 8544 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: 3268
  • 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

  • Gator
  • Posts: 2507
  • 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

  • Gator
  • Posts: 2507
  • 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

  • Gator
  • Posts: 2507
  • 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 »