Bubble sort with counting swaps and comparsions

Question

I have bubble sort code below, which has to count swaps and comparisons of elements. How can it be made more elegant and clear, if it is possible? I think using lots of tuples is not the best way to do this.

bsort' x = bsort (x,0,0)
bsort :: (Ord a) => ([a], Int,Int) -> ([a], Int, Int) -- (table, nswaps, ncompares)
bsort ([],i,j) = ([], i, j)
bsort (lst, inswp, incmp)
 | hasNoSwaps = (lst, swaps, cmps)
 | otherwise = ((next ++ [last bubbled]), subswaps, subcounts)
 where
 (next, subswaps, subcounts) = bsort ((init bubbled), swaps, cmps)
 (bubbled, hasNoSwaps, swaps, cmps) = bubble (lst, inswp ,incmp)
 bubble :: (Ord a) => ([a], Int, Int) -> ([a], Bool, Int, Int)
 bubble ([x], i, j) = ([x], True, i, j)
 bubble ((x:y:xs), swaps, cmps)
 | x > y = (y : bubbled_x, False, newswaps_x+1, newcmps_x+1)
 | otherwise = (x : bubbled_y, swaps_y, newswaps, newcmps+1)
 where
 (bubbled_y, swaps_y, newswaps, newcmps) = bubble ((y:xs), swaps, cmps)
 (bubbled_x, swaps_x, newswaps_x, newcmps_x) = bubble ((x:xs), swaps, cmps)

Answer 1

I think @gallais's answer is pretty good (and upvoted it accordingly). But, here's an alternative approach that leads to pretty clean code. Let's first strip out all the instrumenting from your original code and have a look at your core bsort algorithm:

bsort :: (Ord a) => [a] -> [a]
bsort [] = []
bsort lst
 | hasNoSwaps = lst
 | otherwise = next ++ [last bubbled]
 where
 next = bsort (init bubbled)
 (bubbled, hasNoSwaps) = bubble lst
bubble :: (Ord a) => [a] -> ([a], Bool)
bubble [x] = ([x], True)
bubble (x:y:xs)
 | x > y = (y : bubbled_x, False)
 | otherwise = (x : bubbled_y, swaps_y)
 where
 (bubbled_y, swaps_y) = bubble (y:xs)
 (bubbled_x, swaps_x) = bubble (x:xs)

I think this looks very good. The only changes I would consider making are:

• combine the definition of next and the ++ [last bubbled] expression to make it a little clearer that the contents of the list are preserved
• invert the the hasNoSwaps flag, on the basis that a flag indicating there were swaps is easier to understand than a flag indicating there weren't swaps; and
• find a way to better express the common code in the two cases handled by bubbled

This would give something like:

