Topic: Windows Filename Sort

[irneb]

From this thread http://www.theswamp.org/index.php?topic=16564.msg207439
Don't know if I should reply into a 5 year old thread  ... so rather just started a new one.

VVA's code is awesome, just wanted to provide some alternatives ... and perhaps improve its performance a bit. Here's 2 variants:

Code - Auto/Visual Lisp: [Select]

1. (defun SortStringWithNumberAsNumber2  (sLst IgnoreCase /)
2.   (mapcar (function (lambda (idx) (nth idx sLst)))
3.           (vl-sort-i
4.             (mapcar (function (lambda (str / lst tmp)
5.                                 (setq str (vl-string->list (if IgnoreCase (strcase str) str)))
6.                                 (while str
7.                                   (while (and str (> 11 (- (car str) 47) 0))
8.                                     (setq tmp (cons (car str) tmp)
9.                                           str (cdr str)))
10.                                   (if tmp
11.                                     (setq lst (cons (atoi (vl-list->string (reverse tmp))) lst)
12.                                           tmp nil))
13.                                   (while (and str (not (> 11 (- (car str) 47) 0)))
14.                                     (setq tmp (cons (car str) tmp)
15.                                           str (cdr str)))
16.                                   (if tmp
17.                                     (setq lst (cons (vl-list->string (reverse tmp)) lst)
18.                                           tmp nil)))
19.                                 (reverse lst)))
20.                     sLst)
21.             (function (lambda (a b / lst p1 p2)
22.                         (setq lst (mapcar (function (lambda (x y)
23.                                                       (if (= (type x) 'Str) (if (= (type y) 'Str)
24.                                                           (if (< x y) -1 (if (eq x y) 0 1)) 1)
25.                                                         (if (= (type y) 'Str)
26.                                                           -1 (if (< x y) -1 (if (= x y) 0 1))))))
27.                                           a b))
28.                         (and (setq p1 (vl-position -1 lst))
29.                              (or (not (setq p2 (vl-position 1 lst)))
30.                                  (< p1 p2))))))))
31.  
32. (defun SortStringWithNumberAsNumber3  (sLst IgnoreCase / lst maxnum)
33.   (setq lst (mapcar (function (lambda (str / lst tmp)
34.                                 (setq str (vl-string->list (if IgnoreCase (strcase str) str)))
35.                                 (while str
36.                                   (while (and str (> 11 (- (car str) 47) 0))
37.                                     (setq tmp (cons (car str) tmp)
38.                                           str (cdr str)))
39.                                   (if tmp
40.                                     (setq lst (cons (atoi (vl-list->string (reverse tmp))) lst)
41.                                           tmp nil))
42.                                   (while (and str (not (> 11 (- (car str) 47) 0)))
43.                                     (setq tmp (cons (car str) tmp)
44.                                           str (cdr str)))
45.                                   (if tmp
46.                                     (setq lst (cons (vl-list->string (reverse tmp)) lst)
47.                                           tmp nil)))
48.                                 (reverse lst)))
49.                     sLst)
50.         maxnum (strlen (itoa (apply 'max (vl-remove-if-not 'numberp (apply 'append lst))))))
51.   (mapcar (function (lambda (idx) (nth idx sLst)))
52.           (vl-sort-i
53.             (mapcar (function (lambda (item)
54.                                 (apply 'strcat (mapcar
55.                                                  (function (lambda (x / n)
56.                                                              (if (= (type x) 'Str)
57.                                                                x
58.                                                                (progn
59.                                                                  (setq x (itoa x))
60.                                                                  (repeat (- maxnum (strlen x)) (setq x (strcat "0" x)))
61.                                                                  x))))
62.                                                  item))))
63.                     lst)
64.             '<)))

It seems I'm only getting there in my 2nd version:

Code: [Select]

_$ (setq FilesList@ (list "1-C4.dwg" "7-b7.dwg" "11-C4.dwg" "2-b3.dwg" "2-c2.dwg" "22-b2.dwg" "pn374-x9.dwg" "pn374-z9.dwg"
  "Pn375-A10.dwg" "pN375-A9.dwg" "pn375-D1.dwg" "PN375-D10.dwg" "pN375-D2r3.dwg" "pn375-D22.dwg" "qr86-007.dwg" "pN375-DB.dwg"
  "pn375-DB10a.dwg" "PN375-DB9.dwg"))

_$ (benchmark '((SortStringWithNumberAsNumber FilesList@ t) (SortStringWithNumberAsNumber2 FilesList@ t)
  (SortStringWithNumberAsNumber3 FilesList@ t)))
Benchmarking .............Elapsed milliseconds / relative speed for 1024 iteration(s):

    (SORTSTRINGWITHNUMBERASNUMBER3 FILES...).....1310 / 1.18 <fastest>
    (SORTSTRINGWITHNUMBERASNUMBER FILESL...).....1419 / 1.09
    (SORTSTRINGWITHNUMBERASNUMBER2 FILES...).....1545 / 1.00 <slowest>And then only just slightly.

[Lee Mac]

Here is a modification of a function originally written by gile for use in my TabSort program to perform an 'ArchSort', modified for the purposes of this thread:

Code: [Select]

(defun _FileSort ( lst ignorecase / comparable )

    (defun comparable ( e1 e2 )
        (or
            (and (numberp e1) (numberp e2))
            (= 'STR (type e1) (type e2))
        )
    )
   
    (mapcar '(lambda ( x ) (nth x lst))
        (vl-sort-i (mapcar '(lambda ( x ) (_SplitStr x ignorecase)) lst)
            (function
                (lambda ( x1 x2 / n1 n2 comp )
                    (while
                        (and
                            (setq comp (comparable (setq n1 (car x1)) (setq n2 (car x2))))
                            (= n1 n2)
                            (setq x1 (cdr x1))
                            (setq x2 (cdr x2))
                        )
                    )
                    (cond
                        ((null x1))
                        (comp (< n1 n2))
                        ((numberp n1))
                    )
                )
            )
        )
    )
)

(defun _SplitStr ( str ignorecase / lst test rslt num tmp )

    (setq lst  (vl-string->list (if ignorecase (strcase str) str))
          test (chr (car lst))
    )
    (if (< 47 (car lst) 58)
        (setq num T)
    )
    (while (setq lst (cdr lst))
        (if num
            (cond
                (   (= 46 (car lst))
                    (setq rslt (cons (read test) rslt)
                          test nil
                          num  nil
                          lst  nil
                    )
                )
                (   (< 47 (car lst) 58)
                    (setq test (strcat test (chr (car lst))))
                )
                (   t
                    (setq rslt (cons (read test) rslt)
                          test (chr (car lst))
                          num  nil
                    )
                )
            )
            (cond
                (   (= 46 (car lst))
                    (setq rslt (cons test rslt)
                          test nil
                          lst  nil
                    )
                )
                (   (< 47 (car lst) 58)
                    (setq rslt (cons test rslt)
                          test (chr (car lst))
                          num  T
                    )
                )
                (   t
                    (setq test (strcat test (chr (car lst))))
                )
            )
        )
    )
    (cond
        (   num
            (setq rslt (cons (read test) rslt))
        )
        (   test
            (setq rslt (cons test rslt))
        )
    )   
    (reverse rslt)
)
Appears to return the correct result for the given sample list:

Code: [Select]

_$ (equal (_FileSort FilesList@ t) (SortStringWithNumberAsNumber3 FilesList@ t))
T
A quick benchmark:

Code: [Select]

Benchmarking .............Elapsed milliseconds / relative speed for 1024 iteration(s):

    (_FILESORT FILESLIST@ T).....................1124 / 1.64 <fastest>
    (SORTSTRINGWITHNUMBERASNUMBER3 FILES...).....1420 / 1.3
    (SORTSTRINGWITHNUMBERASNUMBER FILESL...).....1841 / 1 <slowest>

[Lee Mac]

Combining techniques from both functions and optimising Irneb's string separation loop:

Code: [Select]

(defun _FileSort2 ( lst ignorecase / comparable )

    (defun comparable ( e1 e2 )
        (or
            (and (numberp e1) (numberp e2))
            (= 'STR (type e1) (type e2))
        )
    )
   
    (mapcar '(lambda ( x ) (nth x lst))
        (vl-sort-i
            (mapcar
                (function
                    (lambda ( str / lst rslt tmp )
                        (setq lst (vl-string->list (if ignorecase (strcase str) str)))
                        (while lst
                            (if (= 46 (car lst))
                                (setq lst nil)
                            )
                            (while (< 47 (car lst) 58)
                                (setq tmp (cons (car lst) tmp)
                                      lst (cdr lst)
                                )
                            )
                            (if tmp
                                (setq rslt (cons (atoi (vl-list->string (reverse tmp))) rslt)
                                      tmp nil
                                )
                            )
                            (while (and lst (not (< 45 (car lst) 58)))
                                (setq tmp (cons (car lst) tmp)
                                      lst (cdr lst)
                                )
                            )
                            (if tmp
                                (setq rslt (cons (vl-list->string (reverse tmp)) rslt)
                                      tmp nil
                                )
                            )
                        )
                        (reverse rslt)
                    )
                )
                lst
            )
            (function
                (lambda ( x1 x2 / n1 n2 comp )
                    (while
                        (and
                            (setq comp (comparable (setq n1 (car x1)) (setq n2 (car x2))))
                            (= n1 n2)
                            (setq x1 (cdr x1))
                            (setq x2 (cdr x2))
                        )
                    )
                    (cond
                        ((null x1))
                        (comp (< n1 n2))
                        ((numberp n1))
                    )
                )
            )
        )
    )
)
Verification:

Code: [Select]

_$ (equal (_FileSort FilesList@ t) (_FileSort2 FilesList@ t))
T
Result:

Code: [Select]

Benchmarking ..............Elapsed milliseconds / relative speed for 2048 iteration(s):

    (_FILESORT2 FILESLIST@ T)....................1904 / 2.1 <fastest>
    (_FILESORT FILESLIST@ T).....................2418 / 1.65
    (SORTSTRINGWITHNUMBERASNUMBER3 FILES...).....2932 / 1.36
    (SORTSTRINGWITHNUMBERASNUMBER FILESL...).....3994 / 1 <slowest>

[irneb]

Thanks Lee, those are really shaving some fractions off the time! 

[ElpanovEvgeniy]

my version:

Code - Auto/Visual Lisp: [Select]

1. (defun eea-str_int_sort (l f)
2.   (mapcar (function (lambda (a) (nth a l)))
3.           (vl-sort-i (if f
4.                        (mapcar (function strcase) l)
5.                        l
6.                      )
7.                      (function (lambda (a b / i)
8.                                  (setq i (vl-string-mismatch a b))
9.                                  (if (= i 0)
10.                                    (if (and (< 47 (vl-string-elt a i) 58) (< 47 (vl-string-elt b i) 58))
11.                                      (< (atoi a) (atoi b))
12.                                      (< a b)
13.                                    )
14.                                    (if (or (< 47 (vl-string-elt a i) 58) (< 47 (vl-string-elt b i) 58))
15.                                      (if (< 47 (vl-string-elt a (1- i)) 58)
16.                                        (< (atoi (substr a i)) (atoi (substr b i)))
17.                                        (if (and (< 47 (vl-string-elt a i) 58) (< 47 (vl-string-elt b i) 58))
18.                                          (< (atoi (substr a (1+ i))) (atoi (substr b (1+ i))))
19.                                          (< a b)
20.                                        )
21.                                      )
22.                                      (< a b)
23.                                    )
24.                                  )
25.                                )
26.                      )
27.           )
28.   )
29. )

Result:

Code: [Select]

Benchmarking ................Elapsed milliseconds / relative speed for 8192 iteration(s):

    (EEA-STR_INT_SORT L T)..................1638 / 5.49 <fastest>
    (_FILESORT2 L T)........................5288 / 1.7
    (_FILESORT L T).........................6147 / 1.46
    (SORTSTRINGWITHNUMBERASNUMBER3 L T).....7083 / 1.27
    (SORTSTRINGWITHNUMBERASNUMBER2 L T).....8985 / 1 <slowest>

 

[ElpanovEvgeniy]

 

Code: [Select]

(equal (SORTSTRINGWITHNUMBERASNUMBER3 l t) (SORTSTRINGWITHNUMBERASNUMBER2 l t)) >> nil

[Lee Mac]

Code: [Select]

    (EEA-STR_INT_SORT L T)..................1638 / 5.49 <fastest>
    (_FILESORT2 L T)........................5288 / 1.7

I wouldn't expect anything less of you Evgeniy 

Time for me to study I think!

[Lee Mac]

And just when I thought I'd used every Visual LISP function...

Code - Auto/Visual Lisp: [Select]

1. (vl-string-mismatch a b)

You find one I didn't know about 

[ElpanovEvgeniy]

Maybe you do even faster!
I did not achieve maximum speed, I tested just the right job...

[ElpanovEvgeniy]

And just when I thought I'd used every Visual LISP function...

Code - Auto/Visual Lisp: [Select]

1. (vl-string-mismatch a b)

You find one I didn't know about 

I also rarely need this function 

[Lee Mac]

Maybe you do even faster!
I did not achieve maximum speed, I tested just the right job...

A slight variation in the logic:

Code - Auto/Visual Lisp: [Select]

1. (defun eea-str_int_sort2 ( l f )
2.     (mapcar (function (lambda ( a ) (nth a l)))
3.         (vl-sort-i (if f (mapcar (function strcase) l) l)
4.             (function
5.                 (lambda ( a b / i )
6.                     (cond
7.                         (   (zerop (setq i (vl-string-mismatch a b)))
8.                             (if (and (< 47 (ascii a) 58) (< 47 (ascii b) 58))
9.                                 (< (atoi a) (atoi b))
10.                                 (< a b)
11.                             )
12.                         )
13.                         (   (and
14.                                 (< 47 (vl-string-elt a i) 58)
15.                                 (< 47 (vl-string-elt b i) 58)
16.                             )
17.                             (< (atoi (substr a (1+ i))) (atoi (substr b (1+ i))))
18.                         )
19.                         (   (< 47 (vl-string-elt a (1- i)) 58)
20.                             (< (atoi (substr a i)) (atoi (substr b i)))
21.                         )
22.                         (   (< a b))
23.                     )
24.                 )
25.             )
26.         )
27.     )
28. )

Code: [Select]

Benchmarking ...............Elapsed milliseconds / relative speed for 4096 iteration(s):

    (EEA-STR_INT_SORT2 L T).....1139 / 1.03 <fastest>
    (EEA-STR_INT_SORT L T)......1170 / 1 <slowest>

[ElpanovEvgeniy]

Congratulations!
I do not doubt that you will quickly improve my code