Topic: List mapping from list 1 to list 2

[jaydee]

Hi.
I couldn't find anything in this forum. So i would like to ask if someone could help me.
I got these 2 lists in dotted pair and hope i could explain by having the 2 list shown below
The dotted pair is the attribute TAG and their VALUE.
The length of the 2 lists varies, one could be longer then the other or the same.
and the TAG name not in any particular order.
What I want to achieve is to map the VALUE of list 2 to list 1 only if the TAG is the same.

list 1
(("TAGY" . "333") ("TAGX" . "") ("TAGZ" . "123") ("TAG100" . "ABC") ("TAGA" . "") ("TAGB" . "456"))

list 2
(("TAG1" . "AAA") ("TAG2" . "BBB") ("TAG3" . "CCC") ("TAGX" . "DDD") ("TAGY" . "EEE") ("TAGZ" . "FFF") ("TAG11" . "GGG") ("TAG22" . "HHH"))

LIST 1 Result after mapping list 2 to list 1
(("TAGY" . "EEE") ("TAGX" . "DDD") ("TAGZ" . "FFF") ("TAG100" . "ABC") ("TAGA" . "") ("TAGB" . "456"))

Thankyou

[Lee Mac]

Maybe:

Code: [Select]

(defun foo ( a b )
  (mapcar '(lambda ( x ) (cond ((assoc (car x) b)) (x))) a)
)

Code: [Select]

(foo
 '(("TAGY" . "333") ("TAGX" . "") ("TAGZ" . "123") ("TAG100" . "ABC") ("TAGA" . "") ("TAGB" . "456"))
 '(("TAG1" . "AAA") ("TAG2" . "BBB") ("TAG3" . "CCC") ("TAGX" . "DDD") ("TAGY" . "EEE") ("TAGZ" . "FFF") ("TAG11" . "GGG") ("TAG22" . "HHH"))
)

==>  (("TAGY" . "EEE") ("TAGX" . "DDD") ("TAGZ" . "FFF") ("TAG100" . "ABC") ("TAGA" . "") ("TAGB" . "456"))

[Coder]

That's work perfect Lee .

You have one extra paren at the end of your testing the two lists.

Regards

[Lee Mac]

That's work perfect Lee .

You have one extra paren at the end of your testing the two lists.

Thanks, fixed! 

[jaydee]

Thanks agian Lee
You're the man who come to rescue.

Another question. I dont need it yet, but i think it might be usefull in future.
Is it easy to mod the (foo) function to only transfer the NON NULL VALUE ie if the value is "" then ignore

ie
list1
'(("TAG1" . "AAA") )
list2
'(("TAG1" . "") )

list1 result
'(("TAG1" . "AAA") )

Sorry about this, I should have think it throught before asking questions.
I just remember. vl-remove NULL values from list 2 prior to applying (foo) function to lists.

Thankyou

[ronjonp]

Look into the vl-remove-if function:

Code: [Select]

  (vl-remove-if
    '(lambda (x) (= (cdr x) ""))
    '(("TAGY" . "EEE")
      ("TAGX" . "DDD")
      ("TAGZ" . "FFF")
      ("TAG100" . "ABC")
      ("TAGA" . "")
      ("TAGB" . "456")
     )
  )
Make sense?

[CAB]

Maybe this?

Code: [Select]

(defun foo ( a b / lst)
  (mapcar '(lambda ( x / tmp )
             (setq tmp (assoc (car x) b))
             (cond
               ((and (null tmp) (/= (cdr x) ""))(setq lst (cons x lst))) ; not found in list b & /= ""
               ((and tmp (/= (cdr tmp) "")) (setq lst (cons tmp lst)))   ; found and not equal to ""
             )
           ) a)
  (reverse lst)
)

[Stefan]

... or this

Code: [Select]

(defun ph:foo (a b)
  (vl-remove-if-not '(lambda (x) (read (cdr x)))
    (foreach n b
      (setq a (subst n (assoc (car n) a) a))
      )
    )
  )


[JohnK]

I remembered seeing a very cool discussion on something like this from the Newsgroups: autodesk.autocad.customization.  Doug Broad, and Vladimir Nesterovsky created this cool "collect" procedure. ...I searched and searched through what i had left after my HD crash and i did find it but it wasn't exactly related but i modified what was there to work in this situation and this is what i came up with.

I severely crippled Vladimir's procedures functionality for this post but i wanted to post it anyway because `collect' was such a big concept piece it deserves to be studied (i will post the orig snipped discussion i had).

Code: [Select]

