### Author Topic: Sort list of numbers (vl-sort not allowed)  (Read 21263 times)

0 Members and 1 Guest are viewing this topic.

#### ElpanovEvgeniy ##### Re: Sort list of numbers (vl-sort not allowed)
« Reply #30 on: June 20, 2012, 08:12:25 AM »
optimization for repetitive elements:

Code - Auto/Visual Lisp: [Select]
1. (defun eea-sort (l / f)
2.   (defun f (a b c i)
3.     (cond ((not c) (append (eea-sort a) i (eea-sort b)))
4.           ((< (car c) (car i)) (f (cons (car c) a) b (cdr c) i))
5.           ((= (car c) (car i)) (f a b (cdr c) (cons (car c) i)))
6.           ((f a (cons (car c) b) (cdr c) i))
7.     )
8.   )
9.   (if l (f nil nil (cdr l) (list (car l))))
10. )
Code: [Select]
`(eea-sort '(3 43 2 35 23 4 3 3 53 21 32 123 12))`
Stay home. Stay safe. Save lives.

#### alanjt ##### Re: Sort list of numbers (vl-sort not allowed)
« Reply #31 on: June 20, 2012, 08:30:40 AM »
optimization for repetitive elements:
wow
Civil 3D 2019 ~ Windohz 7 64bit
Dropbox

#### highflyingbird ##### Re: Sort list of numbers (vl-sort not allowed)
« Reply #32 on: June 20, 2012, 08:35:33 AM »
optimization for repetitive elements:

Code - Auto/Visual Lisp: [Select]
1. (defun eea-sort (l / f)
2.   (defun f (a b c i)
3.     (cond ((not c) (append (eea-sort a) i (eea-sort b)))
4.           ((< (car c) (car i)) (f (cons (car c) a) b (cdr c) i))
5.           ((= (car c) (car i)) (f a b (cdr c) (cons (car c) i)))
6.           ((f a (cons (car c) b) (cdr c) i))
7.     )
8.   )
9.   (if l (f nil nil (cdr l) (list (car l))))
10. )
Code: [Select]
`(eea-sort '(3 43 2 35 23 4 3 3 53 21 32 123 12))`

Hard error occurred ***
internal stack limit reached (simulated)

Maybe too many recursions
I am a bilingualist,Chinese and Chinglish.

#### highflyingbird ##### Re: Sort list of numbers (vl-sort not allowed)
« Reply #33 on: June 20, 2012, 08:36:36 AM »
This is for test:
Code - Auto/Visual Lisp: [Select]
1. (defun c:test (/ N L)
2.   (initget 7)
3.   (setq N (fix (getreal "\n&#35831;&#36755;&#20837;&#25968;&#32452;&#30340;&#38271;&#24230;(Please Enter the number of list):")))
4.   (setq L (GetRandList 0 N N))
5.
6.   (benchMark '(Msort L) "MyMergesort" 10)              ;--highflybird's
7.   (benchMark '(QuickSort L) "QuickSort" 10)             ;--gile's
8.   (benchMark '(MergeSort L) "MergeSort" 10)           ;--gile's
9.   (benchMark '(eea-sort L) "EEA-Sort" 10)                ;-- ElpanovEvgeniy's
10.   (benchMark '(vl-sort L '<) "vl-sort" 10)
11. )
12.
Code - Auto/Visual Lisp: [Select]
1. ;;;============================================================
2. ;;;&#27979;&#35797;&#29992;&#20989;&#25968;(benchMark function)
3. ;;;============================================================
4. (defun Benchmark (func funName times / t0 t1 res)
5.   (setq t0 (getvar "TDUSRTIMER"))
6.   (repeat times
7.     (setq res (eval func))
8.   )
9.   (setq t1 (* (- (getvar "TDUSRTIMER") t0) 86400))
10.
11.   (princ (strcat "\n\nIt takes: " (rtos t1 2 6) " Seconds  by  " funName))
12.   (princ (strcat ".\nTotal times: " (itoa times)))
13.   (princ (strcat ".\nSpeed is: " (rtos (/ t1 times) 2 6) " Seconds/times."))
14.   ;(princ "\nThe result is: ")
15.   ;(princ res)
16. )
17.
18.
19. ;;;---------------------------------------------------------------------
20. ;;;Definine Rand()
21. ;;;---------------------------------------------------------------------
22. (defun GetRandList(a b n / str scr lst)
23.   (setq scr (vlax-create-object "ScriptControl"))                       ;Create a script
24.   (vlax-put scr 'Language "VBS")
25.   (setq str "Randomize\nFunction Rand(x,y)\nRand=x+Rnd*(y-x)\nEnd Function")
26.                                                                         ;for randomize some features
27.   (vlax-invoke Scr 'ExecuteStatement str)                               ;Execute script
28.   (defun Rand (scr nMin nMax)                                           ;Rand function
29.     (vlax-invoke scr 'run "Rand" nMin nMax)
30.   )
31.   (repeat n
32.     (setq lst (cons (rand scr a b) lst))
33.   )
34.   lst
35. )
« Last Edit: June 20, 2012, 08:56:20 AM by HighflyingBird »
I am a bilingualist,Chinese and Chinglish.

#### ElpanovEvgeniy ##### Re: Sort list of numbers (vl-sort not allowed)
« Reply #34 on: June 20, 2012, 08:41:24 AM »
optimization for repetitive elements:

Code - Auto/Visual Lisp: [Select]
1. (defun eea-sort (l / f)
2.   (defun f (a b c i)
3.     (cond ((not c) (append (eea-sort a) i (eea-sort b)))
4.           ((< (car c) (car i)) (f (cons (car c) a) b (cdr c) i))
5.           ((= (car c) (car i)) (f a b (cdr c) (cons (car c) i)))
6.           ((f a (cons (car c) b) (cdr c) i))
7.     )
8.   )
9.   (if l (f nil nil (cdr l) (list (car l))))
10. )
Code: [Select]
`(eea-sort '(3 43 2 35 23 4 3 3 53 21 32 123 12))`

Hard error occurred ***
internal stack limit reached (simulated)

Maybe too many recursions

recursion is not the best approach for large lists...
maybe my computer is a little stronger Stay home. Stay safe. Save lives.

#### highflyingbird ##### Re: Sort list of numbers (vl-sort not allowed)
« Reply #35 on: June 20, 2012, 08:46:52 AM »
recursion is not the best approach for large lists...
maybe my computer is a little stronger Yes,I am working on an old machine. I am a bilingualist,Chinese and Chinglish.

#### ElpanovEvgeniy ##### Re: Sort list of numbers (vl-sort not allowed)
« Reply #36 on: June 22, 2012, 10:06:01 AM »
new version:
Code - Auto/Visual Lisp: [Select]
1. (defun eea-sort-1 (l)
2.   (defun m (l) (apply (function min) l))
3.   (defun r (l i) (if (and l (/= (car l) i)) (cons (car l) (r (cdr l) i)) (cdr l)))
4.   (defun f (l / a) (setq a (m l)) (if l  (cons a (f (r l a)))))
5.   (f l)
6. )
« Last Edit: June 22, 2012, 10:11:17 AM by ElpanovEvgeniy »
Stay home. Stay safe. Save lives.

#### ElpanovEvgeniy ##### Re: Sort list of numbers (vl-sort not allowed)
« Reply #37 on: June 22, 2012, 10:41:38 AM »
Code - Auto/Visual Lisp: [Select]
1. (defun eea-sort-2 (l)
2.   (defun r (l i) (if (and l (/= (car l) i)) (cons (car l) (r (cdr l) i)) (cdr l)))
3.   (defun f (l / a) (if l (cons (setq a (apply (function min) l)) (f (r l a)))))
4.   (f l)
5. )
Stay home. Stay safe. Save lives.

#### Gasty

• Newt
• Posts: 90 ##### Re: Sort list of numbers (vl-ssk ort not allowed)
« Reply #38 on: June 22, 2012, 09:46:17 PM »
This one is from Vladimir Nesterovsky, an old contributor to the Autodesk Group:
Code: [Select]
`;;;         Mergesort.lsp;;;  free for non-commercial use only;;;   1999 (C.) Vladimir Nesterovsky;;;      vnestr@netvision.net.il;;; http://www.netvision.net.il/php/vnestr;;; sort a list by standard mergesort method;;; using a user-specified comparison function;;; which should return true if and only if its;;; first argument is strictly less than the;;; second (in some appropriate sense).;;; also, define a wrapper function that'll allow;;; for sorting by user-supplied "value function",;;; which is a function of one argument returning;;; some "value" recognizable by the built-in '<;;; operator. Sorting in this way can be much much;;; faster then the usual way of calling the;;; comparison function for each compare, because;;; this potentially slow and heavy value-function;;; gets called only ONCE for each element, and later;;; all the compares are done with very fast and;;; efficient built-in '< calls;;; keeping original order of equal elements;;; in the list (what's called "stable sort");;; uses recursion, so potentially unsafe;;; more code is inlined to speed up the end cases;;; handling, like 2-, 3- or 4-elements lists,;;; also reducing the amount of recursion,;;; which amounts to some 45% speed gain(defun mergesort (lst less-then?) ;; is it the fastest autolisp version? (setq less-then? (make-usubr less-then?)) (_mrgsrt lst))(defun make-usubr (f) (cond  ((and (not (atom f))        (not (equal 'LAMBDA (car f))))     (eval (cons 'LAMBDA f)))  ((eval f))))(defun _mrgsrt (ls / len a b c d l1) (cond  ((< (setq len (length ls)) 2)    ;; one-element or empty list    ls)  ((= len 2)    ;; 26% speed gain for 10-elems list, 18% for 250    ;; when this special case inlined    (if (less-then? (cadr ls) (car ls))      (reverse ls)      ls))  ((= len 3)    ;; more 10% speed gain    (if (less-then? (cadr ls) (car ls))      (cond        ((less-then? (caddr ls) (cadr ls))          (reverse ls))        ((less-then? (caddr ls) (car ls))          (list (cadr ls) (caddr ls) (car ls)))        ((list (cadr ls) (car ls) (caddr ls))))      (cond        ((less-then? (caddr ls) (car ls))          (list (caddr ls) (car ls) (cadr ls)))        ((less-then? (caddr ls) (cadr ls))          (list (car ls) (caddr ls) (cadr ls)))        ( ls ))))  ((= len 4)    ;; another 15% speed gain for 4*2^n initial lengths    ;; (no impact on 3*2^n cases)    (if (less-then? (cadr ls) (car ls))      (setq a (cadr ls) b (car ls))      (setq b (cadr ls) a (car ls)))    (if (less-then? (last ls) (caddr ls))      (setq c (last ls) d (caddr ls))      (setq d (last ls) c (caddr ls)))    (cond      ((less-then? d a)        (list c d a b))      ((less-then? d b)        (if (less-then? c a)          (list c a d b)          (list a c d b)))      ((cond          ((less-then? c a)            (list c a b d))          ((less-then? c b)            (list a c b d))          ((list a b c d))))))  ( t    ;; general case    (repeat (/ len 2)      (setq l1 (cons (car ls) l1)            ls (cdr ls)))    (_mrgsrt-merge      (_mrgsrt (reverse l1))      (_mrgsrt ls)))));;; merge two sorted lists in a stable manner;;; less-then? usubr assumed to be defined globally;;; may be used independently when needed(defun _mrgsrt-merge (l1 l2 / rslt)    (while (and l1 l2)     ;merge the sorted halves back      (while (and l1 l2               (not (less-then? (car l2) (car l1))))        (setq rslt (cons (car l1) rslt)               l1  (cdr l1)))      (while (and l1 l2               (less-then? (car l2) (car l1)))        (setq rslt (cons (car l2) rslt)               l2  (cdr l2))) )    (foreach e l1 (Setq rslt (cons e rslt)))    (foreach e l2 (Setq rslt (cons e rslt)))    (reverse rslt));;; sort by Value function;;;  (it's generally much faster then sorting;;;   by compare-function because potentially;;;   slow value-function will be called only;;;   once for each element here);;; Value function is such that excepts one;;;  argument and returns an atomic value;;;  for which calling '< is meaningful;;;  (numbers usually, but may be strings too).(defun Vmergesort (lst valfun) (setq valfun (make-usubr valfun)) (mapcar 'cdr  (mergesort   (mapcar '(lambda (e)      ;calculate results              (cons (valfun e) e)) ; in advance            lst)             ;store them and   car-less?)))              ;sort by comparing CARs(defun car-less? (a b) (< (car a) (car b)));;; one possible efficiency improvement can be;;; to implement a special version of vmergesort;;; hand-coded to sort its argument list elements;;; by their CARs and also automatically strip them;;; away with CDRs while merging half-lists back(princ "\n   Usage: (MERGESORT list compare-function) ")(princ "\n   Or better: (VMERGESORT list value-function)")(princ)`

#### Stefan

• Bull Frog
• Posts: 235 ##### Re: Sort list of numbers (vl-sort not allowed)
« Reply #39 on: June 23, 2012, 01:42:07 PM »
My first release
Code - Auto/Visual Lisp: [Select]
1. (defun ph:sort (l / f g s r)
2.   (defun f (l n)
3.     (if l
4.       (if (<= n (caar l))
5.         (cons (cons n (car l)) (cdr l))
6.         (cons (car l) (f (cdr l) n))
7.       )
8.       (list (list n))
9.     )
10.   )
11.   (defun g (l1 l2)
12.     (if l1
13.       (if l2
14.         (if (< (car l1) (car l2))
15.           (cons (car l1) (g (cdr l1) l2))
16.           (cons (car l2) (g l1 (cdr l2)))
17.         )
18.         l1
19.       )
20.       l2
21.     )
22.   )
23.   (foreach n l (setq s (f s n)))
24.   (foreach n s (setq r (g r n)))
25. )

#### Stefan

• Bull Frog
• Posts: 235 ##### Re: Sort list of numbers (vl-sort not allowed)
« Reply #40 on: June 23, 2012, 02:20:58 PM »
Crap... nothing new...
It could be
Code - Auto/Visual Lisp: [Select]
1. (defun ph:sort1 (l / f r)
2.   (defun f (l n)
3.     (if l
4.       (if (<= n (car l))
5.         (cons n l)
6.         (cons (car l) (f (cdr l) n))
7.         )
8.       (list n)
9.       )
10.     )
11.   (foreach n l (setq r (f r n)))
12.   )
which is nothing more than a direct approach...

#### highflyingbird ##### Re: Sort list of numbers (vl-sort not allowed)
« Reply #41 on: June 24, 2012, 07:23:35 AM »
My quick sort :
Code - Auto/Visual Lisp: [Select]
1. ;;;=============================================================
2. ;;;Highflybird's  Quick Sorting algorithm -- 1
3. ;;;Considered this case: a sorted list.
4. ;;;If the list is random,just a little slower than Quick Sort 2
5. ;;;but the list is sorted,then is much faster than Quick Sort 2
6. ;;;=============================================================
7. (defun H:QSort1 (Lst / a k L R S)
8.   (if (cddr lst)
9.       (setq k (* (+ (car Lst) (last lst)) 0.5))                 ;the pivot,this is for the worst situation
10.       (setq s lst)
11.       (while s
12.         (if (< (setq a (car S)) k)                              ;compare to the pivot
13.           (setq L (cons a L))                                   ;put the less into the left list
14.           (Setq R (cons a R))                                   ;put the greater into the right list
15.         )
16.         (setq S (cdr S))
17.       )
18.       (cond
19.         ((null R) (H:QSort1 L))                                 ;the right is empty,the recurse the left
20.         ((null L) (H:QSort1 R))                                 ;the Left is empty,the recurse the right
21.         (T (append (H:QSort1 L) (H:QSort1 R)))                  ;otherwise,recurse both
22.       )
23.     )
24.     (if (and (cdr lst) (> (car lst) (cadr lst)))                ;the length of list <= 2
25.       (reverse lst)
26.       lst
27.     )
28.   )
29. )
30.

take the first number as pivot:
Code - Auto/Visual Lisp: [Select]
1. ;;;=============================================================
2. ;;;Highflybird's  Quick Sorting algorithm -- 2
3. ;;;Based the Quick Sorting algorithm ,the worst O(N^2), the best
4. ;;;is O(log(N)),average case performance is O(log(N))
5. ;;;=============================================================
6. (defun H:QSort2 (Lst / a k L R S)
7.   (if (cddr lst)
8.       (setq k (car Lst))                                        ;the pivot
9.       (setq S lst)
10.       (while (setq S (cdr S))
11.         (if (< (setq a (car S)) k)                              ;compare to the pivot
12.           (setq L (cons a L))                                   ;put the less into the left list
13.           (Setq R (cons a R))                                   ;put the greater into the right list
14.         )
15.       )
16.       (cond
17.         ((null R) (reverse (cons k (reverse (H:QSort2 L)))))    ;the right is empty,the recurse the left
18.         ((null L) (cons k (H:QSort2 R)))                        ;the Left is empty,the recurse the right
19.         (T (append (H:QSort2 L) (cons k (H:QSort2 R))))         ;otherwise,recurse both and add the pivot.
20.       )
21.     )
22.     (if (and (cdr lst) (> (car lst) (cadr lst)))                ;the length of list <= 2
23.       (reverse lst)
24.       lst
25.     )
26.   )
27. )
28.
use safearray:
Code - Auto/Visual Lisp: [Select]
1. ;;;=============================================================
2. ;;;Highflybird's  Quick Sorting algorithm -- 3
3. ;;;Because "nth" function is slower,so use safeArray.
4. ;;;the advantage is: the space is slower ,just O(1)
5. ;;;=============================================================
6. (defun QSort3 (low high / i j p c v)
7.   (if (< low high)
8.       (setq i low)
9.       (setq j (1+ high))
10.       (setq p (vlax-safearray-get-element a low))
11.       (setq C T)
12.       (while C
13.           (and (< (vlax-safearray-get-element a (setq i (1+ i))) p)
14.                (< i high)
15.           )
16.         )
17.         (while (> (vlax-safearray-get-element a (setq j (1- j))) p))
18.         (if (< i j)
19.             (setq v (vlax-safearray-get-element a i))
20.             (vlax-safearray-put-element a i
21.               (vlax-safearray-get-element a j)
22.             )
23.             (vlax-safearray-put-element a j v)
24.           )
25.           (setq C nil)
26.         )
27.       )
28.       (vlax-safearray-put-element a low
29.         (vlax-safearray-get-element a j)
30.       )
31.       (vlax-safearray-put-element a j p)
32.       (QSort3 low (1- j))
33.       (QSort3 (1+ j) high)
34.     )
35.   )
36. )
37.
38. (defun MakeArr (L DataType / n a)
39.   (setq n (length L))
40.   (setq a (vlax-make-safearray DataType (cons 0 (1- n))))
41. )
42.
43. (defun H:QSort3 (L / a k c)
44.   (setq a (makearr L vlax-vbdouble))
45.   (setq k (length L))
46.   (QSort3 0 (1- k))
47.   (vlax-safearray->list A)
48. )
I am a bilingualist,Chinese and Chinglish.

#### highflyingbird ##### Re: Sort list of numbers (vl-sort not allowed)
« Reply #42 on: June 24, 2012, 07:26:41 AM »
Shell sort:
Code - Auto/Visual Lisp: [Select]
1. ;;;=============================================================
2. ;;;Highflybird's Shell Sorting algorithm -- 1
3. ;;;Based the Shell Sorting algorithm
4. ;;;=============================================================
5. (defun H:ShellSort (L / a gaps i j k temp gap x n)
6.   (setq n (length L))
7.   (setq a (makeArr L vlax-vbdouble))
8.   ;;(setq gaps  '(1 4 10 23 57 132 301 701 1750))
9.   (setq gaps '(1 5 13 43 113 297 815 1989 4711 11969 27901 84801 213331 543749 1355339
10.                3501671 8810089 21521774 58548857 157840433 410151271 1131376761 2147483647))
11.   (setq k 0)
12.   (while (< (nth k gaps) n)
13.     (setq k (1+ k))
14.   )
15.   (while (>= (setq k (1- k)) 0)
16.     (setq gap (nth k gaps))
17.     (setq i gap)
18.     (while (< i n)
19.       (setq temp (vlax-safearray-get-element a i))
20.       (setq j i)
21.       (while (and (>= j gap)
22.                   (> (setq x (vlax-safearray-get-element a (- j gap))) temp)
23.              )
24.         (vlax-safearray-put-element a j x)
25.         (setq j (- j gap))
26.       )
27.       (vlax-safearray-put-element a j temp)
28.       (setq i (1+ i))
29.     )
30.   )
31.   (vlax-safearray->list A)
32. )
33.
34. ;;;=============================================================
35. ;;;Highflybird's Shell Sorting algorithm -- 1
36. ;;;Based the Shell Sorting algorithm
37. ;;;=============================================================
38. (defun shellSort-1 (v s / GAP I J K P X Y)
39.   (setq gap (/ s 2))
40.   (while (> gap 0)
41.     (setq i gap)
42.     (while (< i s)
43.       (setq j (- i gap))
44.       (while (>= j 0)
45.         (setq k (+ j gap))
46.         (setq x (vlax-safearray-get-element v k))
47.         (setq y (vlax-safearray-get-element v j))
48.         (if (< x y)
49.             (setq p y)
50.             (vlax-safearray-put-element v j x)
51.             (vlax-safearray-put-element v k p)
52.           )
53.         )
54.         (setq j (- j gap))
55.       )
56.       (setq i (1+ i))
57.     )
58.     (setq gap (/ gap 2))
59.   )
60.   v
61. )
I am a bilingualist,Chinese and Chinglish.

