-- | Haskell implementations of @pct@ operations.
-- See <http://rd.slavepianos.org/?t=pct>
module Music.Theory.Z.Drape_1999 where

import Data.Function {- base -}
import Data.List {- base -}
import Data.Maybe {- base -}

import qualified Music.Theory.List as T {- hmt -}
import qualified Music.Theory.Set.List as T {- hmt -}
import qualified Music.Theory.Tuple as T {- hmt -}
import Music.Theory.Z
import Music.Theory.Z.Forte_1973
import Music.Theory.Z.Sro
import Music.Theory.Z.Tto

-- | Cardinality filter
--
-- > cf [0,3] (cg [1..4]) == [[1,2,3],[1,2,4],[1,3,4],[2,3,4],[]]
cf :: (Integral n) => [n] -> [[a]] -> [[a]]
cf :: forall n a. Integral n => [n] -> [[a]] -> [[a]]
cf [n]
ns = forall a. (a -> Bool) -> [a] -> [a]
filter (\[a]
p -> forall i a. Num i => [a] -> i
genericLength [a]
p forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [n]
ns)

-- | Combinatorial sets formed by considering each set as possible
-- values for slot.
--
-- > cgg [[0,1],[5,7],[3]] == [[0,5,3],[0,7,3],[1,5,3],[1,7,3]]
-- > let n = "01" in cgg [n,n,n] == ["000","001","010","011","100","101","110","111"]
cgg :: [[a]] -> [[a]]
cgg :: forall a. [[a]] -> [[a]]
cgg [[a]]
l =
    case [[a]]
l of
      [a]
x:[[a]]
xs -> [ a
yforall a. a -> [a] -> [a]
:[a]
z | a
y <- [a]
x, [a]
z <- forall a. [[a]] -> [[a]]
cgg [[a]]
xs ]
      [[a]]
_ -> [[]]

-- | Combinations generator, ie. synonym for 'powerset'.
--
-- > sort (cg [0,1,3]) == [[],[0],[0,1],[0,1,3],[0,3],[1],[1,3],[3]]
cg :: [a] -> [[a]]
cg :: forall a. [a] -> [[a]]
cg = forall a. [a] -> [[a]]
T.powerset

-- | Powerset filtered by cardinality.
--
-- >>> pct cg -r3 0159
-- 015
-- 019
-- 059
-- 159
--
-- > cg_r 3 [0,1,5,9] == [[0,1,5],[0,1,9],[0,5,9],[1,5,9]]
cg_r :: (Integral n) => n -> [a] -> [[a]]
cg_r :: forall n a. Integral n => n -> [a] -> [[a]]
cg_r n
n = forall n a. Integral n => [n] -> [[a]] -> [[a]]
cf [n
n] forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [[a]]
cg

{- | Chain pcsegs.

>>> echo 024579 | pct chn T0 3 | sort -u
579468 (RT8M)
579A02 (T5)

> chn_t0 z12 3 [0,2,4,5,7,9] == [[5,7,9,10,0,2],[5,7,9,4,6,8]]

>>> echo 02457t | pct chn T0 2
7A0135 (RT5I)
7A81B9 (RT9MI)

> chn_t0 z12 2 [0,2,4,5,7,10] == [[7,10,0,1,3,5],[7,10,8,1,11,9]]

-}
chn_t0 :: Integral i => Z i -> Int -> [i] -> [[i]]
chn_t0 :: forall i. Integral i => Z i -> Int -> [i] -> [[i]]
chn_t0 Z i
z Int
n [i]
p =
    let f :: [i] -> Bool
f [i]
q = forall a. Int -> [a] -> [a]
T.take_right Int
n [i]
p forall a. Eq a => a -> a -> Bool
== forall a. Int -> [a] -> [a]
take Int
n [i]
q
    in forall a. (a -> Bool) -> [a] -> [a]
filter [i] -> Bool
f (forall i. Integral i => Z i -> [i] -> [[i]]
z_sro_rtmi_related Z i
z [i]
p)

{- | Cyclic interval segment.

>>> echo 014295e38t76 | pct cisg
13A7864529B6

> ciseg z12 [0,1,4,2,9,5,11,3,8,10,7,6] == [1,3,10,7,8,6,4,5,2,9,11,6]

-}
ciseg :: Integral i => Z i -> [i] -> [i]
ciseg :: forall i. Integral i => Z i -> [i] -> [i]
ciseg Z i
z = forall t u. (t -> t -> u) -> [t] -> [u]
T.d_dx_by (forall i. Integral i => Z i -> i -> i -> i
z_sub Z i
z) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
cyc

-- | Synonynm for 'z_complement'.
--
-- >>> pct cmpl 02468t
-- 13579B
--
-- > cmpl z12 [0,2,4,6,8,10] == [1,3,5,7,9,11]
cmpl :: Integral i => Z i -> [i] -> [i]
cmpl :: forall i. Integral i => Z i -> [i] -> [i]
cmpl = forall i. Integral i => Z i -> [i] -> [i]
z_complement

-- | Form cycle.
--
-- >>> echo 056 | pct cyc
-- 0560
--
-- > cyc [0,5,6] == [0,5,6,0]
cyc :: [a] -> [a]
cyc :: forall a. [a] -> [a]
cyc [a]
l =
    case [a]
