Two Bad Sorts
May 17, 2011
Both of these sorts are simple to code. We begin with stooge sort:
(define (stooge-sort lt? xv . args)
(if (null? args) (stooge-sort lt? xv 0 (- (vector-length xv) 1))
(let ((lo (car args)) (hi (cadr args)))
(when (lt? (vector-ref xv hi) (vector-ref xv lo))
(let ((t (vector-ref xv lo)))
(vector-set! xv lo (vector-ref xv hi))
(vector-set! xv hi t)))
(when (< 1 (- hi lo))
(let ((mid (quotient (- hi lo -1) 3)))
(stooge-sort lt? xv lo (- hi mid))
(stooge-sort lt? xv (+ lo mid) hi)
(stooge-sort lt? xv lo (- hi mid))))))
xv)
We used a vector instead of a list because it is more convenient to pass subscripts than to repeatedly take slices of lists. Bogosort is even simpler:
(define (sorted? lt? xs)
(cond ((null? xs) #t)
((null? (cdr xs)) #t)
((lt? (cadr xs) (car xs)) #f)
(else (sorted? lt? (cdr xs)))))
(define (bogosort lt? xs)
(if (sorted? lt? xs) xs
(bogosort lt? (shuffle xs))))
Our sorted? is generic; if we limited ourselves to sorting integers, we could have said (apply < xs) and done away with sorted?.
Bogosort uses rand/randint and shuffle from the Standard Prelude. You can run both sorts at http://programmingpraxis.codepad.org/tmpDUJnJ.
Programming Praxis 
My Haskell solution (see http://bonsaicode.wordpress.com/2011/05/17/programming-praxis-two-bad-sorts/ for a version with comments):
import Control.Arrow import System.Random import System.Random.Shuffle stoogesort :: Ord a => [a] -> [a] stoogesort [] = [] stoogesort xs@(h:t) = f $ if last xs < h then last xs : init t ++ [h] else xs where f = if length xs > 2 then s first 2 . s second 1 . s first 2 else id s p n = uncurry (++) . p stoogesort . splitAt (div (n * length xs) 3) bogosort :: Ord a => [a] -> IO [a] bogosort [] = return [] bogosort xs = if and $ zipWith (<=) xs (tail xs) then return xs else bogosort . shuffle' xs (length xs) =<< newStdGenHere’s my python version. Although it is worth noting it’s not very efficient, and bogo can easy cause a stack error.
from random import shuffle def stooge(to_sort): if to_sort[-1] < to_sort[0]: to_sort[-1], to_sort[0] = to_sort[0], to_sort[-1] if len(to_sort) > 2: to_sort[:len(to_sort) * 2 / 3] = stooge(to_sort[:len(to_sort) * 2 / 3]) to_sort[len(to_sort) * 1 / 3:] = stooge(to_sort[len(to_sort) * 1 / 3:]) to_sort[:len(to_sort) * 2 / 3] = stooge(to_sort[:len(to_sort) * 2 / 3]) return to_sort def bogo(to_sort): if all(map(lambda x, y: y is None or x <= y, to_sort, to_sort[1:])): return to_sort shuffle(to_sort) return bogo(to_sort)My Python version:
from random import shuffle def stoogesort(seq, is_gt, a=0, b=-1): b += len(seq) if b == -1 else 0 if len(seq) <= 1 or a > b: return None if is_gt(seq[a], seq[b]): seq[a], seq[b] = seq[b], seq[a] if b - a > 1: t = (b - a + 1) / 3 stoogesort(seq, is_gt, a, b - t) stoogesort(seq, is_gt, a + t, b) stoogesort(seq, is_gt, a, b - t) def bogosort(seq, is_gt): while any(is_gt(x, y) for (x, y) in zip(seq, seq[1:])): shuffle(seq) return NoneMy
bogosortis iterative, so it avoids the Python recursion limit. For a few comments and tests, see github.In Ruby …
def stooge_sort(list, depth=0) puts "#{" "*depth}Enter #{list}" if $VERBOSE if list.last < list.first tmp = list.first list[0] = list.last list[list.size-1] = tmp end puts "#{" "*depth}First Change #{list}" if $VERBOSE if list.size >= 3 # First 2/3 first = 0 last = (list.size/3)*2-1 puts "#{" "*depth}1) first = #{first} last = #{last}" if $VERBOSE l1 = stooge_sort(list[first..last], depth+1) list[first..last] = l1 puts "#{" "*depth}Second Change #{list}" if $VERBOSE # Last 2/3 first = list.size/3 last = list.size-1 puts "#{" "*depth}2) first = #{first} last = #{last}" if $VERBOSE l1 = stooge_sort(list[first..last], depth+1) list[first..last] = l1 puts "#{" "*depth}Third Change #{list}" if $VERBOSE # First 2/3 again first = 0 last = (list.size/3)*2-1 puts "#{" "*depth}3) first = #{first} last = #{last}" if $VERBOSE l1 = stooge_sort(list[first..last], depth+1) list[first..last] = l1 puts "#{" "*depth}Fourth Change #{list}" if $VERBOSE end list end def bogo_sort(list) while list != list.sort list = list.sort_by { rand } end list end $VERBOSE = false l = (1..10).sort_by {rand} puts "Stooge sort success! #{stooge_sort(l)}" l = (1..10).sort_by {rand} puts "Bogo sort success! #{bogo_sort(l)}"set $VERBOSE to true to watch the stooge sort work.
(define (stooge! vec #!optional (start 0) (end (1- (vector-length vec))))
(when (> (vector-ref vec start)
(vector-ref vec end))
(let ((tmp (vector-ref vec start)))
(vector-set! vec start (vector-ref vec end))
(vector-set! vec end tmp)))
(unless (or (= end start) (= 1 (- end start)))
(let* ((len (- end start))
(two-thirds (floor (* 2/3 len)))
(one-third (- len two-thirds)))
(stooge! vec start (+ start two-thirds))
(stooge! vec (+ start one-third) end)
(stooge! vec start (+ start two-thirds)))))
;
(define (sorted? vec)
(fold-left
(lambda (r x)
(if (and r (>= x r)) x #f))
(vector-ref vec 0)
(vector->list vec)))
;
(define (shuffle l)
(if (pair? l)
(if (zero? (random-integer 2))
(cons (car l) (shuffle (cdr l)))
(shuffle (append (cdr l) (list (car l)))))
'()))
;
(define (bogo! vec)
(when (not (sorted? vec))
(let ((i 0))
(map (lambda (x)
(vector-set! vec i x)
(set! i (1+ i)))
(shuffle (vector->list vec))))
(bogo! vec)))
My try in REXX:
ur_liste = '5 3 7 9 1 4 0 7' lst. = '' call liste_array ur_liste start = time('E') call stooge 1,li say 'Stooge:' array_liste() 'in' time('R') 'seconds' lst. = '' max = 10000 fnd = 0 do cnt = 1 to max call random_array ur_liste if bogo() then do say 'Bogo' cnt':' array_liste(), 'in' time('R') 'seconds' fnd = 1 leave end end if fnd == 0 then say 'no sorted array created in' max 'tries', 'in' time('R') 'seconds' exit liste_array: parse arg liste li = 0 do while words(liste) > 0 parse value liste with first liste li = li + 1 lst.li = first lst.0 = li end return random_array: parse arg liste li = 0 do while words(liste) > 0 p = random(1,words(liste)) li = li + 1 lst.li = word(liste,p) lst.0 = li liste = delword(liste,p,1) end return array_liste: liste = '' do i = 1 to li liste = liste lst.i end return strip(liste) stooge: procedure expose lst. parse arg fr,to if lst.fr > lst.to then do tmp = lst.fr lst.fr = lst.to lst.to = tmp end len = to-fr+1 if len > 2 then do third = len % 3 call stooge fr,to-third call stooge fr+third,to call stooge fr,to-third end return bogo: procedure expose lst. prv = lst.1 do i = 2 to lst.0 if lst.i < prv then return 0 prv = lst.i end return 1 /* Stooge: 0 1 3 4 5 7 7 9 in 0.013000 seconds Bogo 9562: 0 1 3 4 5 7 7 9 in 9.671000 seconds */[…] post: Two Bad Sorts « Programming Praxis Categories: Programming 0 Comments Tags: a-version-with, control, haskell, programming, […]
(define (sorted? lt? l)
(cond ((or (null? l) (null? (cdr l))) #t)
((not (lt? (car l) (cadr l))) #f)
(else (sorted? lt? (cdr l)))))
(define (bogo-sort l)
(if (sorted? <= l)
l (bogo-sort (shuffle l))))
(define (stooge-sort l)
(define (stooge-sort-impl v lo hi)
(define (swap! i j)
(let ((t (vector-ref v i)))
(vector-set! v i (vector-ref v j))
(vector-set! v j t)))
(if (and (>= (- hi lo) 1) (< (vector-ref v hi) (vector-ref v lo)))
(swap! lo hi))
(if (>= (- hi lo) 2)
(let ((m (floor (/ (- hi lo -1) 3))))
(stooge-sort-impl v lo (- hi m))
(stooge-sort-impl v (+ lo m) hi)
(stooge-sort-impl v lo (- hi m)))))
(let ((v (list->vector l)))
(stooge-sort-impl v 0 (- (length l) 1))
(vector->list v)))
(define (sorted? lt? l) (cond ((or (null? l) (null? (cdr l))) #t) ((not (lt? (car l) (cadr l))) #f) (else (sorted? lt? (cdr l))))) (define (bogo-sort l) (if (sorted? <= l) l (bogo-sort (shuffle l)))) (define (stooge-sort l) (define (stooge-sort-impl v lo hi) (define (swap! i j) (let ((t (vector-ref v i))) (vector-set! v i (vector-ref v j)) (vector-set! v j t))) (if (and (>= (- hi lo) 1) (< (vector-ref v hi) (vector-ref v lo))) (swap! lo hi)) (if (>= (- hi lo) 2) (let ((m (floor (/ (- hi lo -1) 3)))) (stooge-sort-impl v lo (- hi m)) (stooge-sort-impl v (+ lo m) hi) (stooge-sort-impl v lo (- hi m))))) (let ((v (list->vector l))) (stooge-sort-impl v 0 (- (length l) 1)) (vector->list v)))Bogosort implementation in java: https://gist.github.com/1253001