-- | Symetric Group S4 as related to the composition \"Nomos Alpha\"
-- by Iannis Xenakis.  In particular in relation to the discussion in
-- \"Towards a Philosophy of Music\", /Formalized Music/ pp. 219 -- 221
module Music.Theory.Xenakis.S4 where

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

import qualified Music.Theory.List as T
import qualified Music.Theory.Permutations as T

-- * S4 notation

-- | 'Label's for elements of the symmetric group P4.
data Label = A|B|C|D|D2|E|E2|G|G2|I|L|L2
           | Q1|Q2|Q3|Q4|Q5|Q6|Q7|Q8|Q9|Q10|Q11|Q12
             deriving (Label -> Label -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Label -> Label -> Bool
$c/= :: Label -> Label -> Bool
== :: Label -> Label -> Bool
$c== :: Label -> Label -> Bool
Eq,Eq Label
Label -> Label -> Bool
Label -> Label -> Ordering
Label -> Label -> Label
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Label -> Label -> Label
$cmin :: Label -> Label -> Label
max :: Label -> Label -> Label
$cmax :: Label -> Label -> Label
>= :: Label -> Label -> Bool
$c>= :: Label -> Label -> Bool
> :: Label -> Label -> Bool
$c> :: Label -> Label -> Bool
<= :: Label -> Label -> Bool
$c<= :: Label -> Label -> Bool
< :: Label -> Label -> Bool
$c< :: Label -> Label -> Bool
compare :: Label -> Label -> Ordering
$ccompare :: Label -> Label -> Ordering
Ord,Int -> Label
Label -> Int
Label -> [Label]
Label -> Label
Label -> Label -> [Label]
Label -> Label -> Label -> [Label]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Label -> Label -> Label -> [Label]
$cenumFromThenTo :: Label -> Label -> Label -> [Label]
enumFromTo :: Label -> Label -> [Label]
$cenumFromTo :: Label -> Label -> [Label]
enumFromThen :: Label -> Label -> [Label]
$cenumFromThen :: Label -> Label -> [Label]
enumFrom :: Label -> [Label]
$cenumFrom :: Label -> [Label]
fromEnum :: Label -> Int
$cfromEnum :: Label -> Int
toEnum :: Int -> Label
$ctoEnum :: Int -> Label
pred :: Label -> Label
$cpred :: Label -> Label
succ :: Label -> Label
$csucc :: Label -> Label
Enum,Label
forall a. a -> a -> Bounded a
maxBound :: Label
$cmaxBound :: Label
minBound :: Label
$cminBound :: Label
Bounded,Int -> Label -> ShowS
[Label] -> ShowS
Label -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Label] -> ShowS
$cshowList :: [Label] -> ShowS
show :: Label -> String
$cshow :: Label -> String
showsPrec :: Int -> Label -> ShowS
$cshowsPrec :: Int -> Label -> ShowS
Show)

