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.

About these ads

Pages: 1 2

10 Responses to “Two Bad Sorts”

  1. 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) =<< 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[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)
    
  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[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.

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

Leave a Reply

Fill in your details below or click an icon to log in:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out / Change )

Twitter picture

You are commenting using your Twitter account. Log Out / Change )

Facebook photo

You are commenting using your Facebook account. Log Out / Change )

Google+ photo

You are commenting using your Google+ account. Log Out / Change )

Connecting to %s

Follow

Get every new post delivered to your Inbox.

Join 627 other followers

%d bloggers like this: