Topic: TabSort.lsp

[Lee Mac]

Yeah, I was thinking that - but I didn't want to clutter the dialog with loadsa buttons, I may have one "Sort" button, and a radio_row for the sort options.

[Lee Mac]

Actually, this is 3x faster .... what was I thinking all those mapcar's....    :ugly:

Code: [Select]

;; 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))))))))


Code: [Select]

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

    (ARCHSORT2 LST).....1622 / 3.39 <fastest>
    (ARCHSORT LST)......5491 / 1.00 <slowest>


[CAB]

Not quite there.
(ArchSort2 '("E-2" "M-4" "M10" "A-11" "A-2" "A-1" "E-1" "AC3" "AC12"))
("A-1" "A-11" "A-2" "AC12" "AC3" "E-1" "E-2" "M10" "M-4")

[CAB]

Oh,  I just remembered that some Architects use decimal numbers.
(ArchSort2 '("E-2" "M-4" "M10" "A-11" "A-2" "A-1" "E-1" "AC3" "AC12" "A-1.2"))
("A-1.2" "A-1" "A-11" "A-2" "AC12" "AC3" "E-1" "E-2" "M10" "M-4")
should be
("A-1" "A-1.2" "A-2" "A-11" "AC3" "AC12" "E-1" "E-2" "M-4" "M10")

[Lee Mac]

This should now cope with the decimals quite nicely 

Code: [Select]

;; 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))))))))


Code: [Select]

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


[gile]

Hi,

Code: [Select]

(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))
                   )
                 )
               )
    )
  )
)
<EDIT> : a little benchmark

_$ (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>

[Lee Mac]

Faster, but perhaps not conclusive:   
 

Code: [Select]

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

<EDIT>  Nice code btw

[gile]

Sorry, but I didn't read nothing about these kind of alphanumerical suffixes.
Thought there're only numerical suffixes.

[Lee Mac]

Tbh Gile, I've never come across this kind of sorting - I'm just following the link that CAB provided 

I like your idea of using the vl-sort-i in place of vl-sort, meaning that you can use your sub-function on the list before sorting it, instead of inside the sort function (as in mine) - probably a much quicker way to do it. 

[gile]

This one seems to work as you want

<EDIT>: the 'read' were misplaced

Code: [Select]

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

[Lee Mac]

Nice Gile,

I'm catching up, but you're still quicker 

Code: [Select]

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


Code: [Select]

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

    (ARCHSORT_GILE2 LST).....1045 / 1.97 <fastest>
    (ARCHSORT3_LEE LST)......2059 / 1.00 <slowest>


[gile]

I made a little correction in archSort_gile2: the read statements were in SplitStr and an error occured when comparing a string and a number.
After correction the speed difference with your last code is smaller.

So, I try to optimize the SplitList sub (avoiding recursive process) in archSort_gile3:

Code: [Select]

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

[Lee Mac]

Gile I get this from your latest entry 

(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

[Lee Mac]

Had superfluous code:

Code: [Select]

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

<EDIT>  I spoke too soon... edited, as old code fell down with :  '("A32B" "34C")

[gile]

I forgot to remove a (read ...) in SplitStr.
I edited the code.