Use sorting the inner list.

January 5, 2016

I found the code Lee Mac.

;; Alphanumerical Sort  -  Lee Mac
;; Sorts a list of strings containing a combination of alphabetical & numerical characters.

(defun LM:alphanumsort ( lst )
   (mapcar (function (lambda ( n ) (nth n lst)))
       (vl-sort-i (mapcar 'LM:splitstring lst)
           (function
               (lambda ( a b / x y )
                   (while
                       (and
                           (setq x (car a))
                           (setq y (car b))
                           (= x y)
                       )
                       (setq a (cdr a)
                             b (cdr b)
                       )
                   )
                   (cond
                       (   (null x) b)
                       (   (null y) nil)
                       (   (and (numberp x) (numberp y)) (< x y))
                       (   (numberp x))
                       (   (numberp y) nil)
                       (   (< x y))
                   )
               )
           )
       )
   )
)

;; Split String  -  Lee Mac
;; Splits a string into a list of text and numbers

(defun LM:splitstring ( str )
   (
       (lambda ( l )
           (read
               (strcat "("
                   (vl-list->string
                       (apply 'append
                           (mapcar
                               (function
                                   (lambda ( a b c )
                                       (cond
                                           (   (= 92 b)
                                               (list 32 34 92 b 34 32)
                                           )
                                           (   (or (< 47 b 58)
                                                   (and (= 45 b) (< 47 c 58) (not (< 47 a 58)))
                                                   (and (= 46 b) (< 47 a 58) (< 47 c 58))
                                               )
                                               (list b)
                                           )
                                           (   (list 32 34 b 34 32))
                                       )
                                   )
                               )
                               (cons nil l) l (append (cdr l) '(( )))
                           )
                       )
                   )
                   ")"
               )
           )
       )
       (vl-string->list str)
   )
)

At this forum.

http://www.theswamp.org/index.php?PHPSESSID=fn7e95qsp4cg4oco9vgbvqr1l0&topic=16564.15

How to use this function to sort the list

'(("a" 12 2) ("z" 6 3) ("f" 8 1) ("3" 2 1))

January 5, 2016

I assume you are looking to sort the sublists within the main list, whilst retaining the order of the items within each sublist?

January 5, 2016

List:

'(("a" 12 2) ("z" 6 3) ("f" 8 1) ("3" 2 1))

Result:

'(("3" 2 1) ("a" 12 2) ("f" 8 1) ("z" 6 3))

January 5, 2016

And for identical first elements, this?

'(("a" 12 2) ("z" 6 3) ("a" 5 3) ("f" 8 1) ("a" 5 1) ("3" 2 1))

'(("3" 2 1) ("a" 5 1) ("a" 5 3) ("a" 12 2) ("f" 8 1) ("z" 6 3))

January 5, 2016

The first element is always unique.

Of course, only in my list.

January 5, 2016

For unique first elements, you could use the following:

(defun mysort ( l )
   (vl-sort l
      '(lambda ( a b )
           (cond
               (   (numberp (read (car a))))
               (   (numberp (read (car b))) nil)
               (   (< (car a) (car b)))
           )
       )
   )
)

September 23, 2016

This function sorts so:

List:

(("1" 2 2) ("2" 3 3) ("8" 4 4) ("10" 4 4) ("c11" 5 5) ("c1" 2 2) ("c2" 3 3) ("c8" 4 4) ("c10" 4 4))

Result:

(("10" 4 4) ("8" 4 4) ("2" 3 3) ("1" 2 2) ("c1" 2 2) ("c10" 4 4) ("c11" 5 5) ("c2" 3 3) ("c8" 4 4))

Please change the code to sort the like:

(("1" 2 2) ("2" 3 3) ("8" 4 4) ("10" 4 4) ("c1" 2 2) ("c2" 3 3) ("c8" 4 4) ("c10" 4 4) ("c11" 5 5))

September 23, 2016

And thats when I remembered this:

Strings are sorted by character using the ASCII character code, which may lead to unexpected results:
_$ (vl-sort '("1" "4" "11" "2" "6" "101") '<)
("1" "101" "11" "2" "4" "6")

September 23, 2016

(defun mysort-1 ( l / asciieval evalstrnum )

 (defun asciieval ( s1 )
   (if (vl-position s1 '("0" "1" "2" "3" "4" "5" "6" "7" "8" "9"))
     (* (1+ (vl-position s1 '("0" "1" "2" "3" "4" "5" "6" "7" "8" "9"))) 1e-10)
     (ascii s1)
   )
 )

 (defun evalstrnum ( s / ss ssl k n )
   (while (and (setq ss (substr s 1 1)) (/= ss ""))
     (setq s (substr s 2))
     (setq ssl (cons ss ssl))
   )
   (setq k 0 n 0)
   (foreach s1 ssl
     (setq k (1+ k))
     (setq n (+ n (* (asciieval s1) (expt 10 k))))
   )
   n
 )

 (vl-sort l
   (function
     (lambda ( a b ) 
       (if (= (strlen (car a)) (strlen (car b)))
         (< (evalstrnum (car a)) (evalstrnum (car b)))
         (< (strlen (car a)) (strlen (car b)))
       )
     )
   )
 )
)

;;; (setq l '(("1" 2 2) ("10" 3 3) ("100" 4 4) ("1000" 4 4) ("c1" 5 5) ("c10" 2 2) ("c100" 3 3) ("c1000" 4 4)))
;;; (mysort-1 l) => (("1" 2 2) ("10" 3 3) ("100" 4 4) ("1000" 4 4) ("c1" 5 5) ("c10" 2 2) ("c100" 3 3) ("c1000" 4 4))

;;; (setq l '(("1" 2 2) ("2" 3 3) ("8" 4 4) ("10" 4 4) ("c11" 5 5) ("c1" 2 2) ("c2" 3 3) ("c8" 4 4) ("c10" 4 4) ("c1c" 3 3) ("cc1" 5 5) ("c51" 2 2) ("ac1" 8 ))
;;; (mysort-1 l) => (("1" 2 2) ("2" 3 3) ("8" 4 4) ("10" 4 4) ("c1" 2 2) ("c2" 3 3) ("c8" 4 4) ("c10" 4 4) ("c11" 5 5) ("c51" 2 2) ("c1c" 3 3) ("ac1" 8  ("cc1" 5 5))

Edited September 24, 2016 by marko_ribar

September 24, 2016

@ Marko in your result "c1c" comes after "c51". I wonder if that is logical.

September 24, 2016

By changing my Alphanumerical Sort function from the first post to the equivalent of vl-sort-i (i.e. returning item indices), you can construct the following to sort your list:

(defun mysort ( lst )
   (mapcar '(lambda ( n ) (nth n lst)) (LM:alphanumsort-i (mapcar 'car lst)))
)

;; Alphanumerical Sort-i  -  Lee Mac
;; Sorts a list of strings containing a combination of alphabetical & numerical characters and returns the indices.

(defun LM:alphanumsort-i ( lst )
   (vl-sort-i (mapcar 'LM:splitstring lst)
       (function
           (lambda ( a b / x y )
               (while
                   (and
                       (setq x (car a))
                       (setq y (car b))
                       (= x y)
                   )
                   (setq a (cdr a)
                         b (cdr b)
                   )
               )
               (cond
                   (   (null x) b)
                   (   (null y) nil)
                   (   (and (numberp x) (numberp y)) (< x y))
                   (   (numberp x))
                   (   (numberp y) nil)
                   (   (< x y))
               )
           )
       )
   )
)

;; Split String  -  Lee Mac
;; Splits a string into a list of text and numbers

(defun LM:splitstring ( str )
   (
       (lambda ( l )
           (read
               (strcat "("
                   (vl-list->string
                       (apply 'append
                           (mapcar
                               (function
                                   (lambda ( a b c )
                                       (cond
                                           (   (= 92 b)
                                               (list 32 34 92 b 34 32)
                                           )
                                           (   (or (< 47 b 58)
                                                  ;(and (= 45 b) (< 47 c 58) (not (< 47 a 58)))
                                                   (and (= 46 b) (< 47 a 58) (< 47 c 58))
                                               )
                                               (list b)
                                           )
                                           (   (list 32 34 b 34 32))
                                       )
                                   )
                               )
                               (cons nil l) l (append (cdr l) '(( )))
                           )
                       )
                   )
                   ")"
               )
           )
       )
       (vl-string->list str)
   )
)

_$ (mysort '(("10" 4 4) ("8" 4 4) ("2" 3 3) ("1" 2 2) ("c1" 2 2) ("c10" 4 4) ("c11" 5 5) ("c2" 3 3) ("c8" 4 4)))
(("1" 2 2) ("2" 3 3) ("8" 4 4) ("10" 4 4) ("c1" 2 2) ("c2" 3 3) ("c8" 4 4) ("c10" 4 4) ("c11" 5 5))

September 24, 2016

@ Marko in your result "c1c" comes after "c51". I wonder if that is logical.

In my opinion yes it is logical : My sorting is separately considering numbers and letters... I wrote sorting so that numbers have higher priority then letters, so first come "c51" and then "c1c" as "51"

September 24, 2016

Here, just for Roy's wish version :

(defun mysort-2 ( l / asciieval evalstrnum )

 (defun asciieval ( s1 )
   (if (vl-position s1 '("0" "1" "2" "3" "4" "5" "6" "7" "8" "9"))
     (* (1+ (vl-position s1 '("0" "1" "2" "3" "4" "5" "6" "7" "8" "9"))) 0.09)
     (* (ascii s1) 0.01)
   )
 )

 (defun evalstrnum ( s / ss ssl k n )
   (while (and (setq ss (substr s 1 1)) (/= ss ""))
     (setq s (substr s 2))
     (setq ssl (cons ss ssl))
   )
   (setq k 0 n 0)
   (foreach s1 ssl
     (setq k (1+ k))
     (setq n (+ n (* (asciieval s1) (expt 10 k))))
   )
   n
 )

 (vl-sort l
   (function
     (lambda ( a b ) 
       (if (= (strlen (car a)) (strlen (car b)))
         (< (evalstrnum (car a)) (evalstrnum (car b)))
         (< (strlen (car a)) (strlen (car b)))
       )
     )
   )
 )
)

;;; (setq l '(("1" 2 2) ("10" 3 3) ("100" 4 4) ("1000" 4 4) ("c1" 5 5) ("c10" 2 2) ("c100" 3 3) ("c1000" 4 4)))
;;; (mysort-2 l) => (("1" 2 2) ("10" 3 3) ("c1" 5 5) ("100" 4 4) ("c10" 2 2) ("1000" 4 4) ("c100" 3 3) ("c1000" 4 4))

;;; (setq l '(("1" 2 2) ("2" 3 3) ("8" 4 4) ("10" 4 4) ("c11" 5 5) ("c1" 2 2) ("c2" 3 3) ("c8" 4 4) ("c10" 4 4) ("c1c" 3 3) ("cc1" 5 5) ("c51" 2 2) ("ac1" 8 ))
;;; (mysort-2 l) => (("1" 2 2) ("2" 3 3) ("8" 4 4) ("10" 4 4) ("c1" 2 2) ("c2" 3 3) ("c8" 4 4) ("c10" 4 4) ("c11" 5 5) ("c1c" 3 3) ("c51" 2 2) ("ac1" 8  ("cc1" 5 5))

M.R.

Edited September 24, 2016 by marko_ribar

September 24, 2016

_$ (mysort-2 (mapcar 'list '("1" "10" "100" "1000" "c1" "c10" "c100")))
(("1") ("10") ("c1") ("100") ("c10") ("1000") ("c100"))

September 24, 2016

_$ (mysort-2 (mapcar 'list '("1" "10" "100" "1000" "c1" "c10" "c100")))
(("1") ("10") ("c1") ("100") ("c10") ("1000") ("c100"))

But that's OK, isn't it? Are you suggesting that it shouldn't sort anything - original list order?

September 24, 2016

(defun mysort-3 ( l / asciieval evalstrnum )

 (defun asciieval ( s1 )
   (if (vl-position s1 '("0" "1" "2" "3" "4" "5" "6" "7" "8" "9"))
     (* (1+ (vl-position s1 '("0" "1" "2" "3" "4" "5" "6" "7" "8" "9"))) 1e-10)
     (ascii s1)
   )
 )

 (defun evalstrnum ( s / ss ssl k n )
   (while (and (setq ss (substr s 1 1)) (/= ss ""))
     (setq s (substr s 2))
     (setq ssl (cons ss ssl))
   )
   (setq k 0 n 0)
   (foreach s1 ssl
     (setq k (1+ k))
     (setq n (+ n (* (asciieval s1) (expt 10 k))))
   )
   n
 )

 (vl-sort l
   (function
     (lambda ( a b ) 
       (< (evalstrnum (car a)) (evalstrnum (car b)))
     )
   )
 )
)

;;; (setq l '(("1" 2 2) ("10" 3 3) ("100" 4 4) ("1000" 4 4) ("c1" 5 5) ("c10" 2 2) ("c100" 3 3) ("c1000" 4 4)))
;;; (mysort-3 l) => (("1" 2 2) ("10" 3 3) ("100" 4 4) ("1000" 4 4) ("c1" 5 5) ("c10" 2 2) ("c100" 3 3) ("c1000" 4 4))

;;; (setq l '(("1" 2 2) ("2" 3 3) ("8" 4 4) ("10" 4 4) ("c11" 5 5) ("c1" 2 2) ("c2" 3 3) ("c8" 4 4) ("c10" 4 4) ("c1c" 3 3) ("cc1" 5 5) ("c51" 2 2) ("ac1" 8 ))
;;; (mysort-3 l) => (("1" 2 2) ("2" 3 3) ("8" 4 4) ("10" 4 4) ("c1" 2 2) ("c2" 3 3) ("c8" 4 4) ("c10" 4 4) ("c11" 5 5) ("c51" 2 2) ("c1c" 3 3) ("ac1" 8  ("cc1" 5 5))

;;; here is unclear : "c51" < "c1c" - correct - back to Roy's remark ?

Lee's code :

;;; (setq l '(("1" 2 2) ("10" 3 3) ("100" 4 4) ("1000" 4 4) ("c1" 5 5) ("c10" 2 2) ("c100" 3 3) ("c1000" 4 4)))
;;; (mysort l) => (("1" 2 2) ("10" 3 3) ("100" 4 4) ("1000" 4 4) ("c1" 5 5) ("c10" 2 2) ("c100" 3 3) ("c1000" 4 4))

;;; (setq l '(("1" 2 2) ("2" 3 3) ("8" 4 4) ("10" 4 4) ("c11" 5 5) ("c1" 2 2) ("c2" 3 3) ("c8" 4 4) ("c10" 4 4) ("c1c" 3 3) ("cc1" 5 5) ("c51" 2 2) ("ac1" 8 ))
;;; (mysort l) => (("1" 2 2) ("2" 3 3) ("8" 4 4) ("10" 4 4) ("ac1" 8  ("c1" 2 2) ("c1c" 3 3) ("c2" 3 3) ("c8" 4 4) ("c10" 4 4) ("c11" 5 5) ("c51" 2 2) ("cc1" 5 5))

;;; here is unclear : "c1c" < "c10" - correct ?

September 24, 2016

My attempt:

; (KGA_String_SliceChrSet "abc123cde456fgh789" "0123456789") => ("abc" "123" "cde" "456" "fgh" "789")
(defun KGA_String_SliceChrSet (str chrSet / ret sub)
 (setq chrSet (vl-string->list chrSet))
 (mapcar
   '(lambda (cur nxt / chk)
     (setq chk (list (and (vl-position cur chrSet)) (and (vl-position nxt chrSet))))
     (if (or (equal chk '(T T)) (equal chk '(nil nil)))
       (setq sub (cons cur sub))
       (progn
         (setq ret (cons (vl-list->string (reverse (cons cur sub))) ret))
         (setq sub nil)
       )
     )
   )
   (setq str (vl-string->list str))
   (append (cdr str) '(nil))
 )
 (reverse ret)
)

(defun MySort (lst)
 (setq lst
   (mapcar
     '(lambda (sub) (list (KGA_String_SliceChrSet (car sub) "0123456789") sub))
     lst
   )
 )
 (mapcar
   'cadr
   (vl-sort
     lst
     '(lambda (a b)
       (setq a (car a))
       (setq b (car b))
       (while
         (and
           (car a)
           (car b)
           (= (car a) (car b))
         )
         (setq a (cdr a))
         (setq b (cdr b))
       )
       (if
         (and
           (car a)
           (car b)
           (wcmatch (car a) "#*")
           (wcmatch (car b) "#*")
         )
         (< (atoi (car a)) (atoi (car b)))
         (< (car a) (car b))
       )
     )
   )
 )
)

September 24, 2016

IMO:

"c1"

September 24, 2016

@Roy : I think this is what should it be at the end...

(defun sort ( l )
 (mapcar '(lambda ( x ) (assoc x l)) (mysort-4 (mapcar 'car l)))
)

(defun mysort-4 ( l / asciieval evalstrnum letterspositionsstr removenth massoc groupbyletterspositions g ll )

 (defun asciieval ( s1 )
   (if (vl-position s1 '("0" "1" "2" "3" "4" "5" "6" "7" "8" "9"))
     (* (1+ (vl-position s1 '("0" "1" "2" "3" "4" "5" "6" "7" "8" "9"))) 0.09)
     (* (ascii s1) 0.01)
   )
 )

 (defun evalstrnum ( s / ss ssl k n )
   (while (and (setq ss (substr s 1 1)) (/= ss ""))
     (setq s (substr s 2))
     (setq ssl (cons ss ssl))
   )
   (setq k 0 n 0)
   (foreach s1 ssl
     (setq k (1+ k))
     (setq n (+ n (* (asciieval s1) (expt 10 k))))
   )
   n
 )

 (defun letterspositionsstr ( s / str ss ssl sll sss k f pl )
   (setq str s)
   (while (and (setq ss (substr s 1 1)) (/= ss ""))
     (setq s (substr s 2))
     (setq ssl (cons ss ssl))
   )
   (setq ssl (reverse ssl))
   (setq sss ssl)
   (foreach n '("0" "1" "2" "3" "4" "5" "6" "7" "8" "9")
     (setq sss (vl-remove n sss))
   )
   (setq sll ssl)
   (foreach s1 sss
     (if (null k)
       (setq k -1)
     )
     (while (setq ss (car ssl))
       (if (null f)
         (setq k (1+ k))
       )
       (if (and (null f) (= s1 ss))
         (setq pl (cons k pl) f t)
       )
       (setq ssl (cdr ssl))
     )
     (setq ssl (cdr (member s1 sll)) f nil)
   )
   (cons (reverse pl) (list str))
 )

 (defun removenth ( n l / k ll )
   (setq k -1)
   (foreach i l
     (setq k (1+ k))
     (if (/= k n)
       (setq ll (cons i ll))
     )
   )
   (reverse ll)
 )

 (defun massoc ( key lst / i nlst )
   (while (setq i (assoc key lst))
     (setq nlst (cons i nlst))
     (setq lst (removenth (vl-position i lst) lst))
   )
   nlst
 )

 (defun groupbyletterspositions ( l / ll i lll llll )
   (setq ll (mapcar 'letterspositionsstr l))
   (while (setq i (car ll))
     (setq lll (massoc (car i) ll))
     (foreach ii lll
       (setq ll (removenth (vl-position ii ll) ll))
     )
     (setq llll (cons lll llll))
   )
   (vl-sort llll
     (function
       (lambda ( a b / k m )
         (if (= (length (caar a)) (length (caar b)))
           (progn
             (setq k 0 m 0)
             (> (apply '+ (mapcar '(lambda ( x ) (* x (expt 10 (setq k (1+ k))))) (reverse (caar a)))) (apply '+ (mapcar '(lambda ( x ) (* x (expt 10 (setq m (1+ m))))) (reverse (caar b)))))
           )
           (< (length (caar a)) (length (caar b)))
         )
       )
     )
   )
 )

 (foreach g (groupbyletterspositions l)
   (setq g
     (vl-sort (apply 'append (mapcar 'cdr g))
       (function
         (lambda ( a b ) 
           (< (evalstrnum a) (evalstrnum b))
         )
       )
     )
   )
   (setq ll (cons g ll))
 )
 (apply 'append (reverse ll))
)

;;; (setq l '(("1" 2 2) ("10" 3 3) ("100" 4 4) ("1000" 4 4) ("c1" 5 5) ("c10" 2 2) ("c100" 3 3) ("c1000" 4 4)))
;;; (sort l) => (("1" 2 2) ("10" 3 3) ("100" 4 4) ("1000" 4 4) ("c1" 5 5) ("c10" 2 2) ("c100" 3 3) ("c1000" 4 4))

;;; (setq l '(("1" 2 2) ("2" 3 3) ("8" 4 4) ("10" 4 4) ("c11" 5 5) ("c1" 2 2) ("c2" 3 3) ("c8" 4 4) ("c10" 4 4) ("c1c" 3 3) ("cc1" 5 5) ("c51" 2 2) ("ac1" 8 ))
;;; (sort l) => (("1" 2 2) ("2" 3 3) ("8" 4 4) ("10" 4 4) ("c1" 2 2) ("c2" 3 3) ("c8" 4 4) ("c10" 4 4) ("c11" 5 5) ("c51" 2 2) ("c1c" 3 3) ("ac1" 8  ("cc1" 5 5))

M.R.

Edited September 25, 2016 by marko_ribar

September 24, 2016

@Roy:

_$ (KGA_String_SliceChrSet "abc" "0123456789")
nil

Hence:

_$ (MySort (mapcar 'list '("1b" "1a" "1c")))
(("1b") ("1a") ("1c"))

Sign In

Use sorting the inner list.

Recommended Posts

Kowal

Top Posters In This Topic

Popular Days

Top Posters In This Topic

Popular Days

Lee Mac

Kowal

Lee Mac

Kowal

Lee Mac

Kowal

Grrr

marko_ribar

Roy_043

Lee Mac

marko_ribar

marko_ribar

Lee Mac

marko_ribar

marko_ribar

Roy_043

Roy_043

marko_ribar

Lee Mac

Join the conversation

Tutorials

Forums

Activity