# Bubble sort with counting swaps and comparsions

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)


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)

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

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

• Note that the incr* definitions could be subsumed by using lenses. However I thought it was outside the scope of this answer. Dec 22 '17 at 19:43