-- | "Creating Rhythms" by Stefan Hollos and J. Richard Hollos
--    <http://abrazol.com/books/rhythm1/software.html>
module Music.Theory.Duration.Hollos2014 where

import Data.List {- base -}

import Music.Theory.List {- hmt-base -}

import Music.Theory.Permutations.List {- hmt -}
import Music.Theory.Set.List {- hmt -}

-- | Donald Knuth, Art of Computer Programming, Algorithm H
--   <http://www-cs-faculty.stanford.edu/~knuth/fasc3b.ps.gz>
--
-- > partm 3 6 == [[1,1,4],[2,1,3],[2,2,2]]
partm :: (Num a, Ord a) => a -> a -> [[a]]
partm :: forall a. (Num a, Ord a) => a -> a -> [[a]]
partm a
i a
j =
  let f :: t -> t -> t -> [[t]]
f t
t t
m t
n =
        if t
m forall a. Eq a => a -> a -> Bool
== t
1 Bool -> Bool -> Bool
&& t
t forall a. Eq a => a -> a -> Bool
== t
n
        then [[t
t]]
        else if t
n forall a. Ord a => a -> a -> Bool
< t
m Bool -> Bool -> Bool
|| t
n forall a. Ord a => a -> a -> Bool
< t
1 Bool -> Bool -> Bool
|| t
m forall a. Ord a => a -> a -> Bool
< t
1 Bool -> Bool -> Bool
|| t
t forall a. Ord a => a -> a -> Bool
< t
1
             then []
        else [forall a. [a] -> [a]
reverse (t
t forall a. a -> [a] -> [a]
: [t]
r) | [t]
r <- t -> t -> t -> [[t]]
f t
t (t
m forall a. Num a => a -> a -> a
- t
1) (t
n forall a. Num a => a -> a -> a
- t
t)] forall a. [a] -> [a] -> [a]
++ (t -> t -> t -> [[t]]
f (t
t forall a. Num a => a -> a -> a
- t
1) t
m t
n)
  in forall {t}. (Num t, Ord t) => t -> t -> t -> [[t]]
f (a
j forall a. Num a => a -> a -> a
- a
i forall a. Num a => a -> a -> a
+ a
1) a
i a
j

-- | Generates all partitions of n.
--
-- > compUniq 4 == [[1,1,1,1],[1,1,2],[1,3],[2,2],[4]]
-- > compUniq 5 == [[1,1,1,1,1],[1,1,1,2],[1,1,3],[2,1,2],[1,4],[2,3],[5]]
part :: (Num a, Ord a, Enum a) => a -> [[a]]
part :: forall a. (Num a, Ord a, Enum a) => a -> [[a]]
part a
n = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\a
k -> forall a. (Num a, Ord a) => a -> a -> [[a]]
partm a
k a
n) (forall a. [a] -> [a]
reverse [a
1 .. a
n])

-- | Generates all partitions of n with parts in the set e.
--
-- > parta 8 [2,3] == [[2,2,2,2],[3,2,3]]
parta :: (Num a, Ord a, Enum a) => a -> [a] -> [[a]]
parta :: forall a. (Num a, Ord a, Enum a) => a -> [a] -> [[a]]
parta a
n [a]
e = forall a. (a -> Bool) -> [a] -> [a]
filter (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [a]
e)) (forall a. (Num a, Ord a, Enum a) => a -> [[a]]
part a
n)

-- | Generate all compositions of n.
--
-- > comp 4 == [[1,1,1,1],[1,1,2],[1,2,1],[2,1,1],[1,3],[3,1],[2,2],[4]]
-- > length (comp 8) == 128
comp :: (Num a, Ord a, Enum a) => a -> [[a]]
comp :: forall a. (Num a, Ord a, Enum a) => a -> [[a]]
comp = 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 a. (Num a, Ord a, Enum a) => a -> [[a]]
part

-- | Generates all compositions of n into k parts.
--
-- > compm 3 6 == [[1,1,4],[1,4,1],[4,1,1],[1,2,3],[1,3,2],[2,1,3],[2,3,1],[3,1,2],[3,2,1],[2,2,2]]
-- > length (compm 5 16) == 1365
compm :: (Ord a, Num a) => a -> a -> [[a]]
compm :: forall a. (Ord a, Num a) => a -> a -> [[a]]
compm a
k = 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 a. (Num a, Ord a) => a -> a -> [[a]]
partm a
k

-- | Generates all compositions of n with parts in the set (p1 p2 ... pk).
--
-- > compa 8 [3,4,5,6] == [[3,5],[5,3],[4,4]]
compa :: (Num a, Ord a, Enum a) => a -> [a] -> [[a]]
compa :: forall a. (Num a, Ord a, Enum a) => a -> [a] -> [[a]]
compa a
n [a]
e = forall a. (a -> Bool) -> [a] -> [a]
filter (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [a]
e)) (forall a. (Num a, Ord a, Enum a) => a -> [[a]]
comp a
n)

