-- | 'Rq' sub-divisions.
module Music.Theory.Duration.Rq.Division where

import Data.List.Split {- split -}
import Data.Ratio

import Music.Theory.Duration.Rq
import Music.Theory.Duration.Rq.Tied
import Music.Theory.List
import Music.Theory.Permutations.List

-- | Divisions of /n/ 'Rq' into /i/ equal parts grouped as /j/.
-- A quarter and eighth note triplet is written @(1,1,[2,1],False)@.
type Rq_Div = (Rational,Integer,[Integer],Tied_Right)

-- | Variant of 'Rq_Div' where /n/ is @1@.
type Rq1_Div = (Integer,[Integer],Tied_Right)

-- | Lift 'Rq1_Div' to 'Rq_Div'.
rq1_div_to_rq_div :: Rq1_Div -> Rq_Div
rq1_div_to_rq_div :: Rq1_Div -> Rq_Div
rq1_div_to_rq_div (Integer
i,[Integer]
j,Tied_Right
k) = (Rational
1,Integer
i,[Integer]
j,Tied_Right
k)

-- | Verify that grouping /j/ sums to the divisor /i/.
rq_div_verify :: Rq_Div -> Bool
rq_div_verify :: Rq_Div -> Tied_Right
rq_div_verify (Rational
_,Integer
n,[Integer]
m,Tied_Right
_) = Integer
n forall a. Eq a => a -> a -> Tied_Right
== forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Integer]
m

rq_div_mm_verify :: Int -> [Rq_Div] -> [(Integer,[Rq])]
rq_div_mm_verify :: Int -> [Rq_Div] -> [(Integer, [Rational])]
rq_div_mm_verify Int
n [Rq_Div]
x =
    let q :: [Rational]
q = forall a b. (a -> b) -> [a] -> [b]
map (forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rq_Div -> ([Rational], Tied_Right)
rq_div_to_rq_set_t) [Rq_Div]
x
    in forall a b. [a] -> [b] -> [(a, b)]
zip [Integer
1..] (forall e. Int -> [e] -> [[e]]
chunksOf Int
n [Rational]
q)

-- | Translate from 'Rq_Div' to a sequence of 'Rq' values.
--
-- > rq_div_to_rq_set_t (1,5,[1,3,1],True) == ([1/5,3/5,1/5],True)
-- > rq_div_to_rq_set_t (1/2,6,[3,1,2],False) == ([1/4,1/12,1/6],False)
rq_div_to_rq_set_t :: Rq_Div -> ([Rq],Tied_Right)
rq_div_to_rq_set_t :: Rq_Div -> ([Rational], Tied_Right)
rq_div_to_rq_set_t (Rational
n,Integer
k,[Integer]
d,Tied_Right
t) =
    let q :: [Rational]
q = forall a b. (a -> b) -> [a] -> [b]
map ((forall a. Num a => a -> a -> a
* Rational
n) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Integral a => a -> a -> Ratio a
% Integer
k)) [Integer]
d
    in ([Rational]
q,Tied_Right
t)

-- | Translate from result of 'rq_div_to_rq_set_t' to seqeunce of 'Rq_Tied'.
--
-- > rq_set_t_to_rqt ([1/5,3/5,1/5],True) == [(1/5,_f),(3/5,_f),(1/5,_t)]
rq_set_t_to_rqt :: ([Rq],Tied_Right) -> [Rq_Tied]
rq_set_t_to_rqt :: ([Rational], Tied_Right) -> [Rq_Tied]
rq_set_t_to_rqt ([Rational]
x,Tied_Right
t) = forall a b. (a -> b) -> (a -> b) -> [a] -> [b]
at_last (\Rational
i -> (Rational
i,Tied_Right
False)) (\Rational
i -> (Rational
i,Tied_Right
t)) [Rational]
x