l of
      [] -> []
      a
x:[a]
xs -> (a
xforall a. a -> [a] -> [a]
:[a]
xs) forall a. [a] -> [a] -> [a]
++ [a
x]

-- | Diatonic set name. 'd' for diatonic set, 'm' for melodic minor
-- set, 'o' for octotonic set.
d_nm :: (Integral a) => [a] -> Maybe Char
d_nm :: forall a. Integral a => [a] -> Maybe Char
d_nm [a]
x =
    case [a]
x of
      [a
0,a
2,a
4,a
5,a
7,a
9,a
11] -> forall a. a -> Maybe a
Just Char
'd'
      [a
0,a
2,a
3,a
5,a
7,a
9,a
11] -> forall a. a -> Maybe a
Just Char
'm'
      [a
0,a
1,a
3,a
4,a
6,a
7,a
9,a
10] -> forall a. a -> Maybe a
Just Char
'o'
      [a]
_ -> forall a. Maybe a
Nothing

-- | Diatonic implications.
dim :: Integral i => [i] -> [(i,[i])]
dim :: forall i. Integral i => [i] -> [(i, [i])]
dim [i]
p =
    let g :: (i, [i]) -> Bool
g (i
i,[i]
q) = forall a. Eq a => [a] -> [a] -> Bool
T.is_subset [i]
p (forall i. Integral i => Z i -> i -> [i] -> [i]
z_tto_tn forall i. Num i => Z i
z12 i
i [i]
q)
        f :: [i] -> [(i, [i])]
f = forall a. (a -> Bool) -> [a] -> [a]
filter (i, [i]) -> Bool
g forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. [a] -> [b] -> [(a, b)]
zip [i
0..i
11] forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> [a]
repeat
        d :: [i]
d = [i
0,i
2,i
4,i
5,i
7,i
9,i
11]
        m :: [i]
m = [i
0,i
2,i
3,i
5,i
7,i
9,i
11]
        o :: [i]
o = [i
0,i
1,i
3,i
4,i
6,i
7,i
9,i
10]
    in [i] -> [(i, [i])]
f [i]
d forall a. [a] -> [a] -> [a]
++ [i] -> [(i, [i])]
f [i]
m forall a. [a] -> [a] -> [a]
++ [i] -> [(i, [i])]
f [i]
o

-- | Variant of 'dim' that is closer to the 'pct' form.
--
-- >>> pct dim 016
-- T1d
-- T1m
-- T0o
--
-- > dim_nm [0,1,6] == [(1,'d'),(1,'m'),(0,'o')]
dim_nm :: Integral i => [i] -> [(i,Char)]
dim_nm :: forall i. Integral i => [i] -> [(i, Char)]
dim_nm =
    let pk :: (t -> b) -> (a, t) -> (a, b)
pk t -> b
f (a
i,t
j) = (a
i,t -> b
f t
j)
    in forall a. (a -> a -> Bool) -> [a] -> [a]
