-- | Allen Forte. /The Structure of Atonal Music/.
--   Yale University Press, New Haven, 1973.
module Music.Theory.Z.Forte_1973 where

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

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

import Music.Theory.Unicode {- hmt -}
import Music.Theory.Z {- hmt -}
import Music.Theory.Z.Sro {- hmt -}

-- * Prime form

-- | T-related rotations of /p/, ie. all rotations tranposed to be at zero.
--
-- > z_t_rotations z12 [1,2,4] == [[0,1,3],[0,2,11],[0,9,10]]
z_t_rotations :: Integral i => Z i -> [i] -> [[i]]
z_t_rotations :: forall i. Integral i => Z i -> [i] -> [[i]]
z_t_rotations Z i
z [i]
p =
    let r :: [[i]]
r = forall a. [a] -> [[a]]
T.rotations (forall a. Ord a => [a] -> [a]
sort [i]
p)
    in 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) [[i]]
r

-- | T\/I-related rotations of /p/.
--
-- > ti_rotations z12 [0,1,3] == [[0,1,3],[0,2,11],[0,9,10],[0,9,11],[0,2,3],[0,1,10]]
z_ti_rotations :: Integral i => Z i -> [i] -> [[i]]
z_ti_rotations :: forall i. Integral i => Z i -> [i] -> [[i]]
z_ti_rotations Z i
z [i]
p =
    let q :: [i]
q = forall i (f :: * -> *).
(Integral i, Functor f) =>
Z i -> i -> f i -> f i
z_sro_invert Z i
z i
0 [i]
p
        r :: [[i]]
r = forall a. [a] -> [[a]]
T.rotations (forall a. Ord a => [a] -> [a]
sort [i]
p) forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [[a]]
T.rotations (forall a. Ord a => [a] -> [a]
sort [i]
q)
    in 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) [[i]]
r

-- | Prime form rule requiring comparator, considering 't_rotations'.
z_t_cmp_prime :: Integral i => Z i -> ([i] -> [i] -> Ordering) -> [i] -> [i]
z_t_cmp_prime :: forall i.
Integral i =>
Z i -> ([i] -> [i] -> Ordering) -> [i] -> [i]
z_t_cmp_prime Z i
z [i] -> [i] -> Ordering
f = forall t. t -> (t -> t -> Ordering) -> [t] -> t
T.minimumBy_or [] [i] -> [i] -> Ordering
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i. Integral i => Z i -> [i] -> [[i]]
z_t_rotations Z i
z

-- | Prime form rule requiring comparator, considering 'ti_rotations'.
z_ti_cmp_prime :: Integral i => Z i -> ([i] -> [i] -> Ordering) -> [i] -> [i]
z_ti_cmp_prime :: forall i.
Integral i =>
Z i -> ([i] -> [i] -> Ordering) -> [i] -> [i]
z_ti_cmp_prime Z i
z [i] -> [i] -> Ordering
f = forall t. t -> (t -> t -> Ordering) -> [t] -> t
T.minimumBy_or [] [i] -> [i] -> Ordering
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i. Integral i => Z i -> [i] -> [[i]]
z_ti_rotations Z i
z

-- | Forte comparison function (rightmost first then leftmost outwards).
--
-- > forte_cmp [0,1,3,6,8,9] [0,2,3,6,7,9] == LT
forte_cmp :: (Ord t) => [t] -> [t] -> Ordering
forte_cmp :: forall t. Ord t => [t] -> [t] -> Ordering
forte_cmp [t]
p  [t]
q  =
    case ([t]
p,[t]
q) of
      ([],[]) -> Ordering
EQ
      ([],[t]
_) -> Ordering
LT
      ([t]
_,[]) -> Ordering
GT
      ([t], [t])
_ -> let r :: Ordering
r = forall a. Ord a => a -> a -> Ordering
compare (forall a. [a] -> a
last [t]
p) (forall a. [a] -> a
last [t]
q)
           in if Ordering
r forall a. Eq a => a -> a -> Bool
== Ordering
EQ then forall a. Ord a => a -> a -> Ordering
compare [t]
p [t]
q else Ordering
r

{- | Forte prime form, ie. 'z_ti_cmp_prime' of 'forte_cmp'.

> z_forte_prime z12 [0,1,3,6,8,9] == [0,1,3,6,8,9]
> z_forte_prime z5 [0,1,4] == [0,1,2]
> z_forte_prime z5 [0,1,1] -- ERROR

> S.set (map (z_forte_prime z5) (S.powerset [0..4]))
> S.set (map (z_forte_prime z7) (S.powerset [0..6]))
-}
z_forte_prime :: Integral i => Z i -> [i] -> [i]
z_forte_prime :: forall i. Integral i => Z i -> [i] -> [i]
z_forte_prime Z i
z [i]
x =
  if forall a. Eq a => [a] -> [a]
nub [i]
x forall a. Eq a => a -> a -> Bool
/= [i]
x Bool -> Bool -> Bool
|| forall a b. (a -> b) -> [a] -> [b]
map (forall i. Integral i => Z i -> i -> i
z_mod Z i
z) [i]
x forall a. Eq a => a -> a -> Bool
/= [i]
x
  then forall a. HasCallStack => [Char] -> a
