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.
;; ---------------------------------------------------------------------------
;; 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
;;==========================================================================
