TheSwamp

Code Red => AutoLISP (Vanilla / Visual) => Topic started by: Coder on June 02, 2013, 01:23:43 PM

Title: Sorting a challenge
Post by: Coder on June 02, 2013, 01:23:43 PM
Hello guys .

I have a list of elements and I would like to resort them according to the next list .

Code: [Select]
(setq lst '(("plywood" "10x17" 5) ("plywood" "10x12" 2) ("plywood" "14x12" 14)  ("plywood" "14x11" 4)
             ("steel" "4x4" 8)  ("beam" "12x12" 9)  ("beam" "12x10" 6)  ("beam" "12x7" 3)
         ))

The sorting must be according to the second number after the x operator in the second element of each pair without changing their
the other pair's locations .

The result resorted like this


(setq lst '(("plywood" "10x12" 2)  ("plywood" "10x17" 5) ("plywood" "14x11" 4)  ("plywood" "14x12" 14)
             ("steel" "4x4" 8 ) ("beam" "12x7" 3) ("beam" "12x10" 6) ("beam" "12x12" 9)
         ))
I Hope that is clear and easy enough to you masters to help me with it , and please do not hesitate to ask for any clarification .  :-)

Thanks in advance
Title: Re: Sorting a challenge
Post by: Lee Mac on June 02, 2013, 01:52:17 PM
Quick one:
Code - Auto/Visual Lisp: [Select]
  1. (defun LM:mysort-1 ( lst )
  2.     (apply 'append
  3.         (mapcar
  4.             (function
  5.                 (lambda ( x )
  6.                     (mapcar (function (lambda ( n ) (nth n x)))
  7.                         (vl-sort-i
  8.                             (mapcar
  9.                                 (function
  10.                                     (lambda ( x )
  11.                                         (atoi (substr (cadr x) (+ 2 (vl-string-position 120 (cadr x)))))
  12.                                     )
  13.                                 )
  14.                                 x
  15.                             )
  16.                             '<
  17.                         )
  18.                     )
  19.                 )
  20.             )
  21.             (LM:GroupByFunction lst
  22.                 (lambda ( a b )
  23.                     (and (= (car a) (car b))
  24.                          (= (atoi (cadr a)) (atoi (cadr b)))
  25.                     )
  26.                 )
  27.             )
  28.         )
  29.     )
  30. )
  31.  
  32. ;; Group By Function  -  Lee Mac
  33. ;; Groups items considered equal by a given predicate function
  34.  
  35. (defun LM:GroupByFunction ( lst fun / tmp1 tmp2 x1 )
  36.     (if (setq x1 (car lst))
  37.         (progn
  38.             (foreach x2 (cdr lst)
  39.                 (if (fun x1 x2)
  40.                     (setq tmp1 (cons x2 tmp1))
  41.                     (setq tmp2 (cons x2 tmp2))
  42.                 )
  43.             )
  44.             (cons (cons x1 (reverse tmp1)) (LM:GroupByFunction (reverse tmp2) fun))
  45.         )
  46.     )
  47. )

