Skip to content

Instantly share code, notes, and snippets.

@akorobov
Created June 24, 2012 01:46
Show Gist options
  • Save akorobov/2980968 to your computer and use it in GitHub Desktop.
Save akorobov/2980968 to your computer and use it in GitHub Desktop.
count inversions using modified merge sort
-- regular merge sort
mergesort :: (a -> a-> Bool) -> [a] -> [a]
mergesort pred [] = []
mergesort pred [x] = [x]
mergesort pred xs = merge pred (mergesort pred left) (mergesort pred right) where
(left, right) = splitAt (length xs `div` 2) xs
-- write better split
merge :: (a -> a-> Bool) -> [a] -> [a] -> [a]
merge pred left [] = left
merge pred [] right = right
merge pred (l:left) (r:right) = case pred l r of
True -> l : merge pred left (r:right)
False -> r : merge pred (l:left) right
-- merge sort with counting inversions
msort :: (a -> a -> Bool) -> [a] -> ([a], Integer)
msort pred [] = ([],0)
msort pred [x] = ([x], 0)
msort pred xs = mergei pred (msort pred left) (msort pred right) where
(left, right) = splitAt (length xs `div` 2) xs
-- merge two lists with their inversion counts into one using given predicate
-- use Integer to avoid overflow
mergei :: (a -> a -> Bool) -> ([a], Integer) -> ([a], Integer) -> ([a], Integer)
mergei pred (xs, c1) (ys, c2) = (zs, c1 + c2 + c3) where
(zs, c3) = mergei' pred xs ys (toInteger $ length xs)
-- merge helper
mergei' :: (a -> a -> Bool) -> [a] -> [a] -> Integer -> ([a], Integer)
mergei' pred [] ys 0 = (ys, 0)
mergei' pred xs [] xslen = (xs, 0)
mergei' pred (x:xs) (y:ys) xslen =
case pred x y of
True -> (x:zs, c) where (zs, c) = mergei' pred xs (y:ys) (xslen - 1)
False -> (y:zs, c + xslen) where (zs, c) = mergei' pred (x:xs) ys xslen
main = do
let fname = "/Users/ak/Downloads/IntegerArray.txt"
num <- fmap (map read . words) (readFile fname) :: IO [Int]
putStrLn $ "read " ++ (show $ length num) ++ " entries from " ++ fname
putStrLn $ "total inversions " ++ (show $ snd $ msort (<) num)
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment