(defun BubbleSort (lstItems / blnFlag item1 item2 lstItems2)
(setq item1 (car lstItems))
(foreach item2 (cdr lstItems)
(if (<= item1 item2)
(setq lstItems2 (cons item1 lstItems2)
item1 item2
)
(setq lstItems2 (cons item2 lstItems2)
blnFlag T
)
)
)
(if blnFlag
(BubbleSort (reverse (cons item1 lstItems2)))
(reverse (cons item1 lstItems2))
)
)
Its been a few years since I wrote my last bubble sort function.
(bubblesort '(8 5 2 7 4 3)) returns '(2 3 4 5 7 8 )Code: [Select](defun BubbleSort (lstItems / blnFlag item1 item2 lstItems2)
(setq item1 (car lstItems))
(foreach item2 (cdr lstItems)
(if (< item1 item2)
(setq lstItems2 (cons item1 lstItems2)
item1 item2
)
(setq lstItems2 (cons item2 lstItems2)
blnFlag T
)
)
)
(if blnFlag
(BubbleSort (reverse (cons item1 lstItems2)))
(reverse (cons item1 lstItems2))
)
)
(mapcar '(lambda (y)
(ascii y))
(acad_strlsort
(mapcar '(lambda (x)
(chr x))
'(8 6 5 2 7 4 6 3))))(2 3 4 5 6 6 7 8 )(mapcar '(lambda (y)
(ascii y))
(acad_strlsort
(mapcar '(lambda (x)
(chr x))
'(8 227 101 6 5 2 12 37 7 28 4 6 3 105 10 13))))(defun bubblesort (lst / bubble)
(defun bubble (ele lst)
(cond
((null lst) ele)
((< (car lst) ele) (bubble (car lst) (cdr lst)))
((bubble ele (cdr lst)))
)
)
((lambda (b)
(if lst
(cons b (bubblesort (vl-remove b lst)))
)
)
(bubble (car lst) (cdr lst))
)
)(defun insertsort (lst / insert)
(defun insert (ele lst)
(cond
((null lst) (list ele))
((< ele (car lst)) (cons ele lst))
((cons (car lst) (insert ele (cdr lst))))
)
)
(if lst
(insert (car lst) (insertsort (cdr lst)))
)
)(defun quicksort (lst / left right)
(defun left (ele lst)
(cond
((null lst) nil)
((< ele (car lst)) (left ele (cdr lst)))
(T (cons (car lst) (left ele (cdr lst))))
)
)
(defun right (ele lst)
(cond
((null lst) nil)
((< (car lst) ele) (right ele (cdr lst)))
(T (cons (car lst) (right ele (cdr lst))))
)
)
(if lst
(append (quicksort (left (car lst) (cdr lst)))
(cons (car lst)
(quicksort (right (car lst) (cdr lst)))
)
)
)
)(defun mergesort (lst / merge brklst)
(defun merge (l1 l2)
(cond
((null l1) l2)
((null l2) l1)
((if (< (car l1) (car l2))
(cons (car l1) (merge (cdr l1) l2))
(cons (car l2) (merge l1 (cdr l2)))
)
)
)
)
(defun brklst (lst acc n)
(if (= 0 n)
(list acc lst)
(brklst (cdr lst) (cons (car lst) acc) (1- n))
)
)
(if (cdr lst)
(progn
(setq lst (brklst lst nil (/ (length lst) 2)))
(merge (mergesort (car lst))
(mergesort (cadr lst))
)
)
lst
)
)
Hi,Here're some of the most famous sorting algorithms implementation examples (using 'functional style' rather than looking for 'brute performance'):
(defun BubbleSort (nlst / loopnum lownum next sorted nlst)
(defun loopnum (low lst / )
(if (setq a low
b (cdr lst))
(if (minusp (- (car b) a))
(loopnum (car b) b)
(if b (loopnum a b)))
)
a
)
(while (setq Lownum (car nlst))
(setq next (cdr nlst))
(setq Sorted (cons (loopnum Lownum nlst) Sorted))
(setq nlst (vl-remove (car sorted) nlst))
(if (member Lownum sorted)
(setq nlst (vl-remove lownum nlst))
))
(reverse sorted)
)(defun MinSort (lst / sortedlist)
(while lst
(setq SortedList (cons (apply 'min lst) SortedList))
(setq lst (vl-remove (car SortedList) lst))
)
(reverse SortedList)
)(defun MinSort (lst / sortedlist)
(while lst
(setq SortedList (cons (apply 'max lst) SortedList))
(setq lst (vl-remove (car SortedList) lst))
)
SortedList
)
Why do you think that happens?
(apply 'min <list>)(apply 'min '(4 2 3.36 1))
Returns: 1.0(defun MinSort ( lst / m )
(if lst
(cons (setq m (apply 'min lst))
(MinSort (vl-remove-if '(lambda ( x ) (equal x m 1e-8)) lst))
)
)
)
Perhaps add some tolerance:Code: [Select](defun MinSort ( lst / m )
(if lst
(cons (setq m (apply 'min lst))
(MinSort (vl-remove-if '(lambda ( x ) (equal x m 1e-8)) lst))
)
)
)
What does this give you ??
(bubblesort '(8 6 5 2 7 4 6 3))
(defun gc:sort (lst fun / merge tmp)
(defun merge (l1 l2)
(cond
((null l1) l2)
((null l2) l1)
((fun (car l1) (car l2)) (cons (car l1) (merge (cdr l1) l2)))
(T (cons (car l2) (merge l1 (cdr l2))))
)
)
(setq fun (eval fun)
lst (mapcar 'list lst)
)
(while (cdr lst)
(setq tmp lst
lst nil
)
(while (cdr tmp)
(setq lst (cons (merge (car tmp) (cadr tmp)) lst)
tmp (cddr tmp)
)
)
(and tmp (setq lst (cons (car tmp) lst)))
)
(car lst)
)
Code: [Select](bubble (car lst) (bubblesort (cdr lst)))
(defun BadNumberSort (lst)
(cond
((null lst) lst)
((null (cadr lst)) lst)
((< (car lst) (cadr lst)) (cons (car lst) (BadNumberSort (cdr lst))))
(T (cons (cadr lst) (BadNumberSort (cons (car lst) (cdr (cdr lst))))))
)
)
_$ (BADNUMBERSORT '(5 3 4 1 2))
(3 4 1 2 5)
_$ (BADNUMBERSORT '(3 4 1 2 5))
(3 1 2 4 5)
_$ (BADNUMBERSORT '(3 1 2 4 5))
(1 2 3 4 5)
(defun NumberSort (lst / nlst)
(defun SortNums (slst)
(cond
((null slst) slst)
((null (cadr slst)) slst)
((< (car slst) (cadr slst)) (cons (car slst) (SortNums (cdr slst))))
(T (cons (cadr slst) (SortNums (cons (car slst) (cdr (cdr slst))))))
)
)
(setq nlst (SortNums lst))
(cond
((equal nlst (SortNums nlst)) nlst)
(T (NumberSort nlst))
)
)
NUMBERSORT
_$ (NUMBERSORT '(5 3 4 1 2))
(1 2 3 4 5)
_$ (NUMBERSORT '(5 34 4 11 2 8 ))
(2 4 5 8 11 34)
_$ (NUMBERSORT '(4 3 80 134 4 12 1 10 17))
(1 3 4 4 10 12 17 80 134)
_$ (NUMBERSORT '(6 -4 7 12 -2 4))
(-4 -2 4 6 7 12)
other way:Code - Auto/Visual Lisp: [Select]
...Code: [Select](defun MinSort ( lst / m )
(if lst
(cons (setq m (apply 'min lst))
(MinSort (vl-remove-if '(lambda ( x ) (equal x m 1e-8)) lst))
)
)
)
(eea-sort '(3 43 2 35 23 4 3 3 53 21 32 123 12))
optimization for repetitive elements:wow
optimization for repetitive elements:Code - Auto/Visual Lisp: [Select]
(eea-sort '(3 43 2 35 23 4 3 3 53 21 32 123 12))
optimization for repetitive elements:Code - Auto/Visual Lisp: [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 :-)
;;; 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)
This is the lisp file. includes my code,gile's ,Stefan's,ireb's ,ElpanovEvgeniy's code.Nicely work,HighflyingBird
I compiled this file,then run the test.
(quicksort '(6 5 4 3 3 2 1)) ;;--> '(1 2 3 3 3 4 5 6)It more out a number 3 .
Hi, GileChange:
After revisit this site , I found a bug in the quicksort function you post .Code: [Select](quicksort '(6 5 4 3 3 2 1)) ;;--> '(1 2 3 3 3 4 5 6)It more out a number 3 .
((< ele (car lst)) (left ele (cdr lst)))to:((<= ele (car lst)) (left ele (cdr lst)))
Thanks Lee Mac , thank you a lot .