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)
up vote 4 down vote accepted

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

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. – gallais Dec 22 '17 at 19:43

Your Answer

 

By clicking "Post Your Answer", you acknowledge that you have read our updated terms of service, privacy policy and cookie policy, and that your continued use of the website is subject to these policies.

Not the answer you're looking for? Browse other questions tagged or ask your own question.