error [Char]
"z_forte_prime: invalid input"
  else forall i.
Integral i =>
Z i -> ([i] -> [i] -> Ordering) -> [i] -> [i]
z_ti_cmp_prime Z i
z forall t. Ord t => [t] -> [t] -> Ordering
forte_cmp [i]
x

-- | Transpositional equivalence prime form,
--   ie. 'z_t_cmp_prime' of 'forte_cmp'.
--
-- > (z_forte_prime z12 [0,2,3],z_t_prime z12 [0,2,3]) == ([0,1,3],[0,2,3])
z_t_prime :: Integral i => Z i -> [i] -> [i]
z_t_prime :: forall i. Integral i => Z i -> [i] -> [i]
z_t_prime Z i
z = forall i.
Integral i =>
Z i -> ([i] -> [i] -> Ordering) -> [i] -> [i]
z_t_cmp_prime Z i
z forall t. Ord t => [t] -> [t] -> Ordering
forte_cmp

-- * ICV Metric

-- | Interval class of interval /i/.
--
-- > map (z_ic z12) [0..12] == [0,1,2,3,4,5,6,5,4,3,2,1,0]
-- > map (z_ic z7) [0..7] == [0,1,2,3,3,2,1,0]
-- > map (z_ic z5) [0..5] == [0,1,2,2,1,0]
-- > map (z_ic z12) [5,6,7] == [5,6,5]
-- > map (z_ic z12) [-13,-1,0,1,13] == [1,1,0,1,1]
z_ic :: Integral i => Z i -> i -> i
z_ic :: forall i. Integral i => Z i -> i -> i
z_ic Z i
z i
i =
  let j :: i
j = forall i. Integral i => Z i -> i -> i
z_mod Z i
z i
i
      m :: i
m = forall i. Z i -> i
z_modulus Z i
z
  in if i
j forall a. Ord a => a -> a -> Bool
<= (i
m forall a. Integral a => a -> a -> a
`div` i
2) then i
j else i
m forall a. Num a => a -> a -> a
- i
j

-- | Forte notation for interval class vector.
--
-- > z_icv z12 [0,1,2,4,7,8] == [3,2,2,3,3,2]
z_icv :: (Integral i, Num n) => Z i -> [i] -> [n]
z_icv :: forall i n. (Integral i, Num n) => Z i -> [i] -> [n]
z_icv Z i
z [i]
s =
    let i :: [i]
i = forall a b. (a -> b) -> [a] -> [b]
map (forall i. Integral i => Z i -> i -> i
z_ic Z i
z forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i. Integral i => Z i -> i -> i
z_mod Z i
z forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (-)) (forall a. [a] -> [(a, a)]
S.pairs [i]
s)
        f :: [a] -> (a, b)
f [a]
l = (forall a. [a] -> a
head [a]
l,forall i a. Num i => [a] -> i
genericLength [a]
l)
        j :: [(i, n)]
j = forall a b. (a -> b) -> [a] -> [b]
map forall {b} {a}. Num b => [a] -> (a, b)
f (forall a. Eq a => [a] -> [[a]]
group (forall a. Ord a => [a] -> [a]
sort [i]
i))
        k :: [Maybe n]
k = forall a b. (a -> b) -> [a] -> [b]
map (forall a b. Eq a => a -> [(a, b)] -> Maybe b
`lookup` [(i, n)]
j) [i
1 .. forall i. Z i -> i
z_modulus Z i
z forall a. Integral a => a -> a -> a
`div` i
2]
    in forall a b. (a -> b) -> [a] -> [b]
map (forall a. a -> Maybe a -> a
fromMaybe n
0) [Maybe n]
k

-- * BIP Metric

-- | Basic interval pattern, see Allen Forte \"The Basic Interval Patterns\"
-- /JMT/ 17/2 (1973):234-272
--
-- >>> bip 0t95728e3416
-- 11223344556
--
-- > z_bip z12 [0,10,9,5,7,2,8,11,3,4,1,6] == [1,1,2,2,3,3,4,4,5,5,6]
z_bip :: Integral i => Z i -> [i] -> [i]
z_bip :: forall i. Integral i => Z i -> [i] -> [i]
z_bip Z i
z = forall a. Ord a => [a] -> [a]
sort forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall i. Integral i => Z i -> i -> i
z_ic Z i
z forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i. Integral i => Z i -> i -> i
z_mod Z i
z) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Num a => [a] -> [a]
T.d_dx

{- | Generate SC universe, though not in order of the Forte table.

> length (z_sc_univ z7) == 18
> sort (z_sc_univ z12) == sort (map snd sc_table)
> zipWith (\p q -> (p == q,p,q)) (z_sc_univ z12) (map snd sc_table)

-}
z_sc_univ :: Integral i => Z i -> [[i]]
z_sc_univ :: forall i. Integral i => Z i -> [[i]]
z_sc_univ Z i
z =
    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 a b. (a -> b) -> a -> b
$
    forall a. Eq a => [a] -> [a]
nub forall a b. (a -> b) -> a -> b
$
    forall a b. (a -> b) -> [a] -> [b]
