CountInversion.hs

module CountInversion where

import Control.Arrow

type Count = Int
type Size  = Int
{- |
>>> countInversion [19,11,10,7,8,9,17,18,20,4,3,15,16,1,5,14,6,2,13,12]
114
-}
countInversion :: Ord a => [a] -> Count
countInversion = snd . mergeAndCountAll . map (singleton &&& const 0)

mergeAndCountAll :: Ord a => [(Sized a, Count)] -> (Sized a, Count)
mergeAndCountAll [x] = x
mergeAndCountAll xs  = mergeAndCountAll (mergeAndCountPairs xs)

mergeAndCountPairs :: Ord a => [(Sized a, Count)] -> [(Sized a, Count)]
mergeAndCountPairs (a:b:xs) = mergeAndCount a b : mergeAndCountPairs xs
mergeAndCountPairs xs       = xs

mergeAndCount :: Ord a => (Sized a, Count) -> (Sized a, Count) -> (Sized a, Count)
mergeAndCount (xxs, m) (yys, n)
    | isNil xxs = (yys, m + n)
    | isNil yys = (xxs, m + n)
    | x > y     = (cons y *** (size xxs +)) $ mergeAndCount (xxs, m) (ys, n)
    | otherwise = (cons x *** id)           $ mergeAndCount (xs, m) (yys, n)
    where
        (x,xs) = sizedList (error "xxs: empty Sized List") (,) xxs
        (y,ys) = sizedList (error "yys: empty Sized List") (,) yys

-- サイズ付きリスト
type Sized a = ([a], Size)

nil :: Sized a 
nil = ([], 0)

isNil :: Sized a -> Bool
isNil = sizedList True (const . const False)

cons :: a -> Sized a -> Sized a
cons x (xs, n) = (x:xs, succ n)

hd :: Sized a -> a
hd = sizedList (error "hd: empty Sized List") const 

tl :: Sized a -> Sized a
tl = sizedList (error "tl: empty Sized List") (const id)

singleton :: a -> Sized a
singleton x = cons x nil

sizedList :: b -> (a -> Sized a -> b) -> Sized a -> b
sizedList y f xxs = case xxs of
    ([],   0) -> y
    (x:xs, n) -> f x (xs, pred n)

size :: Sized a -> Size
size = snd