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
pairs [] = []
pairs [x] = error "Non-even list for pair function"
pairs (x:y:xs) = (x,y):pairs xs
fromPairs [] = []
fromPairs ((x,y):xs) = x:y:fromPairs xs
prop_pairsFromTo xs = even (length xs) ==> xs == fromPairs (pairs xs)
pairs1 x = zip x (tail x)
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
lookupDef d a lst = fromMaybe d $ lookup a lst
pairings [] = []
pairings [x,y] = [(x,y)]
pairings (x:y:ys) = (x,y):pairings (y:ys)
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)
zeroMean lst = map (\x -> x mean) lst
where mean = average lst
takeNAccordingTo n (fitnesses,elements) =
take n
$ sortBy (comparing fst)
$ zip fitnesses elements
select c = zipWith (\a b -> if c a b then a else b)
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 p = foldl (\sum i -> if p i then sum+1 else sum) 0
frequencies lst = map (\x -> (head x,genericLength x)) $ group $ sort lst
normalizeFrequencies ls = map (\(a,b) -> (a,b/sum (map snd ls))) ls
average s = sum s / (genericLength $ s)
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)
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
stdDev l = sqrt (sum (map (\x -> (x avg)^2) l)
/ genericLength l)
where avg = average l
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)
majority lst = head $ maximumBy (comparing length) $ group $ sort lst
getKNeighbourhoods k p = get (length p) pknot
where
pknot = p++pknot
get 0 p = []
get i p = take k p:get (i1) (tail p)
prop_headIdentical_KN n xs = 1 <= n && length xs >= 1 ==>
map head (getKNeighbourhoods n xs)
==
xs
splitToLength l lst = unfoldr split lst
where
split [] = Nothing
split lst = Just (take l lst, drop l lst)
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
splitBy :: (a->Bool) -> [a] -> [[a]]
splitBy _ [] = []
splitBy f list = first : splitBy f (dropWhile f rest)
where
(first, rest) = break f list
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)
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]
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
rotate (x:xs) = xs++[x]
cycles x = take (length x) $ iterate rotate x