-- | Set operations on lists.
module Music.Theory.Set.List where

import Control.Monad {- base -}
import Data.List {- base -}

import qualified Math.Combinatorics.Multiset as M {- multiset-comb -}

import qualified Music.Theory.List as T {- hmt-base -}

-- | 'sort' then 'nub'.
--
-- > set [3,3,3,2,2,1] == [1,2,3]
set :: (Ord a) => [a] -> [a]
set :: forall a. Ord a => [a] -> [a]
set = forall a. Eq a => [a] -> [a]
nub forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Ord a => [a] -> [a]
sort

-- | Size of powerset of set of cardinality /n/, ie. @2@ '^' /n/.
--
-- > map n_powerset [6..9] == [64,128,256,512]
n_powerset :: Integral n => n -> n
n_powerset :: forall n. Integral n => n -> n
n_powerset = forall a b. (Num a, Integral b) => a -> b -> a
(^) n
2

-- | Powerset, ie. set of all subsets.
--
-- > sort (powerset [1,2]) == [[],[1],[1,2],[2]]
-- > map length (map (\n -> powerset [1..n]) [6..9]) == [64,128,256,512]
powerset :: [a] -> [[a]]
powerset :: forall a. [a] -> [[a]]
powerset = forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM (forall a b. a -> b -> a
const [Bool
True,Bool
False])

-- | Variant where result is sorted and the empty set is not given.
--
-- > powerset_sorted [1,2,3] == [[1],[2],[3],[1,2],[1,3],[2,3],[1,2,3]]
powerset_sorted :: Ord a => [a] -> [[a]]
powerset_sorted :: forall a. Ord a => [a] -> [[a]]
powerset_sorted = forall a. [a] -> [a]
tail forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b c a. (Ord b, Ord c) => (a -> b) -> (a -> c) -> [a] -> [a]
T.sort_by_two_stage_on forall (t :: * -> *) a. Foldable t => t a -> Int
length forall a. a -> a
id forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [[a]]
powerset

-- | Two element subsets.
--
-- > pairs [1,2,3] == [(1,2),(1,3),(2,3)]
pairs :: [a] -> [(a,a)]
pairs :: forall a. [a] -> [(a, a)]
pairs [a]
s =
    case [a]
s of
      [] -> []
      a
x:[a]
s' -> [(a
x,a
y) | a
y <- [a]
s'] forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [(a, a)]
pairs [a]
s'

{- | Three element subsets.

> triples [1..4] == [(1,2,3),(1,2,4),(1,3,4),(2,3,4)]

> import Music.Theory.Combinations
> let f n = genericLength (triples [1..n]) == nk_combinations n 3
> all f [1..15]
-}
triples :: [a] -> [(a,a,a)]
triples :: forall a. [a] -> [(a, a, a)]
triples [a]
s =
    case [a]
s of
      [] -> []
      a
x:[a]
s' -> [(a
x,a
y,a
z) | (a
y,a
z) <- forall a. [a] -> [(a, a)]
pairs [a]
s'] forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [(a, a, a)]
triples [a]
s'

-- | Set expansion (ie. to multiset of degree /n/).
--
-- > expand_set 4 [1,2,3] == [[1,1,2,3],[1,2,2,3],[1,2,3,3]]
expand_set :: (Ord a) => Int -> [a] -> [[a]]
expand_set :: forall a. Ord a => Int -> [a] -> [[a]]
expand_set Int
n [a]
xs =
    if forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
xs forall a. Ord a => a -> a -> Bool
>= Int
n
    then [[a]
xs]
    else forall a. Eq a => [a] -> [a]
nub (forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (forall a. Ord a => Int -> [a] -> [[a]]
expand_set Int
n) [forall a. Ord a => [a] -> [a]
sort (a
y forall a. a -> [a] -> [a]
: [a]
xs) | a
y <- [a]
xs])

{- | All distinct multiset partitions, see 'M.partitions'.

> partitions "aab" == [["aab"],["a","ab"],["b","aa"],["b","a","a"]]
> partitions "abc" == [["abc"],["bc","a"],["b","ac"],["c","ab"],["c","b","a"]]
-}
partitions :: Eq a => [a] -> [[[a]]]
partitions :: forall a. Eq a => [a] -> [[[a]]]
partitions = forall a b. (a -> b) -> [a] -> [b]
map (forall a b. (a -> b) -> [a] -> [b]
map forall a. Multiset a -> [a]
M.toList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Multiset a -> [a]
M.toList) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Multiset a -> [Multiset (Multiset a)]
M.partitions forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Eq a => [a] -> Multiset a
M.fromListEq

{- | Cartesian product of two sets.

> cartesian_product "abc" [1,2] == [('a',1),('a',2),('b',1),('b',2),('c',1),('c',2)]
> cartesian_product "abc" "" == []
-}
cartesian_product :: [a] -> [b] -> [(a,b)]
cartesian_product :: forall a b. [a] -> [b] -> [(a, b)]
cartesian_product [a]
p [b]
q = [(a
i,b
j) | a
i <- [a]
p, b
j <- [b]
q]

-- | List form of n-fold cartesian product.
--
-- > length (nfold_cartesian_product [[1..13],[1..4]]) == 52
-- > length (nfold_cartesian_product ["abc","de","fgh"]) == 3 * 2 * 3
nfold_cartesian_product :: [[a]] -> [[a]]
nfold_cartesian_product :: forall a. [[a]] -> [[a]]
nfold_cartesian_product [[a]]
l =
    case [[a]]
l of
      [] -> []
      [[a]
_] -> []
      [[a]
x,[a]
y] -> [[a
i,a
j] | a
i <- [a]
x, a
j <- [a]
y]
      [a]
x:[[a]]
l' -> forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\a
e -> forall a b. (a -> b) -> [a] -> [b]
map (a
e forall a. a -> [a] -> [a]
:) (forall a. [[a]] -> [[a]]
nfold_cartesian_product [[a]]
l')) [a]
x

{- | Generate all distinct cycles, aka necklaces, with elements taken from a multiset.

> concatMap multiset_cycles [replicate i 0 ++ replicate (6 - i) 1 | i <- [0 .. 6]]
-}
multiset_cycles :: Ord t => [t] -> [[t]]
multiset_cycles :: forall a. Ord a => [a] -> [[a]]
multiset_cycles = forall a. Multiset a -> [[a]]
M.cycles forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Ord a => [a] -> Multiset a
M.fromList