```{-# 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
```