map (forall i. Integral i => Z i -> [i] -> [i]
z_forte_prime Z i
z) forall a b. (a -> b) -> a -> b
$
    forall a. [a] -> [[a]]
S.powerset (forall i. Integral i => Z i -> [i]
z_univ Z i
z)

-- * Forte Names (Z12)

-- | Synonym for 'String'.
type SC_Name = String

-- | Table of (SC-NAME,PCSET).
type SC_Table n = [(SC_Name,[n])]

-- | The Z12 set-class table (Forte prime forms).
--
-- > length sc_table == 224
sc_table :: Num n => SC_Table n
sc_table :: forall n. Num n => SC_Table n
sc_table =
    [([Char]
"0-1",[])
    ,([Char]
"1-1",[n
0])
    ,([Char]
"2-1",[n
0,n
1])
    ,([Char]
"2-2",[n
0,n
2])
    ,([Char]
"2-3",[n
0,n
3])
    ,([Char]
"2-4",[n
0,n
4])
    ,([Char]
"2-5",[n
0,n
5])
    ,([Char]
"2-6",[n
0,n
6])
    ,([Char]
"3-1",[n
0,n
1,n
2])
    ,([Char]
"3-2",[n
0,n
1,n
3])
    ,([Char]
"3-3",[n
0,n
1,n
4])
    ,([Char]
"3-4",[n
0,n
1,n
5])
    ,([Char]
"3-5",[n
0,n
1,n
6])
    ,([Char]
"3-6",[n
0,n
2,n
4])
    ,([Char]
"3-7",[n
0,n
2,n
5])
    ,([Char]
"3-8",[n
0,n
2,n
6])
    ,([Char]
"3-9",[n
0,n
2,n
7])
    ,([Char]
"3-10",[n
0,n
3,n
6])
    ,([Char]
"3-11",[n
0,n
3,n
7])
    ,([Char]
"3-12",[n
0,n
4,n
8])
    ,([Char]
"4-1",[n
0,n
1,n
2,n
3])
    ,([Char]
"4-2",[n
0,n
1,n
2,n
4])
    ,([Char]
"4-3",[n
0,n
1,n
3,n
4])
    ,([Char]
"4-4",[n
0,n
1,n
2,n
5])
    ,([Char]
"4-5",[n
0,n
1,n
2,n
6])
    ,([Char]
"4-6",[n
0,n
1,n
2,n
7])
    ,([Char]
"4-7",[n
0,n
1,n
4,n
5])
    ,([Char]
"4-8",[n
0,n
1,n
5,n
6])
    ,([Char]
"4-9",[n
0,n
1,n
6,n
7])
    ,([Char]
"4-10",[n
0,n
2,n
3,n
5])
    ,([Char]
"4-11",[n
0,n
1,n
3,n
5])
    ,([Char]
"4-12",[n
0,n
2,n
3,n
6])
    ,([Char]
"4-13",[n
0,n
1,n
3,n
6])
    ,([Char]
"4-14",[n
0,n
2,n
3,n
7])
    ,([Char]
"4-Z15",[n
0,n
1,n
4,n
6])
    ,([Char]
"4-16",[n
0,n
1,n
5,n
7])
    ,([Char]
"4-17",[n
0,n
3,n
4,n
7])
    ,([Char]
"4-18",[n
0,n
1,n
4,n
7])
    ,([Char]
"4-19",[n
0,n
1,n
4,n
8])
    ,([Char]
"4-20",[n
0,n
1,n
5,n
8])
    ,([Char]
"4-21",[n
0,n
2,n
4,n
6])
    ,([Char]
"4-22",[n
0,n
2,n
4,n
7])
    ,([Char]
"4-23",[n
0,n
2,n
5,n
7])
    ,([Char]
"4-24",[n
0,n
2,n
4,n
8])
    ,([Char]
"4-25",[n
0,n
2,n
6,n
8])
    ,([Char]
"4-26",[n
0,n
3,n
5,n
8])
    ,([Char]
"4-27",[n
0,n
2,n
5,n
8])
    ,([Char]
"4-28",[n
0,n
3,n
6,n
9])
    ,([Char]
"4-Z29",[n
0,n
1,n
3,n
7])
    ,([Char]
"5-1",[n
0,n
1,n
2,n
3,n
4])
    ,([Char]
"5-2",[n
0,n
1,n
2,n
3,n
5])
    ,([Char]
"5-3",[n
0,n
1,n
2,n
4,n
5])
    ,([Char]
"5-4",[n
0,n
1,n
2,n
3,n
6])
    ,([Char]
"5-5",[n
0,n
1,n
2,n
3,n
7])
    ,([Char]
"5-6",[n
0,n
1,n
2,n
5,n
6])
    ,([Char]
"5-7",[n
0,n
1,n
2,n
6,n
7])
    ,([Char]
"5-8",[n
0,n
2,n
3,n
4,n
6])
    ,([Char]
"5-9",[n
0,n
1,n
2,n
4,n
6])
    ,([Char]
"5-10",[n
0,n
1,n
3,n
4,n
6])
    ,([Char]
"5-11",[n
0,n
2,n
3,n
4,n
7])
    ,([Char]
"5-Z12",[n
0,n
1,n
3,n
5,n
6])
    ,([Char]
"5-13",[n
0,n
1,n
2,n
4,n
8])
    ,([Char]
"5-14",[n
0,n
1,n
2,n
5,n
7])
    ,([Char]
"5-15",[n
0,n
1,n
2,n
6,n
8])
    ,([Char]
"5-16",[n
0,n
1,n
3,n
4,n
7])
    ,([Char]
"5-Z17",[n
0,n
1,n
3,n
4,n
8])
    ,([Char]
"5-Z18",[n
0,n
1,n
4,n
5,n
7])
    ,([Char]
"5-19",[n
0,n
1,n
3,n
6,n
7])
    ,([Char]
"5-20",[n
0,n
1,n
3,n
7,n
8])
    ,([Char]
"5-21",[n
0,n
1,n
4,n
5,n
8])
    ,([Char]
"5-22",[n
0,n
1,n
4,n
7,n
8])
    ,([Char]
"5-23",[n
0,n
2,n
3,n
5,n
7])
    ,([Char]
"5-24",[n
0,n
1,n
3,n
5,n
7])
    ,([Char]
"5-25",[n
0,n
2,n
3,n
5,n
8])
    ,([Char]
"5-26",[n
0,n
2,n
4,n
5,n
8])
    ,([Char]
"5-27",[n
0,n
1,n
3,n
5,n
8])
    ,([Char]
"5-28",[n
0,n
2,n
3,n
6,n
8])
    ,([Char]
"5-29",[n
0,n
1,n
3,n
6,n
8])
    ,([Char]
"5-30",[n
0,n
1,n
4,n
6,n
8])
    ,([Char]
"5-31",[n
0,n
1,n
3,n
6,n
9])
    ,([Char]
"5-32",[n
0,n
1,n
4,n
6,n
9])
    ,([Char]
"5-33",[n
0,n
2,n
4,n
6,n
8])
    ,([Char]
"5-34",[n
0,n
2,n
4,n
6,n
9])
    ,([Char]
"5-35",[n
0,n
2,n
4,n
7,n
9])
    ,([Char]
"5-Z36",[n
0,n
1,n
2,n
4,n
7])
    ,([Char]
"5-Z37",[n
0,n
3,n
4,n
5,n
8])
    ,([Char]
"5-Z38",[n
0,n
1,n
2,n
5,n
8])
    ,([Char]
"6-1",[n
0,n
1,n
2,n
3,n
4,n
5])
    ,([Char]
"6-2",[n
0,n
1,n
2,n
3,n
4,n
6])
    ,([Char]
"6-Z3",[n
0,n
1,n
2,n
3,n
5,n
6])
    ,([Char]
"6-Z4",[n
0,n
1,n
2,n
4,n
5,n
6])
    ,([Char]
"6-5",[n
0,n
1,n
2,n
3,n
6,n
7])
    ,([Char]
"6-Z6",[n
0,n
1,n
2,n
5,n
6,n
7])
    ,([Char]
"6-7",[n
0,n
1,n
2,n
6,n
7,n
8])
    ,([Char]
"6-8",[n
0,n
2,n
3,n
4,n
5,n
7])
    ,([Char]
"6-9",[n
0,n
1,n
2,n
3,n
5,n
7])
    ,([Char]
"6-Z10",[n
0,n
1,n
3,n
4,n
5,n
7])
    ,([Char]
"6-Z11",[n
0,n
1,n
2,n
4,n
5,n
7])
    ,([Char]
"6-Z12",[n
0,n
1,n
2,n
4,n
6,n
7])
    ,([Char]
"6-Z13",[n
0,n
1,n
3,n
4,n
6,n
7])
    ,([Char]
"6-14",[n
0,n
1,n
3,n
4,n
5,n
8])
    ,([Char]
"6-15",[n
0,n
1,n
2,n
4,n
5,n
8])
    ,([Char]
"6-16",[n
0,n
1,n
4,n
5,n
6,n
8])
    ,([Char]
"6-Z17",[n
0,n
1,n
2,n
4,n
7,n
8])
    ,([Char]
"6-18",[n
0,n
1,n
2,n
5,n
7,n
8])
    ,([Char]
"6-Z19",[n
0,n
1,n
3,n
4,n
7,n
8])
    ,([Char]
"6-20",[n
0,n
1,n
4,n
5,n
8,n
9])
    ,([Char]
"6-21",[n
0,n
2,n
3,n
4,n
6,n
8])
    ,([Char]
"6-22",[n
0,n
1,n
2,n
4,n
6,n
8])
    ,([Char]
"6-Z23",[n
0,n
2,n
3,n
5,n
6,n
8])
    ,([Char]
"6-Z24",[n
0,n
1,n
3,n
4,n
6,n
8])
    ,([Char]
"6-Z25",[n
0,n
1,n
3,n
5,n
6,n
8])
    ,([Char]
"6-Z26",[n
0,n
1,n
3,n
5,n
7,n
8])
    ,([Char]
"6-27",[n
0,n
1,n
3,n
4,n
6,n
9])
    ,([Char]
"6-Z28",[n
0,n
1,n
3,n
5,n
6,n
9])
    ,([Char]
"6-Z29",[n
0,n
1,n
3,n
6,n
8,n
9])
    ,([Char]
"6-30",[n
0,n
1,n
3,n
6,n
7,n
9])
    ,([Char]
"6-31",[n
0,n
1,n
3,n
5,n
8,n
9])
    ,([Char]
"6-32",[n
0,n
2,n
4,n
5,n
7,n
9])
    ,([Char]
"6-33",[n
0,n
2,n
3,n
5,n
7,n
9])
    ,([Char]
"6-34",[n
0,n
1,n
3,n
5,n
7,n
9])
    ,([Char]
"6-35",[n
0,n
2,n
4,n
6,n
8,n
10])
    ,([Char]
"6-Z36",[n
0,n
1,n
2,n
3,n
4,n
7])
    ,([Char]
"6-Z37",[n
0,n
1,n
2,n
3,n
4,n
8])
    ,([Char]
"6-Z38",[n
0,n
1,n
2,n
3,n
7,n
8])
    ,([Char]
"6-Z39",[n
0,n
2,n
3,n
4,n
5,n
8])
    ,([Char]
"6-Z40",[n
0,n
1,n
2,n
3,n
5,n
8])
    ,([Char]
"6-Z41",[n
0,n
1,n
2,n
3,n
6,n
8])
    ,([Char]
"6-Z42",[n
0,n
1,n
2,n
3,n
6,n
9])
    ,([Char]
"6-Z43",[n
0,n
1,n
2,n
5,n
6,n
8])
    ,([Char]
"6-Z44",[n
0,n
1,n
2,n
5,n
6,n
9])
    ,([Char]
"6-Z45",[n
0,n
2,n
3,n
4,n
6,n
9])
    ,([Char]
"6-Z46",[n
0,n
1,n
2,n
4,n
6,n
9])
    ,([Char]
"6-Z47",[n
0,n
1,n
2,n
4,n
7,n
9])
    ,([Char]
"6-Z48",[n
0,n
1,n
2,n
5,n
7,n
9])
    ,([Char]
"6-Z49",[n
0,n
1,n
3,n
4,n
7,n
9])
    ,([Char]
"6-Z50",[n
0,n
1,n
4,n
6,n
7,n
9])
    ,([Char]
"7-1",[n
0,n
1,n
2,n
3,n
4,n
5,n
6])
    ,([Char]
"7-2",[n
0,n
1,n
2,n
3,n
4,n
5,n
7])
    ,([Char]
"7-3",[n
0,n
1,n
2,n
3,n
4,n
5,n
8])
    ,([Char]
"7-4",[n
0,n
1,n
2,n
3,n
4,n
6,n
7])
    ,([Char]
"7-5",[n
0,n
1,n
2,n
3,n
5,n
6,n
7])
    ,([Char]
"7-6",[n
0,n
1,n
2,n
3,n
4,n
7,n
8])
    ,([Char]
"7-7",[n
0,n
1,n
2,n
3,n
6,n
7,n
8])
    ,([Char]
"7-8",[n
0,n
2,n
3,n
4,n
5,n
6,n
8])
    ,([Char]
"7-9",[n
0,n
1,n
2,n
3,n
4,n
6,n
8])
    ,([Char]
"7-10",[n
0,n
1,n
2,n
3,n
4,n
6,n
9])
    ,([Char]
"7-11",[n
0,n
1,n
3,n
4,n
5,n
6,n
8])
    ,([Char]
"7-Z12",[n
0,n
1,n
2,n
3,n
4,n
7,n
9])
    ,([Char]
"7-13",[n
0,n
1,n
2,n
4,n
5,n
6,n
8])
    ,([Char]
"7-14",[n
0,n
1,n
2,n
3,n
5,n
7,n
8])
    ,([Char]
"7-15",[n
0,n
1,n
2,n
4,n
6,n
7,n
8])
    ,([Char]
"7-16",[n
0,n
1,n
2,n
3,n
5,n
6,n
9])
    ,([Char]
"7-Z17",[n
0,n
1,n
2,n
4,n
5,n
6,n
9])
    ,([Char]
"7-Z18",[n
0,n
1,n
2,n
3,n
5,n
8,n
9])
    ,([Char]
"7-19",[n
0,n
1,n
2,n
3,n
6,n
7,n
9])
    ,([Char]
"7-20",[n
0,n
1,n
2,n
4,n
7,n
8,n
9])
    ,([Char]
"7-21",[n
0,n
1,n
2,n
4,n
5,n
8,n
9])
    ,([Char]
"7-22",[n
0,n
1,n
2,n
5,n
6,n
8,n
9])
    ,([Char]
"7-23",[n
0,n
2,n
3,n
4,n
5,n
7,n
9])
    ,([Char]
"7-24",[n
0,n
1,n
2,n
3,n
5,n
7,n
9])
    ,([Char]
"7-25",[n
0,n
2,n
3,n
4,n
6,n
7,n
9])
    ,([Char]
"7-26",[n
0,n
1,n
3,n
4,n
5,n
7,n
9])
    ,([Char]
"7-27",[n
0,n
1,n
2,n
4,n
5,n
7,n
9])
    ,([Char]
"7-28",[n
0,n
1,n
3,n
5,n
6,n
7,n
9])
    ,([Char]
"7-29",[n
0,n
1,n
2,n
4,n
6,n
7,n
9])
    ,([Char]
"7-30",[n
0,n
1,n
2,n
4,n
6,n
8,n
9])
    ,([Char]
"7-31",[n
0,n
1,n
3,n
4,n
6,n
7,n
9])
    ,([Char]
"7-32",[n
0,n
1,n
3,n
4,n
6,n
8,n
9])
    ,([Char]
"7-33",[n
0,n
1,n
2,n
4,n
6,n
8,n
10])
    ,([Char]
"7-34",[n
0,n
1,n
3,n
4,n
6,n
8,n
10])
    ,([Char]
"7-35",[n
0,n
1,n
3,n
5,n
6,n
8,n
10])
    ,([Char]
"7-Z36",[n
0,n
1,n
2,n
3,n
5,n
6,n
8])
    ,([Char]
"7-Z37",[n
0,n
1,n
3,n
4,n
5,n
7,n
8])
    ,([Char]
"7-Z38",[n
0,n
1,n
2,n
4,n
5,n
7,n
8])
    ,([Char]
"8-1",[n
0,n
1,n
2,n
3,n
4,n
5,n
6,n
7])
    ,([Char]
"8-2",[n
0,n
1,n
2,n
3,n
4,n
5,n
6,n
8])
    ,([Char]
"8-3",[n
0,n
1,n
2,n
3,n
4,n
5,n
6,n
9])
    ,([Char]
"8-4",[n
0,n
1,n
2,n
3,n
4,n
5,n
7,n
8])
    ,([Char]
"8-5",[n
0,n
1,n
2,n
3,n
4,n
6,n
7,n
8])
    ,([Char]
"8-6",[n
0,n
1,n
2,n
3,n
5,n
6,n
7,n
8])
    ,([Char]
"8-7",[n
0,n
1,n
2,n
3,n
4,n
5,n
8,n
9])
    ,([Char]
"8-8",[n
0,n
1,n
2,n
3,n
4,n
7,n
8,n
9])
    ,([Char]
"8-9",[n
0,n
1,n
2,n
3,n
6,n
7,n
8,n
9])
    ,([Char]
"8-10",[n
0,n
2,n
3,n
4,n
5,n
6,n
7,n
9])
    ,([Char]
"8-11",[n
0,n
1,n
2,n
3,n
4,n
5,n
7,n
9])
    ,([Char]
"8-12",[n
0,n
1,n
3,n
4,n
5,n
6,n
7,n
9])
    ,([Char]
"8-13",[n
0,n
1,n
2,n
3,n
4,n
6,n
7,n
9])
    ,([Char]
"8-14",[n
0,n
1,n
2,n
4,n
5,n
6,n
7,n
9])
    ,([Char]
"8-Z15",[n
0,n
1,n
2,n
3,n
4,n
6,n
8,n
9])
    ,([Char]
"8-16",[n
0,n
1,n
2,n
3,n
5,n
7,n
8,n
9])
    ,([Char]
"8-17",[n
0,n
1,n
3,n
4,n
5,n
6,n
8,n
9])
    ,([Char]
"8-18",[n
0,n
1,n
2,n
3,n
5,n
6,n
8,n
9])
    ,([Char]
"8-19",[n
0,n
1,n
2,n
4,n
5,n
6,n
8,n
9])
    ,([Char]
"8-20",[n
0,n
1,n
2,n
4,n
5,n
7,n
8,n
9])
    ,([Char]
"8-21",[n
0,n
1,n
2,n
3,n
4,n
6,n
8,n
10])
    ,([Char]
"8-22",[n
0,n
1,n
2,n
3,n
5,n
6,n
8,n
10])
    ,([Char]
"8-23",[n
0,n
1,n
2,n
3,n
5,n
7,n
8,n
10])
    ,([Char]
"8-24",[n
0,n
1,n
2,n
4,n
5,n
6,n
8,n
10])
    ,([Char]
"8-25",[n
0,n
1,n
2,n
4,n
6,n
7,n
8,n
10])
    ,([Char]
"8-26",[n
0,n
1,n
2,n
4,n
5,n
7,n
9,n
10])
    ,([Char]
"8-27",[n
0,n
1,n
2,n
4,n
5,n
7,n
8,n
10])
    ,([Char]
"8-28",[n
0,n
1,n
3,n
4,n
6,n
7,n
9,n
10])
    ,([Char]
"8-Z29",[n
0,n
1,n
2,n
3,n
5,n
6,n
7,n
9])
    ,([Char]
"9-1",[n
0,n
1,n
2,n
3,n
4,n
5,n
6,n
7,n
8])
    ,([Char]
"9-2",[n
0,n
1,n
2,n
3,n
4,n
5,n
6,n
7,n
9])
    ,([Char]
"9-3",[n
0,n
1,n
2,n
3,n
4,n
5,n
6,n
8,n
9])
    ,([Char]
"9-4",[n
0,n
1,n
2,n
3,n
4,n
5,n
7,n
8,n
9])
    ,([Char]
"9-5",[n
0,n
1,n
2,n
3,n
4,n
6,n
7,n
8,n
9])
    ,([Char]
"9-6",[n
0,n
1,n
2,n
3,n
4,n
5,n
6,n
8,n
10])
    ,([Char]
"9-7",[n
0,n
1,n
2,n
3,n
4,n
5,n
7,n
8,n
10])
    ,([Char]
"9-8",[n
0,n
1,n
2,n
3,n
4,n
6,n
7,n
8,n
10])
    ,([Char]
"9-9",[n
0,n
1,n
2,n
3,n
5,n
6,n
7,n
8,n
10])
    ,([Char]
"9-10",[n
0,n
1,n
2,n
3,n
4,n
6,n
7,n
9,n
10])
    ,([Char]
"9-11",[n
0,n
1,n
2,n
3,n
5,n
6,n
7,n
9,n
10])
    ,([Char]
"9-12",[n
0,n
1,n
2,n
4,n
5,n
6,n
8,n
9,n
10])
    ,([Char]
"10-1",[n
0,n
1,n
2,n
3,n
4,n
5,n
6,n
7,n
8,n
9])
    ,([Char]
"10-2",[n
0,n
1,n
2,n
3,n
4,n
5,n
6,n
7,n
8,n
10])
    ,([Char]
"10-3",[n
0,n
1,n
2,n
3,n
4,n
5,n
6,n
7,n
9,n
10])
    ,([Char]
"10-4",[n
0,n
1,n
2,n
3,n
4,n
5,n
6,n
8,n
9,n
10])
    ,([Char]
"10-5",[n
0,n
1,n
2,n
3,n
4,n
5,n
7,n
8,n
9,n
10])
    ,([Char]
"10-6",[n
0,n
1,n
2,n
3,n
4,n
6,n
7,n
8,n
9,n
10])
    ,([Char]
"11-1",[n
0,n
1,n
2,n
3,n
4,n
5,n
6,n
7,n
8,n
9,n
10])
    ,([Char]
"12-1",[n
0,n
1,n
2,n
3,n
4,n
5,n
6,n
7,n
8,n
9,n
10,n
11])]

-- | Unicode (non-breaking hyphen) variant.
sc_table_unicode :: Num n => SC_Table n
sc_table_unicode :: forall n. Num n => SC_Table n
sc_table_unicode =
    let f :: [Char] -> [Char]
f = forall a b. (a -> b) -> [a] -> [b]
map (\Char
c -> if Char
c forall a. Eq a => a -> a -> Bool
== Char
'-' then Char
non_breaking_hypen else Char
c)
    in forall a b. (a -> b) -> [a] -> [b]
map (forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first [Char] -> [Char]
f) forall n. Num n => SC_Table n
sc_table

-- | Lookup name of prime form of set class.  It is an error for the
-- input not to be a forte prime form.
--
-- > forte_prime_name [0,1,4,6] == ("4-Z15",[0,1,4,6])
forte_prime_name :: (Num n,Eq n) => [n] -> (SC_Name,[n])
forte_prime_name :: forall n. (Num n, Eq n) => [n] -> ([Char], [n])
forte_prime_name [n]
p = forall a. a -> Maybe a -> a
fromMaybe (forall a. HasCallStack => [Char] -> a
error [Char]
"forte_prime_name") (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\([Char]
_,[n]
q) -> [n]
p forall a. Eq a => a -> a -> Bool
== [n]
q) forall n. Num n => SC_Table n
sc_table)

