TheSwamp

Code Red => AutoLISP (Vanilla / Visual) => Topic started by: Jeremy Dunn on January 15, 2018, 02:25:15 PM

Title: Sorting points
Post by: Jeremy Dunn on January 15, 2018, 02:25:15 PM
Let us say that I have a list of insertion points that are in a series of rows with one or more points with the same Y value. I want to create a list where the points are ordered going from left to right row by row from top to bottom. What is the best way to do this?
Title: Re: Sorting points
Post by: MP on January 15, 2018, 02:33:39 PM
1. Group points by y ordinate (will need to employ a fuzz value).
2. Sort groups by y ordinate (descending).
3. Sort within a group by x ordinate (ascending).
Title: Re: Sorting points
Post by: ronjonp on January 15, 2018, 03:07:36 PM
Here's a simple example:
Code: [Select]
;; Sort master point list left to right
(setq pts (vl-sort pts '(lambda (a b) (< (car a) (car b)))))
;; While we have pts
(while (setq p (car pts))
  ;; Group by y values to get rows
  (setq tmp (vl-remove-if-not '(lambda (x) (equal (cadr p) (cadr x) 1e-8)) pts))
  ;; Append sublist to 'out'
  (setq out (cons tmp out))
  ;; Remove sublist items from master list
  (mapcar '(lambda (x) (setq pts (vl-remove x pts))) tmp)
)
;; Sort rows from top to bottom
(vl-sort out '(lambda (a b) (> (caar a) (caar b))))
Title: Re: Sorting points
Post by: Grrr1337 on January 15, 2018, 03:44:16 PM
1. Group points by y ordinate (will need to employ a fuzz value).
2. Sort groups by y ordinate (descending).
3. Sort within a group by x ordinate (ascending).

A while back wrote something following these ^^ steps:

Code - Auto/Visual Lisp: [Select]
  1. ; Sort point list by X, then by Y, then by Z
  2. ; fA - determines the sorting order (i.e.: XYZ - first sort by X, then by Y, then by Z)
  3. ; and a Function Accessor, SYM, one of the following: ('XYZ 'XZY 'YXZ 'YZX 'ZXY 'ZYX)
  4. ; fz - fuzz
  5. ; dx, dy, dz - determine the sorting direction (like reversing part of the list), either ">" or "<" for each
  6. ; pL - Point list
  7. ; Usage Examples:
  8. ; (SortPointList 'XYZ 1e-3 > > > pL)
  9. ; (SortPointList 'XYZ 1e-3 < < < pL)
  10. ; (SortPointList 'YXZ 1e-3 > > > pL)
  11. (defun SortPointList ( fA fz dx dy dz pL / fp f )
  12.   (if
  13.     (and
  14.       (setq fp ; function part - of the complete sorting function
  15.         (cadr
  16.           (assoc fA ; function accessor - from the user, that provides the sorting order
  17.             (list ; assoc list of (<FooAccessor> <Foo>)
  18.               ; Unindented explanation (can be erased later) :
  19.               ; (list 'XYZ
  20.               ;   (lambda (a b c) ; a b c are X, Y, Z comparsions between 2 points using (equal) function
  21.               ;     (if a ; (equal x1 x2 fz) - if thats true, then compare the Y-es
  22.               ;       (if b ; (equal y1 y2 fz) - if thats true, then compare the Z-s
  23.               ;         (if c ; (equal z1 z2 fz) - if thats true, then the points are completely equal
  24.               ;           (> z1 z2) (> z1 z2) ; sort whatever
  25.               ;         ); if c
  26.               ;         (> y1 y2) ; else sort by Y-es
  27.               ;       ); if b
  28.               ;       (> x1 x2) ; else sort by X-es
  29.               ;     ); if a
  30.               ;   ); lambda
  31.               ; ); list
  32.               (list 'XYZ (lambda (a b c) (if a (if b (if c (dz z1 z2) (dz z1 z2) ) (dy y1 y2) ) (dx x1 x2) ) ) )
  33.               (list 'XZY (lambda (a b c) (if a (if c (if b (dy y1 y2) (dy y1 y2) ) (dz z1 z2) ) (dx x1 x2) ) ) )
  34.               (list 'YXZ (lambda (a b c) (if b (if a (if c (dz z1 z2) (dz z1 z2) ) (dx x1 x2) ) (dy y1 y2) ) ) )
  35.               (list 'YZX (lambda (a b c) (if b (if c (if a (dx x1 x2) (dx x1 x2) ) (dz z1 z2) ) (dy y1 y2) ) ) )
  36.               (list 'ZXY (lambda (a b c) (if c (if a (if b (dy y1 y2) (dy y1 y2) ) (dx x1 x2) ) (dz z1 z2) ) ) )
  37.               (list 'ZYX (lambda (a b c) (if c (if b (if a (dx x1 x2) (dx x1 x2) ) (dy y1 y2) ) (dz z1 z2) ) ) )
  38.             ); list
  39.           ); assoc
  40.         ); cadr  
  41.       ); setq fn
  42.       (setq f ; the complete sorting function
  43.         (lambda (p1 p2 / x1 y1 z1 x2 y2 z2 a b c) ; Sort By X, then by Y, then by Z:
  44.           (mapcar 'set '(x1 y1 z1) p1) (mapcar 'set '(x2 y2 z2) p2) ; dissect the point coordinates (for a clearer results)
  45.           (mapcar 'set '(a b c) (mapcar (function (lambda (a b) (equal a b fz))) p1 p2)) ; dissect the comparsion results
  46.           (fp a b c)
  47.         ); lambda
  48.       ); setq f
  49.     ); and
  50.     (vl-sort pL (function f)) ; sort the list
  51.   ); if
  52. ); defun SortPointList

So...
Code: [Select]
(setq pL '((1 1 2) (2 1 1) (2 2 2) (2 1 2) (2 3 2) (2 1 3) (1 1 3) (3 3 2) (1 1 3) (2 3 3) (3 1 1) (1 2 3) (1 2 1) (1 3 1) (1 3 0) (2 2 0) (2 3 4) (1 1 1) (2 3 0) (3 3 3) (3 4 2)))

_$ (SortPointList 'XYZ 1e-3 > < > pL)
((3 1 1) (3 3 3) (3 3 2) (3 4 2) (2 1 3) (2 1 2) (2 1 1) (2 2 2) (2 2 0) (2 3 4) (2 3 3) (2 3 2) (2 3 0) (1 1 3) (1 1 3) (1 1 2) (1 1 1) (1 2 3) (1 2 1) (1 3 1) (1 3 0))

_$ (SortPointList 'XYZ 1e-3 > > > pL)
((3 4 2) (3 3 3) (3 3 2) (3 1 1) (2 3 4) (2 3 3) (2 3 2) (2 3 0) (2 2 2) (2 2 0) (2 1 3) (2 1 2) (2 1 1) (1 3 1) (1 3 0) (1 2 3) (1 2 1) (1 1 3) (1 1 3) (1 1 2) (1 1 1))
_$ (SortPointList 'XZY 1e-3 > > > pL)
((3 3 3) (3 4 2) (3 3 2) (3 1 1) (2 3 4) (2 3 3) (2 1 3) (2 3 2) (2 2 2) (2 1 2) (2 1 1) (2 3 0) (2 2 0) (1 2 3) (1 1 3) (1 1 3) (1 1 2) (1 3 1) (1 2 1) (1 1 1) (1 3 0))
_$ (SortPointList 'YXZ 1e-3 > > > pL)
((3 4 2) (3 3 3) (3 3 2) (2 3 4) (2 3 3) (2 3 2) (2 3 0) (1 3 1) (1 3 0) (2 2 2) (2 2 0) (1 2 3) (1 2 1) (3 1 1) (2 1 3) (2 1 2) (2 1 1) (1 1 3) (1 1 3) (1 1 2) (1 1 1))
_$ (SortPointList 'YZX 1e-3 > > > pL)
((3 4 2) (2 3 4) (3 3 3) (2 3 3) (3 3 2) (2 3 2) (1 3 1) (2 3 0) (1 3 0) (1 2 3) (2 2 2) (1 2 1) (2 2 0) (2 1 3) (1 1 3) (1 1 3) (2 1 2) (1 1 2) (3 1 1) (2 1 1) (1 1 1))
_$ (SortPointList 'ZXY 1e-3 > > > pL)
((2 3 4) (3 3 3) (2 3 3) (2 1 3) (1 2 3) (1 1 3) (1 1 3) (3 4 2) (3 3 2) (2 3 2) (2 2 2) (2 1 2) (1 1 2) (3 1 1) (2 1 1) (1 3 1) (1 2 1) (1 1 1) (2 3 0) (2 2 0) (1 3 0))
_$ (SortPointList 'ZYX 1e-3 > > > pL)
((2 3 4) (3 3 3) (2 3 3) (1 2 3) (2 1 3) (1 1 3) (1 1 3) (3 4 2) (3 3 2) (2 3 2) (2 2 2) (2 1 2) (1 1 2) (1 3 1) (1 2 1) (3 1 1) (2 1 1) (1 1 1) (2 3 0) (1 3 0) (2 2 0))


_$ (SortPointList 'XYZ 1e-3 < < < pL)
((1 1 1) (1 1 2) (1 1 3) (1 1 3) (1 2 1) (1 2 3) (1 3 0) (1 3 1) (2 1 1) (2 1 2) (2 1 3) (2 2 0) (2 2 2) (2 3 0) (2 3 2) (2 3 3) (2 3 4) (3 1 1) (3 3 2) (3 3 3) (3 4 2))
_$ (SortPointList 'XZY 1e-3 < < < pL)
((1 3 0) (1 1 1) (1 2 1) (1 3 1) (1 1 2) (1 1 3) (1 1 3) (1 2 3) (2 2 0) (2 3 0) (2 1 1) (2 1 2) (2 2 2) (2 3 2) (2 1 3) (2 3 3) (2 3 4) (3 1 1) (3 3 2) (3 4 2) (3 3 3))
_$ (SortPointList 'YXZ 1e-3 < < < pL)
((1 1 1) (1 1 2) (1 1 3) (1 1 3) (2 1 1) (2 1 2) (2 1 3) (3 1 1) (1 2 1) (1 2 3) (2 2 0) (2 2 2) (1 3 0) (1 3 1) (2 3 0) (2 3 2) (2 3 3) (2 3 4) (3 3 2) (3 3 3) (3 4 2))
_$ (SortPointList 'YZX 1e-3 < < < pL)
((1 1 1) (2 1 1) (3 1 1) (1 1 2) (2 1 2) (1 1 3) (1 1 3) (2 1 3) (2 2 0) (1 2 1) (2 2 2) (1 2 3) (1 3 0) (2 3 0) (1 3 1) (2 3 2) (3 3 2) (2 3 3) (3 3 3) (2 3 4) (3 4 2))
_$ (SortPointList 'ZXY 1e-3 < < < pL)
((1 3 0) (2 2 0) (2 3 0) (1 1 1) (1 2 1) (1 3 1) (2 1 1) (3 1 1) (1 1 2) (2 1 2) (2 2 2) (2 3 2) (3 3 2) (3 4 2) (1 1 3) (1 1 3) (1 2 3) (2 1 3) (2 3 3) (3 3 3) (2 3 4))
_$ (SortPointList 'ZYX 1e-3 < < < pL)
((2 2 0) (1 3 0) (2 3 0) (1 1 1) (2 1 1) (3 1 1) (1 2 1) (1 3 1) (1 1 2) (2 1 2) (2 2 2) (2 3 2) (3 3 2) (3 4 2) (1 1 3) (1 1 3) (2 1 3) (1 2 3) (2 3 3) (3 3 3) (2 3 4))

Although the easier visualisation was thru a custom grread subfunction, where I could toggle the inputs:

(https://s1.gifyu.com/images/SortPointList.gif) (https://gifyu.com/image/LpP1)
Title: Re: Sorting points
Post by: Lee Mac on January 15, 2018, 04:12:12 PM
Another example:
http://www.theswamp.org/index.php?topic=40483.msg457902#msg457902
Title: Re: Sorting points
Post by: Jeremy Dunn on January 15, 2018, 04:34:49 PM
Thanks guys, I was coming up with a solution but I like yours better.
Title: Re: Sorting points
Post by: MP on January 15, 2018, 04:47:33 PM
Quick & Dirty inspired by Ron's post:

Code: [Select]
(defun _GroupAndSort ( points fuzz / test sort result y )
    ;; Note: test exploits lexical globals y & fuzz
    (defun test (p) (equal y (cadr p) fuzz))
    (defun sort (l f g) (vl-sort l (function (lambda (a b) (f (g a) (g b))))))
    (while (setq y (cadar points))
        (setq
            result (cons (sort (vl-remove-if-not 'test points) < car) result)
            points (vl-remove-if 'test points)
        )
    )
    (sort result > cadar)
)

(setq points
   '(   
        (1191.46 378.027)
        (1247.31 347.734)
        (1247.31 378.027)
        (1125.24 392.376)
        (1274.43 363.279)
        (1191.46 332.986)
        (1166.73 347.734)
        (1191.46 347.734)
        (1125.24 363.279)
        (1191.46 392.376)
        (1247.31 363.279)
        (1125.24 347.734)
        (1247.31 392.376)
        (1191.46 363.279)
        (1166.73 378.027)
        (1166.73 332.986)
        (1274.43 378.027)
        (1274.43 347.734)
        (1125.24 332.986)
        (1247.31 332.986)
        (1274.43 392.376)
        (1166.73 392.376)
        (1274.43 332.986)
        (1125.24 378.027)
        (1166.73 363.279)
    )
)
   

Code: [Select]
(foreach group (_GroupAndSort points 0.5)
    (princ "\n")
    (foreach p group (princ p) (princ " "))
    (princ)
)

(1125.24 392.376) (1166.73 392.376) (1191.46 392.376) (1247.31 392.376) (1274.43 392.376)
(1125.24 378.027) (1166.73 378.027) (1191.46 378.027) (1247.31 378.027) (1274.43 378.027)
(1125.24 363.279) (1166.73 363.279) (1191.46 363.279) (1247.31 363.279) (1274.43 363.279)
(1125.24 347.734) (1166.73 347.734) (1191.46 347.734) (1247.31 347.734) (1274.43 347.734)
(1125.24 332.986) (1166.73 332.986) (1191.46 332.986) (1247.31 332.986) (1274.43 332.986)


Cheers.
Title: Re: Sorting points
Post by: Lee Mac on January 15, 2018, 06:00:02 PM
Another, inspired by Michael's post:

Code: [Select]
(defun _groupandsort ( lst fuz / rtn tmp ycl yco )
    (while (setq yco (cadar lst))
        (setq lst (vl-remove-if '(lambda ( p ) (if (equal (cadr p) yco fuz) (setq tmp (cons p tmp)))) lst)
              rtn (cons (vl-sort tmp '(lambda ( a b ) (< (car a) (car b)))) rtn)
              ycl (cons yco ycl)
              tmp nil
        )
    )
    (mapcar '(lambda ( n ) (nth n rtn)) (vl-sort-i ycl '>))
)
Title: Re: Sorting points
Post by: Grrr1337 on January 15, 2018, 06:22:47 PM
-={Challenge}=- Ultimate Sorter

I was wondering if it was possible to use a recursive algorithm to group a list of integer lists (like a list of points, but with more than 3 reals) in order to sort them.
Where the priority is from left to right, car->cadr->caddr->..->last [see the expected result and you'll understand] :
Code: [Select]
(foo
  '( ; a random messed up list of lists is given to be sorted:
    (1 3 6 2)
    (1 2 3 4)
    (1 3 4 5)
    (2 4 6 1 3)
    (3 2 4 5 4)
    (3 2 4 8 2)
    (2 5 5 1 2)
    (2 5 6 1 7)
    (1 2 3 5)
  )
)
>>
'( ; Priority, sort by the minimal (car) value, if there are other elements that are equal, then group and try sorting by (cadr), if some of them have equal, try (caddr)... and so on
  (1 2 3 4) ; CAR = 1
  (1 2 3 5) ; CAR = 1, the next ones are equal to the first, but the last one is above 4
 
  (1 3 4 5) ; CAR = 1, but CADR = 3, thats why is 3rd (because the (cadr) of the first set is with value of 2)
  (1 3 6 2) ; CAR = 1, and CADR = 3, but the 3rd element is higher than the previous item
 
  (2 4 6 1 3) ; CAR = 2 .. compare CADRs, if there are equals, then compare CADDRs
  (2 5 5 1 2)
  (2 5 6 1 7)
 
  (3 2 4 5 4) ; CAR-CADR have equals, compare CADDR
  (3 2 4 8 2)
)

I've called this idea 'Ultimate Sorter', but no idea if such thing is already figured out and its way over my head.
Title: Re: Sorting points
Post by: Lee Mac on January 15, 2018, 06:38:46 PM
-={Challenge}=- Ultimate Sorter

Code: [Select]
(defun foo ( l ) (vl-sort l 'bar))
(defun bar ( a b )
    (cond
        (   (not (and a b)) b)
        (   (= (car a) (car b)) (bar (cdr a) (cdr b)))
        (   (< (car a) (car b)))
    )
)
Title: Re: Sorting points
Post by: Grrr1337 on January 15, 2018, 06:49:42 PM
Lee, just literally "what the hell?!"  :-o

No offence, but I expected that would be a tough job even for you.

Code: [Select]
(vl-string-subst "good" "tough" "tough job!")
EDIT:
Learned how important can be recursive functions that perform comparison just to return that boolean value for the vl-sort function.
Title: Re: Sorting points
Post by: kdub_nz on January 15, 2018, 09:32:15 PM
Quick & Dirty inspired by Ron's post:

Code: [Select]
< .. >
    ;; Note: test exploits lexical globals y & fuzz
< ... >

I had  bit of a laugh when I noticed this. Understanding Nuts and Bolts is more important than pretty printing.
Title: Re: Sorting points
Post by: ahsattarian on February 18, 2021, 05:03:40 AM
In a simple way    :




Code - Auto/Visual Lisp: [Select]
  1. (defun c:a ()
  2.   (defun myprint (txt)
  3.     (princ "\n  ")
  4.     (princ txt)
  5.     (princ "   ===>   ")
  6.     (eval (read (strcat "(princ \n" txt ")")))
  7.   )
  8.   (princ "\n  -------------------------------------------------------  ")
  9.   (setq li10 '(5 3 1 8 6 2 4 7))
  10.   (myprint "li10")
  11.   (setq li110 (vl-sort-i li10 '<))
  12.   (myprint "li110")
  13.   (setq li11 (mapcar '(lambda (a) (nth a li10)) li110))
  14.   (myprint "li11")
  15.   (setq li12 (vl-sort li10 '<))
  16.   (myprint "li12")
  17.   (setq li13 (vl-sort li10 (function (lambda (e1 e2) (< e1 e2)))))
  18.   (myprint "li13")
  19.   (setq li14 (vl-sort li10 '(lambda (e1 e2) (< e1 e2))))
  20.   (myprint "li14")
  21.   (princ "\n  -------------------------------------------------------  ")
  22.   (setq li20 '("1" "8" "5" "3" "6" "2" "4" "7"))
  23.   (myprint "li20")
  24.   (setq li21 (vl-sort li20 '<))
  25.   (myprint "li21")
  26.   (setq li22 (acad_strlsort li20))
  27.   (myprint "li22")
  28.   (princ "\n  -------------------------------------------------------  ")
  29.   (setq li30 '((7 2) (1 3) (8 4) (6 5)))
  30.   (myprint "li30")
  31.   (defun sub1 (lij funcj nthj) (vl-sort lij (function (lambda (e1 e2) (funcj (nthj e1) (nthj e2))))))
  32.   (setq li31 (sub1 li30 < car))
  33.   (myprint "li31")
  34.   (setq li32 (sub1 li30 > cadr))
  35.   (myprint "li32")
  36.   (princ "\n  -------------------------------------------------------  ")
  37.   (setq li40 '((1 3 6 2)
  38.                (1 2 3 4)
  39.                (1 3 4 5)
  40.                (2 4 6 1 3)
  41.                (3 2 4 5 4)
  42.                (3 2 4 8 2)
  43.                (2 5 5 1 2)
  44.                (2 5 5 1)
  45.                (2 5 6 1 7)
  46.                (1 2 3 5)
  47.               )
  48.   )
  49.   (myprint "li40")
  50.   (defun sub2 (a b)
  51.     (cond
  52.       ((not (and a b)) b)
  53.       ((= (car a) (car b)) (sub2 (cdr a) (cdr b)))
  54.       ((< (car a) (car b)))
  55.     )
  56.   )
  57.   (setq li41 (vl-sort li40 'sub2))
  58.   (myprint "li41")
  59.   (princ "\n  -------------------------------------------------------  ")
  60.   (textscr)
  61.   (princ)
  62. )




Title: Re: Sorting points
Post by: Jeremy Dunn on February 19, 2021, 04:05:50 PM
A slight variation. Suppose we have a list of pairs of enames of objects like blocks or text along with their insertion point as in

((ename1 ins1)(ename2 ins2) ... (enameN insN))

Suppose these items are in groups on several lines at different Y values. How can one get just the enames sorted left to right by X in separate lists by line going from top to bottom? In other words sort like

((enameX1 enameX2 ...) ;line1
 (enameX1 enameX2 ...) ;line2
 ...
 (enameX1 enameX2 ...)) ;lineN
Title: Re: Sorting points
Post by: Lee Mac on February 19, 2021, 05:36:27 PM
Revising my above posted function:
Code - Auto/Visual Lisp: [Select]
  1. (defun _groupandsort ( lst fuz / rtn tmp ycl yco xcl )
  2.     (while (setq yco (car (cdadar lst)))
  3.         (setq lst (vl-remove-if '(lambda ( p ) (if (equal (cadadr p) yco fuz) (setq xcl (cons (caadr p) xcl) tmp (cons (car p) tmp)))) lst)
  4.               rtn (cons (mapcar '(lambda ( n ) (nth n tmp)) (vl-sort-i xcl '<)) rtn)
  5.               ycl (cons yco ycl)
  6.               tmp nil
  7.               xcl nil
  8.         )
  9.     )
  10.     (mapcar '(lambda ( n ) (nth n rtn)) (vl-sort-i ycl '>))
  11. )

To test (with Points):
Code - Auto/Visual Lisp: [Select]
  1. (defun c:test ( / e i l s )
  2.     (if (setq s (ssget '((0 . "POINT"))))
  3.         (progn
  4.             (repeat (setq i (sslength s))
  5.                 (setq i (1- i)
  6.                       e (ssname s i)
  7.                       l (cons (list e (cdr (assoc 10 (entget e)))) l)
  8.                 )
  9.             )
  10.             (princ "\n(")
  11.             (foreach x l
  12.                 (princ "\n    ") (princ x)
  13.             )
  14.             (princ "\n)")
  15.             (princ "\n(")
  16.             (foreach g (_groupandsort l 1e-8)
  17.                 (princ "\n    (")
  18.                 (foreach x g (princ x) (princ " "))
  19.                 (princ "\010)")
  20.             )
  21.             (princ "\n)")
  22.         )
  23.     )
  24.     (princ)
  25. )

Results:

(
    (<Entity name: 7ffff706960> (26.5745 14.5973 0.0))
    (<Entity name: 7ffff706950> (24.1737 14.5973 0.0))
    (<Entity name: 7ffff706940> (22.126  14.5973 0.0))
    (<Entity name: 7ffff706930> (20.0077 14.5973 0.0))
    (<Entity name: 7ffff706920> (18.0307 14.5973 0.0))
    (<Entity name: 7ffff706910> (26.5745 16.1731 0.0))
    (<Entity name: 7ffff706900> (24.1737 16.1731 0.0))
    (<Entity name: 7ffff7068f0> (22.126  16.1731 0.0))
    (<Entity name: 7ffff7068e0> (20.0077 16.1731 0.0))
    (<Entity name: 7ffff7068d0> (18.0307 16.1731 0.0))
    (<Entity name: 7ffff7068c0> (26.5745 17.5373 0.0))
    (<Entity name: 7ffff7068b0> (24.1737 17.5373 0.0))
    (<Entity name: 7ffff7068a0> (22.126  17.5373 0.0))
    (<Entity name: 7ffff706890> (20.0077 17.5373 0.0))
    (<Entity name: 7ffff706880> (18.0307 17.5373 0.0))
)
(
    (<Entity name: 7ffff706880> <Entity name: 7ffff706890> <Entity name: 7ffff7068a0> <Entity name: 7ffff7068b0> <Entity name: 7ffff7068c0>)
    (<Entity name: 7ffff7068d0> <Entity name: 7ffff7068e0> <Entity name: 7ffff7068f0> <Entity name: 7ffff706900> <Entity name: 7ffff706910>)
    (<Entity name: 7ffff706920> <Entity name: 7ffff706930> <Entity name: 7ffff706940> <Entity name: 7ffff706950> <Entity name: 7ffff706960>)
)