-- | Combination functions.
module Music.Theory.Combinations where

import Data.List {- base -}

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

-- | Number of /k/ element combinations of a set of /n/ elements.
--
-- > map (uncurry nk_combinations) [(4,2),(5,3),(6,3),(13,3)] == [6,10,20,286]
nk_combinations :: Integral a => a -> a -> a
nk_combinations :: forall a. Integral a => a -> a -> a
nk_combinations a
n a
k = forall a. Integral a => a -> a -> a
T.nk_permutations a
n a
k forall a. Integral a => a -> a -> a
`div` forall n. Integral n => n -> n
T.factorial a
k

-- | /k/ element subsets of /s/.
--
-- > combinations 3 [1..4] == [[1,2,3],[1,2,4],[1,3,4],[2,3,4]]
-- > length (combinations 3 [1..5]) == nk_combinations 5 3
-- > combinations 3 "xyzw" == ["xyz","xyw","xzw","yzw"]
combinations :: Int -> [a] -> [[a]]
combinations :: forall a. Int -> [a] -> [[a]]
combinations Int
k [a]
s =
    case (Int
k,[a]
s) of
      (Int
0,[a]
_) -> [[]]
      (Int
_,[]) -> []
      (Int
_,a
e:[a]
s') -> forall a b. (a -> b) -> [a] -> [b]
map (a
e forall a. a -> [a] -> [a]
:) (forall a. Int -> [a] -> [[a]]
combinations (Int
k forall a. Num a => a -> a -> a
- Int
1) [a]
s') forall a. [a] -> [a] -> [a]
++ forall a. Int -> [a] -> [[a]]
combinations Int
k [a]
s'

-- * Dyck

-- | <http://www.acta.sapientia.ro/acta-info/C1-1/info1-9.pdf> (P.110)
--
-- > dyck_words_lex 3 == [[0,0,0,1,1,1],[0,0,1,0,1,1],[0,0,1,1,0,1],[0,1,0,0,1,1],[0,1,0,1,0,1]]
dyck_words_lex :: (Num t, Ord t) => t -> [[t]]
dyck_words_lex :: forall t. (Num t, Ord t) => t -> [[t]]
dyck_words_lex t
n =
  let gen :: [a] -> t -> t -> t -> [[a]]
gen [a]
x t
i t
n0 t
n1 =
        let d0 :: [[a]]
d0 = [a] -> t -> t -> t -> [[a]]
gen ([a]
x forall a. [a] -> [a] -> [a]
++ [a
0]) (t
i forall a. Num a => a -> a -> a
+ t
1) (t
n0 forall a. Num a => a -> a -> a
+ t
1) t
n1
            d1 :: [[a]]
d1 = [a] -> t -> t -> t -> [[a]]
gen ([a]
x forall a. [a] -> [a] -> [a]
++ [a
1]) (t
i forall a. Num a => a -> a -> a
+ t
1) t
n0 (t
n1 forall a. Num a => a -> a -> a
+ t
1)
        in if (t
n0 forall a. Ord a => a -> a -> Bool
< t
n) Bool -> Bool -> Bool
&& (t
n1 forall a. Ord a => a -> a -> Bool
< t
n) Bool -> Bool -> Bool
&& (t
n0 forall a. Ord a => a -> a -> Bool
> t
n1)
        then forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[[a]]
d0,[[a]]
d1]
        else if ((t
n0 forall a. Ord a => a -> a -> Bool
< t
n) Bool -> Bool -> Bool
&& (t
n1 forall a. Ord a => a -> a -> Bool
< t
n) Bool -> Bool -> Bool
&& (t
n0 forall a. Eq a => a -> a -> Bool
== t
n1)) Bool -> Bool -> Bool
|| ((t
n0 forall a. Ord a => a -> a -> Bool
< t
n) Bool -> Bool -> Bool
&& (t
n1 forall a. Eq a => a -> a -> Bool
== t
n))
             then [[a]]
d0
             else if (t
n0 forall a. Eq a => a -> a -> Bool
== t
n) Bool -> Bool -> Bool
&& (t
n1 forall a. Ord a => a -> a -> Bool
< t
n)
                  then [[a]]
d1
                  else if (t
n0 forall a. Eq a => a -> a -> Bool
== t
n1) Bool -> Bool -> Bool
&& (t
n1 forall a. Eq a => a -> a -> Bool
== t
n)
                       then [[a]
x]
                       else forall a. HasCallStack => [Char] -> a
error [Char]
"?"
  in forall {a} {t}. (Num a, Num t) => [a] -> t -> t -> t -> [[a]]
gen [t
0] (Int
1::Int) t
1 t
0

-- | Translate 01 to [].
--
-- > unwords (map dyck_word_to_str (dyck_words_lex 3)) == "[[[]]] [[][]] [[]][] [][[]] [][][]"
dyck_word_to_str :: Integral n => [n] -> [Char]
dyck_word_to_str :: forall n. Integral n => [n] -> [Char]
dyck_word_to_str = forall a b. (a -> b) -> [a] -> [b]
map (\n
n -> if n
n forall a. Eq a => a -> a -> Bool
== n
0 then Char
'[' else if n
n forall a. Eq a => a -> a -> Bool
== n
1 then Char
']' else forall a. HasCallStack => a
undefined)

-- | Translate [] to 01
dyck_word_from_str :: Integral n => [Char] -> [n]
dyck_word_from_str :: forall n. Integral n => [Char] -> [n]
dyck_word_from_str = forall a b. (a -> b) -> [a] -> [b]
map (\Char
x -> if Char
x forall a. Eq a => a -> a -> Bool
== Char
'[' then n
0 else if Char
x forall a. Eq a => a -> a -> Bool
== Char
']' then n
1 else forall a. HasCallStack => a
undefined)

-- | Is /x/ a segment of a lattice word.
is_lattice_segment :: Integral n => [n] -> Bool
is_lattice_segment :: forall n. Integral n => [n] -> Bool
is_lattice_segment [n]
x =
  let h :: [(n, Int)]
h = forall a. Ord a => [a] -> [(a, Int)]
T.histogram [n]
x
      f :: (n, Int) -> Bool
f (n
i,Int
j) = case forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup (n
i forall a. Num a => a -> a -> a
+ n
1) [(n, Int)]
h of
                  Maybe Int
Nothing -> Bool
True
                  Just Int
k -> Int
j forall a. Ord a => a -> a -> Bool
>= Int
k
  in forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (n, Int) -> Bool
f [(n, Int)]
h

-- | Is /x/ a lattice word.
--
-- is_lattice_word [1,1,1,2,2,1,2,1] == True
is_lattice_word :: Integral n => [n] -> Bool
is_lattice_word :: forall n. Integral n => [n] -> Bool
is_lattice_word = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all forall n. Integral n => [n] -> Bool
is_lattice_segment forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [[a]]
inits

-- | 'is_lattice_word' of 'reverse'.
is_yamanouchi_word :: Integral n => [n] -> Bool
is_yamanouchi_word :: forall n. Integral n => [n] -> Bool
is_yamanouchi_word = forall n. Integral n => [n] -> Bool
is_lattice_word forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
reverse

-- | 'is_lattice_word' of 'dyck_word_from_str'
--
-- > is_dyck_word "[][[][[[][]]]]" == True
is_dyck_word :: String -> Bool
is_dyck_word :: [Char] -> Bool
is_dyck_word = forall n. Integral n => [n] -> Bool
is_lattice_word forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall n. Integral n => [Char] -> [n]
dyck_word_from_str :: String -> [Int])