-- | Lookup entry for set in table.
sc_tbl_lookup :: Integral i => SC_Table i -> [i] -> Maybe (SC_Name,[i])
sc_tbl_lookup :: forall i. Integral i => SC_Table i -> [i] -> Maybe ([Char], [i])
sc_tbl_lookup SC_Table i
tbl [i]
p = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\([Char]
_,[i]
q) -> forall i. Integral i => Z i -> [i] -> [i]
z_forte_prime forall i. Num i => Z i
z12 [i]
p forall a. Eq a => a -> a -> Bool
== [i]
q) SC_Table i
tbl

-- | Erroring variant
sc_tbl_lookup_err :: Integral i => SC_Table i -> [i] -> (SC_Name,[i])
sc_tbl_lookup_err :: forall i. Integral i => SC_Table i -> [i] -> ([Char], [i])
sc_tbl_lookup_err SC_Table i
tbl = forall a. a -> Maybe a -> a
fromMaybe (forall a. HasCallStack => [Char] -> a
error [Char]
"sc_tbl_lookup") forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i. Integral i => SC_Table i -> [i] -> Maybe ([Char], [i])
sc_tbl_lookup SC_Table i
tbl

-- | 'fst' of 'sc_tbl_lookup_err'
sc_name_tbl :: Integral i => SC_Table i -> [i] -> SC_Name
sc_name_tbl :: forall i. Integral i => SC_Table i -> [i] -> [Char]
sc_name_tbl SC_Table i
tbl = forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i. Integral i => SC_Table i -> [i] -> ([Char], [i])
sc_tbl_lookup_err SC_Table i
tbl