-- | Transform sequence of 'Rq_Div' into sequence of 'Rq', discarding
-- any final tie.
--
-- > let q = [(1,5,[1,3,1],True),(1/2,6,[3,1,2],True)]
-- > in rq_div_seq_rq q == [1/5,3/5,9/20,1/12,1/6]
rq_div_seq_rq :: [Rq_Div] -> [Rq]
rq_div_seq_rq :: [Rq_Div] -> [Rational]
rq_div_seq_rq =
    let f :: Maybe Rational -> [Rq_Div] -> [Rational]
f Maybe Rational
i [Rq_Div]
qq = case [Rq_Div]
qq of
                  [] -> forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Rational
i
                  Rq_Div
q:[Rq_Div]
qq' -> let ([Rational]
r,Tied_Right
t) = Rq_Div -> ([Rational], Tied_Right)
rq_div_to_rq_set_t Rq_Div
q
                               r' :: [Rational]
r' = forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Rational]
r (\Rational
j -> forall a b. (a -> b) -> (a -> b) -> [a] -> [b]
at_head (forall a. Num a => a -> a -> a
+ Rational
j) forall a. a -> a
id [Rational]
r) Maybe Rational
i
                           in if Tied_Right
t
                              then let ([Rational]
r'',Rational
i') = forall a. [a] -> ([a], a)
separate_last [Rational]
r'
                                   in [Rational]
r'' forall a. [a] -> [a] -> [a]
++ Maybe Rational -> [Rq_Div] -> [Rational]
f (forall a. a -> Maybe a
Just Rational
i') [Rq_Div]
qq'
                              else [Rational]
r' forall a. [a] -> [a] -> [a]
++ Maybe Rational -> [Rq_Div] -> [Rational]
f forall a. Maybe a
Nothing [Rq_Div]
qq'
    in Maybe Rational -> [Rq_Div] -> [Rational]
f forall a. Maybe a
Nothing

-- | Partitions of an 'Integral' that sum to /n/.  This includes the
-- two 'trivial paritions, into a set /n/ @1@, and a set of @1@ /n/.
--
-- > partitions_sum 4 == [[1,1,1,1],[2,1,1],[2,2],[3,1],[4]]
--
-- > map (length . partitions_sum) [9..15] == [30,42,56,77,101,135,176]
partitions_sum :: Integral i => i -> [[i]]
partitions_sum :: forall i. Integral i => i -> [[i]]
partitions_sum i
n =
    let f :: [a] -> a
f [a]
p = if forall (t :: * -> *) a. Foldable t => t a -> Tied_Right
null [a]
p then a
0 else forall a. [a] -> a
head [a]
p
    in case i
n of
         i
0 -> [[]]
         i
_ -> [i
xforall a. a -> [a] -> [a]
:[i]
y | i
x <- [i
1..i
n], [i]
y <- forall i. Integral i => i -> [[i]]
partitions_sum (i
n forall a. Num a => a -> a -> a
- i
x), i
x forall a. Ord a => a -> a -> Tied_Right
>= forall {a}. Num a => [a] -> a
f [i]
y]

-- | The 'multiset_permutations' of 'partitions_sum'.
--
-- > map (length . partitions_sum_p) [9..12] == [256,512,1024,2048]
partitions_sum_p :: Integral i => i -> [[i]]
partitions_sum_p :: forall i. Integral i => i -> [[i]]
partitions_sum_p = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall a. Ord a => [a] -> [[a]]
multiset_permutations forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i. Integral i => i -> [[i]]
partitions_sum

-- | The set of all 'Rq1_Div' that sum to /n/, a variant on
-- 'partitions_sum_p'.
--
-- > map (length . rq1_div_univ) [3..5] == [8,16,32]
-- > map (length . rq1_div_univ) [9..12] == [512,1024,2048,4096]
rq1_div_univ :: Integer -> [Rq1_Div]
rq1_div_univ :: Integer -> [Rq1_Div]
rq1_div_univ Integer
n =
    let f :: b -> [(Integer, b, Tied_Right)]
f b
l = [(Integer
n,b
l,Tied_Right
k) | Tied_Right
k <- [Tied_Right
False,Tied_Right
True]]
    in forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall {b}. b -> [(Integer, b, Tied_Right)]
f (forall i. Integral i => i -> [[i]]
partitions_sum_p Integer
n)