0 Members and 1 Guest are viewing this topic.
;; ArchSort by Lee McDonnell ~ 18/09/2009(defun StrBrk (str / x slst nLst rLst aLst) (setq slst (vl-string->list str)) (while (setq x (car slst)) (setq slst (cdr slst)) (cond ( (< 47 x 58) (setq nLst (cons x nLst)) (setq rLst (cons (reverse aLst) rLst) aLst nil)) (t (setq aLst (cons x aLst)) (setq rLst (cons (reverse nLst) rLst) nLst nil)))) (mapcar 'vl-list->string (vl-remove nil (reverse (cons (reverse aLst) (cons (reverse nLst) rLst))))))(defun ArchSort2 (lst) (vl-sort lst (function (lambda (a b / a b) (setq a (StrBrk a) b (StrBrk b)) (while (and a b (or (/= (type (read (car a))) (type (read (car b)))) (= (car a) (car b)))) (setq a (cdr a) b (cdr b))) (cond ( (not a) (car b)) ( (not b) (car a)) ( (and (numberp (car a)) (numberp (car b))) (< (read (car a)) (read (car b)))) (t (< (car a) (car b))))))))
Elapsed milliseconds / relative speed for 1024 iteration(s): (ARCHSORT2 LST).....1622 / 3.39 <fastest> (ARCHSORT LST)......5491 / 1.00 <slowest>
;; ArchSort by Lee McDonnell ~ 18/09/2009(defun StrBrk (str / x slst nLst rLst aLst) (setq slst (vl-string->list str)) (while (setq x (car slst)) (setq slst (cdr slst)) (cond ( (and nLst (= 46 x)) (setq nLst (cons x nLst))) ( (< 47 x 58) (setq nLst (cons x nLst)) (setq rLst (cons (reverse aLst) rLst) aLst nil)) (t (setq aLst (cons x aLst)) (setq rLst (cons (reverse nLst) rLst) nLst nil)))) (mapcar 'vl-list->string (vl-remove nil (reverse (cons (reverse aLst) (cons (reverse nLst) rLst))))))(defun ArchSort2 (lst) (vl-sort lst (function (lambda (a b / a b t1 t2) (setq a (StrBrk a) b (StrBrk b)) (while (and a b (or (not (or (= 'SYM (setq t1 (type (read (car a)))) (setq t2 (type (read (car b))))) (and (vl-position t1 '(INT REAL)) (vl-position t2 '(INT REAL))))) (= (car a) (car b)))) (setq a (cdr a) b (cdr b))) (cond ( (not a) (car b)) ( (not b) (car a)) ( (and (numberp (read (car a))) (numberp (read (car b)))) (< (read (car a)) (read (car b)))) (t (< (car a) (car b))))))))
(ArchSort2 '("E-2" "M-4" "M10" "A-11" "A-2" "A-1" "E-1" "AC3" "AC12" "A-1.2"))("A-1" "A-1.2" "A-2" "A-11" "AC3" "AC12" "E-1" "E-2" "M10" "M-4")
(defun archSort (lst / NumSuff) (defun NumSuff (str / slst loop x num dot) (setq slst (reverse (vl-string->list str)) loop T ) (while loop (setq x (car slst)) (cond ((< 47 x 58) (setq num (cons x num) slst (cdr slst) ) ) ((and (= x 46) (not dot)) (setq num (cons x num) slst (cdr slst) dot T ) ) (T (setq loop nil)) ) ) (cons (vl-list->string (reverse slst)) (read (vl-list->string num))) ) (mapcar (function (lambda (x) (nth x lst) ) ) (vl-sort-i (mapcar 'NumSuff lst) (function (lambda (x1 x2) (if (= (car x1) (car x2)) (< (cdr x1) (cdr x2)) (< (car x1) (car x2)) ) ) ) ) ))
_$ (setq lst '("E-2" "M-4" "M10" "A-11" "A-2" "A-1" "E-1" "AC3" "AC12" "A-1.2"))("E-2" "M-4" "M10" "A-11" "A-2" "A-1" "E-1" "AC3" "AC12" "A-1.2")_$ (BENCHMARK '((ArchSort2_Lee lst) (ArchSort_gile lst)))Benchmarking ................Elapsed milliseconds / relative speed for 8192 iteration(s): (ARCHSORT_GILE LST)......1578 / 6.46 <fastest> (ARCHSORT2_LEE LST).....10188 / 1.00 <slowest>
(archsort2 '("A-1A" "A-10A" "A-2B" "A-10B"))("A-1A" "A-2B" "A-10A" "A-10B") (archsort '("A-1A" "A-10A" "A-2B" "A-10B"))("A-10A" "A-10B" "A-1A" "A-2B")
(defun archSort_gile2 (lst / SplitStr lst) (defun SplitStr (str / num-sub str-sub lst) (defun str-sub (char lst) (if lst (if (< 47 (car lst) 58) (cons char (num-sub (chr (car lst)) (cdr lst))) (str-sub (strcat char (chr (car lst))) (cdr lst)) ) (list char) ) ) (defun num-sub (char lst / tmp) (cond ((null lst) (list char)) ((= 46 (car lst)) (if (and (cadr lst) (numberp (read (setq tmp (strcat char "." (chr (cadr lst))))) ) ) (num-sub tmp (cddr lst)) (cons char (str-sub (chr (car lst)) (cdr lst))) ) ) ((< 47 (car lst) 58) (num-sub (strcat char (chr (car lst))) (cdr lst)) ) (T (cons char (str-sub (chr (car lst)) (cdr lst)))) ) ) (setq lst (vl-string->list str)) (if (< 47 (car lst) 58) (num-sub (chr (car lst)) (cdr lst)) (str-sub (chr (car lst)) (cdr lst)) ) ) (mapcar (function (lambda (x) (nth x lst) ) ) (vl-sort-i (mapcar 'SplitStr lst) (function (lambda (x1 x2 / s1 s2 n1 n2) (while (= (setq s1 (car x1)) (setq s2 (car x2))) (setq x1 (cdr x1) x2 (cdr x2) ) ) (if (and (numberp (setq n1 (read s1))) (numberp (setq n2 (read s2)))) (< n1 n2) (< s1 s2) ) ) ) ) ))
_$ (BENCHMARK '((ArchSort2_Lee lst) (ArchSort_gile2 lst)))Benchmarking ...............Elapsed milliseconds / relative speed for 4096 iteration(s): (ARCHSORT_GILE2 LST).....1140 / 4.43 <fastest> (ARCHSORT2_LEE LST)......5047 / 1.00 <slowest>
(defun ArchSort3_lee (lst / StrBrk) (defun StrBrk (Str / x sLst nLst rLst aLst) (setq sLst (vl-string->list Str)) (while (setq x (car sLst)) (setq sLst (cdr sLst)) (cond ( (and nLst (= 46 x)) (setq nLst (cons x nLst))) ( (< 47 x 58) (setq nLst (cons x nLst)) (setq rLst (cons (reverse aLst) rLst) aLst nil)) (t (setq aLst (cons x aLst)) (setq rLst (cons (reverse nLst) rLst) nLst nil)))) (mapcar 'vl-list->string (reverse (vl-remove nil (cons (reverse aLst) (cons (reverse nLst) rLst)))))) (mapcar (function (lambda (x) (nth x lst))) (vl-sort-i (mapcar 'StrBrk lst) (function (lambda (a b / a b t1 t2) (while (and a b (or (not (or (= 'SYM (setq t1 (type (read (car a)))) (setq t2 (type (read (car b))))) (and (vl-position t1 '(INT REAL)) (vl-position t2 '(INT REAL))))) (= (car a) (car b)))) (setq a (cdr a) b (cdr b))) (cond ( (not a) (car b)) ( (not b) (car a)) ( (and (numberp (read (car a))) (numberp (read (car b)))) (< (read (car a)) (read (car b)))) (t (< (car a) (car b)))))))))
Benchmarking ...............Elapsed milliseconds / relative speed for 4096 iteration(s): (ARCHSORT_GILE2 LST).....1045 / 1.97 <fastest> (ARCHSORT3_LEE LST)......2059 / 1.00 <slowest>
(defun archSort_gile3 (lst / SplitStr lst) (defun SplitStr (str / lst test rslt num tmp) (setq lst (vl-string->list str) test (chr (car lst)) ) (if (< 47 (car lst) 58) (setq num T) ) (while (setq lst (cdr lst)) (if num (cond ((= 46 (car lst)) (if (and (cadr lst) (setq tmp (strcat test "." (chr (cadr lst)))) (numberp (read tmp)) ) (setq test tmp lst (cdr lst) ) (setq rslt (cons test rslt) test "." num nil ) ) ) ((< 47 (car lst) 58) (setq test (strcat test (chr (car lst)))) ) (T (setq rslt (cons test rslt) test (chr (car lst)) num nil ) ) ) (if (< 47 (car lst) 58) (setq rslt (cons test rslt) test (chr (car lst)) num T ) (setq test (strcat test (chr (car lst)))) ) ) ) (setq rslt (cons test rslt)) (reverse rslt) ) (mapcar (function (lambda (x) (nth x lst) ) ) (vl-sort-i (mapcar 'SplitStr lst) (function (lambda (x1 x2 / s1 s2) (while (= (setq s1 (car x1)) (setq s2 (car x2))) (setq x1 (cdr x1) x2 (cdr x2) ) ) (if (and (numberp (read s1)) (numberp (read s2))) (< (read s1) (read s2)) (< s1 s2) ) ) ) ) ))
_$ (BENCHMARK '((ArchSort3_Lee lst) (ArchSort_gile2 lst) (ArchSort_gile3 lst)))Benchmarking ................Elapsed milliseconds / relative speed for 8192 iteration(s): (ARCHSORT_GILE3 LST).....1296 / 1.25 <fastest> (ARCHSORT_GILE2 LST).....1453 / 1.12 (ARCHSORT3_LEE LST)......1625 / 1.00 <slowest>
(ArchSort_gile3 '("E-2" "M-4" "M10" "A-11" "A-2" "A-1" "E-1" "AC3" "AC12" "A-1.2")); error: bad argument type: stringp 1
(defun ArchSort_lee6 (lst / StrBrk) (defun StrBrk (Str / x sLst nLst rLst aLst) (setq sLst (vl-string->list Str) aLst "" nLst "") (while (setq x (car sLst)) (setq sLst (cdr sLst)) (cond ( (and nLst (= 46 x)) (setq nLst (strcat nLst (chr x)))) ( (< 47 x 58) (setq nLst (strcat nLst (chr x))) (setq rLst (cons aLst rLst) aLst "")) (t (setq aLst (strcat aLst (chr x))) (setq rLst (cons (cond ((read nLst)) ("")) rLst) nLst "")))) (reverse (vl-remove "" (cons aLst (cons (cond ((read nLst)) ("")) rLst))))) (mapcar (function (lambda (x) (nth x lst))) (vl-sort-i (mapcar 'StrBrk lst) (function (lambda (a b / a b x1 x2) (while (and (setq x1 (car a)) (setq x2 (car b)) (or (= x1 x2) (not (or (= 'STR (type x1) (type x2)) (and (numberp x1) (numberp x2)))))) (setq a (cdr a) b (cdr b))) (< (car a) (car b)))))))
Benchmarking ...............Elapsed milliseconds / relative speed for 4096 iteration(s): (ARCHSORT_GILE2 LST).....1232 / 1.25 <fastest> (ARCHSORT_LEE6 LST)......1544 / 1.00 <slowest>