-- | Lookup a set-class name.  The input set is subject to
-- 'forte_prime' of 'z12' before lookup.
--
-- > sc_name [0,2,3,6,7] == "5-Z18"
-- > sc_name [0,1,4,6,7,8] == "6-Z17"
sc_name :: Integral i => [i] -> SC_Name
sc_name :: forall i. Integral i => [i] -> [Char]
sc_name = forall i. Integral i => SC_Table i -> [i] -> [Char]
sc_name_tbl forall n. Num n => SC_Table n
sc_table

-- | Long name (ie. with enumeration of prime form).
--
-- > sc_name_long [0,1,4,6,7,8] == "6-Z17[012478]"
sc_name_long :: Integral i => [i] -> SC_Name
sc_name_long :: forall i. Integral i => [i] -> [Char]
sc_name_long [i]
p =
    let ([Char]
nm,[i]
p') = forall i. Integral i => SC_Table i -> [i] -> ([Char], [i])
sc_tbl_lookup_err forall n. Num n => SC_Table n
sc_table [i]
p
    in [Char]
nm forall a. [a] -> [a] -> [a]
++ forall i. Integral i => [i] -> [Char]
z16_vec_pp [i]
p'

-- | Unicode (non-breaking hyphen) variant.
sc_name_unicode :: Integral i => [i] -> SC_Name
sc_name_unicode :: forall i. Integral i => [i] -> [Char]
sc_name_unicode = forall i. Integral i => SC_Table i -> [i] -> [Char]
sc_name_tbl forall n. Num n => SC_Table n
sc_table_unicode

-- | Lookup a set-class given a set-class name.
--
-- > sc "6-Z17" == [0,1,2,4,7,8]
sc :: Num n => SC_Name -> [n]
sc :: forall n. Num n => [Char] -> [n]
sc [Char]
n = forall a b. (a, b) -> b
snd (forall a. a -> Maybe a -> a
fromMaybe (forall a. HasCallStack => [Char] -> a
error [Char]
"sc") (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\([Char]
m,[n]
_) -> [Char]
n forall a. Eq a => a -> a -> Bool
== [Char]
m) forall n. Num n => SC_Table n
sc_table))