#### highflyingbird ##### Re: Sort list of numbers (vl-sort not allowed)
« Reply #43 on: June 24, 2012, 07:29:36 AM »
This is the test result (on my old machine):

1,for a random list

Please Enter the length of list: 5000
Please enter the times of test:5

Statement                         Times    Elapse(s)    Average(s/time)
-----------------------------------------------------------------------
(VL-SORT L (QUOTE <))       5        0.094        0.0188
(H:MERGESORT L)                5        1.359        0.2718
(H:QSORT2 L)                      5        1.844        0.3688
(G:MERGESORT L)                5        2.141        0.4282
(H:QSORT1 L)                      5        2.422        0.4844
(H:QSORT3 L)                      5        2.765        0.553
(EEA-SORT L)                      5        3.078        0.6156
(G:QUICKSORT L)                5        3.766        0.7532
(H:SHELLSORT L)                 5        4.203        0.8406
(PH:SORT L)                        1        2.719        2.719
(PH:SORT1 L)                      1        22.953       22.953
(G:INSERTSORT L)                1        26.484       26.484
(EEA-SORT-1 L)                    1        33.672       33.672
(IREB:SORT-MERGE-R L (QUOTE <))   1        59.766       59.766
(IREB:SORT-MERGE-I L (QUOTE <))   1        59.797       59.797
(G:BUBBLESORT L)                  1        74.828       74.828

