# Optimizing a divide-and-conquer algorithm for counting inversions

I have the following code:

inversions :: (Ord a) => [a] -> Int
inversions xs = snd $countInv' (xs, length xs) countInv' :: (Ord a) => ([a], Int) -> ([a], Int) countInv' ([], _) = ([], 0) countInv' ([x], _) = ([x], 0) countInv' (xs, n) = (sorted, leftInv + splitInv + rightInv) where leftLen = n div 2 rightLen = n - leftLen (left, right) = splitAt leftLen xs (sortedLeft, leftInv) = countInv' (left, leftLen) (sortedRight, rightInv) = countInv' (right, rightLen) (sorted, splitInv) = countSplitInv' (sortedLeft, leftLen) (sortedRight, rightLen) countSplitInv' :: (Ord a) => ([a], Int) -> ([a], Int) -> ([a], Int) countSplitInv' ([], _) ([], _) = ([], 0) countSplitInv' (xs, _) ([], _) = (xs, 0) countSplitInv' ([], _) (xs, _) = (xs, 0) countSplitInv' (x : xs, nx) (y : ys, ny) | x > y = (y : sortedY, nx + splitInvY) | otherwise = (x : sortedX, splitInvX) where (sortedX, splitInvX) = countSplitInv' (xs, pred nx) (y : ys, ny) (sortedY, splitInvY) = countSplitInv' (x : xs, nx) (ys, pred ny) main :: IO () main = do contents <- getContents print$ inversions (map read (lines contents) :: [Int])


How could I write this code in a way that is more idiomatic, reduces the amount of repetition, and reduces the amount of data being copied?

As a Haskell beginner, I would appreciate it if you give an indepth explanation of the code you write and try to keep your code as simple as possible.

The problem with countSplitInv' is that merging two lists is has the characteristic of co-recursion (it consumes a finite amount of data from given lists to produce one output element), while computing the inversion count has the characteristic of recursion (accumulates value while traversing given lists).

One way how to remedy that would be to count the inversion count for each element separately. Then we'd be working with lists of [(a, Int)]. This also somewhat simplifies the code as it's not necessary to wrap/unwrap pairs at so many places. Also using as-patterns we can avoid recombining values unnecessarily.

import Criterion.Main

inversions :: (Ord a) => [a] -> Int
inversions xs = sum . map snd $countInv' xs (length xs) countInv' :: (Ord a) => [a] -> Int -> [(a, Int)] countInv' [] _ = [] countInv' [x] _ = [(x, 0)] countInv' xs n = countSplitInv' (countInv' left leftLen) leftLen (countInv' right rightLen) where leftLen = n div 2 rightLen = n - leftLen (left, right) = splitAt leftLen xs -- we only need to keep track of the right part (nx) countSplitInv' :: (Ord a) => [(a, Int)] -> Int -> [(a, Int)] -> [(a, Int)] -- note that the case [] _ [] is contained in xs _ [] countSplitInv' xs _ [] = xs countSplitInv' [] _ ys = ys countSplitInv' xs@((x, ix) : xs') nx ys@((y, iy) : ys') | x > y = (y, iy + nx) : countSplitInv' xs nx ys' | otherwise = (x, ix) : countSplitInv' xs' (nx - 1) ys main = defaultMain [ bgroup "inv"$ map bstep [1..10]
]
where
bstep n = bench (show n2) $nf inversions [n2,n2-1..1] where n2 = 2^n  (I also added main for measuring performance using the criterion package.) This way, countSplitInv' is just co-recursive. According to my benchmarks (compiling with -O2 and running main), for a decreasing list of length 1024 the original took 1.55ms, while this improved version takes 0.96ms. However, we still do splitAt and computing the length of the list at the beginning. A way to solve that is dividing the list not from the top, but the bottom. The trick is to first convert [a] into a list of singletons [[a]] and then merge them pair-wise until we get to a single element. (See also the source of Haskell's standard sort.) It can be implemented in many ways. Since I like the abstraction of monoids, I used a monoid that keeps track of inversion counts of a list of elements, and the monoid operation is merging such two lists. And mconcat is implemented pair-wise so that the order of computations form a balanced binary tree: import Data.Monoid import Criterion.Main countSplitInv' :: (Ord a) => [(a, Int)] -> Int -> [(a, Int)] -> [(a, Int)] countSplitInv' xs _ [] = xs countSplitInv' [] _ ys = ys countSplitInv' xs@((x, ix) : xs') nx ys@((y, iy) : ys') | x > y = (y, iy + nx) : countSplitInv' xs nx ys' | otherwise = (x, ix) : countSplitInv' xs' (nx - 1) ys -- Represents a computation of inversions. data Inv a = Inv { invSize :: !Int -- ^ the length of the list , invSorted :: [(a, Int)] -- ^ sorted elements with their -- inversion counts } instance (Ord a) => Monoid (Inv a) where mempty = Inv 0 [] mappend (Inv nx xs) (Inv ny ys) = Inv (nx + ny) (countSplitInv' xs nx ys) mconcat [] = mempty mconcat [x] = x mconcat xs = mconcat (mergePairs xs) where mergePairs (x:y:zs) = (x mappend y) : mergePairs zs mergePairs zs = zs inject :: a -> Inv a inject x = Inv 1 [(x, 0)] inversions :: (Ord a) => [a] -> Int inversions = sum . map snd . invSorted . mconcat . map inject main = defaultMain [ bgroup "inv"$ map bstep [1..10]
]
where
bstep n = bench (show n2) $nf inversions [n2,n2-1..1] where n2 = 2^n  This variant is again faster, it takes 0.66ms for 1024 element list. And if we use the same trick sort does (see the above link), and partition the input list into decreasing and increasing sequences (for which we can easily compute the inversion counts in linear time), we get somewhat more complex code, but very fast for lists that contain long ordered sequences: import Data.Monoid import Criterion.Main countSplitInv' :: (Ord a) => [(a, Int)] -> Int -> [(a, Int)] -> [(a, Int)] countSplitInv' xs _ [] = xs countSplitInv' [] _ ys = ys countSplitInv' xs@((x, ix) : xs') nx ys@((y, iy) : ys') | x > y = (y, iy + nx) : countSplitInv' xs nx ys' | otherwise = (x, ix) : countSplitInv' xs' (nx - 1) ys -- Represents a computation of inversions. data Inv a = Inv { invSize :: !Int -- ^ the length of the list , invSorted :: [(a, Int)] -- ^ sorted elements with their -- inversion counts } instance (Ord a) => Monoid (Inv a) where mempty = Inv 0 [] mappend (Inv nx xs) (Inv ny ys) = Inv (nx + ny) (countSplitInv' xs nx ys) mconcat [] = mempty mconcat [x] = x mconcat xs = mconcat (mergePairs xs) where mergePairs (x:y:zs) = (x mappend y) : mergePairs zs mergePairs zs = zs sequences :: (Ord a) => [a] -> [Inv a] sequences (a:b:xs) | a > b = descending b [a] 2 xs | otherwise = ascending b (a:) 2 xs where sequences [x] = [Inv 1 [(x, 0)]] sequences [] = [] descending :: (Ord a) => a -> [a] -> Int -> [a] -> [Inv a] descending a as n (b:bs) | a > b = descending b (a:as) (n + 1) bs descending a as n bs = Inv n (zip (a:as) [(n-1),(n-2)..]) : sequences bs ascending :: (Ord a) => a -> ([a] -> [a]) -> Int -> [a] -> [Inv a] ascending a as n (b:bs) | a < b = ascending b (\ys -> as (a:ys)) (n + 1) bs ascending a as n bs = Inv n (zip (as [a]) [(n-1),(n-2)..]) : sequences bs inversions :: (Ord a) => [a] -> Int inversions = sum . map snd . invSorted . mconcat . sequences main = defaultMain [ bgroup "inv"$ map bstep [1..10]
]
where
bstep n = bench (show n2) $nf inversions [n2,n2-1..1] where n2 = 2^n  (For the decreasing list of 1024 numbers, it took 0.11ms, as it computed the result in one single pass.) • Thanks for your comprehensive answer! I haven't done monoids yet, so I don't understand everything after the use of monoids. I will read up on monoids before I look further into your answer. Oct 12, 2014 at 13:19 • @wei2912 For monoids see also What is practical use of monoids? and Examples of monoids/semigroups in programming. – Petr Oct 12, 2014 at 14:12 Well, a simple implementation would be: inversions' :: (Ord a) => [a] -> Int inversions' [] = 0 inversions' [_] = 0 inversions' (x:xs) = (length$ filter (< x) xs) + (inversions' xs)


But that would be an $O(n^2)$ algorithm, as you probably knew, since you seem to have written your code with performance in mind. In fact, you've gone to great lengths (no pun intended) to avoid calling length more than once: with every list that you pass around, you also keep track of its length.

I'm not sure how much performance gain such bookkeeping gives you in practice. You still need to call splitAt with every subdivision, which is $O(n)$. For simplicity, I suspect that you would be better off copying your input into a Data.Vector, and using vectors everywhere instead.

Essentially, what you have is a mergesort that counts inversions instead of producing the sorted list. My simplistic implementation is analogous to an insertion sort.

• length is $O(n)$ according to the docs. A casual benchmark test (which is by no means accurate) revealed that my program took about 12 seconds with length and less than 2 without length, so it appears that not using length makes a significant difference. I will take a look at Data.Vector. Thanks! Oct 12, 2014 at 12:36

A trivial simplification would be to eliminate this redundant special case:

countSplitInv' ([], _) ([], _) = ([], 0)