-- | The set-class table (Forte prime forms), ie. 'snd' of 'sc_table'.
scs :: Num n => [[n]]
scs :: forall n. Num n => [[n]]
scs = forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd forall n. Num n => SC_Table n
sc_table

-- | Cardinality /n/ subset of 'scs'.
--
-- > map (length . scs_n) [1..11] == [1,6,12,29,38,50,38,29,12,6,1]
scs_n :: (Integral i, Num n) => i -> [[n]]
scs_n :: forall i n. (Integral i, Num n) => i -> [[n]]
scs_n i
n = forall a. (a -> Bool) -> [a] -> [a]
filter ((forall a. Eq a => a -> a -> Bool
== i
n) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i a. Num i => [a] -> i
genericLength) forall n. Num n => [[n]]
scs

-- | Vector indicating degree of intersection with inversion at each transposition.
--
-- > tics z12 [0,2,4,5,7,9] == [3,2,5,0,5,2,3,4,1,6,1,4]
-- > map (tics z12) scs
tics :: Integral i => Z i -> [i] -> [Int]
tics :: forall i. Integral i => Z i -> [i] -> [Int]
tics Z i
z [i]
p =
    let q :: [[i]]
q = forall i (f :: * -> *).
(Integral i, Functor f) =>
Z i -> f i -> [f i]
z_sro_t_related Z i
z (forall i (f :: * -> *).
(Integral i, Functor f) =>
Z i -> i -> f i -> f i
z_sro_invert Z i
z i
0 [i]
p)
    in forall a b. (a -> b) -> [a] -> [b]
