module Music.Theory.List where
import Data.Function
import Data.List
import Data.List.Split
import Data.Maybe
bracket :: (a,a) -> [a] -> [a]
bracket (l,r) x = l : x ++ [r]
genericRotate_left :: Integral i => i -> [a] -> [a]
genericRotate_left n =
let f (p,q) = q ++ p
in f . genericSplitAt n
rotate_left :: Int -> [a] -> [a]
rotate_left = genericRotate_left
genericRotate_right :: Integral n => n -> [a] -> [a]
genericRotate_right n = reverse . genericRotate_left n . reverse
rotate_right :: Int -> [a] -> [a]
rotate_right = genericRotate_right
rotate :: (Integral n) => n -> [a] -> [a]
rotate n p =
let m = n `mod` genericLength p
in genericRotate_left m p
rotate_r :: (Integral n) => n -> [a] -> [a]
rotate_r = rotate . negate
rotations :: [a] -> [[a]]
rotations p = map (`rotate_left` p) [0 .. length p 1]
genericAdj2 :: (Integral n) => n -> [t] -> [(t,t)]
genericAdj2 n l =
case l of
p:q:_ -> (p,q) : genericAdj2 n (genericDrop n l)
_ -> []
adj2 :: Int -> [t] -> [(t,t)]
adj2 = genericAdj2
close :: [a] -> [a]
close x =
case x of
[] -> []
e:_ -> x ++ [e]
adj2_cyclic :: Int -> [t] -> [(t,t)]
adj2_cyclic n = adj2 n . close
interleave :: [b] -> [b] -> [b]
interleave p q =
let u (i,j) = [i,j]
in concatMap u (zip p q)
interleave_rotations :: Int -> Int -> [b] -> [b]
interleave_rotations i j s = interleave (rotate_left i s) (rotate_left j s)
histogram :: (Ord a,Integral i) => [a] -> [(a,i)]
histogram x =
let g = group (sort x)
n = map genericLength g
in zip (map head g) n
segments :: Int -> Int -> [a] -> [[a]]
segments i j p =
let q = take i p
p' = drop j p
in if length q /= i then [] else q : segments i j p'
intersect_l :: Eq a => [[a]] -> [a]
intersect_l = foldl1 intersect
union_l :: Eq a => [[a]] -> [a]
union_l = foldl1 union
adj_intersect :: Eq a => Int -> [[a]] -> [[a]]
adj_intersect n = map intersect_l . segments 2 n
cycles :: Int -> [a] -> [[a]]
cycles n = transpose . chunksOf n
collate :: Ord a => [(a,b)] -> [(a,[b])]
collate =
let f l = (fst (head l), map snd l)
in map f . groupBy ((==) `on` fst) . sortBy (compare `on` fst)
with_key :: k -> [v] -> [(k,v)]
with_key h = zip (repeat h)
dx_d :: (Num a) => a -> [a] -> [a]
dx_d = scanl (+)
d_dx :: (Num a) => [a] -> [a]
d_dx l = zipWith () (tail l) l
difference :: (Eq a) => [a] -> [a] -> [a]
difference p q =
let f e = e `notElem` q
in filter f p
is_subset :: Eq a => [a] -> [a] -> Bool
is_subset p q = p `intersect` q == p
is_superset :: Eq a => [a] -> [a] -> Bool
is_superset = flip is_subset
subsequence :: (Eq a) => [a] -> [a] -> Bool
subsequence = isInfixOf
elem_index_unique :: (Eq a) => a -> [a] -> Int
elem_index_unique e p =
case elemIndices e p of
[i] -> i
_ -> error "elem_index_unique"
find_bounds :: (t -> s -> Ordering) -> [(t,t)] -> s -> Maybe (t,t)
find_bounds f l x =
case l of
(p,q):l' -> if f p x /= GT && f q x == GT
then Just (p,q)
else find_bounds f l' x
_ -> Nothing
dropRight :: Int -> [a] -> [a]
dropRight n = reverse . drop n . reverse
at_head :: (a -> b) -> (a -> b) -> [a] -> [b]
at_head f g x =
case x of
[] -> []
e:x' -> f e : map g x'
at_last :: (a -> b) -> (a -> b) -> [a] -> [b]
at_last f g x =
case x of
[] -> []
[i] -> [g i]
i:x' -> f i : at_last f g x'
separate_last :: [a] -> ([a],a)
separate_last x =
let e:x' = reverse x
in (reverse x',e)
indicate_repetitions :: Eq a => [a] -> [Maybe a]
indicate_repetitions =
let f l = case l of
[] -> []
e:l' -> Just e : map (const Nothing) l'
in concatMap f . group
adjacent_groupBy :: (a -> a -> Bool) -> [a] -> [[a]]
adjacent_groupBy f p =
case p of
[] -> []
[x] -> [[x]]
x:y:p' -> let r = adjacent_groupBy f (y:p')
r0:r' = r
in if f x y
then (x:r0) : r'
else [x] : r
group_just :: [Maybe a] -> [[Maybe a]]
group_just = groupBy ((==) `on` isJust)
mergeBy :: (a -> a -> Ordering) -> [a] -> [a] -> [a]
mergeBy f p q =
case (p,q) of
([],_) -> q
(_,[]) -> p
(i:p',j:q') -> case f i j of
GT -> j : mergeBy f p q'
_ -> i : mergeBy f p' q
merge :: Ord a => [a] -> [a] -> [a]
merge = mergeBy compare
merge_set :: Ord a => [[a]] -> [a]
merge_set p =
case p of
[] -> []
[i] -> i
i:p' -> merge i (merge_set p')