Code - Auto/Visual Lisp: [Select]
  1. _$ (mapcar 'print (LM:mysort-1 lst))
  2.  
  3. ("plywood" "10x12" 2)
  4. ("plywood" "10x17" 5)
  5. ("plywood" "14x11" 4)
  6. ("plywood" "14x12" 14)
  7. ("steel" "4x4" 8)
  8. ("beam" "12x7" 3)
  9. ("beam" "12x10" 6)
  10. ("beam" "12x12" 9)
Title: Re: Sorting a challenge
Post by: Lee Mac on June 02, 2013, 02:03:09 PM
Another:
Code - Auto/Visual Lisp: [Select]
  1. (defun LM:mysort-2 ( lst / a b x )
  2.     (if (setq x (car lst))
  3.         (progn
  4.             (setq a (list x))
  5.             (foreach y (cdr lst)
  6.                 (if (and (= (car x) (car y)) (= (atoi (cadr x)) (atoi (cadr y))))
  7.                     (setq a (cons y a))
  8.                     (setq b (cons y b))
  9.                 )
  10.             )
  11.             (append
  12.                 (mapcar (function (lambda ( n ) (nth n a)))
  13.                     (vl-sort-i
  14.                         (mapcar
  15.                             (function
  16.                                 (lambda ( x )
  17.                                     (atoi (substr (cadr x) (+ 2 (vl-string-position 120 (cadr x)))))
  18.                                 )
  19.                             )
  20.                             a
  21.                         )
  22.                         '<
  23.                     )
  24.                 )
  25.                 (LM:mysort-2 (reverse b))
  26.             )
  27.         )
  28.     )
  29. )
Title: Re: Sorting a challenge
Post by: Lee Mac on June 02, 2013, 02:09:53 PM
Another, very inefficient (without using vl-sort):
Code - Auto/Visual Lisp: [Select]
  1. (defun LM:mysort-3 ( l / _sort )
  2.     (defun _sort ( x l a b c / y )
  3.         (cond
  4.             (   (null (setq y (car l)))
  5.                 (append (LM:mysort-3 a) (list x) (LM:mysort-3 b) (LM:mysort-3 (reverse c)))
  6.             )
  7.             (   (and (= (car x) (car y)) (= (atoi (cadr x)) (atoi (cadr y))))
  8.                 (if (< (atoi (substr (cadr x) (+ 2 (vl-string-position 120 (cadr x)))))
  9.                        (atoi (substr (cadr y) (+ 2 (vl-string-position 120 (cadr y)))))
  10.                     )
  11.                     (_sort x (cdr l) a (cons y b) c)
  12.                     (_sort x (cdr l) (cons y a) b c)
  13.                 )
  14.             )
  15.             (   (_sort x (cdr l) a b (cons y c)))
  16.         )
  17.     )
  18.     (if l (_sort (car l) (cdr l) nil nil nil))
  19. )
Title: Re: Sorting a challenge
Post by: ribarm on June 02, 2013, 02:18:05 PM
Lee is just fine, only I would change this line :

Code - Auto/Visual Lisp: [Select]
  1. (atoi (substr (cadr x) (+ 2 (vl-string-position 120 (cadr x)))))
  2.  

to this :

Code - Auto/Visual Lisp: [Select]
  1. (atoi (vl-string-subst "" "x" (cadr x)))
  2.  
Title: Re: Sorting a challenge
Post by: Coder on June 02, 2013, 02:38:25 PM
Thank you for that nice work , but the result still different although it is very close to the correct result .

Many thanks
Title: Re: Sorting a challenge
Post by: Lee Mac on June 02, 2013, 03:59:48 PM
Thank you for that nice work , but the result still different although it is very close to the correct result .

Oh I see - you also need to retain the order of the first dimension figure - I have updated my above posts.

Lee is just fine, only I would change this line :
Code - Auto/Visual Lisp: [Select]
  1. (atoi (substr (cadr x) (+ 2 (vl-string-position 120 (cadr x)))))

to this :
Code - Auto/Visual Lisp: [Select]
  1. (atoi (vl-string-subst "" "x" (cadr x)))

Thank you for the suggestion Marko, however, firstly your suggestion would be incorrect for dimensions with varying numbers of digits given the OP's requirements, e.g. sorting 4x4, 4x10 & 5x4 would result in 4x4, 5x4, 4x10; but nevertheless, I was under the understanding that the OP wanted to retain the order of the first digit, rather than sort it.
Title: Re: Sorting a challenge
Post by: TheMaster on June 02, 2013, 05:49:11 PM
Hello guys .

I have a list of elements and I would like to resort them according to the next list .

Code: [Select]
(setq lst '(("plywood" "10x17" 5) ("plywood" "10x12" 2) ("plywood" "14x12" 14)  ("plywood" "14x11" 4)
             ("steel" "4x4" 8)  ("beam" "12x12" 9)  ("beam" "12x10" 6)  ("beam" "12x7" 3)
         ))

