Bogobogosort (Haskell)

Readme.rst

Bogobogosort (Haskell)

This is an implementation of the best sorting algorithm I've encountered so far, Bogobogosort.

Results

The test function testbbs was run on lists of lengths 1 to 10 for 5 times each. The timed results are:

Length	Time (s)
1	0.01
2	0.01
3	0.01
4	0.01
5	0.02
6	0.04
7	0.16
8	2.47
9	21.40
10	85.75

λ> :r
[1 of 1] Compiling Main             ( Bogobogosort.hs, interpreted )
Ok, one module loaded.
λ> :set +s
λ> testbbs 5 [1..1]
[1]
[1]
[1]
[1]
[1]
(0.01 secs, 105,384 bytes)
λ> testbbs 5 [1..2]
[1,2]
[1,2]
[1,2]
[1,2]
[1,2]
(0.01 secs, 203,360 bytes)
λ> testbbs 5 [1..3]
[1,2,3]
[1,2,3]
[1,2,3]
[1,2,3]
[1,2,3]
(0.01 secs, 408,400 bytes)
λ> testbbs 5 [1..4]
[1,2,3,4]
[1,2,3,4]
[1,2,3,4]
[1,2,3,4]
[1,2,3,4]
(0.01 secs, 940,392 bytes)
λ> testbbs 5 [1..5]
[1,2,3,4,5]
[1,2,3,4,5]
[1,2,3,4,5]
[1,2,3,4,5]
[1,2,3,4,5]
(0.02 secs, 4,271,408 bytes)
λ> testbbs 5 [1..6]
[1,2,3,4,5,6]
[1,2,3,4,5,6]
[1,2,3,4,5,6]
[1,2,3,4,5,6]
[1,2,3,4,5,6]
(0.04 secs, 22,586,512 bytes)
λ> testbbs 5 [1..7]
[1,2,3,4,5,6,7]
[1,2,3,4,5,6,7]
[1,2,3,4,5,6,7]
[1,2,3,4,5,6,7]
[1,2,3,4,5,6,7]
(0.16 secs, 153,380,472 bytes)
λ> testbbs 5 [1..8]
[1,2,3,4,5,6,7,8]
[1,2,3,4,5,6,7,8]
[1,2,3,4,5,6,7,8]
[1,2,3,4,5,6,7,8]
[1,2,3,4,5,6,7,8]
(2.47 secs, 3,234,910,464 bytes)
λ> testbbs 5 [1..9]
[1,2,3,4,5,6,7,8,9]
[1,2,3,4,5,6,7,8,9]
[1,2,3,4,5,6,7,8,9]
[1,2,3,4,5,6,7,8,9]
[1,2,3,4,5,6,7,8,9]
(21.40 secs, 28,542,473,688 bytes)
λ> testbbs 5 [1..10]
[1,2,3,4,5,6,7,8,9,10]
[1,2,3,4,5,6,7,8,9,10]
[1,2,3,4,5,6,7,8,9,10]
[1,2,3,4,5,6,7,8,9,10]
[1,2,3,4,5,6,7,8,9,10]
(85.75 secs, 149,945,559,944 bytes)
λ>

Bogobogosort.hs

-- SPDX-License-Identifier: MIT
-- Copyright (c) 2020 Chua Hou
--
-- In this variant of Bogobogosort, we sort the last (n-1) elements recursively
-- rather than the first (n-1).
--
-- For more information, see
-- https://www.dangermouse.net/esoteric/bogobogosort.html
--
-- The procedure is:
--
-- 1. Sort the last n-1 elements of the copy using bogobogosort.
-- 2. Check to see if the 1st element of the sorted copy is <= than the
--    first element of the last n-1 elements. If so, the copy is now sorted,
--    else randomise the order of the elements of the copy and go to step 1.
-- 3. Repeat.

import System.Random
import Data.Array.IO
import Control.Monad

bogobogosort :: (Ord a) => [a] -> IO [a]
bogobogosort []     = return []  -- base case for empty
bogobogosort [x]    = return [x] -- base case for singleton
bogobogosort (x:xs) = bogobogosort xs >>= step x -- step 1: sort last n-1 elems
    where
        step x (y:ys) -- step 2
            | x <= y    = return (x:y:ys)                 -- in order, done
            | otherwise = shuffle (x:xs) >>= bogobogosort -- shuffle again

-- Performs n times of bogobogosort on a random shuffle of xs
testbbs :: (Ord a, Show a) => Int -> [a] -> IO ()
testbbs n xs = let rs = shuffle xs
               in  foldl s (putStr "") [ rs >>= bogobogosort | i <- [1..n] ]
                    where
                        s n x = n >> x >>= \x -> putStrLn (show x)

-- Snippets copied from elsewhere --

-- https://wiki.haskell.org/Random_shuffle
shuffle :: [a] -> IO [a]
shuffle xs = do
        ar <- newArray n xs
        forM [1..n] $ \i -> do
            j <- randomRIO (i,n)
            vi <- readArray ar i
            vj <- readArray ar j
            writeArray ar j vi
            return vj
  where
    n = length xs
    newArray :: Int -> [a] -> IO (IOArray Int a)
    newArray n xs =  newListArray (1,n) xs

Now moved here.