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