Johnson_2007.hs

-- | 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 = [1,3,4,2,7,6,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 =
    let c = c_7_3_1
        f i (j1,j2) = sort [i,j1,j2]
    in (zipWith f (T.rotate_left 3 c) (T.adj2_cyclic 1 c)
       ,zipWith f c (T.adj2_cyclic 1 (T.rotate_left 2 c)))

d_7_3_1 :: (Enum n,Ord n,Num n) => (Design n,Design n)
d_7_3_1 = let d = Design [1..7] in (d *** d) 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 = [(3,4),(3,11),(4,1),(4,3),(4,5),(4,7),(5,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 = [[1,8,9],[2,3,5],[4,6,7],[1,4,5],[2,6,8],[3,7,9],[1,2,7],[3,4,8],[5,6,9],[1,3,6],[2,4,9],[5,7,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 =
    let c = [1..13]
        c' = T.rotate_left 7 c
        d = T.interleave_rotations 9 3 c
        e = T.interleave_rotations 3 10 c
        f (i1,i2) (j1,j2) = sort [i1,i2,j1,j2]
    in (zipWith f (T.adj2 1 c) (T.adj2 2 d)
       ,zipWith f (T.adj2 1 c') (T.adj2 2 e))

d_13_4_1 :: (Enum n,Ord n,Num n) => (Design n,Design n)
d_13_4_1 = let d = Design [1..13] in (d *** d) 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 = [(3,0),(3,2),(3,5),(3,7),(3,10),(4,0),(4,3),(4,5),(4,8),(4,10),(5,1),(5,3),(5,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 =
    [[1,5,7,12]
    ,[2,8,9,10]
    ,[3,4,6,11]
    ,[4,6,11,12]
    ,[1,7,8,9]
    ,[2,3,5,10]
    ,[3,5,10,12]
    ,[6,7,8,11]
    ,[1,2,4,9]
    ,[2,4,9,12]
    ,[5,6,7,10]
    ,[1,3,8,11]
    ,[1,3,8,12]
    ,[4,5,6,9]
    ,[2,7,10,11]
    ,[2,7,11,12]
    ,[3,4,5,8]
    ,[1,6,9,10]
    ,[1,6,10,12]
    ,[2,3,4,7]
    ,[5,8,9,11]
    ,[5,9,11,12]
    ,[1,2,3,6]
    ,[4,7,8,10]
    ,[4,8,10,12]
    ,[1,2,5,11]
    ,[3,6,7,9]
    ,[3,7,9,12]
    ,[1,4,10,11]
    ,[2,5,6,8]
    ,[2,6,8,12]
    ,[3,9,10,11]
    ,[1,4,5,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 = [(3,2),(3,5),(3,6),(3,9),(3,10),(4,1),(4,4),(4,7),(4,8),(4,11),(5,0),(5,3)]

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