-- | Tom Johnson. \"Networks\". In Conference on Mathematics and
-- Computation in Music, Berlin, May 2007.
module Music.Theory.Block_Design.Johnson_2007 where

import Control.Arrow ((***)) {- base -}
import Data.List {- base -}

import qualified Music.Theory.List as T

-- * Designs

data Design i = Design [i] [[i]]

-- * Johnson (7,3,1), (13,4,1) and (12,4,3)

-- > c_7_3_1 == [1,3,4,2,7,6,5]
c_7_3_1 :: (Num i) => [i]
c_7_3_1 :: forall i. Num i => [i]
c_7_3_1 = [i
1,i
3,i
4,i
2,i
7,i
6,i
5]

-- > b_7_3_1 == ([[1,2,3],[3,4,7],[2,4,6],[2,5,7],[1,6,7],[3,5,6],[1,4,5]]
-- >            ,[[1,2,4],[2,3,7],[4,6,7],[2,5,6],[1,5,7],[1,3,6],[3,4,5]])
b_7_3_1 :: (Ord i,Num i) => ([[i]], [[i]])
b_7_3_1 :: forall i. (Ord i, Num i) => ([[i]], [[i]])
b_7_3_1 =
    let c :: [i]
c = forall i. Num i => [i]
c_7_3_1
        f :: a -> (a, a) -> [a]
f a
i (a
j1,a
j2) = forall a. Ord a => [a] -> [a]
sort [a
i,a
j1,a
j2]
    in (forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith forall {a}. Ord a => a -> (a, a) -> [a]
f (forall a. Int -> [a] -> [a]
T.rotate_left Int
3 [i]
c) (forall t. Int -> [t] -> [(t, t)]
T.adj2_cyclic Int
1 [i]
c)
       ,forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith forall {a}. Ord a => a -> (a, a) -> [a]
f [i]
c (forall t. Int -> [t] -> [(t, t)]
T.adj2_cyclic Int
1 (forall a. Int -> [a] -> [a]
T.rotate_left Int
2 [i]
c)))

d_7_3_1 :: (Enum n,Ord n,Num n) => (Design n,Design n)
d_7_3_1 :: forall n. (Enum n, Ord n, Num n) => (Design n, Design n)
d_7_3_1 = let d :: [[n]] -> Design n
d = forall i. [i] -> [[i]] -> Design i
Design [n
1..n
7] in ([[n]] -> Design n
d forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** [[n]] -> Design n
d) forall i. (Ord i, Num i) => ([[i]], [[i]])
b_7_3_1

-- > length n_7_3_1 == 7 && sort n_7_3_1 == n_7_3_1
n_7_3_1 :: Num i => [(i,i)]
n_7_3_1 :: forall i. Num i => [(i, i)]
n_7_3_1 = [(i
3,i
4),(i
3,i
11),(i
4,i
1),(i
4,i
3),(i
4,i
5),(i
4,i
7),(i
5,i
2)]

-- > Music.Theory.List.histogram (concat p_9_3_1) == [(1,4),(2,4),(3,4),(4,4),(5,4),(6,4),(7,4),(8,4),(9,4)]
p_9_3_1 :: Num i => [[i]]
p_9_3_1 :: forall i. Num i => [[i]]
p_9_3_1 = [[i
1,i
8,i
9],[i
2,i
3,i
5],[i
4,i
6,i
7],[i
1,i
4,i
5],[i
2,i
6,i
8],[i
3,i
7,i
9],[i
1,i
2,i
7],[i
3,i
4,i
8],[i
5,i
6,i
9],[i
1,i
3,i
6],[i
2,i
4,i
9],[i
5,i
7,i
8]]

-- > b_13_4_1 == ([[1,2,4,10],[2,3,5,11],[3,4,6,12],[4,5,7,13],[1,5,6,8],[2,6,7,9],[3,7,8,10],[4,8,9,11],[5,9,10,12],[6,10,11,13],[1,7,11,12],[2,8,12,13]]
-- >             ,[[4,8,9,11],[5,9,10,12],[6,10,11,13],[1,7,11,12],[2,8,12,13],[1,3,9,13],[1,2,4,10],[2,3,5,11],[3,4,6,12],[4,5,7,13],[1,5,6,8],[2,6,7,9]])
b_13_4_1 :: (Enum i,Num i,Ord i) => ([[i]], [[i]])
b_13_4_1 :: forall i. (Enum i, Num i, Ord i) => ([[i]], [[i]])
b_13_4_1 =
    let c :: [i]
c = [i
1..i
13]
        c' :: [i]
c' = forall a. Int -> [a] -> [a]
T.rotate_left Int
7 [i]
c
        d :: [i]
d = forall b. Int -> Int -> [b] -> [b]
T.interleave_rotations Int
9 Int
3 [i]
c
        e :: [i]
e = forall b. Int -> Int -> [b] -> [b]
T.interleave_rotations Int
3 Int
10 [i]
c
        f :: (a, a) -> (a, a) -> [a]
f (a
i1,a
i2) (a
j1,a
j2) = forall a. Ord a => [a] -> [a]
sort [a
i1,a
i2,a
j1,a
j2]
    in (forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith forall {a}. Ord a => (a, a) -> (a, a) -> [a]
f (forall t. Int -> [t] -> [(t, t)]
T.adj2 Int
1 [i]
c) (forall t. Int -> [t] -> [(t, t)]
T.adj2 Int
2 [i]
d)
       ,forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith forall {a}. Ord a => (a, a) -> (a, a) -> [a]
f (forall t. Int -> [t] -> [(t, t)]
T.adj2 Int
1 [i]
c') (forall t. Int -> [t] -> [(t, t)]
T.adj2 Int
2 [i]
e))

d_13_4_1 :: (Enum n,Ord n,Num n) => (Design n,Design n)
d_13_4_1 :: forall n. (Enum n, Ord n, Num n) => (Design n, Design n)
d_13_4_1 = let d :: [[n]] -> Design n
d = forall i. [i] -> [[i]] -> Design i
Design [n
1..n
13] in ([[n]] -> Design n
d forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** [[n]] -> Design n
d) forall i. (Enum i, Num i, Ord i) => ([[i]], [[i]])
b_13_4_1

-- > length n_13_4_1 == 13 && sort n_13_4_1 == n_13_4_1
n_13_4_1 :: Num i => [(i,i)]
n_13_4_1 :: forall i. Num i => [(i, i)]
n_13_4_1 = [(i
3,i
0),(i
3,i
2),(i
3,i
5),(i
3,i
7),(i
3,i
10),(i
4,i
0),(i
4,i
3),(i
4,i
5),(i
4,i
8),(i
4,i
10),(i
5,i
1),(i
5,i
3),(i
5,i
6)]

-- > histogram (concat b_12_4_3) == [(1,11),(2,11),(3,11),(4,11),(5,11),(6,11),(7,11),(8,11),(9,11),(10,11),(11,11),(12,11)]
-- > histogram (map (sort.concat) (chunksOf 3 b_12_4_3)) == [([1,2,3,4,5,6,7,8,9,10,11,12],11)]
-- > map length (adj_intersect 1 b_12_4_3) == [0,0,3,0,0,3,0,0,3,0,0,3,0,0,3,0,0,3,0,0,3,0,0,3,0,0,3,0,0,3,0,0]
-- > map (map length . adj_intersect 1) (cycles 3 b_12_4_3) == [[1,1,1,1,1,1,1,1,1,1],[2,2,2,2,2,2,2,2,2,2],[1,1,1,1,1,1,1,1,1,1]]
-- > map adj_intersect 1 (cycles 3 b_12_4_3) == [[[12],[12],[12],[12],[12],[12],[12],[12],[12],[12]]
-- >                                            ,[[8,9],[7,8],[6,7],[5,6],[4,5],[3,4],[2,3],[1,2],[1,11],[10,11]]
-- >                                            ,[[3],[2],[1],[11],[10],[9],[8],[7],[6],[5]]]
b_12_4_3 :: Integral i => [[i]]
b_12_4_3 :: forall i. Integral i => [[i]]
b_12_4_3 =
    [[i
1,i
5,i
7,i
12]
    ,[i
2,i
8,i
9,i
10]
    ,[i
3,i
4,i
6,i
11]
    ,[i
4,i
6,i
11,i
12]
    ,[i
1,i
7,i
8,i
9]
    ,[i
2,i
3,i
5,i
10]
    ,[i
3,i
5,i
10,i
12]
    ,[i
6,i
7,i
8,i
11]
    ,[i
1,i
2,i
4,i
9]
    ,[i
2,i
4,i
9,i
12]
    ,[i
5,i
6,i
7,i
10]
    ,[i
1,i
3,i
8,i
11]
    ,[i
1,i
3,i
8,i
12]
    ,[i
4,i
5,i
6,i
9]
    ,[i
2,i
7,i
10,i
11]
    ,[i
2,i
7,i
11,i
12]
    ,[i
3,i
4,i
5,i
8]
    ,[i
1,i
6,i
9,i
10]
    ,[i
1,i
6,i
10,i
12]
    ,[i
2,i
3,i
4,i
7]
    ,[i
5,i
8,i
9,i
11]
    ,[i
5,i
9,i
11,i
12]
    ,[i
1,i
2,i
3,i
6]
    ,[i
4,i
7,i
8,i
10]
    ,[i
4,i
8,i
10,i
12]
    ,[i
1,i
2,i
5,i
11]
    ,[i
3,i
6,i
7,i
9]
    ,[i
3,i
7,i
9,i
12]
    ,[i
1,i
4,i
10,i
11]
    ,[i
2,i
5,i
6,i
8]
    ,[i
2,i
6,i
8,i
12]
    ,[i
3,i
9,i
10,i
11]
    ,[i
1,i
4,i
5,i
7]]

-- > length n_12_4_3 == 12 && sort n_12_4_3 == n_12_4_3
n_12_4_3 :: Num i => [(i,i)]
n_12_4_3 :: forall i. Num i => [(i, i)]
n_12_4_3 = [(i
3,i
2),(i
3,i
5),(i
3,i
6),(i
3,i
9),(i
3,i
10),(i
4,i
1),(i
4,i
4),(i
4,i
7),(i
4,i
8),(i
4,i
11),(i
5,i
0),(i
5,i
3)]

-- Local Variables:
-- truncate-lines:t
-- End: