### 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.

Pages: 1 2

### 10 Responses to “Two Bad Sorts”

```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) =<< newStdGen
```
2. John said

Here’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: to_sort[-1], to_sort = to_sort, 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])

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)
```
3. Graham said

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 None
```

My `bogosort` is iterative, so it avoids the Python recursion limit. For a few comments and tests, see github.

4. slabounty said

In Ruby …

```def stooge_sort(list, depth=0)

puts "#{"    "*depth}Enter #{list}" if \$VERBOSE
if list.last < list.first
tmp = list.first
list = 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.

5. Axio said

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

6. Rainer said

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
*/

```
7. […] post: Two Bad Sorts « Programming Praxis Categories: Programming 0 Comments Tags: a-version-with, control, haskell, programming, […]

8. brdassign said

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

9. brdassign said
```(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)))
```