Topic: Linear ListDifference with the same elements

[ribarm]

Only recently I've discovered that ListDifference subfunction isn't always applicable, so I am refering to this example found on Lee Mac's site :

Code - Auto/Visual Lisp: [Select]

1. ;;-------------------=={ List Difference }==------------------;;
2. ;;                                                            ;;
3. ;;  Returns items appearing exclusively in one list but not   ;;
4. ;;  another, i.e. the relative complement: l1 \ l2            ;;
5. ;;------------------------------------------------------------;;
6. ;;  Author: Lee Mac, Copyright © 2011 - www.lee-mac.com       ;;
7. ;;------------------------------------------------------------;;
8. ;;  Arguments:                                                ;;
9. ;;  l1,l2 - lists for which to return the difference          ;;
10. ;;------------------------------------------------------------;;
11. ;;  Returns:  List of items appearing exclusively in list l1  ;;
12. ;;------------------------------------------------------------;;
13.  
14. (defun LM:ListDifference ( l1 l2 )
15.   (vl-remove-if '(lambda ( x ) (member x l2)) l1)
16. )
17.  

For instance if lists contain the same elements, this will give wrong result :
(LM:ListDifference '(0 1 1 2 2 2 3 3 3 3 4 4 4 4 4) '(0 1 2 3 4))
will return : nil

So I've decided to share my subfunction for this linear subtraction of lists with the same elements :

Code - Auto/Visual Lisp: [Select]

1. (defun prelst ( lst el / f )
2.    (vl-remove-if '(lambda ( a ) (or f (setq f (equal a el 1e-8)))) lst)
3. )
4.  
5. (defun suflst ( lst el )
6.   (cdr (vl-member-if '(lambda ( a ) (equal a el 1e-8)) lst))
7. )
8.  
9. (defun diff ( l1 l2 / el )
10.   (setq el (car l2))
11.   (setq l2 (cdr l2))
12.   (setq l1 (append (prelst l1 el) (suflst l1 el)))
13.   (if l2 (diff l1 l2) l1)
14. )
15.  

And in my case, result is :
(diff '(0 1 1 2 2 2 3 3 3 3 4 4 4 4 4) '(0 1 2 3 4))
(1 2 2 3 3 3 4 4 4 4)

You will say just what it should return, like you removed exactly those elements of second list from first list...

I hope someone will use my discovery...
Hope that Lee won't be upset - his subfunctions are also very useful, and in many cases I used just above posted example from Lee's site, but now I think this is also at least good to mention...

Regards, M.R.

[irneb]

Perhaps Lee should rename his function to something showing that it removes duplicates.

My version:

Code - Auto/Visual Lisp: [Select]

1. (defun list-remove-nth  (index source / result)
2.   (repeat (/ index 4)
3.     (setq result (append (vl-list* (cadddr source) (caddr source) (cadr source) (car source) nil) result)
4.           source (cddddr source)))
5.   (repeat (rem index 4)
6.     (setq result (cons (car source) result)
7.           source (cdr source)))
8.   (append (reverse result) (cdr source)))
9.  
10. (defun list-subtract  (minuend subtrahend / n)
11.   (vl-remove-if
12.     '(lambda (x)
13.        (if (setq n (vl-position x subtrahend))
14.          (setq subtrahend (list-remove-nth n subtrahend)))
15.        n)
16.     minuend))

[Lee Mac]

For instance if lists contain the same elements, this will give wrong result :
(LM:ListDifference '(0 1 1 2 2 2 3 3 3 3 4 4 4 4 4) '(0 1 2 3 4))
will return : nil

By my definition of my function, that is the correct result.

;;  Returns items appearing exclusively in one list but not   ;;
;;  another, i.e. the relative complement: l1 \ l2            ;;

Refer:
List Difference
Relative Complement

[ribarm]

Lee, maybe we want to use also different approaches to obtain desired results - my versions give logical solutions :

Linear ListIntersection with the same elements

Like the example with Linear ListDifference with the same elements, Lee's subfunction for intersection also fails :

Code - Auto/Visual Lisp: [Select]

1. ;;-----------------=={ List Intersection }==------------------;;
2. ;;                                                            ;;
3. ;;  Returns a list expressing the intersection of two lists   ;;
4. ;;------------------------------------------------------------;;
5. ;;  Author: Lee Mac, Copyright © 2011 - www.lee-mac.com       ;;
6. ;;------------------------------------------------------------;;
7. ;;  Arguments:                                                ;;
8. ;;  l1,l2 - Lists for which to return the intersection        ;;
9. ;;------------------------------------------------------------;;
10. ;;  Returns:  A list of all items common to both lists        ;;
11. ;;------------------------------------------------------------;;
12.  
13. (defun LM:ListIntersection ( l1 l2 )
14.   (vl-remove-if-not '(lambda ( x ) (member x l2)) l1)
15. )
16.  

For example :
(LM:ListIntersection '(1 1 2 2 2 3 4 5) '(2 2 4 6 7))
will return :
(2 2 2 4), and should (2 2 4)

Here is mine version :

Code - Auto/Visual Lisp: [Select]

1. (defun member-fuzz (expr lst fuzz)
2.   (while (and lst (not (equal (car lst) expr fuzz)))
3.     (setq lst (cdr lst))
4.   )
5.   lst
6. )
7.  
8. (defun i ( l1 l2 )
9.   (vl-remove-if-not '(lambda ( x ) (member-fuzz x l2 1e-8)) l1)
10. )
11.  
12. (defun int ( l1 l2 / in1 in2 )
13.   (if (< (length (setq in1 (i l1 (i l1 l2)))) (length (setq in2 (i l2 (i l1 l2))))) in1 in2)
14. )
15.  

Now :
(int '(1 1 2 2 2 3 4 5) '(2 2 4 6 7))
(2 2 4)

and also :
(int '(2 2 4 6 7) '(1 1 2 2 2 3 4 5))
(2 2 4)

For ListUnion, just use (append) function...

Regards, M.R.

[Lee Mac]

Like the example with Linear ListDifference with the same elements, Lee's subfunction for intersection also fails :

For example :
(LM:ListIntersection '(1 1 2 2 2 3 4 5) '(2 2 4 6 7))
will return :
(2 2 2 4), and should (2 2 4)

Again, by my description, this result is correct since duplicate elements will reside in the list intersection.

This subfunction will return a list expressing the intersection of two lists, that is, a list of items common to both of the supplied lists.

Refer:
List Intersection

[ribarm]

Again, by my description, this result is correct since duplicate elements will reside in the list intersection.

I don't know, but by me list intersection is the one that fulfills statement that all elements in it belong both to either parent lists...

[irneb]

By my definition of my function, that is the correct result.

True if by lists you actually mean sets. A list (in lisp) may contain duplicates, but by definition duplicates in a set makes no sense.

So I'd suggest your functions should be named something like:

• LM:ListDifference => LM:SetRelativeComplement
• LM:ListIntersection => LM:SetIntersection

Just so as to remove possible confusion.

Edit: Notice even the wikipedia page notes the names for this function in various programming languages: http://en.wikipedia.org/wiki/Set_difference#Complements_in_various_programming_languages

E.g. in common lisp it's called set-difference

[pBe]

Vanilla <Not thoroughly tested>

Code - Auto/Visual Lisp: [Select]

1. (defun _reml (l1 l2 / a n ls)
2. (while (setq n nil a (car l2))
3.    (while (and  l1 (null n))
4.         (if (= a (car l1))
5.                     (setq l1 (cdr (member a l1)) n  t)
6.                          (setq ls (append ls (list  (car l1)))
7.                                l1 (cdr l1))))
8.   (setq l2 (cdr l2)))
9.   (append ls l1))
10.  

(_reml '(0 1 1 2 2 2 3 3 3 3 4 4 4 4 4) '(0 1 2 3 4))
(1 2 2 3 3 3 4 4 4 4)

I dont know it this make sense at all but here it is.

Code - Auto/Visual Lisp: [Select]

1. (defun _remall (l1 l2 / a )
2. (while (setq  a (car l2))
3.      (setq l l1)
4.    (while  l
5.         (if (/= a (car l))
6.                      (setq ls (append ls (list  (car l)))))
7.              (setq l (cdr l))
8.           )
9.   (setq l2 (cdr l2) l1 ls ls nil)
10.   ) l1
11.   )
12.  

(_REMall '(0 1 1 2 2 2 5 3 3 3 3 4 6 1 4 4 4 4 7 ) '(0 1 2 3 4))

(5 6 7)

BTW: How come Autolisp code tags doesnt work for me anymore? browser issue?

[irneb]

BTW: How come Autolisp code tags doesnt work for me anymore? browser issue?

Are you sure you used the CadLisp-7 tag? The seem to work for me:

Code - Auto/Visual Lisp: [Select]

1. (list 1 2 3)

[pBe]

BTW: How come Autolisp code tags doesnt work for me anymore? browser issue?

Are you sure you used the CadLisp-7 tag? The seem to work for me:

Code - Auto/Visual Lisp: [Select]

1. (list 1 2 3)

   You are right!!


but before i just select from the drop down list. now mine shows
Code
Autolisp<-----
C#
...

its seems to be missing the cadlisp-7 item? anyhoo. all is well now.

Thank you Irné

CODE/POST updated

[ribarm]

pBe, thanks for reply... But I have small remark ab your code. Isn't this more readable? (You can quickly format your codes in VLISP editor by clicking an icon for formatting)

Code - Auto/Visual Lisp: [Select]

1. (defun _reml (l1 l2 / a n ls)
2.   (while
3.     (setq n nil
4.           a (car l2)
5.     )
6.     (while (and l1 (null n))
7.       (if (equal a (car l1) 1e-8)
8.         (setq l1 (cdr l1)
9.               n t
10.         )
11.         (setq ls (append ls (list (car l1)))
12.               l1 (cdr l1)
13.         )
14.       )
15.     )
16.     (setq l2 (cdr l2))
17.   )
18.   (append ls l1)
19. )
20.  

Code - Auto/Visual Lisp: [Select]

1. (defun _intl (l1 l2 / ll1 ll2 a ls1 ls2)
2.   (setq ll1 l1
3.         ll2 l2
4.   )
5.   (while
6.     (setq a (car ll2))
7.     (while ll1
8.       (if (equal a (car ll1) 1e-8)
9.         (setq ls1 (append ls1 (list a))
10.               ll1 (cdr ll1)
11.         )
12.         (setq ll1 (cdr ll1))
13.       )
14.     )
15.     (setq ll2 (cdr ll2)
16.           ll1 (vl-remove a l1)
17.     )
18.   )
19.   (setq ll1 l1
20.         ll2 l2
21.   )
22.   (while
23.     (setq a (car ll1))
24.     (while ll2
25.       (if (equal a (car ll2) 1e-8)
26.         (setq ls2 (append ls2 (list a))
27.               ll2 (cdr ll2)
28.         )
29.         (setq ll2 (cdr ll2))
30.       )
31.     )
32.     (setq ll1 (cdr ll1)
33.           ll2 (vl-remove a l2)
34.     )
35.   )
36.   (if (< (length ls1) (length ls2)) ls1 ls2)
37. )
38.  

[irneb]

If you mean stuff like indenting the (while ... lines of the defuns, then yes - I'm with you.

If you mean reverse indenting the closing parentheses to their corresponding open parens position, then not so much. It's not that I find it unreadable or anything like that. IMO it's much of a muchness. I just try to conform with the prevailing "standard": Actually it's the convention of most Lisp languages to never use a new-line before a closing parenthesis. E.g.:

• http://c2.com/cgi/wiki?LispIndentation
• http://www.emacswiki.org/emacs/IndentingLisp
• http://dept-info.labri.u-bordeaux.fr/~idurand/enseignement/PFS/Common/Strandh-Tutorial/indentation.html
• http://people.ace.ed.ac.uk/staff/medward2/class/moz/cm/doc/contrib/lispstyle.html
• http://mumble.net/~campbell/scheme/style.txt

So in general (Common Lisp, Scheme & Clojure) use a Python-like indentation - with the closing parenthesis on the same line as the last item in that grouping. I.e. not like you get with a C-like formatting, where each closing bracket goes onto a line of its own back-indented to be in-line with its corresponding open bracket.

This tends to reduce "blank" lines. And actually once you get used to it, it becomes easier to type. Note even the emacs editor uses this formatting style if you autoformat lisp code. And you can set VLIDE to actually conform to the more common formatting style as well - as I usually tend to do since about a year ago when I started to really get into other lisps.

[Marc'Antonio Alessi]

Only recently I've discovered that ListDifference subfunction isn't always applicable, so I am refering to this example found on
(diff '(0 1 1 2 2 2 3 3 3 3 4 4 4 4 4) '(0 1 2 3 4))
(1 2 2 3 3 3 4 4 4 4)
...

Try this:

Code - Auto/Visual Lisp: [Select]

1. (defun ALE_ListRemoveIfMemberFuzz (TstLst In_Lst FuzFac / EndLst NthPos InRLst TmpVal)
2.   (vl-remove-if
3.    '(lambda (LmbDat)
4.       (and
5.         (setq
6.           EndLst
7.             (vl-member-if
8.              '(lambda (LmbDt2)
9.                 (setq TmpVal LmbDt2)
10.                 (equal LmbDt2 LmbDat FuzFac)
11.               )
12.               TstLst
13.             )
14.         )
15.         (progn
16.           (setq
17.             InRLst (reverse TstLst)
18.             NthPos (- (length InRLst) (length EndLst))
19.           )
20.           (while
21.             (/=
22.               NthPos
23.              (length (setq InRLst (cdr (member TmpVal InRLst))))
24.             )
25.           )
26.           (setq TstLst (append (reverse InRLst) (cdr EndLst)))
27.         )
28.       )
29.       EndLst
30.     )
31.     In_Lst
32.   )
33. )
34.  
35. (ALE_ListRemoveIfMemberFuzz '(0 1 2 3 4) '(0 1 1 2 2 2 3 3 3 3 4 4 4 4 4) 1e-8)
36. (1 2 2 3 3 3 4 4 4 4)
37.  
38. (diff '(0 1 1 2 2 2 3 3 3 3 4 4 4 4 4) '(0 1 2 3 4))
39. (1 2 2 3 3 3 4 4 4 4)
40.  
41. (ALE_ListRemoveIfMemberFuzz '(0 1 2 3 4 0 0 0 2 2 4 4 4 4) '(0 1 1 2 2 2 3 3 3 3 4 4 4 4 4) 1e-8)
42. (1 3 3 3)
43.  
44. (diff '(0 1 1 2 2 2 3 3 3 3 4 4 4 4 4) '(0 1 2 3 4 0 0 0 2 2 4 4 4 4))
45. (1 3 3 3)
46.  
47.  

Not recursive.