Author Topic: Search of Windows type Sort function  (Read 8821 times)

0 Members and 1 Guest are viewing this topic.

terrycadd

  • Guest
Search of Windows type Sort function
« on: May 16, 2007, 04:18:40 PM »
Ive searched the forum for a sort function that sorts a list of files or part numbers the way windows sorts filenames. I didnt have any luck, but I did find some very useful utilities, such as getdir by ronjonp.
The vl-directory-files functions sorts the files the same way that acad_strlsort would sort these filenames in a list.  Example:
(setq FileList@ (vl-directory-files Foldername$ "*.dwg" 1))
(setq SortList@ (acad_strlsort FileList@))
Both return the following list:
(list PN375-A10.dwg
      PN375-A9.dwg
      PN375-D1.dwg
      PN375-D10.dwg
      PN375-D14.dwg
      PN375-D2.dwg
      PN375-D22.dwg
      PN375-D7r3.dwg
      PN375-DB.dwg
      PN375-DB10a.dwg
      PN375-DB9.dwg)
The order that Im wanting is:
(list PN375-A9.dwg
      PN375-A10.dwg
      PN375-D1.dwg
      PN375-D2.dwg
      PN375-D7r3.dwg
      PN375-D10.dwg
      PN375-D14.dwg
      PN375-D22.dwg
      PN375-DB9.dwg
      PN375-DB10a.dwg
      PN375-DB.dwg)
I can see the unique groups of PN375-A, PN375-D, PN375-DB. The sort is then based on the numbers that follow the unique groups.
If I missed this topic in my search, please point me to the right thread.
Thanks,
Terry
« Last Edit: May 17, 2007, 10:27:49 AM by Terry Cadd »

VVA

  • Newt
  • Posts: 166