map (forall (t :: * -> *) a. Foldable t => t a -> Int
length forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Eq a => [a] -> [a] -> [a]
intersect [i]
p) [[i]]
q

-- * Z-relation

-- | Locate /Z/ relation of set class.
--
-- > fmap sc_name (z_relation_of (sc "7-Z12")) == Just "7-Z36"
z_relation_of :: Integral i => [i] -> Maybe [i]
z_relation_of :: forall i. Integral i => [i] -> Maybe [i]
z_relation_of [i]
x =
    let n :: Int
n = forall (t :: * -> *) a. Foldable t => t a -> Int
length [i]
x
        eq_i :: [Integer] -> [Integer] -> Bool
        eq_i :: [Integer] -> [Integer] -> Bool
eq_i = forall a. Eq a => a -> a -> Bool
(==)
        f :: [i] -> Bool
f [i]
y = ([i]
x forall a. Eq a => a -> a -> Bool
/= [i]
y) Bool -> Bool -> Bool
&& (forall i n. (Integral i, Num n) => Z i -> [i] -> [n]
z_icv forall i. Num i => Z i
z12 [i]
x [Integer] -> [Integer] -> Bool
`eq_i` forall i n. (Integral i, Num n) => Z i -> [i] -> [n]
z_icv forall i. Num i => Z i
z12 [i]
y)
    in case forall a. (a -> Bool) -> [a] -> [a]
filter [i] -> Bool
f (forall i n. (Integral i, Num n) => i -> [[n]]
scs_n Int
n) of
         [] -> forall a. Maybe a
Nothing
         [[i]
r] -> forall a. a -> Maybe a
Just [i]
r
         [[i]]
_ -> forall a. HasCallStack => [Char] -> a
error [Char]
"z_relation_of"