### Author Topic: Multi Sort  (Read 6488 times)

0 Members and 1 Guest are viewing this topic.

#### CAB

• Global Moderator
• Seagull
• Posts: 10366
##### Multi Sort
« Reply #15 on: August 29, 2005, 12:06:14 PM »
OK as an exercise, here is my feeble attempt at rewriting my sort, stealing much of your code.
Still slower than yours but only slightly.

Code: [Select]
`;; --------------------------------------------------------------------------- ;; Function: tab_sort ;; Purpose : sort list of strings by the prefix then the first numbers found ;; AUTHOR  : Charles Alan Butler;; Version : 2.0  08/29/05;; Params  : tablst:    list of strings to sort;; Returns : sorted list;; --------------------------------------------------------------------------- (defun Num_Sort (tablst / newlst result tmp code codes padlen sub x                 isdigit delist group )  ;;........................................................................  (defun isdigit (code) (< 47 code 58))  ;;........................................................................  (defun delist (lst / delst)    (defun delst (lst / 1-list a)      (while lst        (if (listp lst)          (if (and (listp (setq a (car lst))) a)            (setq 1-list (append (delst a) 1-list))            (setq 1-list (cons a 1-list))          )          (setq 1-list (cons lst 1-list))        )        (setq lst (cond ((listp lst) (cdr lst))))      )      1-list    )    (reverse (delst lst))  )  ;;........................................................................  ;; group ascii into numbers & non numbers  (defun group (newlst / newlst2 tab code result grplst tmplst)    (foreach tab newlst      (setq tmplst nil            result nil      )      (foreach code (reverse tab)        (cond          ((null tmplst)           (setq tmplst (list code))          )          ((isdigit code)           (if (isdigit (car tmplst))             (setq tmplst (cons code tmplst))             (setq               result (cons tmplst result)               tmplst (list code)             )           )          )          ((if (isdigit (car tmplst))             (setq               result (cons tmplst result)               tmplst (list code)             )             (setq tmplst (cons code tmplst))           )          )        )      )      (if tmplst        (setq result (cons tmplst result))      )      (setq newlst2 (cons result newlst2))    )  )  ;;************************************************  ;;        S T A R T   O F   R O U T I N E           ;;************************************************  (vl-load-com)  (setq newlst (mapcar                 '(lambda (x)                    (vl-string->list x)                  )                 tablst               )  )  (setq newlst (group newlst))  ;;  set max length of numerical sequience  (setq padlen 0)  (mapcar    '(lambda (sub)       (mapcar         '(lambda (codes)            (if (isdigit (car codes))              (setq padlen                     (max padlen                          (length codes)                     )              )            )          )         sub       )     )    newlst  )  ;; pad numerical list  (setq newlst         (mapcar           '(lambda (sub)              (mapcar                '(lambda (x)                   (if (isdigit (car x))                     (progn                       (while (< (length x) padlen)                         (setq x (cons 48 x)                         )                       )                       x                     )                     x                   )                 )                sub              )            )           newlst         )  )  ;;  remove grouping  (setq newlst (mapcar 'delist newlst))  ;;  convert back to string  (setq newlst (mapcar                 '(lambda (x)                    (vl-list->string x)                  )                 newlst               )  )  ;;  combine new & old list  (setq tablst (mapcar 'cons tablst (reverse newlst)))  ;;  sort on new list  (setq tablst (vl-sort tablst '(lambda (e1 e2) (< (cdr e1) (cdr e2)))))  ;;--------------------------------------------------------------------  ;;  reduce list to original items  (setq tablst (mapcar 'car tablst))  ;;--------------------------------------------------------------------  tablst) ; end defun;;==========================================================================`
I've reached the age where the happy hour is a nap. (°¿°)
Windows 10 core i7 4790k 4Ghz 32GB GTX 970