nubBy (forall a. Eq a => a -> a -> Bool
(==) forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` forall a b. (a, b) -> b
snd) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
       forall a b. (a -> b) -> [a] -> [b]
map (forall {t} {b} {a}. (t -> b) -> (a, t) -> (a, b)
pk (forall a. a -> Maybe a -> a
fromMaybe (forall a. HasCallStack => [Char] -> a
error [Char]
"dim_mn") forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Integral a => [a] -> Maybe Char
d_nm)) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
       forall i. Integral i => [i] -> [(i, [i])]
dim

-- | Diatonic interval set to interval set.
--
-- >>> pct dis 24
-- 1256
--
-- > dis [2,4] == [1,2,5,6]
dis :: (Integral t) => [Int] -> [t]
dis :: forall t. Integral t => [Int] -> [t]
dis =
    let is :: [[t]]
is = [[], [], [t
1,t
2], [t
3,t
4], [t
5,t
6], [t
6,t
7], [t
8,t
9], [t
10,t
11]]
    in forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ([[t]]
is forall a. [a] -> Int -> a
!!)

-- | Degree of intersection.
--
-- >>> echo 024579e | pct doi 6 | sort -u
-- 024579A
-- 024679B
--
-- > let p = [0,2,4,5,7,9,11]
-- > doi z12 6 p p == [[0,2,4,5,7,9,10],[0,2,4,6,7,9,11]]
--
-- >>> echo 01234 | pct doi 2 7-35 | sort -u
-- 13568AB
--
-- > doi z12 2 (sc "7-35") [0,1,2,3,4] == [[1,3,5,6,8,10,11]]
doi :: Integral i => Z i -> Int -> [i] -> [i] -> [[i]]
doi :: forall i. Integral i => Z i -> Int -> [i] -> [i] -> [[i]]
doi Z i
z Int
n [i]
p [i]
q =
    let f :: i -> [[i]]
f i
j = [forall i. Integral i => Z i -> i -> [i] -> [i]
z_tto_tn Z i
z i
j [i]
p,forall i. Integral i => Z i -> i -> [i] -> [i]
z_tto_tni Z i
z i
j [i]
p]
        xs :: [[i]]
xs = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap i -> [[i]]
f [i
0 .. forall i. Z i -> i
z_modulus Z i
z forall a. Num a => a -> a -> a
- i
1]
    in forall a. Ord a => [a] -> [a]
T.set (forall a. (a -> Bool) -> [a] -> [a]
filter (\[i]
x -> forall (t :: * -> *) a. Foldable t => t a -> Int
length ([i]
x forall a. Eq a => [a] -> [a] -> [a]
`intersect` [i]
q) forall a. Eq a => a -> a -> Bool
== Int
n) [[i]]
xs)

-- | Embedded segment search.
--
-- >>> echo 23A | pct ess 0164325
-- 2B013A9
-- 923507A
--
-- > ess z12 [0,1,6,4,3,2,5] [2,3,10] == [[9,2,3,5,0,7,10],[2,11,0,1,3,10,9]]
ess :: Integral i => Z i -> [i] -> [i] -> [[i]]
ess :: forall i. Integral i => Z i -> [i] -> [i] -> [[i]]
ess Z i
z [i]
p [i]
q = forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Eq a => [a] -> [a] -> Bool
`T.is_embedding` [i]
q) (forall i. Integral i => Z i -> [i] -> [[i]]
z_sro_rtmi_related Z i
z [i]
p)

-- | Forte name (ie 'sc_name').
fn :: Integral i => [i] -> String
fn :: forall i. Integral i => [i] -> [Char]
fn = forall i. Integral i => [i] -> [Char]
sc_name

-- | Z-12 cycles.
frg_cyc :: Integral i => T.T6 [[i]]
frg_cyc :: forall i. Integral i => T6 [[i]]
frg_cyc =
    let add :: i -> i -> i
add = forall i. Integral i => Z i -> i -> i -> i
z_add forall i. Num i => Z i
z12
        mul :: i -> i -> i
mul = forall i. Integral i => Z i -> i -> i -> i
z_mul forall i. Num i => Z i
z12
        c1 :: [[i]]
c1 = [[i
0 .. i
11]]
        c2 :: [[i]]
c2 = forall a b. (a -> b) -> [a] -> [b]
map (\i
n -> forall a b. (a -> b) -> [a] -> [b]
map (i -> i -> i
add i
n) [i
0,i
2..i
10]) [i
0..i
1]
        c3 :: [[i]]
c3 = forall a b. (a -> b) -> [a] -> [b]
map (\i
n -> forall a b. (a -> b) -> [a] -> [b]
map (i -> i -> i
add i
n) [i
0,i
3..i
9]) [i
0..i
2]
        c4 :: [[i]]
c4 = forall a b. (a -> b) -> [a] -> [b]
map (\i
n -> forall a b. (a -> b) -> [a] -> [b]
map (i -> i -> i
add i
n) [i
0,i
4..i
8]) [i
0..i
3]
        c5 :: [[i]]
c5 = forall a b. (a -> b) -> [a] -> [b]
map (forall a b. (a -> b) -> [a] -> [b]
map (i -> i -> i
mul i
5)) [[i]]
c1
        c6 :: [[i]]
c6 = forall a b. (a -> b) -> [a] -> [b]
map (\i
n -> forall a b. (a -> b) -> [a] -> [b]
map (i -> i -> i
add i
n) [i
0,i
6]) [i
0..i
5]
    in ([[i]]
c1,[[i]]
c2,[[i]]
c3,[[i]]
c4,[[i]]
c5,[[i]]
c6)

-- | Fragmentation of cycles.
frg :: Integral i =>  [i] -> T.T6 [String]
frg :: forall i. Integral i => [i] -> T6 [[Char]]
frg [i]
p =
    let f :: [i] -> [Char]
f = forall a b. (a -> b) -> [a] -> [b]
map (\i
n -> if i
n forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [i]
p then forall t. Integral t => t -> Char
z16_to_char i
n else Char
'-')
    in forall p q. (p -> q) -> T6 p -> T6 q
T.t6_map (forall a b. (a -> b) -> [a] -> [b]
map [i] -> [Char]
f) forall i. Integral i => T6 [[i]]
frg_cyc

-- | Header sequence for 'frg_pp'.
frg_hdr :: [String]
frg_hdr :: [[Char]]
frg_hdr = forall a b. (a -> b) -> [a] -> [b]
map (\Int
n -> [Char]
"Fragmentation of " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Int
n forall a. [a] -> [a] -> [a]
++ [Char]
"-cycle(s)") [Int
1::Int .. Int
6]

{-| Fragmentation of cycles.

>>> pct frg 024579
Fragmentation of 1-cycle(s):  [0-2-45-7-9--]
Fragmentation of 2-cycle(s):  [024---] [--579-]
Fragmentation of 3-cycle(s):  [0--9] [-47-] [25--]
Fragmentation of 4-cycle(s):  [04-] [-59] [2--] [-7-]
Fragmentation of 5-cycle(s):  [05------4927]
Fragmentation of 6-cycle(s):  [0-] [-7] [2-] [-9] [4-] [5-]
IC cycle vector: <1> <22> <111> <1100> <5> <000000>

> putStrLn $ frg_pp [0,2,4,5,7,9]
-}
frg_pp :: Integral i => [i] -> String
frg_pp :: forall i. Integral i => [i] -> [Char]
frg_pp =
    let f :: [[Char]] -> [Char]
f = [[Char]] -> [Char]
unwords forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall a. (a, a) -> [a] -> [a]
T.bracket (Char
'[',Char
']'))
        g :: [Char] -> [Char] -> [Char]
g [Char]
x [Char]
y = [Char]
x forall a. [a] -> [a] -> [a]
++ [Char]
": " forall a. [a] -> [a] -> [a]
++ [Char]
y
    in [[Char]] -> [Char]
unlines forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith [Char] -> [Char] -> [Char]
g [[Char]]
frg_hdr forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. T6 t -> [t]
T.t6_to_list forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall p q. (p -> q) -> T6 p -> T6 q
T.t6_map [[Char]] -> [Char]
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i. Integral i => [i] -> T6 [[Char]]
frg

-- | Can the set-class q (under prime form algorithm pf) be drawn from the pcset p.
has_sc_pf :: (Integral a) => ([a] -> [a]) -> [a] -> [a] -> Bool
has_sc_pf :: forall a. Integral a => ([a] -> [a]) -> [a] -> [a] -> Bool
has_sc_pf [a] -> [a]
pf [a]
p [a]
q =
    let n :: Int
n = forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
q
    in [a] -> [a]
pf [a]
q forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` forall a b. (a -> b) -> [a] -> [b]
map [a] -> [a]
pf (forall n a. Integral n => [n] -> [[a]] -> [[a]]
cf [Int
n] (forall a. [a] -> [[a]]
cg [a]
p))

-- | 'has_sc_pf' of 'forte_prime'
--
-- > let d = [0,2,4,5,7,9,11]
-- > has_sc z12 d (z_complement z12 d) == True
--
-- > has_sc z12 [] [] == True
has_sc :: Integral i => Z i -> [i] -> [i] -> Bool
has_sc :: forall i. Integral i => Z i -> [i] -> [i] -> Bool
has_sc Z i
z = forall a. Integral a => ([a] -> [a]) -> [a] -> [a] -> Bool
has_sc_pf (forall i. Integral i => Z i -> [i] -> [i]
z_forte_prime Z i
z)

-- | Interval-class cycle vector.
ic_cycle_vector :: Integral i => [i] -> T.T6 [Int]
ic_cycle_vector :: forall i. Integral i => [i] -> T6 [Int]
ic_cycle_vector [i]
p =
    let f :: [Char] -> Int
f [Char]
str = let str' :: [Char]
str' = if forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
str forall a. Ord a => a -> a -> Bool
> Int
2 then forall a. Int -> [a] -> [a]
T.close Int
1 [Char]
str else [Char]
str
                in forall (t :: * -> *) a. Foldable t => t a -> Int
length (forall a. (a -> Bool) -> [a] -> [a]
filter (\(Char
x,Char
y) -> Char
x forall a. Eq a => a -> a -> Bool
/= Char
'-' Bool -> Bool -> Bool
&& Char
y forall a. Eq a => a -> a -> Bool
/= Char
'-') (forall t. Int -> [t] -> [(t, t)]
T.adj2 Int
1 [Char]
str'))
    in forall p q. (p -> q) -> T6 p -> T6 q
T.t6_map (forall a b. (a -> b) -> [a] -> [b]
map [Char] -> Int
f) (forall i. Integral i => [i] -> T6 [[Char]]
frg [i]
p)

-- | Pretty printer for 'ic_cycle_vector'.
--
-- > let r = "IC cycle vector: <1> <22> <111> <1100> <5> <000000>"
-- > ic_cycle_vector_pp (ic_cycle_vector [0,2,4,5,7,9]) == r
ic_cycle_vector_pp :: T.T6 [Int] -> String
ic_cycle_vector_pp :: T6 [Int] -> [Char]
ic_cycle_vector_pp = ([Char]
"IC cycle vector: " forall a. [a] -> [a] -> [a]
++) forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Char]] -> [Char]
unwords forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. T6 t -> [t]
T.t6_to_list forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall p q. (p -> q) -> T6 p -> T6 q
T.t6_map forall i. Integral i => [i] -> [Char]
z16_seq_pp

-- | Interval cycle filter.
--
-- >>> echo 22341 | pct icf
-- 22341
--
-- > icf [[2,2,3,4,1]] == [[2,2,3,4,1]]
icf :: (Num a,Eq a) => [[a]] -> [[a]]
icf :: forall a. (Num a, Eq a) => [[a]] -> [[a]]
icf = forall a. (a -> Bool) -> [a] -> [a]
filter ((forall a. Eq a => a -> a -> Bool
== a
12) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum)

-- | Interval class set to interval sets.
--
-- >>> pct ici -c 123
-- 123
-- 129
-- 1A3
-- 1A9
--
-- > ici_c [1,2,3] == [[1,2,3],[1,2,9],[1,10,3],[1,10,9]]
ici :: (Num t) => [Int] -> [[t]]
ici :: forall t. Num t => [Int] -> [[t]]
ici [Int]
xs =
    let is :: Int -> [a]
is Int
j = [[a
0], [a
1,a
11], [a
2,a
10], [a
3,a
9], [a
4,a
8], [a
5,a
7], [a
6]] forall a. [a] -> Int -> a
!! Int
j
        ys :: [[t]]
ys = forall a b. (a -> b) -> [a] -> [b]
map forall {a}. Num a => Int -> [a]
is [Int]
xs
    in forall a. [[a]] -> [[a]]
cgg [[t]]
ys

-- | Interval class set to interval sets, concise variant.
--
-- > ici_c [1,2,3] == [[1,2,3],[1,2,9],[1,10,3],[1,10,9]]
ici_c :: [Int] -> [[Int]]
ici_c :: [Int] -> [[Int]]
ici_c [] = []
ici_c (Int
x:[Int]
xs) = forall a b. (a -> b) -> [a] -> [b]
map (Int
xforall a. a -> [a] -> [a]
:) (forall t. Num t => [Int] -> [[t]]
ici [Int]
xs)

-- | Interval segment (INT).
iseg :: Integral i => Z i -> [i] -> [i]
iseg :: forall i. Integral i => Z i -> [i] -> [i]
iseg Z i
z = forall t u. (t -> t -> u) -> [t] -> [u]
T.d_dx_by (forall i. Integral i => Z i -> i -> i -> i
z_sub Z i
z)

-- | Imbrications.
--
-- > let r = [[[0,2,4],[2,4,5],[4,5,7],[5,7,9]]
-- >         ,[[0,2,4,5],[2,4,5,7],[4,5,7,9]]]
-- > in imb [3,4] [0,2,4,5,7,9] == r
imb :: (Integral n) => [n] -> [a] -> [[[a]]]
imb :: forall n a. Integral n => [n] -> [a] -> [[[a]]]
imb [n]
cs [a]
p =
    let g :: b -> [a] -> Bool
g b
n = (forall a. Eq a => a -> a -> Bool
== b
n) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i a. Num i => [a] -> i
genericLength
        f :: [[a]] -> i -> [[a]]
f [[a]]
ps i
n = forall a. (a -> Bool) -> [a] -> [a]
filter (forall {b} {a}. (Eq b, Num b) => b -> [a] -> Bool
g i
n) (forall a b. (a -> b) -> [a] -> [b]
map (forall i a. Integral i => i -> [a] -> [a]
genericTake i
n) [[a]]
ps)
    in forall a b. (a -> b) -> [a] -> [b]
map (forall {i} {a}. Integral i => [[a]] -> i -> [[a]]
f (forall a. [a] -> [[a]]
tails [a]
p)) [n]
cs

{- | 'issb' gives the set-classes that can append to 'p' to give 'q'.

>>> pct issb 3-7 6-32
3-7
3-2
3-11

> issb (sc "3-7") (sc "6-32") == ["3-2","3-7","3-11"]

-}
issb :: Integral i => [i] -> [i] -> [String]
issb :: forall i. Integral i => [i] -> [i] -> [[Char]]
issb [i]
p [i]
q =
    let k :: Int
k = forall (t :: * -> *) a. Foldable t => t a -> Int
length [i]
q forall a. Num a => a -> a -> a
- forall (t :: * -> *) a. Foldable t => t a -> Int
length [i]
p
        f :: [i] -> Bool
f = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\[i]
x -> forall i. Integral i => Z i -> [i] -> [i]
z_forte_prime forall i. Num i => Z i
z12 (forall a. Eq a => [a] -> [a]
nub ([i]
p forall a. [a] -> [a] -> [a]
++ [i]
x)) forall a. Eq a => a -> a -> Bool
== [i]
q) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i. Integral i => Z i -> [i] -> [[i]]
z_tto_ti_related forall i. Num i => Z i
z12
    in forall a b. (a -> b) -> [a] -> [b]