2, for a sorted list:

Please Enter the length of list: 5000
Please enter the times of test:2

Statement                         Times    Elapse(s)    Average(s/time)
-----------------------------------------------------------------------
(VL-SORT L (QUOTE <))        2        0.016        0.008
(H:MERGESORT L)                 2        0.375        0.1875
(G:MERGESORT L)                  2        0.407        0.2035
(H:QSORT1 L)                      2        0.562        0.281
(H:SHELLSORT L)                 2        0.719        0.3595
(H:QSORT2 L)                      2        49.547       24.7735
(H:QSORT3 L)                      2        53.125       26.5625
(G:QUICKSORT L)                   2        168.843      84.4215

3,for a large number list
Please Enter the length of list: 20000
Please enter the times of test:5

Statement                         Times    Elapse(s)    Average(s/time)
-----------------------------------------------------------------------
(VL-SORT L (QUOTE <))        5        0.562        0.1124
(H:MERGESORT L)                5        11.656       2.3312
(H:QSORT2 L)                      5        14.61        2.922
(G:MERGESORT L)                5        16.579       3.3158
(H:QSORT3 L)                      5        19.047       3.8094
(H:QSORT1 L)                      5        21.172       4.2344
(G:QUICKSORT L)                5        30.218       6.0436
(H:SHELLSORT L)                 5        31.453       6.2906

« Last Edit: June 25, 2012, 06:28:05 AM by HighflyingBird »
I am a bilingualist,Chinese and Chinglish.

#### highflyingbird ##### Re: Sort list of numbers (vl-sort not allowed)
« Reply #44 on: June 24, 2012, 07:34:59 AM »
This is the lisp file. includes  my code,gile's ,Stefan's,ireb's ,ElpanovEvgeniy's code.
I compiled this file,then run the test.
I am a bilingualist,Chinese and Chinglish.