(setq vals '(("TAG1" . "AAA") ("TAG2" . "BBB") ("TAG3" . "CCC") ("TAGX" . "DDD") ("TAGY" . "EEE") ("TAGZ" . "FFF") ("TAG11" . "GGG") ("TAG22" . "HHH")))

(defun collect  (vals key val init-val / out a n)
  (setq out init-val)
  (foreach n vals
    (if (setq a (assoc (key n) out))
      (setq out (subst (cons (key n) (val n))
                       a out))))
  out)

(collect vals car cdr '(("TAGY" . "333") ("TAGX" . "") ("TAGZ" . "123") ("TAG100" . "ABC") ("TAGA" . "") ("TAGB" . "456")))

> (("TAGY" . "EEE") ("TAGX" . "DDD") ("TAGZ" . "FFF") ("TAG100" . "ABC") ("TAGA" . "") ("TAGB" . "456"))


Orig:

From: Nesterovsky, Vladimir <vnestr@netvision.net.il>
Subject: Re:
Newsgroups: autodesk.autocad.customization
Content-Type: text/plain; charset="UTF-8"
Content-Transfer-Encoding: quoted-printable
Message-Id: <1115258@discussion.autodesk.com>
References: <1115257@discussion.autodesk.com>
Date: Wed, 14 Nov 2001 20:40:36 +0000

Doug Broad <dbroad@nash.cc.nc.us> wrote in message
news:388922990B12E288D8AEEA8B193C7555@in.WebX.maYIadrTaRb...
> [.....]
> ;;Examples: (collect vals car cadr +) or (collect vals car cadr list)

Now _that's_ functional programming thinking!
Very, very interesting!

I took a liberty to change your code a little. The whole idea of
collecting is not to build the intermediary list, but rather apply
the result-building function while collecting, thus maintaining
the current result all the time.

That means we have to supply a function that will took two
arguments -- the interim result and the newly found value.
That also means that we have to have one more argument --
the initial value to be used on first call:

(setq vals '(("25x19" 1500)("50x19" 2500) ("25x19" 1000)
      ("6x19" 750)("50x19" 3000)("25x19" 1000)("25x19" 2000)))

(defun collect  (vals key val add init-val / out a n)
  (foreach n  vals
    (if (setq a (assoc (key n) out))
      (setq out (subst (cons (key n)
                             (add (val n) (cdr a)))
                       a out))
      (setq out (cons (cons (key n)
                            (add (val n) init-val))
                      out))))
  out)

; Examples:
;  (collect vals car cadr + 0)
;  (collect vals car cadr cons nil)

The extra init-val argument is here because of language limitations.
We should've been able to define functions capable of taking
variable number of arguments and acting accordingly, for instance,

(+ 1 2) =3D> 3
(+ 1 0) =3D> 1
(+ )  =3D> 0

so we would have defined new construct-list function so that

(conlst 1 '(2)) =3D> (1 2)
(conlst 1 '()) =3D> (1)
(conlst ) =3D> ()

Then we could drop the init-val argument and just use (add) call
with no arguments instead to produce the function's "implied" value
on first-call. I think I saw something about these "implied" values
in SICP but dont recall exactly. I think they used different name for
this concept there. Anyway...


Enjoy,


P.S. By the same token (* 1 2 3) =3D=3D (* 2 3) so (* ) should return 1.
Alisp mistakenly returns 0.

[ronjonp]

... or this

Code: [Select]

(defun ph:foo (a b)
  (vl-remove-if-not '(lambda (x) (read (cdr x)))
    (foreach n b
      (setq a (subst n (assoc (car n) a) a))
      )
    )
  )


I like  good solution!

[CAB]

One more variant from Lee's.
I like the read test though

Code: [Select]

(defun foo ( a b )
  (vl-remove-if '(lambda(x) (=(cdr x)""))
    (mapcar '(lambda ( x ) (cond ((assoc (car x) b)) (x))) a)
  )
)

[Stefan]

A new one, faster than previously... (vl-remove and (read (cdr are not such a good (i.e. fast) idea

Code: [Select]

(defun ph:foo (a b / e lst)
  (foreach n a
    (or
      (and
(setq e (assoc (car n) b))
(/= (cdr e) "") ;prevents replacing a filled item with an empty one
(setq lst (cons e lst))
)
      (= (cdr n) "") ; remove this if an empty item from list1 is OK
      (setq lst (cons n lst))
      )
    )
  (reverse lst)
  )


[jaydee]

Wow, theres so many ways of getting the same results.
Thankyou verymuch everyone.
You guys actually done more than what i asked for.

Initially i throught this is not right, my list (list 1) result are alot shorter, and after a closer look, you guys are right.
if list1 and list2 cantain the same TAG and both having a NULL values then its true both can be removed from listing.

Thankyou

[Lee Mac]

One more variant:

Code: [Select]

(defun foo ( a b )
  (apply 'append
    (mapcar
      (function
        (lambda ( x )
          (if (/= "" (cdr (setq x (cond ((assoc (car x) b)) (x))))) (list x))
        )
      )
      a
    )
  )
)