The sorting must be according to the second number after the x operator in the second element of each pair without changing their
the other pair's locations .

The result resorted like this


(setq lst '(("plywood" "10x12" 2)  ("plywood" "10x17" 5) ("plywood" "14x11" 4)  ("plywood" "14x12" 14)
             ("steel" "4x4" 8 ) ("beam" "12x7" 3) ("beam" "12x10" 6) ("beam" "12x12" 9)
         ))
I Hope that is clear and easy enough to you masters to help me with it , and please do not hesitate to ask for any clarification .  :-)

Thanks in advance

Solving your problem isn't terribly difficult, but why store the information in that form, when it could be stored as numeric data, which is what dimensions are?
Title: Re: Sorting a challenge
Post by: ribarm on June 03, 2013, 05:08:49 AM
Thank you for the suggestion Marko, however, firstly your suggestion would be incorrect for dimensions with varying numbers of digits given the OP's requirements, e.g. sorting 4x4, 4x10 & 5x4 would result in 4x4, 5x4, 4x10; but nevertheless, I was under the understanding that the OP wanted to retain the order of the first digit, rather than sort it.

You are absolutely right, but if I was to make list, I would firstly format second element of an item to equal number of digits, and then use variant with (vl-string-subst)... So be careful : item : ("beam" "12x7" 3) would become ("beam" "12x07" 3) and not ("beam" "12x70" 3)

