content: {-# LANGUAGE ScopedTypeVariables #-}
  module Utils.List where
  
  import Data.List
  import Data.Function
  import Data.Maybe
  import Control.Arrow ((&&&))
  import qualified Data.Map as M
  import Test.QuickCheck
  
  
  -- | Group list into indevidual pairs: [1,2,3,4] => [(1,2),(3,4)]. 
  --   Works only with even number of elements
  pairs [] = []
  pairs [x] = error "Non-even list for pair function"
  pairs (x:y:xs) = (x,y):pairs xs
  
  -- | Undo pairs function
  fromPairs [] = []
  fromPairs ((x,y):xs) = x:y:fromPairs xs
  
  prop_pairsFromTo xs = even (length xs) ==> xs == fromPairs (pairs xs)
  
  -- | Group list into pairs: [1,2,3] => [(1,2),(2,3)]. 
  --   Works with non null lists
  
  pairs1 x = zip x (tail x)
  
  -- | Undo pairs1 function
  fromPairs1 [] = []
  fromPairs1 [(x,y)] = [x,y]
  fromPairs1 ((x,y):xs) = x:fromPairs1 (xs)
  
  prop_pairsFromTo1 xs = length xs > 1 ==> xs == fromPairs1 (pairs1 xs)
  
  crease op = map (uncurry op) . pairs1
  creaseM op = sequence . (crease op)
  
  ranks f xs = map fst $ rankBy f xs
  
  rankBy f xs = map (\(rank,(orig,val)) -> (rank,val))
                . sortBy (compare`on`(fst.snd))
                . zip [1..] 
                . sortBy (f`on`snd) 
                . zip [1..] 
                $ xs
  
  clusterBy :: Ord b => (a -> b) -> [a] -> [[a]]
  clusterBy f = M.elems . M.map reverse . M.fromListWith (++)
              . map (f &&& return)
  
  
  groupItems b a items = map ( (b . head) &&& map a) 
                         . groupBy ((==)`on` b)
                         . sortBy (comparing b) $ items 
  
  -- Assoc-list lookup with default value
  lookupDef d a lst = fromMaybe d $ lookup a lst
  
  -- get all consecutive pairs of a list: 
  --pairings "kissa"
  -- => [('k','i'),('i','s'),('s','s'),('s','a')]
  
  pairings [] = []
  pairings [x,y] = [(x,y)]
  pairings (x:y:ys) = (x,y):pairings (y:ys)
  
  -- Perform an operation for each in lst
  forEach fun lst = unfoldr op ([],lst)
      where
       op (start,[]) = Nothing
       op (start,a:as) = Just (start++(fun a):as
                              ,(start++[a],as)) 
  
  forPairs fun lst lst2 = map (map fst) 
                           $ forEach (\(a,b)->(fun a b,b))
                           $ zip lst lst2
  
  -- 
  replicateList n l = concat $ replicate n l
  --
  
  concatZipNub (a:as) (b:bs) 
      | a == b = a:concatZipNub as bs
      | a /= b = a:b:concatZipNub as bs                    
  concatZipNub [] _ = []
  concatZipNub _ [] = []
  
  histogram binWidth values = (map len grouped)
      where
       len x = (snap (head x), fromIntegral (length x)) 
       min = minimum values
       max = maximum values
       grouped = group sorted
       sorted = sort $ map snap values
       snap x = binWidth*(fromIntegral $ floor (x/binWidth))
  
  binList binWidth op ivs = zip bins (map op values) 
      where
       values = map (map snd) grouped
       bins = map (fst.head) grouped 
       grouped = groupBy (\(a,_) (b,_) -> a == b ) sorted
       sorted = sortBy (comparing fst) $ map snapIndex ivs
       snapIndex (i,v) = (binWidth*(i`div`binWidth),v)
       
  
  
  -- Map numeric list so it becomes zeromean
  zeroMean lst = map (\x -> x - mean) lst 
      where mean = average lst
  
  -- Take n best elements according to fitnesses
  
  takeNAccordingTo n (fitnesses,elements) = 
                  take n
                $ sortBy (comparing fst)
                $ zip fitnesses elements
  
  -- Zip two lists by selection function
  select c = zipWith (\a b -> if c a b then a else b)
  
  -- Take half
  
  takeHalf lst = take (length lst `div` 2) lst
  
  splitToNParts n lst | n <= 0    = error "splitToNParts n <= 0"
                      | otherwise = takeLengths (lengths (length lst) n) lst
          where
          lengths len n = zipWith (+) (replicate n (len`div`n)) (replicate (len`mod`n) 1++repeat 0)
  
  prop_splitEq n xs = n>0 ==> concat (splitToNParts n xs) == xs
  prop_splitLen n xs = n>0 && n<= (length xs) ==> length (splitToNParts n xs) == n
  
  -- Count elements that match predicate p
  count p = foldl (\sum i -> if p i then sum+1 else sum) 0 
  
  -- Count frequencies of elements in list
  frequencies lst = map (\x -> (head x,genericLength x)) $ group $ sort lst
  normalizeFrequencies ls = map (\(a,b) -> (a,b/sum (map snd ls))) ls
  -- Count average of list
  average s = sum s / (genericLength $ s) 
  
  -- Take n smallest given op
  smallestBy  op n lst = smallestBy' op n lst [] 
  smallestBy' op n [] o = o
  smallestBy' op n (i:input) [] = smallestBy' op n input [i]
  smallestBy' op n (i:input) output@(o:os) 
       = smallestBy' op n input (take n $ insertBy op i output)
  -- (sloppily) Count median of list
  median s | odd len = sorted !! middle
           | otherwise = ((sorted !! middle) + 
                         (sorted !! (middle -1))) / 2
      where
       middle = len `div` 2
       sorted = sort s
       len = length s
  
  takeTail n lst = reverse $ take n $ reverse lst
  
  -- Count standard deviation of a list 
  stdDev l = sqrt (sum (map (\x -> (x - avg)^2) l)  
                   / genericLength l)
          where avg = average l
  
  -- Transform a list so that nth element is sum of n first elements
  cumulate [] = []
  cumulate values = tail $ scanl (+) 0 values
  
  schwartzianTransform :: (Ord a,Ord b) => (a -> b) -> [a] -> [a]
  schwartzianTransform f = map snd . sort . map (\x -> (f x, x))
  
  sortVia f = map snd . sortBy cmp . map (\x -> (f x , x))
      where cmp (a1,a2) (b1,b2) = compare a1 b1
  
  comparing p a b = compare (p a) (p b)
  
  -- Pick element that has majority in the list
  majority lst = head $ maximumBy (comparing length) $ group $ sort lst
  
  -- Get all possible k-sized neighbourhoods in the list
  getKNeighbourhoods k p = get (length p) pknot
      where 
          pknot = p++pknot
          get 0 p = []
          get i p = take k p:get (i-1) (tail p)
  
  prop_headIdentical_KN n xs = 1 <= n && length xs >= 1 ==>
                      map head (getKNeighbourhoods n xs)
                      ==
                      xs
  
  -- Split a list to `l` length pieces.
  splitToLength l lst = unfoldr split lst
      where
       split [] = Nothing
       split lst = Just (take l lst, drop l lst) 
  
  -- Take n pieces of given lengths
  --takeLengths :: [Int] -> [a] -> [[a]]
  takeLengths [] lst = []
  takeLengths (l:ls) lst = take l lst:takeLengths ls (drop l lst) 
  
  prop_takeLen ls xs = all (>=0) ls &&  sum ls < length xs ==> length (takeLengths ls xs) == length ls
  prop_takeLens ls xs = all (>=0) ls &&  sum ls < length xs ==> map length (takeLengths ls xs) == ls
  
  -- From LicencedPreludeExts (hawiki)
  splitBy :: (a->Bool) -> [a] -> [[a]]
  splitBy _ [] = []
  splitBy f list =  first : splitBy f (dropWhile f rest)
     where
       (first, rest) = break f list
  
  --splitBetween :: ((a,a) -> Bool) -> [a] -> [[a]]
  splitBetween c acc [] = [reverse acc] 
  splitBetween c acc [a] = [reverse $ a:acc] 
  splitBetween c acc (a:b:cs) | c a b = (reverse $ a:acc):splitBetween c [] (b:cs)
                              | otherwise = splitBetween c (a:acc) (b:cs)
  
  -- split list into subsets matching predicate
  tear op l = (filter (not.op) l, filter op l)
  
  swapEverywhere a b = concat $ zipWith merge (inits a) (tails a)
      where
       merge i [] = []
       merge i (t:ts) = map (\x -> i++[x]++ts) b
  
  
  takeWhile2 op lst = reverse $ tw op [head lst] (tail lst)
   where
      tw _  l [] = []
      tw op l (x:xs) = if op (head l) x 
                                then tw op (x:l) xs
                                else l
  
  applyMap val ops = map (\op -> op val) ops 
  applyMapM :: (Monad m) => a -> [a -> m b] -> m [b]
  applyMapM val ops = mapM (\op -> op val) ops 
  changesM :: (Monad m) => [a -> m b] -> a -> m [b]
  changesM = flip applyMapM
  
  rollList (a:xs) = xs ++[a]
  roll = rollList
  
  mergeList a b = a ++ drop (length a) b
  
  takeWhile1 test [] = []
  takeWhile1 test (x:xs) | test x = x:takeWhile1 test xs
                         | otherwise =  [x]
  
  
  -- Modify each element in list with function that has knowledge of already
  -- modified elements
  editingMap f l = editingTrav f [] l
  
  editingTrav fun [] l@(x:xs) = editingTrav fun [(fun l x)] xs
  editingTrav fun a [] = reverse a
  editingTrav fun ss l@(x:xs) = editingTrav fun
                                           (fun (reverse ss++l) x:ss)
                                           xs
  
  
  -- Rotations of list
  rotate (x:xs) = xs++[x]
  cycles x = take (length x) $ iterate rotate x
  