-- | Initial half of 'Seq' (ie. #4).  The complete 'Seq' is formed by
-- appending the 'complement' of the 'Half_Seq'.
type Half_Seq = [Int]

-- | Complete sequence (ie. #8).
type Seq = [Int]

-- | Complement of a 'Half_Seq'.
--
-- > map complement [[4,1,3,2],[6,7,8,5]] == [[8,5,7,6],[2,3,4,1]]
complement :: Half_Seq -> Half_Seq
complement :: [Int] -> [Int]
complement [Int]
x =
    case forall a. Ord a => [a] -> [a]
sort [Int]
x of
      [Int
1,Int
2,Int
3,Int
4] -> forall a b. (a -> b) -> [a] -> [b]
map (forall a. Num a => a -> a -> a
+ Int
4) [Int]
x
      [Int
5,Int
6,Int
7,Int
8] -> forall a b. (a -> b) -> [a] -> [b]
map (forall a. Num a => a -> a -> a
+ (-Int
4)) [Int]
x
      [Int]
_ -> forall a. HasCallStack => String -> a
error String
"complement"

-- | Form 'Seq' from 'Half_Seq'.
--
-- > full_seq [3,2,4,1] == [3,2,4,1,7,6,8,5]
-- > label_of (full_seq [3,2,4,1]) == G2
-- > label_of (full_seq [1,4,2,3]) == L
full_seq :: Half_Seq -> Seq
full_seq :: [Int] -> [Int]
full_seq [Int]
x = [Int]
x forall a. [a] -> [a] -> [a]
++ [Int] -> [Int]
complement [Int]
x

-- | Lower 'Half_Seq', ie. 'complement' or 'id'.
--
-- > map lower [[4,1,3,2],[6,7,8,5]] == [[4,1,3,2],[2,3,4,1]]
lower :: Half_Seq -> Half_Seq
lower :: [Int] -> [Int]
lower [Int]
x =
    case forall a. Ord a => [a] -> [a]
sort [Int]
x of
      [Int
1,Int
2,Int
3,Int
4] -> [Int]
x
      [Int
5,Int
6,Int
7,Int
8] -> [Int] -> [Int]
complement [Int]
x
      [Int]
_ -> forall a. HasCallStack => String -> a
error (forall a. Show a => a -> String
show (String
"lower",[Int]
x))

-- | Application of 'Label' /p/ on /q/.
--
-- > l_on Q1 I == Q1
-- > l_on D Q12 == Q4
-- > [l_on L L,l_on E D,l_on D E] == [L2,C,B]
l_on :: Label -> Label -> Label
l_on :: Label -> Label -> Label
l_on Label
p Label
q =
    let p' :: [Int]
p' = Label -> [Int]
seq_of Label
p
        q' :: [Int]
q' = Label -> [Int]
seq_of Label
q
        r :: [Int]
r = forall a b. (a -> b) -> [a] -> [b]
map (\Int
i -> [Int]
q' forall a. [a] -> Int -> a
!! (Int
i forall a. Num a => a -> a -> a
- Int
1)) [Int]
p'
    in [Int] -> Label
label_of [Int]
r

{- | Generalisation of Fibonnaci process, /f/ is the binary operator
giving the next element, /p/ and /q/ are the initial elements.

See discussion in: Carlos Agon, Moreno Andreatta, Gérard Assayag, and
Stéphan Schaub. _Formal Aspects of Iannis Xenakis' "Symbolic Music": A
Computer-Aided Exploration of Compositional Processes_. Journal of New
Music Research, 33(2):145-159, 2004.

Note that the article has an error, printing Q4 for Q11 in the sequence below.

> import qualified Music.Theory.List as T

> let r = [D,Q12,Q4, E,Q8,Q2, E2,Q7,Q4, D2,Q3,Q11, L2,Q7,Q2, L,Q8,Q11]
> (take 18 (fib_proc l_on D Q12) == r,T.duplicates r == [Q2,Q4,Q7,Q8,Q11])

Beginning E then G2 no Q nodes are visited.

> let r = [E,G2,L2,C,G,D,E,B,D2,L,G,C,L2,E2,D2,B]
> (take 16 (fib_proc l_on E G2) == r,T.duplicates r == [B,C,D2,E,G,L2])

> let [a,b] = take 2 (T.segments 18 18 (fib_proc l_on D Q12)) in a == b

The prime numbers that are not factors of 18 are {1,5,7,11,13,17}.
They form a closed group under modulo 18 multiplication.

> let n = [5,7,11,13,17]
> let r0 = [(5,7,17),(5,11,1),(5,13,11),(5,17,13)]
> let r1 = [(7,11,5),(7,13,1),(7,17,11)]
> let r2 = [(11,13,17),(11,17,7)]
> let r3 = [(13,17,5)]
> [(p,q,(p * q) `mod` 18) | p <- n, q <- n, p < q] == concat [r0,r1,r2,r3]

The article also omits the 5 after 5,1 in the sequence below.

> let r = [11,13,17,5,13,11,17,7,11,5,1,5,5,7,17,11,7,5,17,13,5,11,1,11]
> take 24 (fib_proc (\p q -> (p * q) `mod` 18) 11 13) == r

-}
fib_proc :: (a -> a -> a) -> a -> a -> [a]
fib_proc :: forall a. (a -> a -> a) -> a -> a -> [a]
fib_proc a -> a -> a
f a
p a
q = let r :: a
r = a -> a -> a
f a
p a
q in a
p forall a. a -> [a] -> [a]
: forall a. (a -> a -> a) -> a -> a -> [a]
fib_proc a -> a -> a
f a
q a
r

-- | 'Seq' of 'Label', inverse of 'label_of'.
--
-- > seq_of Q1 == [8,7,5,6,4,3,1,2]
seq_of :: Label -> Seq
seq_of :: Label -> [Int]
seq_of Label
i = forall a. a -> Maybe a -> a
fromMaybe (forall a. HasCallStack => String -> a
error String
"seq_of") (forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Label
i [(Label, [Int])]
viii_6b)

-- | 'Half_Seq' of 'Label', ie. 'half_seq' '.' 'seq_of'.
--
-- > half_seq_of Q1 == [8,7,5,6]
half_seq_of :: Label -> Seq
half_seq_of :: Label -> [Int]
half_seq_of = [Int] -> [Int]
half_seq forall b c a. (b -> c) -> (a -> b) -> a -> c
. Label -> [Int]
seq_of

-- | 'Half_Seq' of 'Seq', ie. 'take' @4@.
--
-- > complement (half_seq (seq_of Q7)) == [3,4,2,1]
half_seq :: Seq -> Half_Seq
half_seq :: [Int] -> [Int]
half_seq = forall a. Int -> [a] -> [a]
take Int
4

-- | 'Label' of 'Seq', inverse of 'seq_of'.
--
-- > label_of [8,7,5,6,4,3,1,2] == Q1
-- > label_of (seq_of Q4) == Q4
label_of :: Seq -> Label
label_of :: [Int] -> Label
label_of [Int]
i =
    let err :: a
err = forall a. HasCallStack => String -> a
error (String
"label_of: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show [Int]
i)
    in forall a. a -> Maybe a -> a
fromMaybe forall {a}. a
err (forall v k. Eq v => v -> [(k, v)] -> Maybe k
T.reverse_lookup [Int]
i [(Label, [Int])]
viii_6b)

-- | 'True' if two 'Half_Seq's are complementary, ie. form a 'Seq'.
--
-- > complementary [4,2,1,3] [8,6,5,7] == True
complementary :: Half_Seq -> Half_Seq -> Bool
complementary :: [Int] -> [Int] -> Bool
complementary [Int]
p [Int]
q =
    let c :: [Int]
c = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (forall a. Ord a => [a] -> [a]
sort [forall a. Ord a => [a] -> [a]
sort [Int]
p,forall a. Ord a => [a] -> [a]
sort [Int]
q])
    in [Int]
c forall a. Eq a => a -> a -> Bool
== [Int
1..Int
8]

-- * Rel

-- | Relation between to 'Half_Seq' values as a
-- /(complementary,permutation)/ pair.
type Rel = (Bool,T.Permutation)

-- | Determine 'Rel' of 'Half_Seq's.
--
-- > relate [1,4,2,3] [1,3,4,2] == (False,[0,3,1,2])
-- > relate [1,4,2,3] [8,5,6,7] == (True,[1,0,2,3])
relate :: Half_Seq -> Half_Seq -> Rel
relate :: [Int] -> [Int] -> Rel
relate [Int]
p [Int]
q =
    if [Int] -> [Int] -> Bool
complementary [Int]
p [Int]
q
    then (Bool
True,forall t. Eq t => [t] -> [t] -> [Int]
T.permutation ([Int] -> [Int]
complement [Int]
p) [Int]
q)
    else (Bool
False,forall t. Eq t => [t] -> [t] -> [Int]
T.permutation [Int]
p [Int]
q)

-- | 'Rel' from 'Label' /p/ to /q/.
--
-- > relate_l L L2 == (False,[0,3,1,2])
relate_l :: Label -> Label -> Rel
relate_l :: Label -> Label -> Rel
relate_l Label
p Label
q = [Int] -> [Int] -> Rel
relate (Label -> [Int]
half_seq_of Label
p) (Label -> [Int]
half_seq_of Label
q)

-- | 'relate' adjacent 'Half_Seq', see also 'relations_l'.
relations :: [Half_Seq] -> [Rel]
relations :: [[Int]] -> [Rel]
relations [[Int]]
p = forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith [Int] -> [Int] -> Rel
relate [[Int]]
p (forall a. [a] -> [a]
tail [[Int]]
p)

-- | 'relate' adjacent 'Label's.
--
-- > relations_l [L2,L,A] == [(False,[0,2,3,1]),(False,[2,0,1,3])]
relations_l :: [Label] -> [Rel]
relations_l :: [Label] -> [Rel]
relations_l [Label]
p = forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Label -> Label -> Rel
relate_l [Label]
p (forall a. [a] -> [a]
tail [Label]
p)

-- | Apply 'Rel' to 'Half_Seq'.
--
-- > apply_relation (False,[0,3,1,2]) [1,4,2,3] == [1,3,4,2]
apply_relation :: Rel -> Half_Seq -> Half_Seq
apply_relation :: Rel -> [Int] -> [Int]
apply_relation (Bool
c,[Int]
p) [Int]
i =
    let j :: [Int]
j = forall t. [Int] -> [t] -> [t]
T.apply_permutation [Int]
p [Int]
i
    in if Bool
c then [Int] -> [Int]
complement [Int]
j else [Int]
j

-- | Apply sequence of 'Rel' to initial 'Half_Seq'.
apply_relations :: [Rel] -> Half_Seq -> [Half_Seq]
apply_relations :: [Rel] -> [Int] -> [[Int]]
apply_relations [Rel]
rs [Int]
i =
    case [Rel]
rs of
      [] -> [[Int]
i]
      (Rel
r:[Rel]
rs') -> let i' :: [Int]
i' = Rel -> [Int] -> [Int]
apply_relation Rel
r [Int]
i
                 in [Int]
i forall a. a -> [a] -> [a]
: [Rel] -> [Int] -> [[Int]]
apply_relations [Rel]
rs' [Int]
i'

-- | Variant of 'apply_relations'.
--
-- > apply_relations_l (relations_l [L2,L,A,Q1]) L2 == [L2,L,A,Q1]
apply_relations_l :: [Rel] -> Label -> [Label]
apply_relations_l :: [Rel] -> Label -> [Label]
apply_relations_l [Rel]
rs = forall a b. (a -> b) -> [a] -> [b]
map ([Int] -> Label
label_of forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> [Int]
full_seq) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                       [Rel] -> [Int] -> [[Int]]
apply_relations [Rel]
rs forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                       Label -> [Int]
half_seq_of

-- * Face

-- | Enumeration of set of /faces/ of a cube.
data Face = F_Back | F_Front | F_Right | F_Left | F_Bottom | F_Top
          deriving (Face -> Face -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Face -> Face -> Bool
$c/= :: Face -> Face -> Bool
== :: Face -> Face -> Bool
$c== :: Face -> Face -> Bool
Eq,Int -> Face
Face -> Int
Face -> [Face]
Face -> Face
Face -> Face -> [Face]
Face -> Face -> Face -> [Face]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Face -> Face -> Face -> [Face]
$cenumFromThenTo :: Face -> Face -> Face -> [Face]
enumFromTo :: Face -> Face -> [Face]
$cenumFromTo :: Face -> Face -> [Face]
enumFromThen :: Face -> Face -> [Face]
$cenumFromThen :: Face -> Face -> [Face]
enumFrom :: Face -> [Face]
$cenumFrom :: Face -> [Face]
fromEnum :: Face -> Int
$cfromEnum :: Face -> Int
toEnum :: Int -> Face
$ctoEnum :: Int -> Face
pred :: Face -> Face
$cpred :: Face -> Face
succ :: Face -> Face
$csucc :: Face -> Face
Enum,Face
forall a. a -> a -> Bounded a
maxBound :: Face
$cmaxBound :: Face
minBound :: Face
$cminBound :: Face
Bounded,Eq Face
Face -> Face -> Bool
Face -> Face -> Ordering
Face -> Face -> Face
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Face -> Face -> Face
$cmin :: Face -> Face -> Face
max :: Face -> Face -> Face
$cmax :: Face -> Face -> Face
>= :: Face -> Face -> Bool
$c>= :: Face -> Face -> Bool
> :: Face -> Face -> Bool
$c> :: Face -> Face -> Bool
<= :: Face -> Face -> Bool
$c<= :: Face -> Face -> Bool
< :: Face -> Face -> Bool
$c< :: Face -> Face -> Bool
compare :: Face -> Face -> Ordering
$ccompare :: Face -> Face -> Ordering
Ord,Int -> Face -> ShowS
[Face] -> ShowS
Face -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Face] -> ShowS
$cshowList :: [Face] -> ShowS
show :: Face -> String
$cshow :: Face -> String
showsPrec :: Int -> Face -> ShowS
$cshowsPrec :: Int -> Face -> ShowS
Show)

-- | Table indicating set of faces of cubes as drawn in Fig. VIII-6 (p.220).
--
-- > lookup [1,4,6,7] faces == Just F_Left
-- > T.reverse_lookup F_Right faces == Just [2,3,5,8]
faces :: [([Int],Face)]
faces :: [([Int], Face)]
faces =
    [([Int
1,Int
3,Int
6,Int
8],Face
F_Back) -- (I in viii-6)
    ,([Int
2,Int
4,Int
5,Int
7],Face
F_Front)
    ,([Int
2,Int
3,Int
5,Int
8],Face
F_Right)
    ,([Int
1,Int
4,Int
6,Int
7],Face
F_Left)
    ,([Int
3,Int
4,Int
5,Int
6],Face
F_Bottom)
    ,([Int
1,Int
2,Int
7,Int
8],Face
F_Top)]

-- * Figures

-- | Label sequence of Fig. VIII-6. Hexahedral (Octahedral) Group (p. 220)
--
-- > let r = [I,A,B,C,D,D2,E,E2,G,G2,L,L2,Q1,Q2,Q3,Q4,Q5,Q6,Q7,Q8,Q9,Q10,Q11,Q12]
-- > in viii_6_lseq == r
viii_6_lseq :: [Label]
viii_6_lseq :: [Label]
viii_6_lseq =
    [Label
L2,Label
L,Label
A,Label
Q1,Label
Q7,Label
Q3,Label
Q9
    ,Label
G2,Label
G,Label
C,Label
Q8,Label
Q5,Label
Q10,Label
Q2
    ,Label
E,Label
E2,Label
B,Label
Q4,Label
Q11,Label
Q12,Label
Q6
    ,Label
D,Label
D2,Label
I]

-- | Label sequence of Fig. VIII-7 (p.221)
--
-- > let r = [I,A,B,C,D,D2,E,E2,G,G2,L,L2,Q1,Q2,Q3,Q4,Q5,Q6,Q7,Q8,Q9,Q10,Q11,Q12]
-- > in viii_7_lseq == r
viii_7_lseq :: [Label]
viii_7_lseq :: [Label]
viii_7_lseq =
    [Label
I,Label
A,Label
B,Label
C
    ,Label
D,Label
D2,Label
E,Label
E2
    ,Label
G,Label
G2,Label
L,Label
L2
    ,Label
Q1,Label
Q2,Label
Q3,Label
Q4
    ,Label
Q5,Label
Q6,Label
Q7,Label
Q8
    ,Label
Q9,Label
Q10,Label
Q11,Label
Q12]

-- | Fig. VIII-7 (p.221)
--
-- > map (take 4) (take 4 viii_7) == [[I,A,B,C]
-- >                                 ,[A,I,C,B]
-- >                                 ,[B,C,I,A]
-- >                                 ,[C,B,A,I]]
--
-- > import Music.Theory.Array.MD
--
-- > let t = md_matrix_opt show (\x -> "_" ++ x ++ "_") (head viii_7,head viii_7) viii_7
-- > putStrLn $ unlines $ md_table' t
viii_7 :: [[Label]]
viii_7 :: [[Label]]
viii_7 = forall a b. (a -> b) -> [a] -> [b]
map (\Label
i -> forall a b. (a -> b) -> [a] -> [b]
map (Label -> Label -> Label
`l_on` Label
i) [Label]
viii_7_lseq) [Label]
viii_7_lseq

-- | Label sequence of Fig. VIII-6/b (p.221)
--
-- > length viii_6b_l == length viii_6_l
-- > take 8 viii_6b_l == [I,A,B,C,D2,D,E2,E]
viii_6b_lseq :: [Label]
viii_6b_lseq :: [Label]
viii_6b_lseq =
    [Label
I,Label
A,Label
B,Label
C
    ,Label
D2,Label
D,Label
E2,Label
E
    ,Label
G2,Label
G,Label
L2,Label
L
    ,Label
Q7,Label
Q2,Label
Q3,Label
Q11
    ,Label
Q8,Label
Q6,Label
Q1,Label
Q5
    ,Label
Q9,Label
Q10,Label
Q4,Label
Q12]

-- | Fig. VIII-6/b 'Half_Seq'.
--
-- > viii_6b_p' == map half_seq_of viii_6b_l
-- > nub (map (length . nub) viii_6b_p') == [4]
viii_6b_p' :: [Half_Seq]
viii_6b_p' :: [[Int]]
viii_6b_p' =
    [[Int
1,Int
2,Int
3,Int
4]
    ,[Int
2,Int
1,Int
4,Int
3]
    ,[Int
3,Int
4,Int
1,Int
2]
    ,[Int
4,Int
3,Int
2,Int
1]
    ,[Int
2,Int
3,Int
1,Int
4]
    ,[Int
3,Int
1,Int
2,Int
4]
    ,[Int
2,Int
4,Int
3,Int
1]
    ,[Int
4,Int
1,Int
3,Int
2]

    ,[Int
3,Int
2,Int
4,Int
1]
    ,[Int
4,Int
2,Int
1,Int
3]
    ,[Int
1,Int
3,Int
4,Int
2]
    ,[Int
1,Int
4,Int
2,Int
3]
    ,[Int
7,Int
8,Int
6,Int
5]
    ,[Int
7,Int
6,Int
5,Int
8]
    ,[Int
8,Int
6,Int
7,Int
5]
    ,[Int
6,Int
7,Int
8,Int
5]

    ,[Int
6,Int
8,Int
5,Int
7]
    ,[Int
6,Int
5,Int
7,Int
8]
    ,[Int
8,Int
7,Int
5,Int
6]
    ,[Int
7,Int
5,Int
8,Int
6]
    ,[Int
5,Int
8,Int
7,Int
6]
    ,[Int
5,Int
7,Int
6,Int
8]
    ,[Int
8,Int
5,Int
6,Int
7]
    ,[Int
5,Int
6,Int
8,Int
7]]

-- | Variant of 'viii_6b' with 'Half_Seq'.
viii_6b' :: [(Label,Half_Seq)]
viii_6b' :: [(Label, [Int])]
viii_6b' = forall a b. [a] -> [b] -> [(a, b)]
zip [Label]
viii_6b_lseq [[Int]]
viii_6b_p'

-- | Fig. VIII-6/b.
--
-- > map (viii_6b !!) [0,8,16] == [(I,[1,2,3,4,5,6,7,8])
-- >                              ,(G2,[3,2,4,1,7,6,8,5])
-- >                              ,(Q8,[6,8,5,7,2,4,1,3])]
viii_6b :: [(Label,Seq)]
viii_6b :: [(Label, [Int])]
viii_6b = forall a b. [a] -> [b] -> [(a, b)]
zip [Label]
viii_6b_lseq (forall a b. (a -> b) -> [a] -> [b]
map [Int] -> [Int]
full_seq [[Int]]
viii_6b_p')

-- | The sequence of 'Rel' to give 'viii_6_l' from 'L2'.
--
-- > apply_relations_l viii_6_relations L2 == viii_6_l
-- > length (nub viii_6_relations) == 14
viii_6_relations :: [Rel]
viii_6_relations :: [Rel]
viii_6_relations = [[Int]] -> [Rel]
relations (forall a b. (a -> b) -> [a] -> [b]
map Label -> [Int]
half_seq_of [Label]
viii_6_lseq)

-- | The sequence of 'Rel' to give 'viii_6b_l' from 'I'.
--
-- > apply_relations_l viii_6b_relations I == viii_6b_l
-- > length (nub viii_6b_relations) == 10
viii_6b_relations :: [Rel]
viii_6b_relations :: [Rel]
viii_6b_relations = [[Int]] -> [Rel]
relations (forall a b. (a -> b) -> [a] -> [b]
map Label -> [Int]
half_seq_of [Label]
viii_6b_lseq)