vl-sort help

vl-sort help

zph
Collaborator Collaborator
5,666 Views
58 Replies
Message 1 of 59

vl-sort help

zph
Collaborator
Collaborator

Good day!

 

Below is an excerpt of code:

 

(princ "\n qList1: ")(princ qList)
(setq qList (vl-sort qList (function (lambda (x y) (< (car x) (car y))))))
(princ "\n qList2: ")(princ qList)

 

 

And below is the what is returned:

 

 qList1: ((NEW-TEST-VAL-D . 0) (NEW-TEST-VAL-D . 0) (NEW-TEST-VAL-C . 0) (NEW-TEST-VAL-B . 0) (NEW-TEST-VAL-A . 0))
 qList2: ((NEW-TEST-VAL-A . 0) (NEW-TEST-VAL-B . 0) (NEW-TEST-VAL-C . 0) (NEW-TEST-VAL-D . 0) (NEW-TEST-VAL-D . 0))

 

 

Why doesn't this instance of vl-sort remove the duplicate dotted pair (highlighted red)?  What am I missing?

 

Thanks!

~Z

0 Likes
Accepted solutions (1)
5,667 Views
58 Replies
Replies (58)
Message 2 of 59

rkmcswain
Mentor
Mentor

The documentation says (vl-sort) may remove duplicates. Kind of a strange rule for a function IMO. More on that here. Beyone that, Lee Mac has some tools that should help.

R.K. McSwain     | CADpanacea | on twitter
Message 3 of 59

ActivistInvestor
Mentor
Mentor

@zph wrote:

Good day!

 

Below is an excerpt of code:

 

(princ "\n qList1: ")(princ qList)
(setq qList (vl-sort qList (function (lambda (x y) (< (car x) (car y))))))
(princ "\n qList2: ")(princ qList)

 

 

And below is the what is returned:

 

 qList1: ((NEW-TEST-VAL-D . 0) (NEW-TEST-VAL-D . 0) (NEW-TEST-VAL-C . 0) (NEW-TEST-VAL-B . 0) (NEW-TEST-VAL-A . 0))
 qList2: ((NEW-TEST-VAL-A . 0) (NEW-TEST-VAL-B . 0) (NEW-TEST-VAL-C . 0) (NEW-TEST-VAL-D . 0) (NEW-TEST-VAL-D . 0))

 

 

Why doesn't this instance of vl-sort remove the duplicate dotted pair (highlighted red)?  What am I missing?

 

Thanks!

~Z


 

What determines if vl-sort removes elements is whether they compare as equal using the (eq) function.

 

 

Command: (setq list1 '((A . 4) (B . 3) (C . 2) (D . 1) (D . 1)))
((A . 4) (B . 3) (C . 2) (D . 1) (D . 1))

Command: (setq list2 (list '(A . 4) '(B . 3) '(C . 2) (last list1) (last list1)))
((A . 4) (B . 3) (C . 2) (D . 1) (D . 1))

Command: !list1
((A . 4) (B . 3) (C . 2) (D . 1) (D . 1))

Command: !list2
((A . 4) (B . 3) (C . 2) (D . 1) (D . 1))

Command: (vl-sort list1 '(lambda (a b) (< (cdr a) (cdr b))))
((D . 1) (D . 1) (C . 2) (B . 3) (A . 4))

Command: (vl-sort list2 '(lambda (a b) (< (cdr a) (cdr b))))
((D . 1) (C . 2) (B . 3) (A . 4))

Command: (eq (nth 3 list1) (nth 4 list1))
nil

Command: (eq (nth 3 list2) (nth 4 list2))
T

 

 

Message 4 of 59

zph
Collaborator
Collaborator

rkmcswain,

 

Thank you for the reply.

 

Yeah, I saw the specific use of the word *may*; I raised an eyebrow.  Not the most useful explanation I've ever read.

 

I checked out Lee Mac's functions and I did find one that was able to eliminate the duplicated dotted pair.

 

Thanks!

~Z

 

 

0 Likes
Message 5 of 59

zph
Collaborator
Collaborator

@ActivistInvestor,

 

Thank you for your reply.  Honestly, your examples didn't make any sense until I researched the EQ function.

 

I made the assumption that EQ compared items much like = and EQUAL compare values.

 

From the Autodesk help files:

 

eq returns nil because f1 and f3, while containing the same value, do not refer to the same list.

 

Is there a built in sorting function that compares a list's contents using EQUAL instead of comparing lists using EQ?

0 Likes
Message 6 of 59

Ranjit_Singh
Advisor
Advisor

ActivistInvestor wrote:

..........

What determines if vl-sort removes elements is whether they compare as equal using the (eq) function.


In my experience only whole numbers and strings are respected for the equality comparison in vl-sort. Try the following and you will see that real type duplicates are retained, although they might be equal.

Command: (vl-sort '(5.0 1 2 3.0 3.0) '<)
(1 2 3.0 3.0 5.0)
0 Likes
Message 7 of 59

ActivistInvestor
Mentor
Mentor
Accepted solution

@Ranjit_Singh wrote:

In my experience only whole numbers and strings are respected for the equality comparison in vl-sort. Try the following and you will see that real type duplicates are retained, although they might be equal.

Command: (vl-sort '(5.0 1 2 3.0 3.0) '<)
(1 2 3.0 3.0 5.0)

I should have stated that my comments were specifically about how lists are treated.

 

When given list aruments, the (eq) function indicates if the arguments are the same physical object.

 

Command: (setq a '(1 2 3))
(1 2 3)

Command: (setq b '(1 2 3))
(1 2 3)

Command: (eq a b)
nil

Command: (eq a a)
T

 

 

Message 8 of 59

ActivistInvestor
Mentor
Mentor

@zph wrote:

@ActivistInvestor,

 

Thank you for your reply.  Honestly, your examples didn't make any sense until I researched the EQ function.

 

I made the assumption that EQ compared items much like = and EQUAL compare values.

 

From the Autodesk help files:

 

eq returns nil because f1 and f3, while containing the same value, do not refer to the same list.

 

Is there a built in sorting function that compares a list's contents using EQUAL instead of comparing lists using EQ?


No built-in sorting function I'm aware of.

 

I've used this in the past:

 

;;  (lsort <list> <comparer>)
;;
;;  <comparer> is a function that takes two arguments,
;;  and returns non-nil if the first argument is greater 
;;  than the second, or nil otherwise. The arguments are 
;;  the elements of the list to be sorted. This argument 
;;  must be quoted.
;;  
;;  The default sort order is descending. To change the
;;  sort order to ascending, the <comparer> function can 
;;  return the logical complement (not) of it's result.
;;
;; Examples:
;;
;;  1.  Sort a list of coordinates on the Y-component:
;;
;;      Assume unsorted data is in 'UNSORTED
;;
;;    (setq sorted 
;;       (lsort unsorted 
;;         '(lambda (a b)
;;             (> (cadr a) (cadr b))
;;          )
;;       )
;;    )
;;              
;;
;;  2.  Sort a list of entity names by layer:
;;
;;    (setq sorted 
;;       (lsort unsorted 
;;         '(lambda (e1 e2) 
;;            (> (cdr (assoc 8 (entget e1)))
;;               (cdr (assoc 8 (entget e2)))
;;            )
;;          )
;;       )
;;    )
;;    
;;  3.  Sort a list of coordinates on multiple
;;      keys (first by the X ordinate, and then 
;;      by the Y ordinate):
;;    
;;     (setq epsilon 1e-6)
;;     
;;     (defun compare-points (p1 p2)
;;        (cond
;;           (  (equal (car p1) (car p2) epsilon)  ; if x are equal,
;;              (> (cadr p1) (cadr p2)))           ; then compare y,
;;           (t (> (car p1) (car p2)))             ; else compare x
;;        )
;;     )
;;     
;;     (setq sorted (lsort unsorted 'compare-points))
;;    

(defun lsort (input comparer / fun)
   (setq fun (cond (comparer) (t '>)))
   (lsort-aux input)
)

(defun lsort-aux (input)
   (if (cdr input)
      (  (lambda (tlist)
            (lsort-merge 
               (lsort-aux (car tlist))
               (lsort-aux (cadr tlist))
            )
         )
         (lsort-split input)
      )
      input
   )
)

(defun lsort-split (right / left)
   (repeat (/ (length right) 2)
      (setq
         left (cons (car right) left)
         right (cdr right)
      )
   )
   (list left right)
)

(defun lsort-merge (left right / out)
   (while (and left right)
      (if (apply fun (list (car left) (car right)))
         (setq
            out (cons (car left) out)
            left (cdr left)
         )
         (setq
            out (cons (car right) out)
            right (cdr right)
         )
      )
   )
   (append (reverse out) left right)
)
0 Likes
Message 9 of 59

_gile
Consultant
Consultant

@zph wrote:

rkmcswain,

 

Thank you for the reply.

 

Yeah, I saw the specific use of the word *may*; I raised an eyebrow.  Not the most useful explanation I've ever read.

 

I checked out Lee Mac's functions and I did find one that was able to eliminate the duplicated dotted pair.

 

Thanks!

~Z

 

 


Just to remove duplicated items in a list, you can use this:

 

(defun distinct (lst)
  (if lst
    (cons (car lst) (distinct (vl-remove (car lst) lst)))
  )
)


Gilles Chanteau
Programmation AutoCAD LISP/.NET
GileCAD
GitHub

0 Likes
Message 10 of 59

ActivistInvestor
Mentor
Mentor

@Ranjit_Singh wrote:

In my experience only whole numbers and strings are respected for the equality comparison in vl-sort. Try the following and you will see that real type duplicates are retained, although they might be equal.

Command: (vl-sort '(5.0 1 2 3.0 3.0) '<)
(1 2 3.0 3.0 5.0)

Actually, what vl-sort is comparing is not the values of list elements, it is comparing the list nodes containing the elements for equality (which is what the EQ function does).

 

In the following example, all three occurrences of 4.0 are the same object:

 

Command: (setq list1 '(2.0 3 4.0 1.0))
(2.0 3 4.0 1.0)

Command: (setq list1 (cons (caddr list1) (cons (caddr list1) list1)))
(4.0 4.0 2.0 3 4.0 1.0)

Command: (vl-sort list1 '>)
(4.0 3 2.0 1.0)


 

0 Likes
Message 11 of 59

john.uhden
Mentor
Mentor

I guess that's great for numbers, but not so great for strings...

 

Command: (setq x (list "a" "d" "b" "a" "c" "d"))
("a" "d" "b" "a" "c" "d")

Command: (vl-sort x '>)
("d" "d" "c" "b" "a" "a")

What, doesn't (eq "d" "d")?

 

Of course, it could work like this:

(defun stringp (x)(= (type x) 'STR))

(setq x (list "a" "d" "b" "a" "c" "d"))

(if (vl-every 'stringp x)
  (mapcar 'chr
    (vl-sort (mapcar 'car (mapcar 'vl-string->list x)) '>)
  )
)
("d" "c" "b" "a")

John F. Uhden

0 Likes
Message 12 of 59

_gile
Consultant
Consultant

As this remains quite confusing according to how the list to be sorted have been built (as shown by @ActivistInvestor), I'd use two different and more explicit functions: one to sort and remove duplicates and another one to sort and do not remove duplicates.

 

(defun SortWithoutRemovingDuplicates (lst fun)
  (mapcar '(lambda (x) (nth x lst)) (vl-sort-i lst fun))
)

(defun SortAndRemoveDuplicates (lst fun / distinct)
  (defun distinct (lst)
    (if lst
      (cons (car lst) (distinct (vl-remove (car lst) lst)))
    )
  )
  (vl-sort (distinct lst) fun)
)


Gilles Chanteau
Programmation AutoCAD LISP/.NET
GileCAD
GitHub

0 Likes
Message 13 of 59

ActivistInvestor
Mentor
Mentor

@john.uhden wrote:

I guess that's great for numbers, but not so great for strings...

 

Command: (setq x (list "a" "d" "b" "a" "c" "d"))
("a" "d" "b" "a" "c" "d")

Command: (vl-sort x '>)
("d" "d" "c" "b" "a" "a")

What, doesn't (eq "d" "d")?

 

Of course, it could work like this:

(defun stringp (x)(= (type x) 'STR))

(setq x (list "a" "d" "b" "a" "c" "d"))

(if (vl-every 'stringp x)
  (mapcar 'chr
    (vl-sort (mapcar 'car (mapcar 'vl-string->list x)) '>)
  )
)
("d" "c" "b" "a")

 

 

vl-sort is not comparing values. It is comparing cons cells. It removes duplicate references to the same cons cell.

 

It shouldn't matter what kind of data is in a cell.

 

 

Command: (setq l1 '("fee" "fie" "foe" "fum"))
("fee" "fie" "foe" "fum")

Command: (setq l2 (append l1 l1))
("fee" "fie" "foe" "fum" "fee" "fie" "foe" "fum")

Command: (vl-sort l2 '>)
("fum" "foe" "fie" "fee")

Command: (setq l3 (cons "fee" (cons "fie" l2)))
("fee" "fie" "fee" "fie" "foe" "fum" "fee" "fie" "foe" "fum")

Command: (vl-sort l3 '>)
("fum" "foe" "fie" "fie" "fee" "fee")

Command: (setq list1 '(5.25 7 3.25 4.0))
(5.25 7 3.25 4.0)

Command: (repeat 10 (setq list1 (cons (last list1) list1)))
(4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 5.25 7 3.25 4.0)

Command: (vl-sort list1 '>)
(7 5.25 4.0 3.25)

Command: (setq list2 '(5.25 7 3.25 4.0))
(5.25 7 3.25 4.0)

Command: (repeat 10 (setq list2 (cons 4.0 list2)))
(4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 5.25 7 3.25 4.0)

Command: (vl-sort list2 '>)
(7 5.25 4.0 4.0 3.25)

Command: (setq list3 (append list1 list2))
(4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 5.25 7 3.25 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 5.25 7 3.25 4.0)

Command: (vl-sort list3 '>)
(7 5.25 5.25 4.0 4.0 4.0 3.25 3.25)
0 Likes
Message 14 of 59

john.uhden
Mentor
Mentor

This might help:

 

(defun remdupes (old / new)
  (foreach item old
    (if (not (vl-position item new))(setq new (cons item new)))
  )
  (reverse new)
)

Command: (setq x (list "a" "d" "b" "a" "c" "d"))
("a" "d" "b" "a" "c" "d")

Command: (remdupes x)
("a" "d" "b" "c")

John F. Uhden

0 Likes
Message 15 of 59

_gile
Consultant
Consultant

@john.uhden wrote:

This might help:

 

(defun remdupes (old / new)
  (foreach item old
    (if (not (vl-position item new))(setq new (cons item new)))
  )
  (reverse new)
)

Command: (setq x (list "a" "d" "b" "a" "c" "d"))
("a" "d" "b" "a" "c" "d")

Command: (remdupes x)
("a" "d" "b" "c")


This reminds me a challenge at TheSwamp.



Gilles Chanteau
Programmation AutoCAD LISP/.NET
GileCAD
GitHub

0 Likes
Message 16 of 59

ActivistInvestor
Mentor
Mentor

@_gile wrote:

@john.uhden wrote:

This might help:

 

(defun remdupes (old / new)
  (foreach item old
    (if (not (vl-position item new))(setq new (cons item new)))
  )
  (reverse new)
)

Command: (setq x (list "a" "d" "b" "a" "c" "d"))
("a" "d" "b" "a" "c" "d")

Command: (remdupes x)
("a" "d" "b" "c")


This reminds me a challenge at TheSwamp.


That was back during a time when AutoLISP's stack was too limited for recursive solutions.

 

 

(defun distinct (lst)
   (distinct-sub lst nil)
)

(defun distinct-sub (lst dupes)
   (cond
      (  (not lst) nil)
      (  (vl-position (car lst) dupes)
         (distinct-sub (cdr lst) dupes))
      (t (cons (car lst) 
               (distinct-sub (cdr lst) 
                             (cons (car lst) dupes))))
   )
)
0 Likes
Message 17 of 59

_gile
Consultant
Consultant

@ActivistInvestor wrote:

That was back during a time when AutoLISP's stack was too limited for recursive solutions.

(defun distinct (lst)
   (distinct-sub lst nil)
)

(defun distinct-sub (lst dupes)
   (cond
      (  (not lst) nil)
      (  (vl-position (car lst) dupes)
         (distinct-sub (cdr lst) dupes))
      (t (cons (car lst) 
               (distinct-sub (cdr lst) 
                             (cons (car lst) dupes))))
   )
)

Should not it have been:

 

(defun distinct (lst / distinct-sub)
  (distinct-sub lst nil)
)

(defun distinct-sub (lst dupes)
  (cond
    (  (not lst) (reverse dupes))
    (  (vl-position (car lst) dupes)
       (distinct-sub (cdr lst) dupes))
    (t (distinct-sub (cdr lst)
                     (cons (car lst) dupes)))
  )
)


Gilles Chanteau
Programmation AutoCAD LISP/.NET
GileCAD
GitHub

0 Likes
Message 18 of 59

john.uhden
Mentor
Mentor

Have you any idea why duplicates are removed from a list of multiple-character strings vs. not removed from single-character strings?

 

Actually, it's not as simple as that...

 

Command: (setq a '("d" "dog" "c" "cat" "d" "dog" "b" "bug" "b" "a"))
("d" "dog" "c" "cat" "d" "dog" "b" "bug" "b" "a")

Command: (vl-sort a '>)
("dog" "dog" "d" "d" "cat" "c" "bug" "b" "b" "a")

 

Command: (setq b '("dog" "cat" "dog" "b" "b" "a"))
("dog" "cat" "dog" "b" "b" "a")

Command: (vl-sort b '>)
("dog" "dog" "cat" "b" "b" "a")

 

Command: (setq c '("dog" "cat" "dog" "bug" "ant"))
("dog" "cat" "dog" "bug" "ant")

Command: (vl-sort c '>)
("dog" "dog" "cat" "bug" "ant")

 

Must have something to do with an Englishmun.

John F. Uhden

0 Likes
Message 19 of 59

ActivistInvestor
Mentor
Mentor

Hi @_gile.

 

Actually, it should not have been either of those.

 

It should have been:

 

(defun distinct (lst)
   (cond
      (  (not lst) nil)
      (  (vl-position (car lst) (cdr lst))
         (distinct (cdr lst)))
      (t (cons (car lst) (distinct (cdr lst))))
   )
)


 

 


@_gile wrote:

@ActivistInvestor wrote:

That was back during a time when AutoLISP's stack was too limited for recursive solutions.

(defun distinct (lst)
   (distinct-sub lst nil)
)

(defun distinct-sub (lst dupes)
   (cond
      (  (not lst) nil)
      (  (vl-position (car lst) dupes)
         (distinct-sub (cdr lst) dupes))
      (t (cons (car lst) 
               (distinct-sub (cdr lst) 
                             (cons (car lst) dupes))))
   )
)

Should not it have been:

 

(defun distinct (lst / distinct-sub)
  (distinct-sub lst nil)
)

(defun distinct-sub (lst dupes)
  (cond
    (  (not lst) (reverse dupes))
    (  (vl-position (car lst) dupes)
       (distinct-sub (cdr lst) dupes))
    (t (distinct-sub (cdr lst)
                     (cons (car lst) dupes)))
  )
)

 

0 Likes
Message 20 of 59

marko_ribar
Advisor
Advisor

Here is my version, and it will not remove duplicates...

 

(defun sort ( l f / fun out )
  (defun fun ( l f / k kk )
    (if l
      (progn
        (setq k -1)
        (foreach a l
          (setq k (1+ k))
          (if (vl-every '(lambda ( x ) (apply f (list a x))) (vl-remove-if '(lambda ( x ) (= (vl-position x l) k)) l))
            (setq out (cons a out) kk k)
          )
        )
        (fun (vl-remove-if '(lambda ( x ) (= (vl-position x l) kk)) l) f)
      )
    )
    (reverse out)
  )
  (fun l f)
)

;;; (sort '(2 4 7 3 5 1) '<) => (1 2 3 4 5 7)

P.S. Quickly written, so there may be some lacks...

HTH., M.R.

Marko Ribar, d.i.a. (graduated engineer of architecture)
0 Likes