-- | Generates all compositions of n with m parts in the set (p1 p2 ... pk).
--
-- > compam 4 16 [3,4,5]
compam :: (Num a, Ord a, Enum a) => a -> a -> [a] -> [[a]]
compam :: forall a. (Num a, Ord a, Enum a) => a -> a -> [a] -> [[a]]
compam a
k a
n [a]
e = forall a. (a -> Bool) -> [a] -> [a]
filter (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [a]
e)) (forall a. (Ord a, Num a) => a -> a -> [[a]]
compm a
k a
n)

-- | Generates all binary necklaces of length n.  <http://combos.org/necklace>
--
-- > neck 5 == [[1,1,1,1,1],[1,1,1,1,0],[1,1,0,1,0],[1,1,1,0,0],[1,0,1,0,0],[1,1,0,0,0],[1,0,0,0,0],[0,0,0,0,0]]
neck :: (Ord t, Num t) => Int -> [[t]]
neck :: forall t. (Ord t, Num t) => Int -> [[t]]
neck Int
n = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall a. Ord a => [a] -> [[a]]
multiset_cycles [forall a. Int -> a -> [a]
replicate Int
i t
0 forall a. [a] -> [a] -> [a]
++ forall a. Int -> a -> [a]
replicate (Int
n forall a. Num a => a -> a -> a
- Int
i) t
1 | Int
i <- [Int
0 .. Int
n]]

-- | Generates all binary necklaces of length n with m ones.
--
-- > neckm 8 2 == [[1,0,0,0,1,0,0,0],[1,0,0,1,0,0,0,0],[1,0,1,0,0,0,0,0],[1,1,0,0,0,0,0,0]]
neckm :: (Num a, Ord a) => Int -> Int -> [[a]]
neckm :: forall a. (Num a, Ord a) => Int -> Int -> [[a]]
neckm Int
n Int
m = forall a. (a -> Bool) -> [a] -> [a]
filter ((forall a. Eq a => a -> a -> Bool
== Int
m) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Int
length forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Eq a => a -> a -> Bool
== a
1)) (forall t. (Ord t, Num t) => Int -> [[t]]
neck Int
n)

-- | Part is the length of a substring 10...0 composing the necklace.
--   For example the necklace 10100 has parts of size 2 and 3.
--
-- > necklaceParts [1,0,1,0,0] == [2,3]
-- > necklaceParts [0,0,0,0,0,0,0,0] == []
necklaceParts :: (Eq a, Num a) => [a] -> [Int]
necklaceParts :: forall a. (Eq a, Num a) => [a] -> [Int]
necklaceParts [a]
l = forall a. Num a => [a] -> [a]
d_dx (forall a. (a -> Bool) -> [a] -> [Int]
findIndices (forall a. Eq a => a -> a -> Bool
== a
1) [a]
l forall a. [a] -> [a] -> [a]
++ [forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
l])

necklaceWithParts :: (Eq a, Num a) => [Int] -> [a] -> Bool
necklaceWithParts :: forall a. (Eq a, Num a) => [Int] -> [a] -> Bool
necklaceWithParts [Int]
e [a]
l =
  let p :: [Int]
p = forall a. (Eq a, Num a) => [a] -> [Int]
necklaceParts [a]
l
  in Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Int]
p) Bool -> Bool -> Bool
&& forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Int]
e) [Int]
p

-- | Generates all binary necklaces of length n with parts in e.
--
-- > necka 8 [2,3,4] == [[1,0,1,0,1,0,1,0],[1,0,1,0,0,1,0,0],[1,0,1,0,1,0,0,0],[1,0,0,0,1,0,0,0]]
necka :: (Num a, Ord a) => Int -> [Int] -> [[a]]
necka :: forall a. (Num a, Ord a) => Int -> [Int] -> [[a]]
necka Int
n [Int]
e = forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. (Eq a, Num a) => [Int] -> [a] -> Bool
necklaceWithParts [Int]
e) (forall t. (Ord t, Num t) => Int -> [[t]]
neck Int
n)

-- | Generates all binary necklaces of length n with m ones and parts in e.
neckam :: (Num a, Ord a) => Int -> Int -> [Int] -> [[a]]
neckam :: forall a. (Num a, Ord a) => Int -> Int -> [Int] -> [[a]]
neckam Int
n Int
m [Int]
e = forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. (Eq a, Num a) => [Int] -> [a] -> Bool
necklaceWithParts [Int]
e) (forall a. (Num a, Ord a) => Int -> Int -> [[a]]
neckm Int
n Int
m)

-- | Generates all permutations of the non-negative integers in the set.
--
-- > permi [1,2,3] == [[1,2,3],[1,3,2],[2,1,3],[2,3,1],[3,1,2],[3,2,1]]
permi :: [a] -> [[a]]
permi :: forall a. [a] -> [[a]]
permi = forall a. [a] -> [[a]]
permutations_l