map forall i. Integral i => [i] -> [Char]
sc_name (forall a. (a -> Bool) -> [a] -> [a]
filter [i] -> Bool
f (forall n a. Integral n => [n] -> [[a]] -> [[a]]
cf [Int
k] forall n. Num n => [[n]]
scs))

-- | Matrix search.
--
-- >>> pct mxs 024579 642 | sort -u
-- 6421B9
-- B97642
--
-- > set (mxs z12 [0,2,4,5,7,9] [6,4,2]) == [[6,4,2,1,11,9],[11,9,7,6,4,2]]
mxs :: Integral i => Z i -> [i] -> [i] -> [[i]]
mxs :: forall i. Integral i => Z i -> [i] -> [i] -> [[i]]
mxs Z i
z [i]
p [i]
q = forall a. (a -> Bool) -> [a] -> [a]
filter ([i]
q forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf`) (forall i. Integral i => Z i -> [i] -> [[i]]
z_sro_rti_related Z i
z [i]
p)

-- | Normalize (synonym for 'set')
--
-- >>> pct nrm 0123456543210
-- 0123456
--
-- > nrm [0,1,2,3,4,5,6,5,4,3,2,1,0] == [0,1,2,3,4,5,6]
nrm :: (Ord a) => [a] -> [a]
nrm :: forall a. Ord a => [a] -> [a]
nrm = forall a. Ord a => [a] -> [a]
T.set

-- | Normalize, retain duplicate elements.
nrm_r :: (Ord a) => [a] -> [a]
nrm_r :: forall a. Ord a => [a] -> [a]
nrm_r = forall a. Ord a => [a] -> [a]
sort

{- | Pitch-class invariances (called @pi@ at @pct@).

>>> pct pi 0236 12
pcseg 0236
pcseg 6320
pcseg 532B
pcseg B235

> pci z12 [1,2] [0,2,3,6] == [[0,2,3,6],[5,3,2,11],[6,3,2,0],[11,2,3,5]]

-}
pci :: Integral i => Z i-> [Int] -> [i] -> [[i]]
pci :: forall i. Integral i => Z i -> [Int] -> [i] -> [[i]]
pci Z i
z [Int]
i [i]
p =
    let f :: [a] -> [a]
f [a]
q = forall a. Ord a => [a] -> [a]
T.set (forall a b. (a -> b) -> [a] -> [b]
map ([a]
q forall a. [a] -> Int -> a
!!) [Int]
i)
    in forall a. (a -> Bool) -> [a] -> [a]
filter (\[i]
q -> forall a. Ord a => [a] -> [a]
f [i]
q forall a. Eq a => a -> a -> Bool
== forall a. Ord a => [a] -> [a]
f [i]
p) (forall i. Integral i => Z i -> [i] -> [[i]]
z_sro_rti_related Z i
z [i]
p)

{- | Relate sets (TnMI), ie 'z_tto_rel'

>>> $ pct rs 0123 641B
>>> T1M

> map tto_pp (rs 5 z12 [0,1,2,3] [6,4,1,11]) == ["T1M","T4MI"]

-}
rs :: Integral t => t -> Z t -> [t] -> [t] -> [Tto t]
rs :: forall t. Integral t => t -> Z t -> [t] -> [t] -> [Tto t]
rs t
m Z t
z [t]
p [t]
q = forall t. (Ord t, Integral t) => t -> Z t -> [t] -> [t] -> [Tto t]
z_tto_rel t
m Z t
z (forall a. Ord a => [a] -> [a]
T.set [t]
p) (forall a. Ord a => [a] -> [a]
T.set [t]
q)

{- | Relate segments.

>>> $ pct rsg 156 3BA
>>> T4I
>>> $ pct rsg 0123 05A3
>>> T0M
>>> $ pct rsg 0123 4B61
>>> RT1M
>>> $ pct rsg 0123 B614
>>> r3RT1M

> let sros = map (sro_parse 5) . words
> rsg 5 z12 [1,5,6] [3,11,10] == sros "T4I r1RT4MI"
> rsg 5 z12 [0,1,2,3] [0,5,10,3] == sros "T0M RT3MI"
> rsg 5 z12 [0,1,2,3] [4,11,6,1] == sros "T4MI RT1M"
> rsg 5 z12 [0,1,2,3] [11,6,1,4] == sros "r1T4MI r1RT1M"

-}
rsg :: Integral i => i -> Z i -> [i] -> [i] -> [Sro i]
rsg :: forall i. Integral i => i -> Z i -> [i] -> [i] -> [Sro i]
rsg = forall t. (Ord t, Integral t) => t -> Z t -> [t] -> [t] -> [Sro t]
z_sro_rel

-- | Subsets.
--
-- > cf [4] (sb z12 [sc "6-32",sc "6-8"]) == [[0,2,3,5],[0,1,3,5],[0,2,3,7],[0,2,4,7],[0,2,5,7]]
sb :: Integral i => Z i -> [[i]] -> [[i]]
sb :: forall i. Integral i => Z i -> [[i]] -> [[i]]
sb Z i
z [[i]]
xs =
    let f :: [i] -> Bool
f [i]
p = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\[i]
q -> forall i. Integral i => Z i -> [i] -> [i] -> Bool
has_sc Z i
z [i]
q [i]
p) [[i]]
xs
    in forall a. (a -> Bool) -> [a] -> [a]
filter [i] -> Bool
f forall n. Num n => [[n]]
scs

{- | scc = set class completion

>>> pct scc 6-32 168
35A
49B
3AB
34B

> scc z12 (sc "6-32") [1,6,8] == [[3,5,10],[4,9,11],[3,10,11],[3,4,11]]

-}
scc :: Integral i => Z i -> [i] -> [i] -> [[i]]
scc :: forall i. Integral i => Z i -> [i] -> [i] -> [[i]]
scc Z i
z [i]
r [i]
p = forall a b. (a -> b) -> [a] -> [b]
map (forall a. Eq a => [a] -> [a] -> [a]
\\ [i]
p) (forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Eq a => [a] -> [a] -> Bool
T.is_subset [i]
p) (forall i. Integral i => Z i -> [i] -> [[i]]
z_tto_ti_related Z i
z [i]
r))

-- | Header fields for 'si'.
si_hdr :: [String]
si_hdr :: [[Char]]
si_hdr =
    [[Char]
"pitch-class-set"
    ,[Char]
"set-class"
    ,[Char]
"interval-class-vector"
    ,[Char]
"tics"
    ,[Char]
"complement"
    ,[Char]
"multiplication-by-five-transform"]

-- | (Pcset,Tto,Forte-Prime)
type Si i = ([i],Tto i,[i])

-- | Calculator for si.
--
-- > si_calc [0,5,3,11]
si_calc :: Integral i => [i] -> (Si i,[i],[Int],Si i,Si i)
si_calc :: forall i. Integral i => [i] -> (Si i, [i], [Int], Si i, Si i)
si_calc [i]
p =
    let n :: Int
n = forall (t :: * -> *) a. Foldable t => t a -> Int
length [i]
p
        p_icv :: [i]
p_icv = forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n forall a. a -> [a] -> [a]
: forall i n. (Integral i, Num n) => Z i -> [i] -> [n]
z_icv forall i. Num i => Z i
z12 [i]
p
        gen_si :: [a] -> ([a], Tto a, [a])
gen_si [a]
x = let x_f :: [a]
x_f = forall i. Integral i => Z i -> [i] -> [i]
z_forte_prime forall i. Num i => Z i
z12 [a]
x
                       x_o :: Tto a
x_o = forall a. [a] -> a
head (forall t. Integral t => t -> Z t -> [t] -> [t] -> [Tto t]
rs a
5 forall i. Num i => Z i
z12 [a]
x_f [a]
x)
                   in (forall a. Eq a => [a] -> [a]
nub (forall a. Ord a => [a] -> [a]
sort [a]
x),Tto a
x_o,[a]
x_f)
    in (forall {a}. Integral a => [a] -> ([a], Tto a, [a])
gen_si [i]
p,[i]
p_icv,forall i. Integral i => Z i -> [i] -> [Int]
tics forall i. Num i => Z i
z12 [i]
p,forall {a}. Integral a => [a] -> ([a], Tto a, [a])
gen_si (forall i. Integral i => Z i -> [i] -> [i]
z_complement forall i. Num i => Z i
z12 [i]
p),forall {a}. Integral a => [a] -> ([a], Tto a, [a])
gen_si (forall a b. (a -> b) -> [a] -> [b]
map (forall i. Integral i => Z i -> i -> i -> i
z_mul forall i. Num i => Z i
z12 i
5) [i]
p))

-- | Pretty printer for RHS for si.
--
-- > si_rhs_pp [0,5,3,11]
si_rhs_pp :: (Integral i,Show i) => [i] -> [String]
si_rhs_pp :: forall i. (Integral i, Show i) => [i] -> [[Char]]
si_rhs_pp [i]
p =
    let pf_pp :: Bool -> (Tto t, [t]) -> [Char]
pf_pp Bool
concise (Tto t
x_o,[t]
x_f) =
            forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [forall t. (Show t, Num t, Eq t) => Tto t -> [Char]
tto_pp Tto t
x_o,[Char]
" ",forall i. Integral i => [i] -> [Char]
sc_name [t]
x_f
                   ,if Bool
concise then [Char]
"" else forall i. Integral i => [i] -> [Char]
z16_vec_pp [t]
x_f]
        si_pp :: ([t], Tto t, [t]) -> [Char]
si_pp ([t]
x,Tto t
x_o,[t]
x_f) = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [forall i. Integral i => [i] -> [Char]
z16_set_pp [t]
x,[Char]
" (",forall {t} {t}.
(Show t, Integral t, Num t, Eq t) =>
Bool -> (Tto t, [t]) -> [Char]
pf_pp Bool
True (Tto t
x_o,[t]
x_f),[Char]
")"]
        (([i]
p',Tto i
p_o,[i]
p_f),[i]
p_icv,[Int]
p_tics,Si i
c,Si i
m) = forall i. Integral i => [i] -> (Si i, [i], [Int], Si i, Si i)
si_calc [i]
p
    in [forall i. Integral i => [i] -> [Char]
z16_set_pp [i]
p'
       ,forall {t} {t}.
(Show t, Integral t, Num t, Eq t) =>
Bool -> (Tto t, [t]) -> [Char]
pf_pp Bool
False (Tto i
p_o,[i]
p_f)
       ,forall i. Integral i => [i] -> [Char]
z16_vec_pp [i]
p_icv
       ,forall i. Integral i => [i] -> [Char]
z16_vec_pp [Int]
p_tics
       ,forall {t} {t} {t}.
(Show t, Integral t, Integral t, Num t, Eq t) =>
([t], Tto t, [t]) -> [Char]
si_pp Si i
c
       ,forall {t} {t} {t}.
(Show t, Integral t, Integral t, Num t, Eq t) =>
([t], Tto t, [t]) -> [Char]
si_pp Si i
m]

{- | Set information.

$ pct si 053b
pitch-class-set: {035B}
set-class: TB  4-Z15[0146]
interval-class-vector: [4111111]
tics: [102222102022]
complement: {1246789A} (TAI 8-Z15)
multiplication-by-five-transform: {0317} (T0  4-Z29)
$

> putStr $ unlines $ si [0,5,3,11]
-}
si :: (Integral i,Show i) => [i] -> [String]
si :: forall i. (Integral i, Show i) => [i] -> [[Char]]
si [i]
p = forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\[Char]
k [Char]
v -> forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Char]
k,[Char]
": ",[Char]
v]) [[Char]]
si_hdr (forall i. (Integral i, Show i) => [i] -> [[Char]]
si_rhs_pp [i]
p)

{- | Super set-class.

>>> pct spsc 4-11 4-12
5-26[02458]

> spsc z12 [sc "4-11",sc "4-12"] == [[0,2,4,5,8]]

>>> pct spsc 3-11 3-8
4-27[0258]
4-Z29[0137]

> spsc z12 [sc "3-11",sc "3-8"] == [[0,2,5,8],[0,1,3,7]]

>>> pct spsc `pct fl 3`
6-Z17[012478]

> spsc z12 (cf [3] scs) == [[0,1,2,4,7,8]]

-}
spsc :: Integral i => Z i -> [[i]] -> [[i]]
spsc :: forall i. Integral i => Z i -> [[i]] -> [[i]]
spsc Z i
z [[i]]
xs =
    let f :: [i] -> Bool
f [i]
y = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (forall i. Integral i => Z i -> [i] -> [i] -> Bool
has_sc Z i
z [i]
y) [[i]]
xs
        g :: [a] -> [a] -> Bool
g = forall a. Eq a => a -> a -> Bool
(==) forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` forall (t :: * -> *) a. Foldable t => t a -> Int
length
    in (forall a. [a] -> a
head forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy forall {a}. [a] -> [a] -> Bool
g forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter [i] -> Bool
f) forall n. Num n => [[n]]
scs

{- | sra = stravinsky rotational array

>>> echo 019BA7 | pct sra
019BA7
08A96B
021A34
0B812A
0923B1
056243

> let r = [[0,1,9,11,10,7],[0,8,10,9,6,11],[0,2,1,10,3,4],[0,11,8,1,2,10],[0,9,2,3,11,1],[0,5,6,2,4,3]]
> sra z12 [0,1,9,11,10,7] == r

-}
sra :: Integral i => Z i -> [i] -> [[i]]
sra :: forall i. Integral i => Z i -> [i] -> [[i]]
sra Z i
z = forall a b. (a -> b) -> [a] -> [b]
map (forall i. Integral i => Z i -> i -> [i] -> [i]
z_sro_tn_to Z i
z i
0) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [[a]]
T.rotations

{- | Serial operation.

>>> echo 156 | pct sro T4
59A

> sro (Z.sro_parse "T4") [1,5,6] == [5,9,10]

>>> echo 024579 | pct sro RT4I
79B024

> sro (Z.Sro 0 True 4 False True) [0,2,4,5,7,9] == [7,9,11,0,2,4]

>>> echo 156 | pct sro T4I
3BA

> sro (Z.sro_parse "T4I") [1,5,6] == [3,11,10]
> sro (Z.Sro 0 False 4 False True) [1,5,6] == [3,11,10]

>>> echo 156 | pct sro T4  | pct sro T0I
732

> (sro (Z.sro_parse "T0I") . sro (Z.sro_parse "T4")) [1,5,6] == [7,3,2]

>>> echo 024579 | pct sro RT4I
79B024

> sro (Z.sro_parse "RT4I") [0,2,4,5,7,9] == [7,9,11,0,2,4]

-}
sro :: Integral i => Z i -> Sro i -> [i] -> [i]
sro :: forall i. Integral i => Z i -> Sro i -> [i] -> [i]
sro = forall i. Integral i => Z i -> Sro i -> [i] -> [i]
z_sro_apply

{- | tmatrix

>>> pct tmatrix 1258

1258
0147
9A14
67A1

> tmatrix z12 [1,2,5,8] == [[1,2,5,8],[0,1,4,7],[9,10,1,4],[6,7,10,1]]

-}
tmatrix :: Integral i => Z i -> [i] -> [[i]]
tmatrix :: forall i. Integral i => Z i -> [i] -> [[i]]
tmatrix Z i
z [i]
p =
    let i :: [i]
i = forall a b. (a -> b) -> [a] -> [b]
map (forall i. Integral i => Z i -> i -> i
z_negate Z i
z) (forall t u. (t -> t -> u) -> [t] -> [u]
T.d_dx_by (forall i. Integral i => Z i -> i -> i -> i
z_sub Z i
z) [i]
p)
    in forall a b. (a -> b) -> [a] -> [b]
map (\i
n -> forall a b. (a -> b) -> [a] -> [b]
map (forall i. Integral i => Z i -> i -> i -> i
z_add Z i
z i
n) [i]
p) (forall a. Num a => a -> [a] -> [a]
T.dx_d i
0 [i]
i)


{- | trs = transformations search.  Search all RTnMI of /p/ for /q/.

>>> echo 642 | pct trs 024579 | sort -u
531642
6421B9
642753
B97642

> let r = [[5,3,1,6,4,2],[6,4,2,1,11,9],[6,4,2,7,5,3],[11,9,7,6,4,2]]
> sort (trs z12 [0,2,4,5,7,9] [6,4,2]) == r

-}
trs :: Integral i => Z i -> [i] -> [i] -> [[i]]
trs :: forall i. Integral i => Z i -> [i] -> [i] -> [[i]]
trs Z i
z [i]
p [i]
q = forall a. (a -> Bool) -> [a] -> [a]
filter ([i]
q forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf`) (forall i. Integral i => Z i -> [i] -> [[i]]
z_sro_rtmi_related Z i
z [i]
p)

-- | Like 'trs', but of 'z_sro_rti_related'.
--
-- > trs_m z12 [0,2,4,5,7,9] [6,4,2] == [[6,4,2,1,11,9],[11,9,7,6,4,2]]
trs_m :: Integral i => Z i -> [i] -> [i] -> [[i]]
trs_m :: forall i. Integral i => Z i -> [i] -> [i] -> [[i]]
trs_m Z i
z [i]
p [i]
q = forall a. (a -> Bool) -> [a] -> [a]
filter ([i]
q forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf`) (forall i. Integral i => Z i -> [i] -> [[i]]
z_sro_rti_related Z i
z [i]
p)