bsort :: (Ord a) => [a] -> [a]
bsort [] = []
bsort lst | not anySwaps = lst -- if no swaps, we're done
 | otherwise = bsort (init lst') ++ [last lst']
 where (lst', anySwaps) = bubble lst
bubble :: (Ord a) => [a] -> ([a], Bool)
bubble [x] = ([x], False)
bubble (x:y:xs) | x > y = bubble' True (y:x:xs)
 | otherwise = bubble' False (x:y:xs)
 where bubble' swapped (z:zs) = let (zs', anySwaps) = bubble zs
 in (z:zs', swapped || anySwaps)

though this is more personal taste than a firm recommendation, especially the way I would write the bubble cases in terms of bubble' -- many people might find your original version clearer.

However, there's no doubt that we want to preserve, as much as possible, the clean expression of the algorithm as we add instrumentation. We'll want to use some monad, so let's convert it to run in the identity monad with as little damage as possible. Let's define:

import Control.Monad.Identity
type M = Identity

Now, here's my version running in the monad M, with as much of the straightforward structure preserved as I could manage without resorting to fancy applicative and/or lifted operator tricks:

bsort :: (Ord a) => [a] -> M [a]
bsort [] = return []
bsort lst = do (lst', anySwaps) <- bubble lst
 if not anySwaps
 then return lst
 else do lst'' <- bsort (init lst')
 return (lst'' ++ [last lst'])
bubble :: (Ord a) => [a] -> M ([a], Bool)
bubble [x] = return ([x], False)
bubble (x:y:xs) | x > y = bubble' True (y:x:xs)
 | otherwise = bubble' False (x:y:xs)
 where bubble' swapped (z:zs) = do (zs', anySwaps) <- bubble zs
 return (z:zs', swapped || anySwaps)

I find this version a little more difficult to follow than the non-monadic version, but it's not that bad.

Adding instrumentation to the bubble function is pretty straightforward:

bubble :: (Ord a) => [a] -> M ([a], Bool)
bubble [x] = return ([x], False)
bubble (x:y:xs) | x > y = countCompare >> countSwap >> bubble' True (y:x:xs)
 | otherwise = countCompare >> bubble' False (x:y:xs)
 where bubble' swapped (z:zs) = do (zs', anySwaps) <- bubble zs
 return (z:zs', swapped || anySwaps)

And now we can redefine the monad M to something useful and give definitions for the countCompare and countSwap functions. Unlike @gallais, I'll use a Writer monad with a monoid instance to sum up the separate counts:

import Control.Monad.Writer
type M = Writer Stats
data Stats = Stats Int Int -- compares, swaps
 deriving (Show)
instance Monoid Stats where
 mempty = Stats 0 0
 Stats x y `mappend` Stats x' y' = Stats (x+x') (y+y')

The countCompare and countSwap functions just tell out an increment to the stats (which will all be summed together by the monoid instance):

countCompare, countSwap :: M ()
countCompare = tell (Stats 1 0)
countSwap = tell (Stats 0 1)

The final program, with a bsort' definition to run the whole thing, looks like:

import Control.Monad.Writer
-- *Instrumentation
type M = Writer Stats
data Stats = Stats Int Int -- compares, swaps
 deriving (Show)
instance Monoid Stats where
 mempty = Stats 0 0
 Stats x y `mappend` Stats x' y' = Stats (x+x') (y+y')
countCompare, countSwap :: M ()
countCompare = tell (Stats 1 0)
countSwap = tell (Stats 0 1)
-- *Core algorithm
bsort :: (Ord a) => [a] -> M [a]
bsort [] = return []
bsort lst = do (lst', anySwaps) <- bubble lst
 if not anySwaps
 then return lst
 else do lst'' <- bsort (init lst')
 return (lst'' ++ [last lst'])
bubble :: (Ord a) => [a] -> M ([a], Bool)
bubble [x] = return ([x], False)
bubble (x:y:xs) 
 | x > y = countCompare >> countSwap >> bubble' True (y:x:xs)
 | otherwise = countCompare >> bubble' False (x:y:xs)
 where bubble' swapped (z:zs) = do (zs', anySwaps) <- bubble zs
 return (z:zs', swapped || anySwaps)
-- *Monad runner
bsort' :: (Ord a) => [a] -> ([a], Stats)
bsort' = runWriter . bsort

and we get:

> bsort' [10,9..1]
([1,2,3,4,5,6,7,8,9,10],Stats 45 45)
> bsort' [1..10]
([1,2,3,4,5,6,7,8,9,10],Stats 9 0)

which matches the stats you get with your original version.

As a side note, there are some potential space leak issues when using the writer monad, so this might not be the best way of instrumenting large programs. However, it's fairly easy to convert this to a state monad implementation without modifying the definition of bubble.

If you want, some exercises for you:

1. Take your uninstrumented version from the top of this answer and apply the same transformation I did, first modifying so it type checks in some monad (like Identity) while preserving as much of the original structure as possible; then, add instrumentation using the Writer monad.
2. Try converting it to run in the State monad, using @gallais's answer as a guide, but without making any changes to the instrumented monadic version of the algorithm from exercise 1. (Hint: @gallais's incrSwaps will end up being a drop-in replacement for countSwap.)

Answer 2

Here's a refactored version using a State monad to handle the threading of the counters.

We start with the type of counters, the notion of being Instrumented (i.e. a computation with counters) and some basic combinators increasing the counters.

import Control.Monad.State
data Counters = Counters
 { swaps :: !Int
 , comparisons :: !Int
 }
type Instrumented = State Counters
incrSwaps :: Instrumented ()
incrSwaps = do
 cnts <- get
 put $ cnts { swaps = swaps cnts + 1 }
incrComparisons :: Instrumented ()
incrComparisons = do
 cnts <- get
 put $ cnts { comparisons = comparisons cnts + 1 }

We can then write down a comparison operator which records the fact it was called by increasing the appropriate counter:

cmpGT :: Ord a => a -> a -> Instrumented Bool
cmpGT x y = do
 incrComparisons
 return $ x > y

Using the same idea, we can port your definition of bubble. Two things to be careful about: you need to use do blocks now and you shouldn't forget to call incrSwaps in the branch where you performed a swap:

bubble :: Ord a => [a] -> Instrumented (Bool, [a])
bubble [] = return (True, [])
bubble [x] = return (True, [x])
bubble (x : y : zs) = do
 xgty <- cmpGT x y
 if xgty
 then do
 incrSwaps
 rec <- snd <$> bubble (x : zs)
 return $ (False, y : rec)
 else do
 fmap (x :) <$> bubble (y : zs)

bsort is not that different (I don't post lastAndInit :: [a] -> (a, [a]) here as it's not important, it's in the gist)

bsort :: Ord a => [a] -> Instrumented [a]
bsort [] = return []
bsort xxs = do
 (hasNoSwaps, bubbled) <- bubble xxs
 if hasNoSwaps
 then return xxs
 else do
 let (y, ys) = lastAndInit bubbled
 next <- bsort ys
 return $ next ++ [y]

Finally, bsort' corresponds to the combination of an initial state and runState:

initialCounters :: Counters
initialCounters = Counters 0 0
bsort' :: Ord a => [a] -> ([a], Counters)
bsort' xs = bsort xs `runState` initialCounters

• gallais: Note that the incr* definitions could be subsumed by using lenses. However I thought it was outside the scope of this answer.