Re: Search of Windows type Sort function
« Reply #1 on: May 17, 2007, 08:14:11 AM »
Try It
Code: [Select]
;;Usage (SortStringWithNumberAsNumber '("A9" "A1" "A10" "B11" "B2" "B05"))
;;Return ("A1" "A9" "A10" "B2" "B05" "B11")
(defun SortStringWithNumberAsNumber (ListOfString)
;;;Function Normalize (add 0 befor number) number in string
;;; Count normalize symbols set in variable count
  (defun NormalizeNumberInString (str / ch i pat ret count buf)
    (setq i     0
          pat   '("0" "1" "2" "3" "4" "5" "6" "7" "8" "9")
          ret   ""
          count 4 ;_Count normalize symbols
    ) ;_ end of setq
    (while (/= (setq ch (substr str (setq i (1+ i)) 1)) "")
      (if (vl-position ch pat)
        (progn
          (setq buf ch) ;_ end of setq
          (while
            (vl-position (setq ch (substr str (setq i (1+ i)) 1)) pat)
             (setq buf (strcat buf ch))
          ) ;_ end of while
          (while (< (strlen buf) count) (setq buf (strcat "0" buf)))
          (setq ret (strcat ret buf))
        ) ;_ end of progn
      ) ;_ end of if
      (setq ret (strcat ret ch))
    ) ;_ end of while
    ret
  ) ;_ end of defun
  (vl-load-com)
  (mapcar '(lambda (x) (nth x ListOfString))
          (vl-sort-i (mapcar 'NormalizeNumberInString ListOfString)
                     '<
          ) ;_ end of VL-SORT-I
  ) ;_ end of mapcar
) ;_ end of defun
Usage
Code: [Select]
(setq lst (list "PN375-A10.dwg"
      "PN375-A9.dwg"
      "PN375-A04.dwg"
      "PN375-A555.dwg"               
      "PN375-D1.dwg"
      "PN375-D10.dwg"
      "PN375-D14.dwg"
      "PN375-D2.dwg"
      "PN375-D22.dwg"
      "PN375-D7r3.dwg"
      "PN375-DB.dwg"
      "PN375-DB10a.dwg"
      "PN375-DB9.dwg"))

(mapcar '(lambda(x)(terpri)(princ x))
        (SortStringWithNumberAsNumber lst))
Return
PN375-A04.dwg
PN375-A9.dwg
PN375-A10.dwg
PN375-A555.dwg
PN375-D1.dwg
PN375-D2.dwg
PN375-D7r3.dwg
PN375-D10.dwg
PN375-D14.dwg
PN375-D22.dwg
PN375-DB.dwg
PN375-DB9.dwg
PN375-DB10a.dwg


mkweaver

  • Bull Frog
  • Posts: 344
Re: Search of Windows type Sort function
« Reply #2 on: May 17, 2007, 08:45:37 AM »
Very nice!  Saved to my library.

Thanks,
Mike

CAB

  • Global Moderator
  • Seagull
  • Posts: 10339
Re: Search of Windows type Sort function
« Reply #3 on: May 17, 2007, 02:33:17 PM »
Excellent, I like it too.
 :-)
I've reached the age where the happy hour is a nap. ()
Windows 10 core i7 4790k 4Ghz 32GB GTX 970
Please support this web site.

GDF

  • Water Moccasin
  • Posts: 1982
Re: Search of Windows type Sort function
« Reply #4 on: May 17, 2007, 02:41:55 PM »
Kool

Like it...
Why is there never enough time to do it right, but always enough time to do it over?
BricsCAD 2019x64 Windows 10x64

terrycadd

  • Guest
Re: Search of Windows type Sort function
« Reply #5 on: May 18, 2007, 04:28:29 PM »
I just completed win_sort.  It was quite a challenge for a Newt with only 52 postings.  I also attached dependant files, number_sort, change_nth and delete_nth.  The win_sort function sorts a list of strings very similar to the way Windows sorts files in folders.  It may be used to display filenames in a dialog list, and may also be used in a plot script function to plot a folder of drawings in the Windows sorted order other than just the acad_strlsort order.  This is my first version, and it is a bit lengthy.  You are welcomed and challenged to find a shorter way to accomplish its tasks. 

Here are the results of the following functions using the FilesList@ for a test run.

(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"))

SortStringWithNumberAsNumber  win_sort
          1-C4.dwg                      1-C4.dwg
          2-b3.dwg                      2-b3.dwg
          2-c2.dwg                      2-c2.dwg
          7-b7.dwg                      7-b7.dwg
          11-C4.dwg                    11-C4.dwg
          22-b2.dwg                     22-b2.dwg
          PN375-D10.dwg              pn374-x9.dwg
          PN375-DB9.dwg              pn374-z9.dwg
          Pn375-A10.dwg              pN375-A9.dwg
          pN375-A9.dwg                Pn375-A10.dwg
          pN375-D2r3.dwg             pn375-D1.dwg
          pN375-DB.dwg                pN375-D2r3.dwg
          pn374-x9.dwg                PN375-D10.dwg
          pn374-z9.dwg                pn375-D22.dwg
          pn375-D1.dwg                pN375-DB.dwg
          pn375-D22.dwg              PN375-DB9.dwg
          pn375-DB10a.dwg           pn375-DB10a.dwg
          qr86-007.dwg                 qr86-007.dwg
Code: [Select]
;-------------------------------------------------------------------------------
; win_sort - Windows type of sort function
; Arguments: 1
;   List@ = List of strings or filenames
; Returns: List of strings sorted similar to how Windows sorts files
;-------------------------------------------------------------------------------
(defun win_sort (Original@ / AlphaSort@ Cnt# Compare$ First Item List@ Loop
  Next$ Num# NumSort@ NumStrings@ Passed Prefix$ Prefixes@ PrefixList@
  PrefixSort@ Previous$ SortLenghts@ SortList@ Str$)
  (setq Passed t)
  (if (= (type Original@) 'LIST)
    (foreach Item Original@ (if (/= (type Item) 'STR) (setq Passed nil)))
    (setq Passed nil)
  );if
  (if (not Passed)
    (progn (princ "\nUsage: (win_sort <list of strings>)") (exit))
  );if
  (setq Original@ (acad_strlsort Original@))
  (setq AlphaSort@ (mapcar 'strcase Original@))
  (setq Num# 0 Next$ (chr 160));a unique character
  (repeat (length AlphaSort@)
    (setq Previous$ Next$
          Next$ (nth Num# AlphaSort@)
          Prefix$ nil
          Cnt# 1
    );setq
    (if (not (wcmatch (substr Next$ 1 1) "#"))
      (repeat (strlen Next$)
        (setq Str$ (substr Next$ 1 Cnt#)
              Compare$ (strcat Str$ "*")
        );setq
        (if (and (wcmatch Previous$ Compare$)(not (wcmatch (substr Str$ (strlen Str$)) "#")))
          (setq Prefix$ Str$)
        );if
        (setq Cnt# (1+ Cnt#))
      );repeat
    );if
    (if Prefix$
      (progn
        (setq Compare$ (strcat Prefix$ "#*"))
        (if (and (wcmatch Previous$ Compare$)(wcmatch Next$ Compare$))
          (setq Passed t)
          (setq Passed nil)
        );if
      );progn
    );if
    (if (and Passed Prefix$ (not (member Prefix$ Prefixes@)))
      (setq Prefixes@ (append Prefixes@ (list Prefix$)))
    );if
    (setq Num# (1+ Num#))
  );repeat
  (if Prefixes@
    (progn
      (if (> (length Prefixes@) 1)
        (progn
          (setq Num# 1 List@ (cons (nth 0 Prefixes@) (append Prefixes@ (list (last Prefixes@)))))
          (repeat (length Prefixes@)
            (setq Compare$ (strcat (nth Num# List@) "*"))
            (if (and (wcmatch (nth (1- Num#) List@) Compare$)(wcmatch (nth (1+ Num#) List@) Compare$))
              (setq Prefixes@ (vl-remove (nth Num# List@) Prefixes@))
            );if
            (setq Num# (1+ Num#))
          );repeat
        );progn
      );if
      (setq SortLenghts@ (reverse (number_sort (mapcar 'strlen Prefixes@))))
      (setq List@ Prefixes@)
      (foreach Num# SortLenghts@
        (setq First t)
        (foreach Str$ List@
          (if (and (= (strlen Str$) Num#) First)
            (setq First nil
                  List@ (vl-remove Str$ List@)
                  PrefixSort@ (append PrefixSort@ (list Str$))
            );setq
          );if
        );foreach
      );foreach
      (setq Prefixes@ (mapcar 'list PrefixSort@))
      (setq List@ AlphaSort@ Num# 0)
      (foreach Prefix$ PrefixSort@
        (setq Compare$ (strcat Prefix$ "#*")
              PrefixList@ (nth Num# Prefixes@)
              First t
        );setq
        (foreach Str$ List@
          (if (wcmatch Str$ Compare$)
            (progn
              (if First
                (setq PrefixList@ (append PrefixList@ (list (vl-position Str$ AlphaSort@)))
                      First nil
                );setq
              );if
              (setq List@ (vl-remove Str$ List@)
                    Str$ (substr Str$ (1+ (strlen Prefix$)))
                    PrefixList@ (append PrefixList@ (list Str$))
              );setq
            );if
          );if
        );foreach
        (setq Prefixes@ (change_nth Num# PrefixList@ Prefixes@))
        (setq Num# (1+ Num#))
      );foreach
      (foreach PrefixList@ Prefixes@
        (setq NumStrings@ (cddr PrefixList@)
              NumSort@ (number_sort (mapcar 'atoi NumStrings@))
              List@ nil
        );setq
        (foreach Num# NumSort@
          (setq Loop t Cnt# 0)
          (while Loop
            (setq Str$ (nth Cnt# NumStrings@))
            (if (= (atoi Str$) Num#)
              (setq NumStrings@ (delete_nth Cnt# NumStrings@)
                    Str$ (strcat (nth 0 PrefixList@) Str$)
                    List@ (append List@ (list Str$))
                    Loop nil
              );setq
            );if
            (setq Cnt# (1+ Cnt#))
          );while
        );foreach
        (setq Num# (nth 1 PrefixList@) SortList@ Original@)
        (foreach Str$ List@
          (setq Str$ (nth (vl-position Str$ AlphaSort@) Original@))
          (setq SortList@ (change_nth Num# Str$ SortList@))
          (setq Num# (1+ Num#))
        );foreach
        (setq Original@ SortList@)
      );foreach
    );progn
  );if
  (foreach Str$ AlphaSort@
    (if (wcmatch (substr Str$ 1 1) "#")
      (setq NumStrings@ (append NumStrings@ (list Str$)))
    );if
  );foreach
  (if NumStrings@
    (progn
      (setq NumSort@ (number_sort (mapcar 'atoi NumStrings@))
            List@ nil
      );setq
      (foreach Num# NumSort@
        (setq Loop t Cnt# 0)
        (while Loop
          (setq Str$ (nth Cnt# NumStrings@))
          (if (= (atoi Str$) Num#)
            (setq NumStrings@ (delete_nth Cnt# NumStrings@)
                  List@ (append List@ (list Str$))
                  Loop nil
            );setq
          );if
          (setq Cnt# (1+ Cnt#))
        );while
      );foreach
      (setq Num# 0 SortList@ Original@)
      (foreach Str$ List@
        (setq Str$ (nth (vl-position Str$ AlphaSort@) Original@))
        (setq SortList@ (change_nth Num# Str$ SortList@))
        (setq Num# (1+ Num#))
      );foreach
      (setq Original@ SortList@)
    );progn
  );if
  Original@
);defun win_sort
;-------------------------------------------------------------------------------
; number_sort - Sorts list of numbers
; Arguments: 1
;   List@ = List of numbers
; Returns: List of sorted numbers
;-------------------------------------------------------------------------------
(defun number_sort (List@ / High~ Item~ List1@ List2@ Low~ NewList@ Passed Swap~)
  (setq Passed t)
  (if (= (type List@) 'LIST)
    (foreach Item~ List@ (if (not (numberp Item~)) (setq Passed nil)))
    (setq Passed nil)
  );if
  (if (not Passed)
    (progn (princ "\nUsage: (number_sort <list of numbers>)") (exit))
  );if
  (repeat (/ (length List@) 2)
    (setq Low~ (car List@) High~ nil NewList@ nil)
    (foreach Item~ (cdr List@)
      (and (< Item~ Low~) (setq Swap~ Low~ Low~ Item~ Item~ Swap~))
      (and (> Item~ High~) (setq Swap~ High~ High~ Item~ Item~ Swap~))
      (setq NewList@ (cons Item~ NewList@))
    );foreach
    (setq List1@ (cons Low~ List1@) List2@ (cons High~ List2@) List@ (cdr (reverse NewList@)))
  );repeat
  (append (reverse List1@) List@ List2@)
);defun number_sort
;-------------------------------------------------------------------------------
; Change_nth - Changes the nth item in a list with a new item value.
; Arguments: 3
;   Num# = Nth number in list to change
;   Value = New item value to change to
;   OldList@ = List to change item value
; Returns: A list with the nth item value changed.
;-------------------------------------------------------------------------------
(defun Change_nth (Num# Value OldList@)
  (if (<= 0 Num# (1- (length OldList@)))
    (if (> Num# 0)
      (cons (car OldList@) (Change_nth (1- Num#) Value (cdr OldList@)))
      (cons Value (cdr OldList@))
    );if
    OldList@
  );if
);defun Change_nth
;-------------------------------------------------------------------------------
; Delete_nth - Deletes the nth item from a list.
; Arguments: 2
;   Num# = Nth number in list to delete
;   OldList@ = List to delete the nth item
; Returns: A list with the nth item deleted.
;-------------------------------------------------------------------------------
(defun Delete_nth (Num# OldList@)
  (setq Num# (1+ Num#))
  (vl-remove-if '(lambda (x) (zerop (setq Num# (1- Num#)))) OldList@)
);defun Delete_nth
;-------------------------------------------------------------------------------
« Last Edit: May 21, 2007, 04:20:50 PM by Terry Cadd »

VVA

  • Newt
  • Posts: 166
Re: Search of Windows type Sort function
« Reply #6 on: May 19, 2007, 06:36:17 AM »
Win_sort sort string with ignore case of none numeric char
Other variant
Code: [Select]
;;Usage (SortStringWithNumberAsNumber '("A9" "A1" "A10" "B11" "B2" "B05"))
;;Return ("A1" "A9" "A10" "B2" "B05" "B11")
(defun SortStringWithNumberAsNumber1 (ListOfString)
;;;Function Normalize (add 0 befor number) number in string
;;; Count normalize symbols set in variable count
  (defun NormalizeNumberInString (str / ch i pat ret count buf)
    (setq i     0
          pat   '("0" "1" "2" "3" "4" "5" "6" "7" "8" "9")
          ret   ""
          count 4 ;_Count normalize symbols
    ) ;_ end of setq
    (while (/= (setq ch (substr str (setq i (1+ i)) 1)) "")
      (if (vl-position ch pat)
        (progn
          (setq buf ch) ;_ end of setq
          (while
            (vl-position (setq ch (substr str (setq i (1+ i)) 1)) pat)
             (setq buf (strcat buf ch))
          ) ;_ end of while
          (while (< (strlen buf) count) (setq buf (strcat "0" buf)))
          (setq ret (strcat ret buf))
        ) ;_ end of progn
      ) ;_ end of if
      (setq ret (strcat ret ch))
    ) ;_ end of while
    ret
  ) ;_ end of defun
  (vl-load-com)
  (mapcar '(lambda (x) (nth x ListOfString))
          (vl-sort-i (mapcar 'NormalizeNumberInString (mapcar 'strcase ListOfString))
                     '<
          ) ;_ end of VL-SORT-I
  ) ;_ end of mapcar
) ;_ end of defun
Test
Code: [Select]
(setq Lst (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"))
(mapcar '(lambda(x)(terpri)(princ x))
        (SortStringWithNumberAsNumber1 lst))
Result
SortStringWithNumberAsNumber1   Win_Sort
1-C4.dwg                            1-C4.dwg
2-b3.dwg                                         2-b3.dwg
2-c2.dwg                                         2-c2.dwg
7-b7.dwg                                         7-b7.dwg
11-C4.dwg                           11-C4.dwg
22-b2.dwg                           22-b2.dwg
pn374-x9.dwg                           pn374-x9.dwg
pn374-z9.dwg                           pn374-z9.dwg
pN375-A9.dwg                           pN375-A9.dwg
Pn375-A10.dwg                           Pn375-A10.dwg
pn375-D1.dwg                           pn375-D1.dwg
pN375-D2r3.dwg                           pN375-D2r3.dwg
PN375-D10.dwg                           PN375-D10.dwg
pn375-D22.dwg                           pn375-D22.dwg
pN375-DB.dwg                           pN375-DB.dwg
PN375-DB9.dwg                           PN375-DB9.dwg
pn375-DB10a.dwg                           pn375-DB10a.dwg
qr86-007.dwg                           qr86-007.dwg


terrycadd

  • Guest
Re: Search of Windows type Sort function
« Reply #7 on: May 19, 2007, 02:34:01 PM »
VVA,
You have written a very nice and short program. It does everything that win_sort does in the sort. Good job! 
I've attached two demos that you and others can try out to test their own sort functions. SortDemo1 is using your SortStringWithNumberAsNumber1 function, and SortDemo2 is using the win_sort function.
Code: [Select]
;-------------------------------------------------------------------------------
(defun c:SortDemo1 (/ Filename$ OriginalList@ PathFilename$ SortedList@)
  (princ "\nSelect a drawing in a folder for Folder name:")(princ)
  (if (not *LastFolder$)
    (setq *LastFolder$ (getvar "DWGPREFIX"))
  );if
  (if (setq PathFilename$ (getfiled " Select a drawing in a folder for Folder name" *LastFolder$ "dwg" 2))
    (setq *LastFolder$ (strcat (vl-filename-directory PathFilename$) "\\"))
    (exit)
  );if
  (textscr)
  (princ (strcat "\n" *LastFolder$))
  (setq OriginalList@ (vl-directory-files *LastFolder$ "*.dwg" 1))
  (princ (strcat "\n" (chr 160) "\nOriginal list:\n--------------"))
  (foreach Filename$ OriginalList@
    (princ "\n")(princ Filename$)
  );foreach
  ;Here you can change the sort function name that you are testing
  (setq SortedList@ (SortStringWithNumberAsNumber1 (vl-directory-files *LastFolder$ "*.dwg" 1)))
  (princ (strcat "\n" (chr 160) "\nSorted list:\n------------"))
  (foreach Filename$ SortedList@
    (princ "\n")(princ Filename$)
  );foreach
  (princ)
);defun c:SortDemo1
;-------------------------------------------------------------------------------
(defun c:SortDemo2 (/ Filename$ OriginalList@ PathFilename$ SortedList@)
  (princ "\nSelect a drawing in a folder for Folder name:")(princ)
  (if (not *LastFolder$)
    (setq *LastFolder$ (getvar "DWGPREFIX"))
  );if
  (if (setq PathFilename$ (getfiled " Select a drawing in a folder for Folder name" *LastFolder$ "dwg" 2))
    (setq *LastFolder$ (strcat (vl-filename-directory PathFilename$) "\\"))
    (exit)
  );if
  (textscr)
  (princ (strcat "\n" *LastFolder$))
  (setq OriginalList@ (vl-directory-files *LastFolder$ "*.dwg" 1))
  (princ (strcat "\n" (chr 160) "\nOriginal list:\n--------------"))
  (foreach Filename$ OriginalList@
    (princ "\n")(princ Filename$)
  );foreach
  ;Here you can change the sort function name that you are testing
  (setq SortedList@ (win_sort (vl-directory-files *LastFolder$ "*.dwg" 1)))
  (princ (strcat "\n" (chr 160) "\nSorted list:\n------------"))
  (foreach Filename$ SortedList@
    (princ "\n")(princ Filename$)
  );foreach
  (princ)
);defun c:SortDemo2
;-------------------------------------------------------------------------------
« Last Edit: May 19, 2007, 11:02:40 PM by Terry Cadd »

CAB

  • Global Moderator
  • Seagull
  • Posts: 10339
Re: Search of Windows type Sort function
« Reply #8 on: May 20, 2007, 12:16:10 PM »
VVA has done an excellent job.
I wrote a version that changes the strings to list but it was much longer & slower than your code.
I made some mods of your code for my use. I'll post them in case anyone is interested.

Code: [Select]
;;  By VVW --  05.20.07 mods by CAB
;;Usage (SortStringWithNumberAsNumber '("A9" "A1" "A10" "B11" "B2" "B05") nil)
;;  CAB added Ignore Case Flag as an argument
;;Return ("A1" "A9" "A10" "B2" "B05" "B11")
(defun SortStringWithNumberAsNumber (ListOfString IgnoreCase / NorStrs count
                                     NormalizeNumberInString getcount)
;;;Function Normalize (add 0 befor number) number in string
;;; Count normalize symbols set in variable count
;;; CAB added count as an argument
  (defun NormalizeNumberInString (str count / ch i pat ret buf)
    (setq i   0
          pat '("0" "1" "2" "3" "4" "5" "6" "7" "8" "9")
          ret ""
    ) ;_ end of setq
    (while (/= (setq ch (substr str (setq i (1+ i)) 1)) "")
      (if (vl-position ch pat)
        (progn
          (setq buf ch) ;_ end of setq
          (while
            (vl-position (setq ch (substr str (setq i (1+ i)) 1)) pat)
             (setq buf (strcat buf ch))
          ) ;_ end of while
          (while (< (strlen buf) count) (setq buf (strcat "0" buf)))
          (setq ret (strcat ret buf))
        ) ;_ end of progn
      ) ;_ end of if
      (setq ret (strcat ret ch))
    ) ;_ end of while
    ret
  ) ;_ end of defun
  ;;-------------------------------------------------
  ;;  function to Count the longest number in string
  ;;  CAB added to get the correct COUNT
  (defun getcount (lst / count pat)
    (setq count 0)
    (setq pat '("0" "1" "2" "3" "4" "5" "6" "7" "8" "9"))
    (mapcar
      '(lambda (str / i maxlen ch)
         (setq i 0 maxlen 0)
         (while (/= (setq ch (substr str (setq i (1+ i)) 1)) "")
           (if (vl-position ch pat) ; number
             (setq maxlen (1+ maxlen))
             (setq count  (max count maxlen) maxlen 0)
           )
         )
       )
      Lst
    )
    count
  )
  ;;===============================================

  (setq count   (GetCount ListOfString)
        NorStrs (mapcar '(lambda (x) (NormalizeNumberInString x count))
                        ListOfString)
  )
  (and IgnoreCase (setq NorStrs (mapcar 'strcase NorStrs)))
  (mapcar '(lambda (x) (nth x ListOfString)) (vl-sort-i NorStrs '<))
) ;_ end of defun


<edit: corrections made per VVA suggestion below>
« Last Edit: May 21, 2007, 11:33:57 AM by CAB »
I've reached the age where the happy hour is a nap. ()
Windows 10 core i7 4790k 4Ghz 32GB GTX 970
Please support this web site.

VVA

  • Newt
  • Posts: 166
Re: Search of Windows type Sort function
« Reply #9 on: May 21, 2007, 04:21:41 AM »
CAB has written, I so think, a final variant of function. One small addition:
NorStrs count set as local variables
Code: [Select]
;;Published http://www.theswamp.org/index.php?topic=16564.0
;;By VVA --  05.20.07 mods by CAB
;;Usage (SortStringWithNumberAsNumber '("A9" "A1" "A10" "B11" "B2" "B05") nil)
;;With ignore case (SortStringWithNumberAsNumber '("A9" "A1" "A10" "B11" "B2" "B05") t)
;;  CAB added Ignore Case Flag as an argument
;;Return ("A1" "A9" "A10" "B2" "B05" "B11")
(defun SortStringWithNumberAsNumber (ListOfString IgnoreCase / NorStrs count)
;;;Function Normalize (add 0 befor number) number in string
;;; Count normalize symbols set in variable count
;;; CAB added count as an argument
  (defun NormalizeNumberInString (str count / ch i pat ret buf)
    (setq i   0
          pat '("0" "1" "2" "3" "4" "5" "6" "7" "8" "9")
          ret ""
    ) ;_ end of setq
    (while (/= (setq ch (substr str (setq i (1+ i)) 1)) "")
      (if (vl-position ch pat)
        (progn
          (setq buf ch) ;_ end of setq
          (while
            (vl-position (setq ch (substr str (setq i (1+ i)) 1)) pat)
             (setq buf (strcat buf ch))
          ) ;_ end of while
          (while (< (strlen buf) count) (setq buf (strcat "0" buf)))
          (setq ret (strcat ret buf))
        ) ;_ end of progn
      ) ;_ end of if
      (setq ret (strcat ret ch))
    ) ;_ end of while
    ret
  ) ;_ end of defun
  ;;-------------------------------------------------
  ;;  function to Count the longest number in string
  ;;  CAB added to get the correct COUNT
  (defun getcount (lst / count pat)
    (setq count 0)
    (setq pat '("0" "1" "2" "3" "4" "5" "6" "7" "8" "9"))
    (mapcar
      '(lambda (str / i maxlen ch)
         (setq i 0 maxlen 0)
         (while (/= (setq ch (substr str (setq i (1+ i)) 1)) "")
           (if (vl-position ch pat) ; number
             (setq maxlen (1+ maxlen))
             (setq count  (max count maxlen) maxlen 0)
           )
         )
       )
      Lst
    )
    count
  )
  ;;===============================================
  (setq count   (GetCount ListOfString)
        NorStrs (mapcar '(lambda (x) (NormalizeNumberInString x count))
                        ListOfString)
  )
  (and IgnoreCase (setq NorStrs (mapcar 'strcase NorStrs)))
  (mapcar '(lambda (x) (nth x ListOfString)) (vl-sort-i NorStrs '<))
) ;_ end of defun

terrycadd

  • Guest
Re: Search of Windows type Sort function
« Reply #10 on: May 21, 2007, 10:42:01 AM »
VVA,
Thank you so much for writing this sort program. Its excellent!
Thanks,
Terry

VVA

  • Newt
  • Posts: 166
Re: Search of Windows type Sort function
« Reply #11 on: June 21, 2007, 03:48:50 AM »
Found one bugs (thanks Elpanov Evgeniy)
(SortStringWithNumberAsNumber '("A9" "A1" "A10" "B11" "B2" "B05") nil)
 return
("A1" "A10" "A9" "B05" "B11" "B2")
should be
("A1" "A9" "A10" "B2" "B05" "B11")
The corrected variant
Code: [Select]
;;Published http://www.theswamp.org/index.php?topic=16564.0
;;By VVA --  05.20.07 mods by CAB
;;Usage (SortStringWithNumberAsNumber '("A9" "A1" "A10" "B11" "B2" "B05") nil)
;;With ignore case (SortStringWithNumberAsNumber '("A9" "A1" "A10" "B11" "B2" "B05") t)
;;  CAB added Ignore Case Flag as an argument
;;Return ("A1" "A9" "A10" "B2" "B05" "B11")
(defun SortStringWithNumberAsNumber (ListOfString IgnoreCase / NorStrs count)
;;;Function Normalize (add 0 befor number) number in string
;;; Count normalize symbols set in variable count
;;; CAB added count as an argument
  (defun NormalizeNumberInString (str count / ch i pat ret buf)
    (setq i   0
          pat '("0" "1" "2" "3" "4" "5" "6" "7" "8" "9")
          ret ""
    ) ;_ end of setq
    (while (/= (setq ch (substr str (setq i (1+ i)) 1)) "")
      (if (vl-position ch pat)
        (progn
          (setq buf ch) ;_ end of setq
          (while
            (vl-position (setq ch (substr str (setq i (1+ i)) 1)) pat)
             (setq buf (strcat buf ch))
          ) ;_ end of while
          (while (< (strlen buf) count) (setq buf (strcat "0" buf)))
          (setq ret (strcat ret buf))
        ) ;_ end of progn
      ) ;_ end of if
      (setq ret (strcat ret ch))
    ) ;_ end of while
    ret
  ) ;_ end of defun
  ;;-------------------------------------------------
  ;;  function to Count the longest number in string
  ;;  CAB added to get the correct COUNT
  (defun getcount (lst / count pat)
    (setq count 0)
    (setq pat '("0" "1" "2" "3" "4" "5" "6" "7" "8" "9"))
    (mapcar
      '(lambda (str / i maxlen ch)
         (setq i 0 maxlen 0)
         (while (/= (setq ch (substr str (setq i (1+ i)) 1)) "")
           (if (vl-position ch pat) ; number
             (setq maxlen (1+ maxlen))
             (setq count  (max count maxlen) maxlen 0)
           )
         )
(setq count  (max count maxlen)) ;_<<< ADD 21.06.2007 by VVA
       )
      Lst
    )
    count
  )
  ;;===============================================
  (setq count   (GetCount ListOfString)
        NorStrs (mapcar '(lambda (x) (NormalizeNumberInString x count))
                        ListOfString)
  )
  (and IgnoreCase (setq NorStrs (mapcar 'strcase NorStrs)))
  (mapcar '(lambda (x) (nth x ListOfString)) (vl-sort-i NorStrs '<))
) ;_ end of defun


antistar

  • Newt
  • Posts: 96
Re: Search of Windows type Sort function
« Reply #12 on: January 27, 2014, 10:11:10 AM »
Hi,
Could anyone help me to sort this way?
("AS1" "AS2" "AS10" "T1" "T2" "T10" "T1A" "T2A" "T10A" "T1B" "T2B" T10B ")

Thanks in advance.

dale_fuger

  • Guest
Re: Search of Windows type Sort function
« Reply #13 on: January 27, 2014, 11:29:44 PM »
You might look into DOSLib's DOS_STRSORT function and it's logical sorting option.

http://www.en.na.mcneel.com/doslib/string_functions/dos_strsort.htm

For example:

Command: (dos_strsort '("A1" "A10" "A9" "B05" "B11" "B2") -1)
("A1" "A9" "A10" "B2" "B05" "B11")

Does this help?

-- Dale

Marc'Antonio Alessi

  • Swamp Rat
  • Posts: 988
  • Marco
Re: Search of Windows type Sort function
« Reply #14 on: January 28, 2014, 06:13:30 AM »
Hi,
Could anyone help me to sort this way?
("AS1" "AS2" "AS10" "T1" "T2" "T10" "T1A" "T2A" "T10A" "T1B" "T2B" T10B ")

Thanks in advance.
I have this:
Code: [Select]
; Function: ALE_List_SortAtoms
;
; Version 1.00 -    01/2005    (old name ALE_SortAlphaNum)
; Version 1.13 - 24/01/2007
; Version 1.20 - 26/03/2007
; Version 1.21 - 26/08/2010
;
; Example:
;   (ALE_List_SortAtoms
;    '("C20.10R" "C20.3R" nil (1 . 20) "C12" nil "C20.1R" "0"
;      "20K" T (10 20 30) T "2K" -99 "C2" 0 (55) "C201" "-99"
;      "L4" "L1" "L100" "-200K" 8 1 "2C" "20C.1R" "20C.10R"
;      "20C.3R" "20C.R4" "20C.R44" "20C.R3" 4 "20C" "4R" "4C"
;      3.2 1 10 100 200 2 20
;     )
;   )
; =>(nil nil -99 0 1 1 2 3.2 4 8 10 20 100 200 "-200K" "-99" "0"
;    "2C" "2K" "4C" "4R" "20C" "20C.10R" "20C.1R" "20C.3R" "20C.R3"
;    "20C.R4" "20C.R44" "20K" "C2" "C12" "C20.10R" "C20.1R" "C20.3R"
;    "C201" "L1" "L4" "L100" T T (55) (10 20 30) (1 . 20)
;   )
;
(defun ALE_List_SortAtoms (InpLst)
  (mapcar
   '(lambda (LmbDat) (nth LmbDat InpLst))
    (vl-sort-i InpLst
     '(lambda (LmbDt1 LmbDt2 / Typ001 Typ002 Num001 Num002 Flg001 Flg002)
        (setq Typ001 (type LmbDt1)    Typ002 (type LmbDt2))
        (cond
          ( (not LmbDt1) )
          ( (not LmbDt2) nil)
          ( (eq Typ001 'LIST) nil)
          ( (eq Typ002 'LIST) )
          ( (eq Typ001 'SYM)  nil)
          ( (eq Typ002 'SYM) )
          ( (and
              (setq Flg001 (numberp LmbDt1)  Flg002 (numberp LmbDt2))
              Flg001
            )
            (< LmbDt1 LmbDt2)
          )
          ( (and Flg002 (not Flg001)) nil )
          ( Flg001 )
          ( (=
              (setq Num001 (if Flg001 LmbDt1 (atof LmbDt1)))
              (setq Num002 (if Flg002 LmbDt2 (atof LmbDt2)))
              0
            )
            (setq
              Num001 (atof
                       (vl-string-translate
                         " ABCDEFGHIJKLMNOPQRSTUVWXYZ"
                         "000000000000000000000000000"
                         (strcase LmbDt1)
                       )
                     )
              Num002 (atof
                       (vl-string-translate
                         " ABCDEFGHIJKLMNOPQRSTUVWXYZ"
                         "000000000000000000000000000"
                         (strcase LmbDt2)
                       )
                     )
              LmbDt1 (vl-string-translate "123456789" "000000000" LmbDt1)
              LmbDt2 (vl-string-translate "123456789" "000000000" LmbDt2)
            )
            (cond
              ( (and (= LmbDt1 LmbDt2) (< Num001 Num002)) )
              ( (< LmbDt1 LmbDt2) )
            )
          )
          ( (and (zerop Num001) (not (eq LmbDt1 "0"))) nil )
          ( (and (zerop Num002) (not (eq LmbDt2 "0"))) )
          ( (or (< Num001 Num002) (and (= Num001 Num002) (< LmbDt1 LmbDt2))) )
        )
      )
    )
  )
)
Code: [Select]
(ALE_List_SortAtoms '("T1A" "AS2" "AS10" "T10B" "T1" "AS1" "T2" "T10" "T2A" "T10A" "T1B" "T2B"))
=====>  ("AS1" "AS2" "AS10" "T1" "T2" "T10" "T10A" "T10B" "T1A" "T2A" "T1B" "T2B")
Your=>  ("AS1" "AS2" "AS10" "T1" "T2" "T10" "T1A" "T2A" "T10A" "T1B" "T2B" "T10B")

antistar

  • Newt
  • Posts: 96
Re: Search of Windows type Sort function
« Reply #15 on: January 28, 2014, 06:39:59 AM »
You might look into DOSLib's DOS_STRSORT function and it's logical sorting option.

http://www.en.na.mcneel.com/doslib/string_functions/dos_strsort.htm

For example:

Command: (dos_strsort '("A1" "A10" "A9" "B05" "B11" "B2") -1)
("A1" "A9" "A10" "B2" "B05" "B11")

Does this help?

-- Dale

Hi Dale,
This function does not return what I need.
Still I appreciate your attention and reply.
Thanks a lot...  :-)

antistar

  • Newt
  • Posts: 96
Re: Search of Windows type Sort function
« Reply #16 on: January 28, 2014, 06:44:23 AM »

I have this:

Code: [Select]
(ALE_List_SortAtoms '("T1A" "AS2" "AS10" "T10B" "T1" "AS1" "T2" "T10" "T2A" "T10A" "T1B" "T2B"))
=====>  ("AS1" "AS2" "AS10" "T1" "T2" "T10" "T10A" "T10B" "T1A" "T2A" "T1B" "T2B")
Your=>  ("AS1" "AS2" "AS10" "T1" "T2" "T10" "T1A" "T2A" "T10A" "T1B" "T2B" "T10B")

Hi Marc'Antonio,
Your code is what is closer than I need.
Thanks for your attention and help.

CAB

  • Global Moderator
  • Seagull
  • Posts: 10339
Re: Search of Windows type Sort function
« Reply #17 on: January 28, 2014, 08:49:37 AM »
You can use Gile's Alpha2Num routine & index sort on the resulting numbers.  8)
I've reached the age where the happy hour is a nap. ()
Windows 10 core i7 4790k 4Ghz 32GB GTX 970
Please support this web site.

Lee Mac

  • Seagull
  • Posts: 12227
  • London, England
Re: Search of Windows type Sort function
« Reply #18 on: January 28, 2014, 07:13:48 PM »
I have this in my library:

Code - Auto/Visual Lisp: [Select]
  1. ;; Alphanumerical Sort  -  Lee Mac
  2. ;; Sorts a list of strings containing a combination of alphabetical & numerical characters.
  3.  
  4. (defun LM:alphanumsort ( lst )
  5.     (mapcar (function (lambda ( n ) (nth n lst)))
  6.         (vl-sort-i (mapcar 'LM:splitstring lst)
  7.             (function
  8.                 (lambda ( a b / x y )
  9.                     (while
  10.                         (and
  11.                             (setq x (car a))
  12.                             (setq y (car b))
  13.                             (= x y)
  14.                         )
  15.                         (setq a (cdr a)
  16.                               b (cdr b)
  17.                         )
  18.                     )
  19.                     (cond
  20.                         (   (null x) b)
  21.                         (   (null y) nil)
  22.                         (   (and (numberp x) (numberp y)) (< x y))
  23.                         (   (numberp x))
  24.                         (   (numberp y) nil)
  25.                         (   (< x y))
  26.                     )
  27.                 )
  28.             )
  29.         )
  30.     )
  31. )
  32.  
  33. ;; Split String  -  Lee Mac
  34. ;; Splits a string into a list of text and numbers
  35.  
  36. (defun LM:splitstring ( str )
  37.     (
  38.         (lambda ( l )
  39.             (read
  40.                 (strcat "("
  41.                     (vl-list->string
  42.                         (apply 'append
  43.                             (mapcar
  44.                                 (function
  45.                                     (lambda ( a b c )
  46.                                         (cond
  47.                                             (   (= 92 b)
  48.                                                 (list 32 34 92 b 34 32)
  49.                                             )
  50.                                             (   (or (< 47 b 58)
  51.                                                     (and (= 45 b) (< 47 c 58) (not (< 47 a 58)))
  52.                                                     (and (= 46 b) (< 47 a 58) (< 47 c 58))
  53.                                                 )
  54.                                                 (list b)
  55.                                             )
  56.                                             (   (list 32 34 b 34 32))
  57.                                         )
  58.                                     )
  59.                                 )
  60.                                 (cons nil l) l (append (cdr l) '(( )))
  61.                             )
  62.                         )
  63.                     )
  64.                     ")"
  65.                 )
  66.             )
  67.         )
  68.         (vl-string->list str)
  69.     )
  70. )

Marc'Antonio Alessi

  • Swamp Rat
  • Posts: 988
  • Marco
Re: Search of Windows type Sort function
« Reply #19 on: January 29, 2014, 03:01:43 AM »
I have this in my library:...
Hi Lee,
Code: [Select]
ALE=====>  ("AS1" "AS2" "AS10" "T1" "T2" "T10" "T10A" "T10B" "T1A" "T2A" "T1B" "T2B")
LM:=====>  ("AS1" "AS2" "AS10" "T1" "T1A" "T1B" "T2" "T2A" "T2B" "T10" "T10A" "T10B")
Antistar>  ("AS1" "AS2" "AS10" "T1" "T2" "T10" "T1A" "T2A" "T10A" "T1B" "T2B" "T10B")
which is more correct?

snownut2

  • Swamp Rat
  • Posts: 934
  • ADT 2004 - AutoCad 2011 Bricscad 19
Re: Search of Windows type Sort function
« Reply #20 on: January 29, 2014, 06:45:39 AM »
It seems from a logic perspective that LeeMac's is more correct.

CAB

  • Global Moderator
  • Seagull
  • Posts: 10339
Re: Search of Windows type Sort function
« Reply #21 on: January 30, 2014, 10:58:49 AM »
My attempt resulted same as Lee but not so elegant.
Code - Auto/Visual Lisp: [Select]
  1. (defun c:test ()
  2.   (MySort '("T2A" "AS10" "T10B" "T1" "T2" "AS2" "T10" "T1A" "AS1" "T10A" "T1B" "T2B"))
  3. ;|
  4.   ALE=====>  ("AS1" "AS2" "AS10" "T1" "T2" "T10" "T10A" "T10B" "T1A" "T2A" "T1B" "T2B")
  5.   LM:=====>  ("AS1" "AS2" "AS10" "T1" "T1A" "T1B" "T2" "T2A" "T2B" "T10" "T10A" "T10B")
  6.   Antistar>  ("AS1" "AS2" "AS10" "T1" "T2" "T10" "T1A" "T2A" "T10A" "T1B" "T2B" "T10B") desired result
  7.   CAB=====>  ("AS1" "AS2" "AS10" "T1" "T1A" "T1B" "T2" "T2A" "T2B" "T10" "T10A" "T10B")
  8.              
  9. |;
  10.   )
  11.  
  12. ;;  CAB 01/30/14
  13. (defun parseNum (str / lst tnum tstr)
  14.   (mapcar
  15.     (function
  16.      (lambda(x)
  17.        (cond
  18.          ((< 47 x 58) ; number
  19.           (if tstr (setq lst (cons (vl-list->string (reverse tstr)) lst) tstr nil))
  20.           (if tnum (setq tnum (cons x tnum))(setq tnum (list x)))
  21.           )
  22.          (t ; non-number
  23.           (if tnum (setq lst (cons (atoi(vl-list->string (reverse tnum))) lst) tnum nil))
  24.           (if tstr (setq tstr (cons x tstr))(setq tstr (list x)))
  25.           )
  26.         )
  27.        ))
  28.     (vl-string->list str))
  29.   (if tstr (setq lst (cons (vl-list->string (reverse tstr)) lst)))
  30.   (if tnum (setq lst (cons (atoi(vl-list->string (reverse tnum))) lst)))
  31.   (reverse lst)
  32. )
  33.  
  34.  
  35. (defun MySort (lst)
  36.   (mapcar '(lambda (x) (nth x lst))
  37.           (vl-sort-i (mapcar '(lambda(x) (ParseNum x)) lst)
  38.                      '(lambda (e1 e2)
  39.                         (if (= (car e1) (car e2))
  40.                           (if (= (cadr e1) (cadr e2))
  41.                             (< (caddr e1) (caddr e2))
  42.                             (< (cadr e1) (cadr e2))
  43.                           )
  44.                           (< (car e1) (car e2))
  45.                         )
  46.                       )
  47.           )
  48.   )
  49. )
I've reached the age where the happy hour is a nap. ()
Windows 10 core i7 4790k 4Ghz 32GB GTX 970
Please support this web site.

Andrea

  • Water Moccasin
  • Posts: 2360
Re: Search of Windows type Sort function
« Reply #22 on: June 27, 2017, 01:48:46 PM »
100 kudos  :smitten:
Keep smile...

rayakmal

  • Newt
  • Posts: 24
Re: Search of Windows type Sort function
« Reply #23 on: September 24, 2018, 04:51:26 AM »
I have this in my library:

Code - Auto/Visual Lisp: [Select]
  1. ;; Alphanumerical Sort  -  Lee Mac
  2. ;; Sorts a list of strings containing a combination of alphabetical & numerical characters.
  3.  
  4. (defun LM:alphanumsort ( lst )
  5.     (mapcar (function (lambda ( n ) (nth n lst)))
  6.         (vl-sort-i (mapcar 'LM:splitstring lst)
  7.             (function
  8.                 (lambda ( a b / x y )
  9.                     (while
  10.                         (and
  11.                             (setq x (car a))
  12.                             (setq y (car b))
  13.                             (= x y)
  14.                         )
  15.                         (setq a (cdr a)
  16.                               b (cdr b)
  17.                         )
  18.                     )
  19.                     (cond
  20.                         (   (null x) b)
  21.                         (   (null y) nil)
  22.                         (   (and (numberp x) (numberp y)) (< x y))
  23.                         (   (numberp x))
  24.                         (   (numberp y) nil)
  25.                         (   (< x y))
  26.                     )
  27.                 )
  28.             )
  29.         )
  30.     )
  31. )
  32.  
  33. ;; Split String  -  Lee Mac
  34. ;; Splits a string into a list of text and numbers
  35.  
  36. (defun LM:splitstring ( str )
  37.     (
  38.         (lambda ( l )
  39.             (read
  40.                 (strcat "("
  41.                     (vl-list->string
  42.                         (apply 'append
  43.                             (mapcar
  44.                                 (function
  45.                                     (lambda ( a b c )
  46.                                         (cond
  47.                                             (   (= 92 b)
  48.                                                 (list 32 34 92 b 34 32)
  49.                                             )
  50.                                             (   (or (< 47 b 58)
  51.                                                     (and (= 45 b) (< 47 c 58) (not (< 47 a 58)))
  52.                                                     (and (= 46 b) (< 47 a 58) (< 47 c 58))
  53.                                                 )
  54.                                                 (list b)
  55.                                             )
  56.                                             (   (list 32 34 b 34 32))
  57.                                         )
  58.                                     )
  59.                                 )
  60.                                 (cons nil l) l (append (cdr l) '(( )))
  61.                             )
  62.                         )
  63.                     )
  64.                     ")"
  65.                 )
  66.             )
  67.         )
  68.         (vl-string->list str)
  69.     )
  70. )

What if I have a multi dimension list like this:

(("A.05" "12.34" "Regular") ("A.10 "34.54 "BigSize") ("B.9" "66.73" "Regular") ("A.05" "12.55" "BigSize"))

What is the most efficient and correct way  to sort this list?

Lee Mac

  • Seagull
  • Posts: 12227
  • London, England
Re: Search of Windows type Sort function
« Reply #24 on: September 24, 2018, 12:28:27 PM »
What if I have a multi dimension list like this:

(("A.05" "12.34" "Regular") ("A.10 "34.54 "BigSize") ("B.9" "66.73" "Regular") ("A.05" "12.55" "BigSize"))

What is the most efficient and correct way  to sort this list?

Should the list be sorted by the first element; or by first, then second, then third?

rayakmal

  • Newt
  • Posts: 24
Re: Search of Windows type Sort function
« Reply #25 on: April 29, 2019, 12:21:22 AM »
What if I have a multi dimension list like this:

(("A.05" "12.34" "Regular") ("A.10 "34.54 "BigSize") ("B.9" "66.73" "Regular") ("A.05" "12.55" "BigSize"))

What is the most efficient and correct way  to sort this list?

Should the list be sorted by the first element; or by first, then second, then third?

I gave a wrong list. It should be like this:

(("A.05" 12.34 "Regular") ("A.10" 34.54 "BigSize") ("B.9" 66.73 "Regular") ("A.10" 12.12 "BigSize") ("A.05" 12.55 "BigSize"))

The result:
(("A.05" 12.34 "Regular") ("A.05" 12.55 "BigSize") ("A.10" 12.12 "BigSize") ("A.10" 34.54 "BigSize") ("B.9" 66.73 "Regular"))
The list should be sort by the first element and then second.

Lee Mac

  • Seagull
  • Posts: 12227
  • London, England
Re: Search of Windows type Sort function
« Reply #26 on: April 29, 2019, 08:19:37 AM »
I gave a wrong list. It should be like this:
Code: [Select]
(("A.05" 12.34 "Regular") ("A.10" 34.54 "BigSize") ("B.9" 66.73 "Regular") ("A.10" 12.12 "BigSize") ("A.05" 12.55 "BigSize"))The result:
Code: [Select]
(("A.05" 12.34 "Regular") ("A.05" 12.55 "BigSize") ("A.10" 12.12 "BigSize") ("A.10" 34.54 "BigSize") ("B.9" 66.73 "Regular"))The list should be sort by the first element and then second.

Consider the following function based on the code from my earlier post -
Code - Auto/Visual Lisp: [Select]
  1. (defun mysort ( l )
  2.     (vl-sort l
  3.         (function
  4.             (lambda ( a b / x y )
  5.                 (if (= (car  a) (car  b))
  6.                     (< (cadr a) (cadr b))
  7.                     (progn
  8.                         (setq a (LM:splitstring (car a))
  9.                               b (LM:splitstring (car b))
  10.                         )
  11.                         (while
  12.                             (and
  13.                                 (setq x (car a))
  14.                                 (setq y (car b))
  15.                                 (= x y)
  16.                             )
  17.                             (setq a (cdr a)
  18.                                   b (cdr b)
  19.                             )
  20.                         )
  21.                         (cond
  22.                             (   (null x) b)
  23.                             (   (null y) nil)
  24.                             (   (and (numberp x) (numberp y)) (< x y))
  25.                             (   (numberp x))
  26.                             (   (numberp y) nil)
  27.                             (   (< x y))
  28.                         )
  29.                     )
  30.                 )
  31.             )
  32.         )
  33.     )
  34. )
  35.  
  36. ;; Split String  -  Lee Mac
  37. ;; Splits a string into a list of text and numbers
  38.  
  39. (defun LM:splitstring ( str )
  40.     (
  41.         (lambda ( l )
  42.             (read
  43.                 (strcat "("
  44.                     (vl-list->string
  45.                         (apply 'append
  46.                             (mapcar
  47.                                 (function
  48.                                     (lambda ( a b c )
  49.                                         (cond
  50.                                             (   (= 92 b)
  51.                                                 (list 32 34 92 b 34 32)
  52.                                             )
  53.                                             (   (or (< 47 b 58)
  54.                                                     (and (= 45 b) (< 47 c 58) (not (< 47 a 58)))
  55.                                                     (and (= 46 b) (< 47 a 58) (< 47 c 58))
  56.                                                 )
  57.                                                 (list b)
  58.                                             )
  59.                                             (   (list 32 34 b 34 32))
  60.                                         )
  61.                                     )
  62.                                 )
  63.                                 (cons nil l) l (append (cdr l) '(( )))
  64.                             )
  65.                         )
  66.                     )
  67.                     ")"
  68.                 )
  69.             )
  70.         )
  71.         (vl-string->list str)
  72.     )
  73. )

Example:
Code - Auto/Visual Lisp: [Select]
  1. _$ (mysort '(("A.05" 12.34 "Regular") ("A.10" 34.54 "BigSize") ("B.9" 66.73 "Regular") ("A.10" 12.12 "BigSize") ("A.05" 12.55 "BigSize")))
  2. (("A.05" 12.34 "Regular") ("A.05" 12.55 "BigSize") ("A.10" 12.12 "BigSize") ("A.10" 34.54 "BigSize") ("B.9" 66.73 "Regular"))


ronjonp

  • Needs a day job
  • Posts: 6938
Re: Search of Windows type Sort function
« Reply #27 on: April 29, 2019, 12:37:24 PM »
I'm sure this logic is flawed and horribly inefficient but it's the first thing that came to mind :)
Code - Auto/Visual Lisp: [Select]
  1. (vl-sort '(("A.05" 12.34 "Regular")
  2.            ("A.10" 34.54 "BigSize")
  3.            ("B.9" 66.73 "Regular")
  4.            ("A.10" 12.12 "BigSize")
  5.            ("A.05" 12.55 "BigSize")
  6.           )
  7.          '(lambda (a b)
  8.             (< (apply 'strcat (mapcar 'vl-princ-to-string a))
  9.                (apply 'strcat (mapcar 'vl-princ-to-string b))
  10.             )
  11.           )
  12. )
  13. ;; (("A.05" 12.34 "Regular") ("A.05" 12.55 "BigSize") ("A.10" 12.12 "BigSize") ("A.10" 34.54 "BigSize") ("B.9" 66.73 "Regular"))

Windows 10 x64 - AutoCAD /C3D 2020

Custom Build PC

Lee Mac

  • Seagull
  • Posts: 12227
  • London, England
Re: Search of Windows type Sort function
« Reply #28 on: April 29, 2019, 12:59:54 PM »
I'm sure this logic is flawed and horribly inefficient but it's the first thing that came to mind :)

Add ("B.10" 66.73 "Regular") to your list  :wink:

ronjonp

  • Needs a day job
  • Posts: 6938
Re: Search of Windows type Sort function
« Reply #29 on: April 29, 2019, 03:34:23 PM »
I'm sure this logic is flawed and horribly inefficient but it's the first thing that came to mind :)

Add ("B.10" 66.73 "Regular") to your list  :wink:
DOH!   :-) That's some strange numbering since "A.05" is formatted correctly.

Windows 10 x64 - AutoCAD /C3D 2020

Custom Build PC

Lee Mac

  • Seagull
  • Posts: 12227
  • London, England
Re: Search of Windows type Sort function
« Reply #30 on: April 29, 2019, 06:03:46 PM »
I'm sure this logic is flawed and horribly inefficient but it's the first thing that came to mind :)

Add ("B.10" 66.73 "Regular") to your list  :wink:
DOH!   :-) That's some strange numbering since "A.05" is formatted correctly.

I agree - if leading zeroes could be guaranteed, this task would be significantly easier...  :-)

rayakmal

  • Newt
  • Posts: 24
Re: Search of Windows type Sort function
« Reply #31 on: April 29, 2019, 09:56:29 PM »

Consider the following function based on the code from my earlier post -
Code - Auto/Visual Lisp: [Select]
  1. (defun mysort ( l )
  2.     (vl-sort l
  3.         (function
  4.             (lambda ( a b / x y )
  5.                 (if (= (car  a) (car  b))
  6.                     (< (cadr a) (cadr b))
  7.                     (progn
  8.                         (setq a (LM:splitstring (car a))
  9.                               b (LM:splitstring (car b))
  10.                         )
  11.                         (while
  12.                             (and
  13.                                 (setq x (car a))
  14.                                 (setq y (car b))
  15.                                 (= x y)
  16.                             )
  17.                             (setq a (cdr a)
  18.                                   b (cdr b)
  19.                             )
  20.                         )
  21.                         (cond
  22.                             (   (null x) b)
  23.                             (   (null y) nil)
  24.                             (   (and (numberp x) (numberp y)) (< x y))
  25.                             (   (numberp x))
  26.                             (   (numberp y) nil)
  27.                             (   (< x y))
  28.                         )
  29.                     )
  30.                 )
  31.             )
  32.         )
  33.     )
  34. )
  35.  
  36. ;; Split String  -  Lee Mac
  37. ;; Splits a string into a list of text and numbers
  38.  
  39. (defun LM:splitstring ( str )
  40.     (
  41.         (lambda ( l )
  42.             (read
  43.                 (strcat "("
  44.                     (vl-list->string
  45.                         (apply 'append
  46.                             (mapcar
  47.                                 (function
  48.                                     (lambda ( a b c )
  49.                                         (cond
  50.                                             (   (= 92 b)
  51.                                                 (list 32 34 92 b 34 32)
  52.                                             )
  53.                                             (   (or (< 47 b 58)
  54.                                                     (and (= 45 b) (< 47 c 58) (not (< 47 a 58)))
  55.                                                     (and (= 46 b) (< 47 a 58) (< 47 c 58))
  56.                                                 )
  57.                                                 (list b)
  58.                                             )
  59.                                             (   (list 32 34 b 34 32))
  60.                                         )
  61.                                     )
  62.                                 )
  63.                                 (cons nil l) l (append (cdr l) '(( )))
  64.                             )
  65.                         )
  66.                     )
  67.                     ")"
  68.                 )
  69.             )
  70.         )
  71.         (vl-string->list str)
  72.     )
  73. )

Example:
Code - Auto/Visual Lisp: [Select]
  1. _$ (mysort '(("A.05" 12.34 "Regular") ("A.10" 34.54 "BigSize") ("B.9" 66.73 "Regular") ("A.10" 12.12 "BigSize") ("A.05" 12.55 "BigSize")))
  2. (("A.05" 12.34 "Regular") ("A.05" 12.55 "BigSize") ("A.10" 12.12 "BigSize") ("A.10" 34.54 "BigSize") ("B.9" 66.73 "Regular"))

Wow  :-o :-o :-o That's what I want, Lee. 
Once again, Thanks.  I really appreciate your help.

Ron, Thanks for chiming in.

Lee Mac

  • Seagull
  • Posts: 12227
  • London, England
Re: Search of Windows type Sort function
« Reply #32 on: May 01, 2019, 01:58:25 PM »
You're welcome!  :-)