Code - Auto/Visual Lisp: [Select]
  1. (defun formatcadrbydigits ( lst / singlenumblengths cadrnew lenlst amax bmax lstn )
  2.  
  3.   (defun singlenumblengths ( str / a b )
  4.     (setq a (substr str 1 (vl-string-position 120 str)))
  5.     (setq b (substr str (+ 2 (vl-string-position 120 str))))
  6.     (list (strlen a) (strlen b))
  7.   )
  8.  
  9.   (defun cadrnew ( str / a b )
  10.     (setq a (substr str 1 (vl-string-position 120 str)))
  11.     (setq b (substr str (+ 2 (vl-string-position 120 str))))
  12.     (repeat (- amax (strlen a))
  13.       (setq a (strcat "0" a))
  14.     )
  15.     (repeat (- bmax (strlen b))
  16.       (setq b (strcat "0" b))
  17.     )
  18.     (strcat a "x" b)
  19.   )
  20.  
  21.   (setq lenlst (mapcar '(lambda (x) (singlenumblengths (cadr x))) lst))
  22.  
  23.   (setq amax (caar (vl-sort lenlst '(lambda (a b) (> (car a) (car b))))))
  24.   (setq bmax (cadar (vl-sort lenlst '(lambda (a b) (> (cadr a) (cadr b))))))
  25.    
  26.   (setq lstn (mapcar '(lambda (x) (list (car x) (cadrnew (cadr x)) (caddr x))) lst))
  27.  
  28. )
  29.  

Code: [Select]
Command: (formatcadrbydigits lst)
(("plywood" "10x17" 5) ("plywood" "10x12" 2) ("plywood" "14x12" 14) ("plywood"
"14x11" 4) ("steel" "04x04" 8) ("beam" "12x12" 9) ("beam" "12x10" 6) ("beam"
"12x07" 3))
Title: Re: Sorting a challenge
Post by: ribarm on June 03, 2013, 06:31:48 AM
Then after firstly formatting lst, comes sorting with (vl-string-subst) variant of Lee's code, and then you can return it back to original with :

Code - Auto/Visual Lisp: [Select]
  1. (defun formatcadrbydigitsback ( lst / cadrnew lstn )
  2.  
  3.   (defun cadrnew ( str / a b )
  4.     (setq a (substr str 1 (vl-string-position 120 str)))
  5.     (setq b (substr str (+ 2 (vl-string-position 120 str))))
  6.     (setq a (itoa (atoi a)))
  7.     (setq b (itoa (atoi b)))
  8.     (strcat a "x" b)
  9.   )
  10.  
  11.   (setq lstn (mapcar '(lambda (x) (list (car x) (cadrnew (cadr x)) (caddr x))) lst))
  12.  
  13. )
  14.  

Code: [Select]
Command: (formatcadrbydigitsback (formatcadrbydigits lst))
(("plywood" "10x17" 5) ("plywood" "10x12" 2) ("plywood" "14x12" 14) ("plywood"
"14x11" 4) ("steel" "4x4" 8) ("beam" "12x12" 9) ("beam" "12x10" 6) ("beam"
"12x7" 3))

M.R.
Title: Re: Sorting a challenge
Post by: ribarm on June 03, 2013, 07:44:13 AM
In case you can't sort it right, remember that you should use this Lee's variant (pre-modified version with (vl-string-subst)) :

Code - Auto/Visual Lisp: [Select]
  1. (defun LM:mysort ( lst )
  2.    (apply 'append
  3.        (mapcar
  4.            (function
  5.                (lambda ( x )
  6.                    (mapcar (function (lambda ( n ) (nth n x)))
  7.                        (vl-sort-i
  8.                            (mapcar
  9.                                (function
  10.                                    (lambda ( x )
  11.                                        (atoi (vl-string-subst "" "x" (cadr x)))
  12.                                    )
  13.                                )
  14.                                x
  15.                            )
  16.                            '<
  17.                        )
  18.                    )
  19.                )
  20.            )
  21.            (LM:GroupByFunction lst
  22.                (lambda ( a b )
  23.                    (= (car a) (car b))
  24.                )
  25.            )
  26.        )
  27.    )
  28. )
  29.  
  30. ;; Group By Function  -  Lee Mac
  31. ;; Groups items considered equal by a given predicate function
  32.  
  33. (defun LM:GroupByFunction ( lst fun / tmp1 tmp2 x1 )
  34.    (if (setq x1 (car lst))
  35.        (progn
  36.            (foreach x2 (cdr lst)
  37.                (if (fun x1 x2)
  38.                    (setq tmp1 (cons x2 tmp1))
  39.                    (setq tmp2 (cons x2 tmp2))
  40.                )
  41.            )
  42.            (cons (cons x1 (reverse tmp1)) (LM:GroupByFunction (reverse tmp2) fun))
  43.        )
  44.    )
  45. )
  46.  

And after you loaded all last 3 codes, use it like this :

Code: [Select]
(formatcadrbydigitsback (LM:mysort (formatcadrbydigits lst)))

Code: [Select]
Command: (formatcadrbydigitsback (LM:mysort (formatcadrbydigits lst)))
(("plywood" "10x12" 2) ("plywood" "10x17" 5) ("plywood" "14x11" 4) ("plywood"
"14x12" 14) ("steel" "4x4" 8) ("beam" "12x7" 3) ("beam" "12x10" 6) ("beam"
"12x12" 9))
Title: Re: Sorting a challenge
Post by: Coder on June 03, 2013, 03:13:06 PM
Thank you guys for the nice work and many examples on the thread .  :-)

I will check them tomorrow and will let you know .

Many thanks .
Title: Re: Sorting a challenge
Post by: Coder on June 05, 2013, 04:14:55 AM
Thank you Lee for the nice work as I used to see .  :-)

And thanks to every one for their participation in the thread .

Great forum . 
Title: Re: Sorting a challenge
Post by: Lee Mac on June 05, 2013, 06:49:50 AM
Thank you Coder  :-)
Title: Re: Sorting a challenge
Post by: ElpanovEvgeniy on June 06, 2013, 10:10:18 AM
my version for revers sort:

Code - Auto/Visual Lisp: [Select]
  1. (vl-sort lst
  2.          (function
  3.            (lambda (a b)
  4.              (or (< (car a) (car b))
  5.                  (and (= (car a) (car b))
  6.                       (>= (read (vl-string-subst "e" "x" (cadr a))) (read (vl-string-subst "e" "x" (cadr b))))
  7.                  )
  8.              )
  9.            )
  10.          )
  11. )
Title: Re: Sorting a challenge
Post by: ElpanovEvgeniy on June 06, 2013, 10:31:10 AM
my version for revers sort:

Code - Auto/Visual Lisp: [Select]
  1. (vl-sort lst
  2.          (function
  3.            (lambda (a b)
  4.              (or (< (car a) (car b))
  5.                  (and (= (car a) (car b))
  6.                       (>= (read (vl-string-subst "e" "x" (cadr a))) (read (vl-string-subst "e" "x" (cadr b))))
  7.                  )
  8.              )
  9.            )
  10.          )
  11. )

oops

Code - Auto/Visual Lisp: [Select]
  1. (("beam" "12x12" 9) ("beam" "12x10" 6) ("beam" "12x7" 3)
  2.  ("plywood" "10x17" 5) ("plywood" "14x12" 14) ("plywood" "10x12" 2) ("plywood" "14x11" 4)
  3.  ("steel" "4x4" 8))
Title: Re: Sorting a challenge
Post by: ElpanovEvgeniy on June 06, 2013, 10:32:36 AM
Code - Auto/Visual Lisp: [Select]
  1. (vl-sort lst
  2.          (function
  3.            (lambda (a b)
  4.              (or (< (car a) (car b))
  5.                  (and (= (car a) (car b))
  6.                       (<= (read (vl-string-subst "e-" "x" (cadr a))) (read (vl-string-subst "e-" "x" (cadr b))))
  7.                  )
  8.              )
  9.            )
  10.          )
  11. )

Code - Auto/Visual Lisp: [Select]
  1. (("beam" "12x12" 9) ("beam" "12x10" 6) ("beam" "12x7" 3)
  2.  ("plywood" "10x17" 5) ("plywood" "10x12" 2) ("plywood" "14x12" 14) ("plywood" "14x11" 4)
  3.  ("steel" "4x4" 8))
Title: Re: Sorting a challenge
Post by: ElpanovEvgeniy on June 06, 2013, 10:34:10 AM
interesting idea, but it does not work ...
Title: Re: Sorting a challenge
Post by: ribarm on June 06, 2013, 01:10:35 PM
Thanks "e-"...

You don't even need (read)

Code - Auto/Visual Lisp: [Select]
  1. (vl-sort lst
  2.         (function
  3.           (lambda (a b)
  4.             (or (< (car a) (car b))
  5.                 (and (= (car a) (car b))
  6.                      (<= (vl-string-subst "" "x" (cadr a)) (vl-string-subst "" "x" (cadr b)))
  7.                 )
  8.             )
  9.           )
  10.         )
  11. )
  12.  
Title: Re: Sorting a challenge
Post by: ribarm on June 08, 2013, 06:31:09 AM
(defun LM:mysort-3 ( l / _sort )
   (defun _sort ( x l a b c / y )
       (cond
           (   (null (setq y (car l)))
               (append (LM:mysort-3 a) (list x) (LM:mysort-3 b) (LM:mysort-3 (reverse c)))
           )
           (   (and (= (car x) (car y)) (= (atoi (cadr x)) (atoi (cadr y))))
               (if (< (atoi (substr (cadr x) (+ 2 (vl-string-position 120 (cadr x)))))
                      (atoi (substr (cadr y) (+ 2 (vl-string-position 120 (cadr y)))))
                   )
                   (_sort x (cdr l) a (cons y b) c)
                   (_sort x (cdr l) (cons y a) b c)
               )
           )
           (   (_sort x (cdr l) a b (cons y c)))
       )
   )
   (if l (_sort (car l) (cdr l) nil nil nil))
)


Why here (reverse)... Just can't figure it up...
No need to answer - just experimenting with code tags...