-- | Tom Johnson. /Other Harmony: Beyond Tonal and Atonal/. Editions 75, 2014.
module Music.Theory.Graph.Johnson_2014 where

import Control.Monad {- base -}
import Data.Int {- base -}
import Data.List {- base -}
import Data.Maybe {- base -}

import qualified Control.Monad.Logic as L {- logict -}
import qualified Data.Map as M {- containers -}
import qualified Data.Graph.Inductive as G {- fgl -}
--import qualified Data.Graph.Inductive.PatriciaTree as G {- fgl -}

import qualified Music.Theory.Combinations as T {- hmt-base -}
import qualified Music.Theory.List as T {- hmt-base -}
import qualified Music.Theory.Tuple as T {- hmt-base -}

import qualified Music.Theory.Graph.Dot as T {- hmt -}
import qualified Music.Theory.Graph.Fgl as T {- hmt -}
import qualified Music.Theory.Key as T {- hmt -}
import qualified Music.Theory.Pitch.Note as T {- hmt -}
import qualified Music.Theory.Set.List as T {- hmt -}
import qualified Music.Theory.Tuning as T {- hmt -}
import qualified Music.Theory.Tuning.Graph.Euler as T {- hmt -}
import qualified Music.Theory.Z as T {- hmt -}
import qualified Music.Theory.Z.Forte_1973 as T {- hmt -}
import qualified Music.Theory.Z.Tto as T {- hmt -}
import qualified Music.Theory.Z.Sro as T {- hmt -}

-- * Common

type Z12 = Int8

dif :: Num a => (a, a) -> a
dif :: forall a. Num a => (a, a) -> a
dif = forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (-)

absdif :: Num a => (a, a) -> a
absdif :: forall a. Num a => (a, a) -> a
absdif = forall a. Num a => a -> a
abs forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Num a => (a, a) -> a
dif

-- | interval (0,11) to interval class (0,6)
i_to_ic :: (Num a, Ord a) => a -> a
i_to_ic :: forall a. (Num a, Ord a) => a -> a
i_to_ic a
n = if a
n forall a. Ord a => a -> a -> Bool
> a
6 then a
12 forall a. Num a => a -> a -> a
- a
n else a
n

p2_and :: (t -> u -> Bool) -> (t -> u -> Bool) -> t -> u -> Bool
p2_and :: forall t u. (t -> u -> Bool) -> (t -> u -> Bool) -> t -> u -> Bool
p2_and t -> u -> Bool
p t -> u -> Bool
q t
i u
j = t -> u -> Bool
p t
i u
j Bool -> Bool -> Bool
&& t -> u -> Bool
q t
i u
j

-- | degree of intersection
doi :: Eq t => [t] -> [t] -> Int
doi :: forall t. Eq t => [t] -> [t] -> Int
doi [t]
p = 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 [t]
p

doi_of :: Eq t => Int -> [t] -> [t] -> Bool
doi_of :: forall t. Eq t => Int -> [t] -> [t] -> Bool
doi_of Int
n [t]
p = forall a. Eq a => a -> a -> Bool
(==) Int
n forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. Eq t => [t] -> [t] -> Int
doi [t]
p

-- | The sum of the pointwise absolute difference.
loc_dif :: Num t => [t] -> [t] -> t
loc_dif :: forall t. Num t => [t] -> [t] -> t
loc_dif [t]
p [t]
q = let f :: a -> a -> a
f a
i a
j = forall a. Num a => a -> a
abs (a
i forall a. Num a => a -> a -> a
- a
j) in forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum (forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith forall a. Num a => a -> a -> a
f [t]
p [t]
q)

loc_dif_of :: (Eq t, Num t) => t -> [t] -> [t] -> Bool
loc_dif_of :: forall t. (Eq t, Num t) => t -> [t] -> [t] -> Bool
loc_dif_of t
n [t]
p [t]
q = forall t. Num t => [t] -> [t] -> t
loc_dif [t]
p [t]
q forall a. Eq a => a -> a -> Bool
== t
n

loc_dif_in :: (Eq t, Num t) => [t] -> [t] -> [t] -> Bool
loc_dif_in :: forall t. (Eq t, Num t) => [t] -> [t] -> [t] -> Bool
loc_dif_in [t]
n [t]
p [t]
q = forall t. Num t => [t] -> [t] -> t
loc_dif [t]
p [t]
q forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [t]
n

-- | The number of places that are, pointwise, not equal.
--
-- > loc_dif_n "test" "pest" == 1
loc_dif_n :: (Eq t,Num i) => [t] -> [t] -> i
loc_dif_n :: forall t i. (Eq t, Num i) => [t] -> [t] -> i
loc_dif_n [t]
p [t]
q =
    let f :: a -> a -> a
f a
i a
j = if a
i forall a. Eq a => a -> a -> Bool
== a
j then a
0 else a
1
    in forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum (forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith forall {a} {a}. (Eq a, Num a) => a -> a -> a
f [t]
p [t]
q)

loc_dif_n_of :: Eq t => Int -> [t] -> [t] -> Bool
loc_dif_n_of :: forall t. Eq t => Int -> [t] -> [t] -> Bool
loc_dif_n_of Int
n [t]
p [t]
q = forall t i. (Eq t, Num i) => [t] -> [t] -> i
loc_dif_n [t]
p [t]
q forall a. Eq a => a -> a -> Bool
== Int
n

-- > min_vl [6,11,13] [6,10,14] == 2
min_vl :: (Num a,Ord a) => [a] -> [a] -> a
min_vl :: forall a. (Num a, Ord a) => [a] -> [a] -> a
min_vl [a]
p [a]
q =
    let f :: [a] -> a
f [a]
x = forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum (forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (forall a b c. ((a, b) -> c) -> a -> b -> c
curry forall a. Num a => (a, a) -> a
absdif) [a]
p [a]
x)
    in forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum (forall a b. (a -> b) -> [a] -> [b]
map [a] -> a
f (forall a. [a] -> [[a]]
permutations [a]
q))

min_vl_of :: (Num a, Ord a) => a -> [a] -> [a] -> Bool
min_vl_of :: forall a. (Num a, Ord a) => a -> [a] -> [a] -> Bool
min_vl_of a
n [a]
p [a]
q = forall a. (Num a, Ord a) => [a] -> [a] -> a
min_vl [a]
p [a]
q forall a. Eq a => a -> a -> Bool
== a
n

min_vl_in :: (Num a, Ord a) => [a] -> [a] -> [a] -> Bool
min_vl_in :: forall a. (Num a, Ord a) => [a] -> [a] -> [a] -> Bool
min_vl_in [a]
n [a]
p [a]
q = forall a. (Num a, Ord a) => [a] -> [a] -> a
min_vl [a]
p [a]
q forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [a]
n

combinations2 :: Ord t => [t] -> [(t, t)]
combinations2 :: forall t. Ord t => [t] -> [(t, t)]
combinations2 [t]
p = [(t
i,t
j) | t
i <- [t]
p, t
j <- [t]
p, t
i forall a. Ord a => a -> a -> Bool
< t
j]

set_pp :: Show t => [t] -> String
set_pp :: forall t. Show t => [t] -> String
set_pp = forall a. [a] -> [[a]] -> [a]
intercalate String
"," forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a. Show a => a -> String
show

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

set_pp_tto_rel :: (Integral t, Show t) => T.Z t -> [t] -> [t] -> String
set_pp_tto_rel :: forall t. (Integral t, Show t) => Z t -> [t] -> [t] -> String
set_pp_tto_rel Z t
z [t]
p = forall a. [a] -> [[a]] -> [a]
intercalate String
"," forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall t. (Show t, Num t, Eq t) => Tto t -> String
T.tto_pp forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. Integral t => Z t -> [t] -> [t] -> [Tto t]
tto_rel_to Z t
z [t]
p

-- * Map

m_get :: Ord k => M.Map k v -> k -> v
m_get :: forall k v. Ord k => Map k v -> k -> v
m_get Map k v
m k
i = forall a. a -> Maybe a -> a
fromMaybe (forall a. HasCallStack => String -> a
error String
"get") (forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup k
i Map k v
m)

-- | degree of intersection
m_doi_of :: M.Map Int [Z12] -> Int -> Int -> Int -> Bool
m_doi_of :: Map Int [Z12] -> Int -> Int -> Int -> Bool
m_doi_of Map Int [Z12]
m Int
n Int
p Int
q = forall t. Eq t => Int -> [t] -> [t] -> Bool
doi_of Int
n (forall k v. Ord k => Map k v -> k -> v
m_get Map Int [Z12]
m Int
p) (forall k v. Ord k => Map k v -> k -> v
m_get Map Int [Z12]
m Int
q)

-- * Edge

-- | Add /k/ as prefix to both left and right hand sides of edge.
e_add_id :: k -> [(t,u)] -> [((k,t),(k,u))]
e_add_id :: forall k t u. k -> [(t, u)] -> [((k, t), (k, u))]
e_add_id k
k = forall a b. (a -> b) -> [a] -> [b]
map (\(t
lhs,u
rhs) -> ((k
k,t
lhs),(k
k,u
rhs)))

gen_edges :: (t -> t -> Bool) -> [t] -> [(t,t)]
gen_edges :: forall t. (t -> t -> Bool) -> [t] -> [(t, t)]
gen_edges t -> t -> Bool
f [t]
l = [(t
p,t
q) | t
p <- [t]
l, t
q <- [t]
l, t -> t -> Bool
f t
p t
q]

gen_u_edges :: Ord a => (a -> a -> Bool) -> [a] -> [(a, a)]
gen_u_edges :: forall a. Ord a => (a -> a -> Bool) -> [a] -> [(a, a)]
gen_u_edges = forall a. Ord a => (a -> a -> Bool) -> [a] -> [(a, a)]
T.e_univ_select_u_edges

-- * Graph

oh_def_opt :: [T.Dot_Meta_Attr]
oh_def_opt :: [Dot_Meta_Attr]
oh_def_opt =
  [(String
"graph:layout",String
"neato")
  ,(String
"graph:epsilon",String
"0.000001")
  ,(String
"node:shape",String
"plaintext")
  ,(String
"node:fontsize",String
"10")
  ,(String
"node:fontname",String
"century schoolbook")]

gen_graph :: Ord v => [T.Dot_Meta_Attr] -> T.Graph_Pp v e -> [T.Edge_Lbl v e] -> [String]
gen_graph :: forall v e.
Ord v =>
[Dot_Meta_Attr] -> Graph_Pp v e -> [Edge_Lbl v e] -> [String]
gen_graph [Dot_Meta_Attr]
opt Graph_Pp v e
pp [Edge_Lbl v e]
es = forall (gr :: * -> * -> *) v e.
Graph gr =>
[Dot_Meta_Attr] -> Graph_Pp v e -> gr v e -> [String]
T.fgl_to_udot ([Dot_Meta_Attr]
oh_def_opt forall a. [a] -> [a] -> [a]
++ [Dot_Meta_Attr]
opt) Graph_Pp v e
pp (forall v e. (Eq v, Ord v) => [Edge_Lbl v e] -> Gr v e
T.g_from_edges_l [Edge_Lbl v e]
es)

gen_graph_ul :: Ord v => [T.Dot_Meta_Attr] -> (v -> String) -> [T.Edge v] -> [String]
gen_graph_ul :: forall v.
Ord v =>
[Dot_Meta_Attr] -> (v -> String) -> [Edge v] -> [String]
gen_graph_ul [Dot_Meta_Attr]
opt v -> String
pp [Edge v]
es = forall (gr :: * -> * -> *) v e.
Graph gr =>
[Dot_Meta_Attr] -> Graph_Pp v e -> gr v e -> [String]
T.fgl_to_udot ([Dot_Meta_Attr]
oh_def_opt forall a. [a] -> [a] -> [a]
++ [Dot_Meta_Attr]
opt) (forall v e. (v -> String) -> Graph_Pp v e
T.gr_pp_label_v v -> String
pp) (forall v. Ord v => [Edge v] -> Gr v ()
T.g_from_edges [Edge v]
es)

gen_graph_ul_ty :: Ord v => String -> (v -> String) -> [T.Edge v] -> [String]
gen_graph_ul_ty :: forall v. Ord v => String -> (v -> String) -> [Edge v] -> [String]
gen_graph_ul_ty String
ty = forall v.
Ord v =>
[Dot_Meta_Attr] -> (v -> String) -> [Edge v] -> [String]
gen_graph_ul [(String
"graph:layout",String
ty)]

gen_flt_graph_pp :: Ord t => [T.Dot_Meta_Attr] -> ([t] -> String) -> ([t] -> [t] -> Bool) -> [[t]] -> [String]
gen_flt_graph_pp :: forall t.
Ord t =>
[Dot_Meta_Attr]
-> ([t] -> String) -> ([t] -> [t] -> Bool) -> [[t]] -> [String]
gen_flt_graph_pp [Dot_Meta_Attr]
opt [t] -> String
pp [t] -> [t] -> Bool
f [[t]]
p = forall v.
Ord v =>
[Dot_Meta_Attr] -> (v -> String) -> [Edge v] -> [String]
gen_graph_ul [Dot_Meta_Attr]
opt [t] -> String
pp (forall a. Ord a => (a -> a -> Bool) -> [a] -> [(a, a)]
gen_u_edges [t] -> [t] -> Bool
f [[t]]
p)

gen_flt_graph :: (Ord t, Show t) => [T.Dot_Meta_Attr] -> ([t] -> [t] -> Bool) -> [[t]] -> [String]
gen_flt_graph :: forall t.
(Ord t, Show t) =>
[Dot_Meta_Attr] -> ([t] -> [t] -> Bool) -> [[t]] -> [String]
gen_flt_graph [Dot_Meta_Attr]
opt = forall t.
Ord t =>
[Dot_Meta_Attr]
-> ([t] -> String) -> ([t] -> [t] -> Bool) -> [[t]] -> [String]
gen_flt_graph_pp [Dot_Meta_Attr]
opt forall t. Show t => [t] -> String
set_pp

-- * P.12

-- > circ_5 12 0 == [0,7,2,9,4,11,6,1,8,3,10,5]
circ_5 :: Integral a => Int -> a -> [a]
circ_5 :: forall a. Integral a => Int -> a -> [a]
circ_5 Int
l a
n = forall a. Int -> [a] -> [a]
take Int
l (forall a. (a -> a) -> a -> [a]
iterate (forall i. Integral i => Z i -> i -> i
T.z_mod forall i. Num i => Z i
T.z12 forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Num a => a -> a -> a
+ a
7)) (forall i. Integral i => Z i -> i -> i
T.z_mod forall i. Num i => Z i
T.z12 a
n))

all_pairs :: [t] -> [u] -> [(t,u)]
all_pairs :: forall t u. [t] -> [u] -> [(t, u)]
all_pairs [t]
x [u]
y = [(t
p,u
q) | t
p <- [t]
x, u
q <- [u]
y]

adj :: [t] -> [(t,t)]
adj :: forall t. [t] -> [(t, t)]
adj = forall t. Int -> [t] -> [(t, t)]
T.adj2 Int
1

adj_cyc :: [t] -> [(t,t)]
adj_cyc :: forall t. [t] -> [(t, t)]
adj_cyc = forall t. Int -> [t] -> [(t, t)]
T.adj2_cyclic Int
1

p12_c5_eset :: [(Int,Int)]
p12_c5_eset :: [(Int, Int)]
p12_c5_eset =
    let l1 :: [Int]
l1 = forall a. Integral a => Int -> a -> [a]
circ_5 Int
4 Int
9 -- [9,4,11,6]
        l2 :: [Int]
l2 = forall a. Integral a => Int -> a -> [a]
circ_5 Int
5 Int
10 -- [10,5,0,7,2]
        l3 :: [Int]
l3 = forall a. Integral a => Int -> a -> [a]
circ_5 Int
3 Int
1 -- [1,8,3]
        align :: [b] -> [b] -> [(b, b)]
align [b]
p [b]
q = forall a. (a -> Bool) -> [a] -> [a]
filter ((forall a. Eq a => a -> a -> Bool
== b
4) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i. Integral i => Z i -> i -> i
T.z_mod forall i. Num i => Z i
T.z12 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Num a => (a, a) -> a
dif) (forall t u. [t] -> [u] -> [(t, u)]
all_pairs [b]
p [b]
q)
    in forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall t. [t] -> [(t, t)]
adj [[Int]
l1,[Int]
l2,[Int]
l3] forall a. [a] -> [a] -> [a]
++ forall {b}. Integral b => [b] -> [b] -> [(b, b)]
align [Int]
l1 [Int]
l2 forall a. [a] -> [a] -> [a]
++ forall {b}. Integral b => [b] -> [b] -> [(b, b)]
align [Int]
l2 [Int]
l3

e_add_label :: (T.Edge v -> l) -> [T.Edge v] -> [T.Edge_Lbl v l]
e_add_label :: forall v l. (Edge v -> l) -> [Edge v] -> [Edge_Lbl v l]
e_add_label Edge v -> l
f = let g :: Edge v -> (Edge v, l)
g (v
p,v
q) = ((v
p,v
q),Edge v -> l
f (v
p,v
q)) in forall a b. (a -> b) -> [a] -> [b]
map Edge v -> (Edge v, l)
g

p12_c5_gr :: [String]
p12_c5_gr :: [String]
p12_c5_gr =
    let o :: [Dot_Meta_Attr]
o = [(String
"graph:start",String
"187623")
            ,(String
"node:fontsize",String
"10")
            ,(String
"edge:fontsize",String
"9")]
        e_l :: [Edge_Lbl Int Int]
e_l = forall v l. (Edge v -> l) -> [Edge v] -> [Edge_Lbl v l]
e_add_label (forall a. (Num a, Ord a) => a -> a
i_to_ic forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Num a => (a, a) -> a
absdif) [(Int, Int)]
p12_c5_eset
    in forall v e.
Ord v =>
[Dot_Meta_Attr] -> Graph_Pp v e -> [Edge_Lbl v e] -> [String]
gen_graph [Dot_Meta_Attr]
o (\(Int
_,Int
v) -> [(String
"label",forall i. (Integral i, Show i) => i -> String
T.pc_pp Int
v)],\((Int, Int)
_,Int
e) -> [(String
"label",forall a. Show a => a -> String
show Int
e)]) [Edge_Lbl Int Int]
e_l

-- > T.euler_plane_r p12_euler_plane == [1/1,16/15,9/8,6/5,5/4,4/3,45/32,3/2,8/5,5/3,16/9,15/8]
p12_euler_plane :: T.Euler_Plane Rational
p12_euler_plane :: Euler_Plane Rational
p12_euler_plane =
    let f :: Rational -> Rational
f = forall n. (Ord n, Fractional n) => n -> n
T.fold_ratio_to_octave_err
        l1 :: [Rational]
l1 = Int -> Rational -> Rational -> [Rational]
T.tun_seq Int
4 (Rational
3forall a. Fractional a => a -> a -> a
/Rational
2) (Rational -> Rational
f (Rational
1 forall a. Num a => a -> a -> a
* Rational
2forall a. Fractional a => a -> a -> a
/Rational
3 forall a. Num a => a -> a -> a
* Rational
5forall a. Fractional a => a -> a -> a
/Rational
4))
        l2 :: [Rational]
l2 = Int -> Rational -> Rational -> [Rational]
T.tun_seq Int
5 (Rational
3forall a. Fractional a => a -> a -> a
/Rational
2) (Rational -> Rational
f (Rational
1 forall a. Num a => a -> a -> a
* Rational
2forall a. Fractional a => a -> a -> a
/Rational
3 forall a. Num a => a -> a -> a
* Rational
2forall a. Fractional a => a -> a -> a
/Rational
3))
        l3 :: [Rational]
l3 = Int -> Rational -> Rational -> [Rational]
T.tun_seq Int
3 (Rational
3forall a. Fractional a => a -> a -> a
/Rational
2) (Rational -> Rational
f (Rational
1 forall a. Num a => a -> a -> a
* Rational
2forall a. Fractional a => a -> a -> a
/Rational
3 forall a. Num a => a -> a -> a
* Rational
4forall a. Fractional a => a -> a -> a
/Rational
5))
        ([T2 Rational]
c1,[T2 Rational]
c2) = T2 Rational -> T3 [Rational] -> ([T2 Rational], [T2 Rational])
T.euler_align_rat (Rational
5forall a. Fractional a => a -> a -> a
/Rational
4,Rational
5forall a. Fractional a => a -> a -> a
/Rational
4) ([Rational]
l1,[Rational]
l2,[Rational]
l3)
    in ([[Rational]
l1,[Rational]
l2,[Rational]
l3],[T2 Rational]
c1 forall a. [a] -> [a] -> [a]
++ [T2 Rational]
c2)

p12_euler_plane_gr :: [String]
p12_euler_plane_gr :: [String]
p12_euler_plane_gr = RAT_LABEL_OPT -> Euler_Plane Rational -> [String]
T.euler_plane_to_dot_rat (Int
0,Bool
True) Euler_Plane Rational
p12_euler_plane

-- * P.14

p14_eset :: ([(Int, Int)], [(Int, Int)], [(Int, Int)])
p14_eset :: ([(Int, Int)], [(Int, Int)], [(Int, Int)])
p14_eset =
  let univ :: [Int]
univ = [Int
0 .. Int
11]
      trs :: b -> [b] -> [b]
trs b
n = forall a b. (a -> b) -> [a] -> [b]
map (forall i. Integral i => Z i -> i -> i
T.z_mod forall i. Num i => Z i
T.z12 forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Num a => a -> a -> a
+ b
n))
      e_par :: [(Int, Int)]
e_par = forall t u. [t] -> [u] -> [(t, u)]
zip [Int]
univ [Int]
univ
      e_rel :: [(Int, Int)]
e_rel = forall t u. [t] -> [u] -> [(t, u)]
zip [Int]
univ (forall {b}. Integral b => b -> [b] -> [b]
trs Int
9 [Int]
univ)
      e_med :: [(Int, Int)]
e_med = forall t u. [t] -> [u] -> [(t, u)]
zip [Int]
univ (forall {b}. Integral b => b -> [b] -> [b]
trs Int
4 [Int]
univ)
  in ([(Int, Int)]
e_par,[(Int, Int)]
e_rel,[(Int, Int)]
e_med)

p14_mk_e :: [(Int, Int)] -> [(T.Key,T.Key)]
p14_mk_e :: [(Int, Int)] -> [(Key, Key)]
p14_mk_e =
  let pc_to_key :: c -> p -> (Note, Alteration, c)
pc_to_key c
m p
pc = let (Note
n,Alteration
a) = forall a. a -> Maybe a -> a
fromMaybe (forall a. HasCallStack => String -> a
error String
"p14_mk_e?") (forall i. Integral i => i -> Maybe (Note, Alteration)
T.pc_to_note_alteration_ks p
pc) in (Note
n,Alteration
a,c
m)
      e_lift :: (p, p) -> (Key, Key)
e_lift (p
lhs,p
rhs) = (forall {p} {c}. Integral p => c -> p -> (Note, Alteration, c)
pc_to_key Mode
T.Major_Mode p
lhs,forall {p} {c}. Integral p => c -> p -> (Note, Alteration, c)
pc_to_key Mode
T.Minor_Mode p
rhs)
  in forall a b. (a -> b) -> [a] -> [b]
map forall {p} {p}. (Integral p, Integral p) => (p, p) -> (Key, Key)
e_lift

p14_edges_u :: [(T.Key,T.Key)]
p14_edges_u :: [(Key, Key)]
p14_edges_u =
  let ([(Int, Int)]
e_par,[(Int, Int)]
e_rel,[(Int, Int)]
e_med) = ([(Int, Int)], [(Int, Int)], [(Int, Int)])
p14_eset
  in [(Int, Int)] -> [(Key, Key)]
p14_mk_e (forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[(Int, Int)]
e_par,[(Int, Int)]
e_rel,[(Int, Int)]
e_med])

p14_edges :: [(T.Key,T.Key)]
p14_edges :: [(Key, Key)]
p14_edges =
  let ([(Int, Int)]
e_par,[(Int, Int)]
e_rel,[(Int, Int)]
e_med) = ([(Int, Int)], [(Int, Int)], [(Int, Int)])
p14_eset
      del_par :: [Int]
del_par = [Int
10]
      del_rel :: [Int]
del_rel = [Int
5,Int
6]
      del_med :: [Int]
del_med = [Int
2,Int
5,Int
8,Int
11]
      rem_set :: t a -> [(a, b)] -> [(a, b)]
rem_set t a
r = forall a. (a -> Bool) -> [a] -> [a]
filter (\(a
lhs,b
_) -> a
lhs forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` t a
r)
      e_mod :: [(Int, Int)]
e_mod = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [forall {t :: * -> *} {a} {b}.
(Foldable t, Eq a) =>
t a -> [(a, b)] -> [(a, b)]
rem_set [Int]
del_par [(Int, Int)]
e_par,forall {t :: * -> *} {a} {b}.
(Foldable t, Eq a) =>
t a -> [(a, b)] -> [(a, b)]
rem_set [Int]
del_rel [(Int, Int)]
e_rel,forall {t :: * -> *} {a} {b}.
(Foldable t, Eq a) =>
t a -> [(a, b)] -> [(a, b)]
rem_set [Int]
del_med [(Int, Int)]
e_med]
  in [(Int, Int)] -> [(Key, Key)]
p14_mk_e [(Int, Int)]
e_mod

p14_mk_gr :: [T.Dot_Meta_Attr] -> [T.Edge T.Key] -> [String]
p14_mk_gr :: [Dot_Meta_Attr] -> [(Key, Key)] -> [String]
p14_mk_gr [Dot_Meta_Attr]
opt [(Key, Key)]
e =
    let opt' :: [Dot_Meta_Attr]
opt' = (String
"graph:start",String
"168732") forall a. a -> [a] -> [a]
: [Dot_Meta_Attr]
opt
        pp :: Graph_Pp Key e
pp = forall v e. (v -> String) -> Graph_Pp v e
T.gr_pp_label_v Key -> String
T.key_lc_uc_pp
        gr :: Gr Key ()
gr = forall v. Ord v => [Edge v] -> Gr v ()
T.g_from_edges [(Key, Key)]
e
    in forall (gr :: * -> * -> *) v e.
Graph gr =>
[Dot_Meta_Attr] -> Graph_Pp v e -> gr v e -> [String]
T.fgl_to_udot [Dot_Meta_Attr]
opt' forall {e}. Graph_Pp Key e
pp Gr Key ()
gr

p14_gr_u :: [String]
p14_gr_u :: [String]
p14_gr_u =
  [Dot_Meta_Attr] -> [(Key, Key)] -> [String]
p14_mk_gr
  [(String
"edge:len",String
"1.5")
  ,(String
"edge:fontsize",String
"6")
  ,(String
"node:shape",String
"box")
  ,(String
"node:fontsize",String
"10")
  ,(String
"node:fontname",String
"century schoolbook")]
  [(Key, Key)]
p14_edges_u

p14_gr :: [String]
p14_gr :: [String]
p14_gr = [Dot_Meta_Attr] -> [(Key, Key)] -> [String]
p14_mk_gr [] [(Key, Key)]
p14_edges

p14_gen_tonnetz_n :: Int -> [Int] -> [Int] -> [Int]
p14_gen_tonnetz_n :: Int -> [Int] -> [Int] -> [Int]
p14_gen_tonnetz_n Int
n [Int]
k [Int]
x =
  let gen_neighbours_n :: [a] -> a -> [a]
gen_neighbours_n [a]
l a
z = forall a b. (a -> b) -> [a] -> [b]
map (forall a. Num a => a -> a -> a
+ a
z) [a]
l forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map (a
z forall a. Num a => a -> a -> a
-) [a]
l
  in if Int
n forall a. Eq a => a -> a -> Bool
== Int
0
     then [Int]
x
     else let r :: [Int]
r = forall a. Eq a => [a] -> [a]
nub ([Int]
x forall a. [a] -> [a] -> [a]
++ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (forall {a}. Num a => [a] -> a -> [a]
gen_neighbours_n [Int]
k) [Int]
x)
          in Int -> [Int] -> [Int] -> [Int]
p14_gen_tonnetz_n (Int
n forall a. Num a => a -> a -> a
- Int
1) [Int]
k [Int]
r

p14_gen_tonnetz_e :: Int -> [Int] -> [Int] -> [((Int, Int), Int)]
p14_gen_tonnetz_e :: Int -> [Int] -> [Int] -> [Edge_Lbl Int Int]
p14_gen_tonnetz_e Int
n [Int]
k =
    let gen_e :: b -> b -> ((b, b), b)
gen_e b
x b
y = ((forall a. Ord a => a -> a -> a
min b
x b
y,forall a. Ord a => a -> a -> a
max b
x b
y),forall a. Num a => a -> a
abs (b
x forall a. Num a => a -> a -> a
- b
y))
        gen_e_n :: t b -> b -> b -> Maybe ((b, b), b)
gen_e_n t b
d_set b
x b
y = if forall a. Num a => a -> a
abs (b
x forall a. Num a => a -> a -> a
- b
y) forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` t b
d_set then forall a. a -> Maybe a
Just (forall {b}. (Ord b, Num b) => b -> b -> ((b, b), b)
gen_e b
x b
y) else forall a. Maybe a
Nothing
        f :: [Int] -> Maybe (Edge_Lbl Int Int)
f [Int
p,Int
q] = forall {t :: * -> *} {b}.
(Foldable t, Num b, Ord b) =>
t b -> b -> b -> Maybe ((b, b), b)
gen_e_n [Int]
k Int
p Int
q
        f [Int]
_ = forall a. HasCallStack => String -> a
error String
"p14_gen_tonnetz_e"
    in forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe [Int] -> Maybe (Edge_Lbl Int Int)
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [[a]]
T.combinations Int
2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Int] -> [Int] -> [Int]
p14_gen_tonnetz_n Int
n [Int]
k

-- Neo-Riemannian Tonnettz
p14_nrt_gr :: [String]
p14_nrt_gr :: [String]
p14_nrt_gr =
  let e :: [Edge_Lbl Int Int]
e = Int -> [Int] -> [Int] -> [Edge_Lbl Int Int]
p14_gen_tonnetz_e Int
3 [Int
7,Int
9,Int
16] [Int
48]
      o :: [Dot_Meta_Attr]
o = [(String
"node:shape",String
"circle")
          ,(String
"node:fontsize",String
"10")
          ,(String
"node:fontname",String
"century schoolbook")
          ,(String
"edge:len",String
"1")]
      pp :: ((a, Int) -> [Dot_Meta_Attr], b -> [a])
pp = (\(a
_,Int
v) -> [(String
"label",forall i. (Integral i, Show i) => i -> String
T.pc_pp (forall i. Integral i => Z i -> i -> i
T.z_mod forall i. Num i => Z i
T.z12 Int
v))],forall a b. a -> b -> a
const [])
  in forall v e.
Ord v =>
[Dot_Meta_Attr] -> Graph_Pp v e -> [Edge_Lbl v e] -> [String]
gen_graph [Dot_Meta_Attr]
o forall {a} {b} {a}. ((a, Int) -> [Dot_Meta_Attr], b -> [a])
pp [Edge_Lbl Int Int]
e

-- * P.31

p31_f_4_22 :: [Z12]
p31_f_4_22 :: [Z12]
p31_f_4_22 = [Z12
0,Z12
2,Z12
4,Z12
7]

p31_e_set :: [([Z12],[Z12])]
p31_e_set :: [([Z12], [Z12])]
p31_e_set = forall a. Ord a => (a -> a -> Bool) -> [a] -> [(a, a)]
T.e_univ_select_u_edges (forall t. Eq t => Int -> [t] -> [t] -> Bool
doi_of Int
3) (forall a b. (a -> b) -> [a] -> [b]
map forall a. Ord a => [a] -> [a]
sort (forall (f :: * -> *) i.
(Eq (f i), Integral i, Functor f) =>
Z i -> f i -> [f i]
T.z_sro_ti_related forall i. Num i => Z i
T.z12 [Z12]
p31_f_4_22))

p31_gr :: [String]
p31_gr :: [String]
p31_gr = forall v.
Ord v =>
[Dot_Meta_Attr] -> (v -> String) -> [Edge v] -> [String]
gen_graph_ul [] forall t. Show t => [t] -> String
set_pp [([Z12], [Z12])]
p31_e_set

-- * P.114

p114_f_3_7 :: [Z12]
p114_f_3_7 :: [Z12]
p114_f_3_7 = [Z12
0,Z12
2,Z12
5]

p114_mk_o :: Show t => t -> [T.Dot_Meta_Attr]
p114_mk_o :: forall t. Show t => t -> [Dot_Meta_Attr]
p114_mk_o t
el =
  [(String
"node:shape",String
"box")
  ,(String
"edge:len",forall a. Show a => a -> String
show t
el)
  ,(String
"edge:fontsize",String
"10")]

p114_mk_gr :: Double -> ([Z12] -> [Z12] -> Bool) -> [String]
p114_mk_gr :: Double -> ([Z12] -> [Z12] -> Bool) -> [String]
p114_mk_gr Double
el [Z12] -> [Z12] -> Bool
flt =
  let n :: [[Z12]]
n = forall a b. (a -> b) -> [a] -> [b]
map forall a. Ord a => [a] -> [a]
sort (forall (f :: * -> *) i.
(Eq (f i), Integral i, Functor f) =>
Z i -> f i -> [f i]
T.z_sro_ti_related forall i. Num i => Z i
T.z12 [Z12]
p114_f_3_7)
  in forall t.
(Ord t, Show t) =>
[Dot_Meta_Attr] -> ([t] -> [t] -> Bool) -> [[t]] -> [String]
gen_flt_graph (forall t. Show t => t -> [Dot_Meta_Attr]
p114_mk_o Double
el) [Z12] -> [Z12] -> Bool
flt [[Z12]]
n

p114_f37_sc_pp :: [Z12] -> String
p114_f37_sc_pp :: [Z12] -> String
p114_f37_sc_pp = forall t. (Integral t, Show t) => Z t -> [t] -> [t] -> String
set_pp_tto_rel forall i. Num i => Z i
T.z12 [Z12
0,Z12
2,Z12
5]

p114_g0 :: [String]
p114_g0 :: [String]
p114_g0 =
  let mk_e :: ([Z12] -> [Z12] -> Bool) -> [([Z12], [Z12])]
mk_e [Z12] -> [Z12] -> Bool
flt = forall a. Ord a => (a -> a -> Bool) -> [a] -> [(a, a)]
gen_u_edges [Z12] -> [Z12] -> Bool
flt (forall a b. (a -> b) -> [a] -> [b]
map forall a. Ord a => [a] -> [a]
sort (forall (f :: * -> *) i.
(Eq (f i), Integral i, Functor f) =>
Z i -> f i -> [f i]
T.z_sro_ti_related forall i. Num i => Z i
T.z12 [Z12]
p114_f_3_7))
  in forall v.
Ord v =>
[Dot_Meta_Attr] -> (v -> String) -> [Edge v] -> [String]
gen_graph_ul (forall t. Show t => t -> [Dot_Meta_Attr]
p114_mk_o (Double
2.5::Double)) [Z12] -> String
p114_f37_sc_pp (([Z12] -> [Z12] -> Bool) -> [([Z12], [Z12])]
mk_e (forall t. Eq t => Int -> [t] -> [t] -> Bool
doi_of Int
2))

p114_g1 :: [String]
p114_g1 :: [String]
p114_g1 = Double -> ([Z12] -> [Z12] -> Bool) -> [String]
p114_mk_gr Double
2.5 (forall t. Eq t => Int -> [t] -> [t] -> Bool
doi_of Int
2)

p114_gr_set :: [(String,[String])]
p114_gr_set :: [(String, [String])]
p114_gr_set =
  [(String
"p114.0.dot",[String]
p114_g0)
  ,(String
"p114.1.dot",[String]
p114_g1)
  ,(String
"p114.2.dot"
   ,let o :: [Dot_Meta_Attr]
o = [(String
"edge:len",String
"1.25")]
    in forall t.
(Ord t, Show t) =>
[Dot_Meta_Attr] -> ([t] -> [t] -> Bool) -> [[t]] -> [String]
gen_flt_graph [Dot_Meta_Attr]
o (forall t. (Eq t, Num t) => t -> [t] -> [t] -> Bool
loc_dif_of Int
1) (forall a. Int -> [a] -> [[a]]
T.combinations Int
3 [Int
1::Int .. Int
6]))
  ,(String
"p114.3.dot",Double -> ([Z12] -> [Z12] -> Bool) -> [String]
p114_mk_gr Double
1.5 (forall t. Eq t => Int -> [t] -> [t] -> Bool
loc_dif_n_of Int
1))
  ,(String
"p114.4.dot",Double -> ([Z12] -> [Z12] -> Bool) -> [String]
p114_mk_gr Double
1.5 (forall t. (Eq t, Num t) => t -> [t] -> [t] -> Bool
loc_dif_of Z12
1))
  ,(String
"p114.5.dot",Double -> ([Z12] -> [Z12] -> Bool) -> [String]
p114_mk_gr Double
1.5 (forall t. (Eq t, Num t) => t -> [t] -> [t] -> Bool
loc_dif_of Z12
2))
  ,(String
"p114.6.dot",Double -> ([Z12] -> [Z12] -> Bool) -> [String]
p114_mk_gr Double
1.5 (forall t. (Eq t, Num t) => [t] -> [t] -> [t] -> Bool
loc_dif_in [Z12
1,Z12
2]))
  ,(String
"p114.7.dot",Double -> ([Z12] -> [Z12] -> Bool) -> [String]
p114_mk_gr Double
1.5 (forall t. (Eq t, Num t) => [t] -> [t] -> [t] -> Bool
loc_dif_in [Z12
1,Z12
2,Z12
3]))
  ,(String
"p114.8.dot",Double -> ([Z12] -> [Z12] -> Bool) -> [String]
p114_mk_gr Double
1.5 (forall a. (Num a, Ord a) => [a] -> [a] -> [a] -> Bool
min_vl_in [Z12
1,Z12
2,Z12
3]))
  ,(String
"p114.9.dot",Double -> ([Z12] -> [Z12] -> Bool) -> [String]
p114_mk_gr Double
2.0 (forall a. (Num a, Ord a) => [a] -> [a] -> [a] -> Bool
min_vl_in [Z12
1,Z12
2,Z12
3,Z12
4]))
  ]

-- * P.125

p125_gr :: [String]
p125_gr :: [String]
p125_gr =
    let t :: [[Int]]
        t :: [[Int]]
t = [[Int
p,Int
q,Int
r] | Int
p <- [Int
0 .. Int
11], Int
q <- [Int
0 .. Int
11], Int
q forall a. Ord a => a -> a -> Bool
> Int
p, Int
r <- [Int
0 ..Int
11], Int
r forall a. Ord a => a -> a -> Bool
> Int
q]
        c :: [(Int, [[Int]])]
c = forall a b. Ord a => [(a, b)] -> [(a, [b])]
T.collate (forall t u. [t] -> [u] -> [(t, u)]
zip (forall a b. (a -> b) -> [a] -> [b]
map forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [[Int]]
t) [[Int]]
t)
        with_h :: Int -> Maybe [[Int]]
with_h Int
n = forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Int
n [(Int, [[Int]])]
c
        ch :: [[Int]]
ch = forall a. HasCallStack => Maybe a -> a
fromJust (forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 forall a. [a] -> [a] -> [a]
(++) (Int -> Maybe [[Int]]
with_h Int
15) (Int -> Maybe [[Int]]
with_h Int
16))
    in forall v.
Ord v =>
[Dot_Meta_Attr] -> (v -> String) -> [Edge v] -> [String]
gen_graph_ul [] forall t. Show t => [t] -> String
set_pp (forall a. Ord a => (a -> a -> Bool) -> [a] -> [(a, a)]
T.e_univ_select_u_edges (forall t. Eq t => Int -> [t] -> [t] -> Bool
doi_of Int
2) [[Int]]
ch)

-- * P.131

p131_gr :: [String]
p131_gr :: [String]
p131_gr =
    let c :: [[Int]]
c = let u :: [Int]
u = [Int
6::Int .. Int
14]
            in [[Int
p,Int
q,Int
r] | Int
p <- [Int]
u, Int
q <- [Int]
u, Int
q forall a. Ord a => a -> a -> Bool
> Int
p, Int
r <- [Int]
u, Int
r forall a. Ord a => a -> a -> Bool
> Int
q, Int
p forall a. Num a => a -> a -> a
+ Int
q forall a. Num a => a -> a -> a
+ Int
r forall a. Eq a => a -> a -> Bool
== Int
30]
    in forall v.
Ord v =>
[Dot_Meta_Attr] -> (v -> String) -> [Edge v] -> [String]
gen_graph_ul [] forall t. Show t => [t] -> String
set_pp (forall a. Ord a => (a -> a -> Bool) -> [a] -> [(a, a)]
T.e_univ_select_u_edges (forall a. (Num a, Ord a) => a -> [a] -> [a] -> Bool
min_vl_of Int
2) [[Int]]
c)

-- * P.148

p148_mk_gr :: ([Int] -> [Int] -> Bool) -> [String]
p148_mk_gr :: ([Int] -> [Int] -> Bool) -> [String]
p148_mk_gr [Int] -> [Int] -> Bool
f =
    let mid_set_pp :: [Int] -> String
        mid_set_pp :: [Int] -> String
mid_set_pp = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall a. Show a => a -> String
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
take Int
3 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
drop Int
1
        i_seq :: Num i => [[i]]
        i_seq :: forall i. Num i => [[i]]
i_seq = forall a. [a] -> [[a]]
permutations [i
1,i
2,i
3,i
4]
        p_seq :: (Ord i,Num i) => [[i]]
        p_seq :: forall i. (Ord i, Num i) => [[i]]
p_seq = forall a. Ord a => [a] -> [a]
sort (forall a b. (a -> b) -> [a] -> [b]
map (forall a. Num a => a -> [a] -> [a]
T.dx_d i
0) forall i. Num i => [[i]]
i_seq)
    in forall v.
Ord v =>
[Dot_Meta_Attr] -> (v -> String) -> [Edge v] -> [String]
gen_graph_ul [(String
"edge:len",String
"1.75")] [Int] -> String
mid_set_pp (forall a. Ord a => (a -> a -> Bool) -> [a] -> [(a, a)]
T.e_univ_select_u_edges [Int] -> [Int] -> Bool
f forall i. (Ord i, Num i) => [[i]]
p_seq)

p148_gr_set :: [(String,[String])]
p148_gr_set :: [(String, [String])]
p148_gr_set =
  [(String
"p148.0.dot",([Int] -> [Int] -> Bool) -> [String]
p148_mk_gr (forall t. Eq t => Int -> [t] -> [t] -> Bool
doi_of Int
4))
  ,(String
"p148.1.dot",([Int] -> [Int] -> Bool) -> [String]
p148_mk_gr (forall a. (Num a, Ord a) => [a] -> [a] -> [a] -> Bool
min_vl_in [Int
1]))
  ,(String
"p148.2.dot",([Int] -> [Int] -> Bool) -> [String]
p148_mk_gr (forall a. (Num a, Ord a) => [a] -> [a] -> [a] -> Bool
min_vl_in [Int
1,Int
2]))
  ,(String
"p148.3.dot",([Int] -> [Int] -> Bool) -> [String]
p148_mk_gr (forall t u. (t -> u -> Bool) -> (t -> u -> Bool) -> t -> u -> Bool
p2_and (forall t. Eq t => Int -> [t] -> [t] -> Bool
doi_of Int
4) (forall a. (Num a, Ord a) => [a] -> [a] -> [a] -> Bool
min_vl_in [Int
1])))
  ,(String
"p148.4.dot",([Int] -> [Int] -> Bool) -> [String]
p148_mk_gr (forall t u. (t -> u -> Bool) -> (t -> u -> Bool) -> t -> u -> Bool
p2_and (forall t. Eq t => Int -> [t] -> [t] -> Bool
doi_of Int
4) (forall a. (Num a, Ord a) => [a] -> [a] -> [a] -> Bool
min_vl_in [Int
1,Int
2])))
  ,(String
"p148.5.dot",([Int] -> [Int] -> Bool) -> [String]
p148_mk_gr (forall t. Eq t => Int -> [t] -> [t] -> Bool
loc_dif_n_of Int
1))
  ,(String
"p148.6.dot",([Int] -> [Int] -> Bool) -> [String]
p148_mk_gr (forall t. (Eq t, Num t) => t -> [t] -> [t] -> Bool
loc_dif_of Int
1))
  ]

-- * P.162

-- > length p162_ch == 30
p162_ch :: [[Int]]
p162_ch :: [[Int]]
p162_ch =
  let n :: [Int]
n = [Int
0::Int,Int
1,Int
2,Int
3,Int
4,Int
5,Int
6,Int
7,Int
8]
      c :: [[Int]]
c = forall a. Int -> [a] -> [[a]]
T.combinations Int
4 [Int]
n
  in forall a. (a -> Bool) -> [a] -> [a]
filter ((forall a. Eq a => a -> a -> Bool
== Int
1) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Integral a => a -> a -> a
`mod` Int
4) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum) [[Int]]
c

-- > length p162_e == 47
p162_e :: [T.Edge [Int]]
p162_e :: [Edge [Int]]
p162_e = forall a. Ord a => (a -> a -> Bool) -> [a] -> [(a, a)]
T.e_univ_select_u_edges (forall t. Eq t => Int -> [t] -> [t] -> Bool
doi_of Int
3) [[Int]]
p162_ch

p162_gr :: [String]
p162_gr :: [String]
p162_gr =
    let opt :: [Dot_Meta_Attr]
opt = [(String
"graph:layout",String
"neato")
              ,(String
"edge:len",String
"1.75")]
    in forall v.
Ord v =>
[Dot_Meta_Attr] -> (v -> String) -> [Edge v] -> [String]
gen_graph_ul [Dot_Meta_Attr]
opt forall t. Show t => [t] -> String
set_pp [Edge [Int]]
p162_e

-- * P.172

-- > M.size p172_nd_map == 24
p172_nd_map :: M.Map Int [Z12]
p172_nd_map :: Map Int [Z12]
p172_nd_map =
    let nd_exp :: [[Z12]]
nd_exp = forall a b. (a -> b) -> [a] -> [b]
map forall a. Ord a => [a] -> [a]
sort (forall (f :: * -> *) i.
(Eq (f i), Integral i, Functor f) =>
Z i -> f i -> [f i]
T.z_sro_ti_related forall i. Num i => Z i
T.z12 [Z12
0,Z12
1,Z12
3,Z12
7])
    in forall k a. Ord k => [(k, a)] -> Map k a
M.fromList (forall t u. [t] -> [u] -> [(t, u)]
zip [Int
0..] [[Z12]]
nd_exp)

p172_nd_e_set :: [(Int,Int)]
p172_nd_e_set :: [(Int, Int)]
p172_nd_e_set = forall a. Ord a => (a -> a -> Bool) -> [a] -> [(a, a)]
T.e_univ_select_u_edges (Map Int [Z12] -> Int -> Int -> Int -> Bool
m_doi_of Map Int [Z12]
p172_nd_map Int
0) [Int
0..Int
23]

p172_nd_e_set_alt :: [T.Edge Int]
p172_nd_e_set_alt :: [(Int, Int)]
p172_nd_e_set_alt = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (forall t. [t] -> [(t, t)]
T.e_path_to_edges forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
T.close Int
1) [[Int]]
p172_cyc0

p172_gr :: G.Gr () ()
p172_gr :: Gr () ()
p172_gr = forall (gr :: * -> * -> *).
Graph gr =>
[Int] -> [(Int, Int)] -> gr () ()
G.mkUGraph [Int
0..Int
23] [(Int, Int)]
p172_nd_e_set

p172_set_pp :: Int -> String
p172_set_pp :: Int -> String
p172_set_pp = forall t. Show t => [t] -> String
set_pp forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k v. Ord k => Map k v -> k -> v
m_get Map Int [Z12]
p172_nd_map

-- > let (c0,c1) = p172_all_cyc p172_gr
-- > (length c0,length c1) == (48,48)
p172_all_cyc :: ([[Int]], [[Int]])
p172_all_cyc :: ([[Int]], [[Int]])
p172_all_cyc =
    let (Gr () ()
a, Gr () ()
b) = forall t. [t] -> (t, t)
T.firstSecond (forall v e. Gr v e -> [Gr v e]
T.g_partition Gr () ()
p172_gr)
    in (forall a. Logic a -> [a]
L.observeAll (forall (m :: * -> *) v e.
(MonadPlus m, MonadLogic m) =>
Gr v e -> m [Int]
T.ug_hamiltonian_path_ml_0 Gr () ()
a)
       ,forall a. Logic a -> [a]
L.observeAll (forall (m :: * -> *) v e.
(MonadPlus m, MonadLogic m) =>
Gr v e -> m [Int]
T.ug_hamiltonian_path_ml_0 Gr () ()
b))

p172_cyc0 :: [[Int]]
p172_cyc0 :: [[Int]]
p172_cyc0 = forall a b. (a -> b) -> [a] -> [b]
map (forall a. [a] -> Int -> a
!! Int
0) [forall a b. (a, b) -> a
fst ([[Int]], [[Int]])
p172_all_cyc,forall a b. (a, b) -> b
snd ([[Int]], [[Int]])
p172_all_cyc]

p172_g1 :: [String]
p172_g1 :: [String]
p172_g1 = forall v.
Ord v =>
[Dot_Meta_Attr] -> (v -> String) -> [Edge v] -> [String]
gen_graph_ul [(String
"edge:len",String
"2.0")] Int -> String
p172_set_pp [(Int, Int)]
p172_nd_e_set

p172_g2 :: [String]
p172_g2 :: [String]
p172_g2 = forall v.
Ord v =>
[Dot_Meta_Attr] -> (v -> String) -> [Edge v] -> [String]
gen_graph_ul [] Int -> String
p172_set_pp [(Int, Int)]
p172_nd_e_set_alt

p172_g3 :: [String]
p172_g3 :: [String]
p172_g3 =
  let m_set_pp_tto_rel :: Int -> String
m_set_pp_tto_rel = forall t. (Integral t, Show t) => Z t -> [t] -> [t] -> String
set_pp_tto_rel forall i. Num i => Z i
T.z12 [Z12
0,Z12
1,Z12
3,Z12
7] forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k v. Ord k => Map k v -> k -> v
m_get Map Int [Z12]
p172_nd_map
  in forall v.
Ord v =>
[Dot_Meta_Attr] -> (v -> String) -> [Edge v] -> [String]
gen_graph_ul [(String
"node:shape",String
"box"),(String
"edge:len",String
"2.0")] Int -> String
m_set_pp_tto_rel [(Int, Int)]
p172_nd_e_set

-- | 'T.Tto' T/n/.
tto_tn :: Integral t => t -> T.Tto t
tto_tn :: forall t. Integral t => t -> Tto t
tto_tn t
n = forall t. t -> t -> Bool -> Tto t
T.Tto (forall i. Integral i => Z i -> i -> i
T.z_mod forall i. Num i => Z i
T.z12 t
n) t
1 Bool
False

-- | 'Z.Tto' T/n/I.
tto_tni :: Integral t => t -> T.Tto t
tto_tni :: forall t. Integral t => t -> Tto t
tto_tni t
n = forall t. t -> t -> Bool -> Tto t
T.Tto (forall i. Integral i => Z i -> i -> i
T.z_mod forall i. Num i => Z i
T.z12 t
n) t
1 Bool
True

gen_tto_alt_seq :: Integral t => (t -> T.Tto t,t -> T.Tto t) -> Int -> t -> t -> t -> [T.Tto t]
gen_tto_alt_seq :: forall t.
Integral t =>
(t -> Tto t, t -> Tto t) -> Int -> t -> t -> t -> [Tto t]
gen_tto_alt_seq (t -> Tto t
f,t -> Tto t
g) Int
k t
n t
m t
x =
    let t :: [Tto t]
t = forall a b. (a -> b) -> [a] -> [b]
map t -> Tto t
f (forall a. Int -> [a] -> [a]
take Int
k [t
x,t
x forall a. Num a => a -> a -> a
+ t
n ..])
        i :: [Tto t]
i = forall a b. (a -> b) -> [a] -> [b]
map t -> Tto t
g (forall a. Int -> [a] -> [a]
take Int
k [t
x forall a. Num a => a -> a -> a
+ t
m,t
x forall a. Num a => a -> a -> a
+ t
m forall a. Num a => a -> a -> a
+ t
n ..])
    in forall a. [a] -> [a] -> [a]
T.interleave [Tto t]
t [Tto t]
i

-- | /k/ is length of the T & I sequences, /n/ is the T & I sequence
-- interval, /m/ is the interval between the T & I sequence.
--
-- > r = ["T0 T5I T3 T8I T6 T11I T9 T2I","T1 T6I T4 T9I T7 T0I T10 T3I"]
-- > map (unwords . map T.tto_pp . gen_tni_seq 4 3 5) [0,1] == r
gen_tni_seq :: Integral t => Int -> t -> t -> t -> [T.Tto t]
gen_tni_seq :: forall t. Integral t => Int -> t -> t -> t -> [Tto t]
gen_tni_seq = forall t.
Integral t =>
(t -> Tto t, t -> Tto t) -> Int -> t -> t -> t -> [Tto t]
gen_tto_alt_seq (forall t. Integral t => t -> Tto t
tto_tn,forall t. Integral t => t -> Tto t
tto_tni)

-- > putStrLn $ unlines $ map (unwords . map Z.tto_pp) c4
p172_c4 :: [[T.Tto Int]]
p172_c4 :: [[Tto Int]]
p172_c4 = forall a b. (a -> b) -> [a] -> [b]
map (forall t. Integral t => Int -> t -> t -> t -> [Tto t]
gen_tni_seq Int
3 Int
4 Int
9) [Int
0 .. Int
3] forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map (forall t. Integral t => Int -> t -> t -> t -> [Tto t]
gen_tni_seq Int
2 Int
6 Int
11) [Int
0 .. Int
5]

tto_seq_edges :: (Show t,Num t,Eq t) => [[T.Tto t]] -> [(String, String)]
tto_seq_edges :: forall t. (Show t, Num t, Eq t) => [[Tto t]] -> [Dot_Meta_Attr]
tto_seq_edges = forall a. Eq a => [a] -> [a]
nub forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Ord a => [a] -> [a]
sort forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (forall a b. (a -> b) -> [a] -> [b]
map forall t. Ord t => (t, t) -> (t, t)
T.t2_sort forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. [t] -> [(t, t)]
adj_cyc forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall t. (Show t, Num t, Eq t) => Tto t -> String
T.tto_pp)

p172_g4 :: [String]
p172_g4 :: [String]
p172_g4 = forall v.
Ord v =>
[Dot_Meta_Attr] -> (v -> String) -> [Edge v] -> [String]
gen_graph_ul [(String
"edge:len",String
"2.0")] forall a. a -> a
id (forall t. (Show t, Num t, Eq t) => [[Tto t]] -> [Dot_Meta_Attr]
tto_seq_edges [[Tto Int]]
p172_c4)

p172_gr_set :: [(String,[String])]
p172_gr_set :: [(String, [String])]
p172_gr_set =
    [(String
"p172.0.dot",[String]
p172_g1)
    ,(String
"p172.1.dot",[String]
p172_g2)
    ,(String
"p172.2.dot",[String]
p172_g3)
    ,(String
"p172.3.dot",[String]
p172_g4)]

-- * P.177

-- > map (partition_ic 4) p_set
-- > map (partition_ic 6) p_set
partition_ic :: (Num t, Ord t, Show t) => t -> [t] -> ([t], [t])
partition_ic :: forall t. (Num t, Ord t, Show t) => t -> [t] -> ([t], [t])
partition_ic t
n [t]
p =
    case forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((forall a. Eq a => a -> a -> Bool
== t
n) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (Num a, Ord a) => a -> a
i_to_ic forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Num a => (a, a) -> a
absdif) (forall t. Ord t => [t] -> [(t, t)]
combinations2 [t]
p) of
      Just (t
i,t
j) -> let q :: [t]
q = forall a. Ord a => [a] -> [a]
sort [t
i,t
j] in ([t]
q,forall a. Ord a => [a] -> [a]
sort ([t]
p forall a. Eq a => [a] -> [a] -> [a]
\\ [t]
q))
      Maybe (t, t)
Nothing -> forall a. HasCallStack => String -> a
error (forall a. Show a => a -> String
show (String
"partition_ic",t
n,[t]
p))

p177_gr_set :: [(String,[String])]
p177_gr_set :: [(String, [String])]
p177_gr_set =
    let p_set :: [[Int]]
p_set = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (forall (f :: * -> *) i.
(Eq (f i), Integral i, Functor f) =>
Z i -> f i -> [f i]
T.z_sro_ti_related forall i. Num i => Z i
T.z12) [[Int
0::Int,Int
1,Int
4,Int
6],[Int
0,Int
1,Int
3,Int
7]]
    in [(String
"p177.0.dot",forall v.
Ord v =>
[Dot_Meta_Attr] -> (v -> String) -> [Edge v] -> [String]
gen_graph_ul [] forall t. Show t => [t] -> String
set_pp (forall a b. (a -> b) -> [a] -> [b]
map (forall t. (Num t, Ord t, Show t) => t -> [t] -> ([t], [t])
partition_ic Int
4) [[Int]]
p_set))
       ,(String
"p177.1.dot",forall v. Ord v => String -> (v -> String) -> [Edge v] -> [String]
gen_graph_ul_ty String
"circo" forall t. Show t => [t] -> String
set_pp (forall a b. (a -> b) -> [a] -> [b]
map (forall t. (Num t, Ord t, Show t) => t -> [t] -> ([t], [t])
partition_ic Int
6) [[Int]]
p_set))
       ,(String
"p177.2.dot"
        ,let gr_pp :: Graph_Pp [Int] e
gr_pp = forall v e. (v -> String) -> Graph_Pp v e
T.gr_pp_label_v forall t. Show t => [t] -> String
set_pp
             gr :: Gr [Int] ()
gr = forall v. Ord v => [Edge v] -> Gr v ()
T.g_from_edges (forall a b. (a -> b) -> [a] -> [b]
map (forall t. (Num t, Ord t, Show t) => t -> [t] -> ([t], [t])
partition_ic Int
6) [[Int]]
p_set)
         in forall (gr :: * -> * -> *) v e.
Graph gr =>
[Dot_Meta_Attr] -> Graph_Pp v e -> gr v e -> [String]
T.fgl_to_udot [(String
"edge:len",String
"1.5")] forall {e}. Graph_Pp [Int] e
gr_pp Gr [Int] ()
gr)]

-- * P.178

type SC = [Int]
type PCSET = [Int]

ait :: [SC]
ait :: [[Int]]
ait = forall a b. (a -> b) -> [a] -> [b]
map forall n. Num n => String -> [n]
T.sc [String
"4-Z15",String
"4-Z29"]

-- | List of pcsets /s/ where /prime(p+s)=r/ and /prime(q+s)=r/.
-- /#p/ and /#q/ must be equal, and less than /#r/.
--
-- > mk_bridge (T.sc "4-Z15") [0,6] [1,7] == [[2,5],[8,11]]
-- > mk_bridge (T.sc "4-Z29") [0,6] [1,7] == [[2,11],[5,8]]
mk_bridge :: SC -> PCSET -> PCSET -> [PCSET]
mk_bridge :: [Int] -> [Int] -> [Int] -> [[Int]]
mk_bridge [Int]
r [Int]
p [Int]
q =
    let n :: Int
n = forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
r forall a. Num a => a -> a -> a
- forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
p
        c :: [[Int]]
c = forall a. Int -> [a] -> [[a]]
T.combinations Int
n [Int
0..Int
11]
        f :: [Int] -> Bool
f [Int]
s = forall i. Integral i => Z i -> [i] -> [i]
T.z_forte_prime forall i. Num i => Z i
T.z12 ([Int]
p forall a. [a] -> [a] -> [a]
++ [Int]
s) forall a. Eq a => a -> a -> Bool
== [Int]
r Bool -> Bool -> Bool
&& forall i. Integral i => Z i -> [i] -> [i]
T.z_forte_prime forall i. Num i => Z i
T.z12 ([Int]
q forall a. [a] -> [a] -> [a]
++ [Int]
s) forall a. Eq a => a -> a -> Bool
== [Int]
r
    in forall a. (a -> Bool) -> [a] -> [a]
filter [Int] -> Bool
f [[Int]]
c

-- | 'concatMap' of 'mk_bridge'.
--
-- > mk_bridge_set ait [0,6] [1,7] == [[2,5],[8,11],[2,11],[5,8]]
mk_bridge_set :: [SC] -> PCSET -> PCSET -> [PCSET]
mk_bridge_set :: [[Int]] -> [Int] -> [Int] -> [[Int]]
mk_bridge_set [[Int]]
r_set [Int]
p [Int]
q = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\[Int]
r -> [Int] -> [Int] -> [Int] -> [[Int]]
mk_bridge [Int]
r [Int]
p [Int]
q) [[Int]]
r_set

mk_bridge_set_seq :: [SC] -> [PCSET] -> [[PCSET]]
mk_bridge_set_seq :: [[Int]] -> [[Int]] -> [[[Int]]]
mk_bridge_set_seq [[Int]]
r_set [[Int]]
k_seq =
    case [[Int]]
k_seq of
      [Int]
p:[Int]
q:[[Int]]
k_seq' -> [[Int]] -> [Int] -> [Int] -> [[Int]]
mk_bridge_set [[Int]]
r_set [Int]
p [Int]
q forall a. a -> [a] -> [a]
: [[Int]] -> [[Int]] -> [[[Int]]]
mk_bridge_set_seq [[Int]]
r_set ([Int]
q forall a. a -> [a] -> [a]
: [[Int]]
k_seq')
      [[Int]]
_ -> []

-- > zip [0..] (mk_bridge_set_seq ait p178_i6_seq)
p178_i6_seq :: [PCSET]
p178_i6_seq :: [[Int]]
p178_i6_seq = forall a b. (a -> b) -> [a] -> [b]
map (forall a. Ord a => [a] -> [a]
sort forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\Int
n -> forall t. (Integral t, Ord t) => Z t -> [t] -> [t]
T.z_pcset forall i. Num i => Z i
T.z12 [Int
n,Int
nforall a. Num a => a -> a -> a
+Int
6])) [Int
0..Int
6]

p178_ch :: [(PCSET,[PCSET],PCSET)]
p178_ch :: [([Int], [[Int]], [Int])]
p178_ch = forall a b c. [a] -> [b] -> [c] -> [(a, b, c)]
zip3 [[Int]]
p178_i6_seq ([[Int]] -> [[Int]] -> [[[Int]]]
mk_bridge_set_seq [[Int]]
ait [[Int]]
p178_i6_seq) (forall a. [a] -> [a]
tail [[Int]]
p178_i6_seq)

type ID = Char

-- | Add 'ID' to vertices, the @2,11@ the is between @0,6@ and @1,7@
-- is /not/ the same @2,11@ that is between @3,9@ and @4,10@.
p178_e :: [((ID,PCSET),(ID,PCSET))]
p178_e :: [((Char, [Int]), (Char, [Int]))]
p178_e =
    let f :: Char -> (b, [b], b) -> [((Char, b), (Char, b))]
f Char
k (b
p,[b]
c,b
q) = forall a b. (a -> b) -> [a] -> [b]
map (\b
x -> ((Char
'.',b
p),(Char
k,b
x))) [b]
c forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map (\b
x -> ((Char
k,b
x),(Char
'.',b
q))) [b]
c
    in forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith forall {b}. Char -> (b, [b], b) -> [((Char, b), (Char, b))]
f [Char
'a'..] [([Int], [[Int]], [Int])]
p178_ch)

p178_gr_1 :: [String]
p178_gr_1 :: [String]
p178_gr_1 =
    let opt :: [Dot_Meta_Attr]
opt = [(String
"node:shape",String
"rectangle")
              ,(String
"node:start",String
"1362874")
              ,(String
"edge:len",String
"2")]
    in forall v.
Ord v =>
[Dot_Meta_Attr] -> (v -> String) -> [Edge v] -> [String]
gen_graph_ul [Dot_Meta_Attr]
opt (forall t. Show t => [t] -> String
set_pp forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) [((Char, [Int]), (Char, [Int]))]
p178_e

p178_gr_2 :: [String]
p178_gr_2 :: [String]
p178_gr_2 =
    let opt :: [Dot_Meta_Attr]
opt = [(String
"node:shape",String
"point")]
    in forall v.
Ord v =>
[Dot_Meta_Attr] -> (v -> String) -> [Edge v] -> [String]
gen_graph_ul [Dot_Meta_Attr]
opt (forall a b. a -> b -> a
const String
"") [((Char, [Int]), (Char, [Int]))]
p178_e

-- * P.196

p196_gr :: [String]
p196_gr :: [String]
p196_gr = forall t.
(Ord t, Show t) =>
[Dot_Meta_Attr] -> ([t] -> [t] -> Bool) -> [[t]] -> [String]
gen_flt_graph [(String
"edge:len",String
"1.25")] (forall t. (Eq t, Num t) => t -> [t] -> [t] -> Bool
loc_dif_of Int
1) (forall a. Int -> [a] -> [[a]]
T.combinations Int
3 [Int
1::Int .. Int
6])

-- * P.201

type SET = [Int]
type E = (SET,SET)

bd_9_3_2_12 :: [SET]
bd_9_3_2_12 :: [[Int]]
bd_9_3_2_12 =
    [[Int
0,Int
1,Int
2],[Int
0,Int
1,Int
2],[Int
0,Int
3,Int
4],[Int
0,Int
3,Int
4],[Int
0,Int
5,Int
6],[Int
0,Int
5,Int
7],[Int
0,Int
6,Int
8],[Int
0,Int
7,Int
8]
    ,[Int
1,Int
3,Int
5],[Int
1,Int
3,Int
8],[Int
1,Int
4,Int
5],[Int
1,Int
4,Int
8],[Int
1,Int
6,Int
7],[Int
1,Int
6,Int
7]
    ,[Int
2,Int
3,Int
6],[Int
2,Int
3,Int
7],[Int
2,Int
4,Int
6],[Int
2,Int
4,Int
7],[Int
2,Int
5,Int
8],[Int
2,Int
5,Int
8]
    ,[Int
3,Int
5,Int
6],[Int
3,Int
7,Int
8]
    ,[Int
4,Int
5,Int
7],[Int
4,Int
6,Int
8]]

p201_mk_e :: [Int] -> [E]
p201_mk_e :: [Int] -> [Edge [Int]]
p201_mk_e =
    let f :: a -> [a] -> Maybe ([a], [a])
f a
n [a]
s = if a
n forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [a]
s then forall a. a -> Maybe a
Just ([a
n],forall a. Ord a => [a] -> [a]
sort (a
n forall a. Eq a => a -> [a] -> [a]
`delete` [a]
s)) else forall a. Maybe a
Nothing
        g :: Int -> [Edge [Int]]
g Int
n = forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (forall {a}. Ord a => a -> [a] -> Maybe ([a], [a])
f Int
n) [[Int]]
bd_9_3_2_12
    in forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Int -> [Edge [Int]]
g

p201_e :: [[E]]
p201_e :: [[Edge [Int]]]
p201_e = forall a b. (a -> b) -> [a] -> [b]
map [Int] -> [Edge [Int]]
p201_mk_e [[Int
0,Int
3,Int
4],[Int
1,Int
6,Int
7],[Int
2,Int
5,Int
8]]

p201_o :: [T.Dot_Meta_Attr]
p201_o :: [Dot_Meta_Attr]
p201_o =
  [(String
"graph:splines",String
"false")
  ,(String
"node:shape",String
"box")
  ,(String
"edge:len",String
"1.75")]

-- > length p201_gr_set
p201_gr_set :: [[String]]
p201_gr_set :: [[String]]
p201_gr_set = forall a b. (a -> b) -> [a] -> [b]
map (forall v.
Ord v =>
[Dot_Meta_Attr] -> (v -> String) -> [Edge v] -> [String]
gen_graph_ul [Dot_Meta_Attr]
p201_o forall t. Show t => [t] -> String
set_pp) [[Edge [Int]]]
p201_e

p201_gr_join :: [String]
p201_gr_join :: [String]
p201_gr_join =
    let e :: [[((Int, [Int]), (Int, [Int]))]]
e = forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith forall k t u. k -> [(t, u)] -> [((k, t), (k, u))]
e_add_id [Int
0::Int ..] [[Edge [Int]]]
p201_e
    in forall v.
Ord v =>
[Dot_Meta_Attr] -> (v -> String) -> [Edge v] -> [String]
gen_graph_ul [Dot_Meta_Attr]
p201_o (forall t. Show t => [t] -> String
set_pp forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) (forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[((Int, [Int]), (Int, [Int]))]]
e)

-- * P.205

bd_9_3_2_34 :: [SET]
bd_9_3_2_34 :: [[Int]]
bd_9_3_2_34 =
    [[Int
0,Int
1,Int
2],[Int
0,Int
1,Int
3],[Int
0,Int
2,Int
4],[Int
0,Int
3,Int
4]
    ,[Int
0,Int
5,Int
6],[Int
0,Int
5,Int
7],[Int
0,Int
6,Int
8],[Int
0,Int
7,Int
8]
    ,[Int
1,Int
2,Int
5],[Int
1,Int
3,Int
6],[Int
1,Int
4,Int
5],[Int
1,Int
4,Int
8]
    ,[Int
1,Int
6,Int
7],[Int
1,Int
7,Int
8],[Int
2,Int
3,Int
6],[Int
2,Int
3,Int
7]
    ,[Int
2,Int
4,Int
7],[Int
2,Int
5,Int
8],[Int
2,Int
6,Int
8],[Int
3,Int
4,Int
8]
    ,[Int
3,Int
5,Int
7],[Int
3,Int
5,Int
8],[Int
4,Int
5,Int
6],[Int
4,Int
6,Int
7]]

p205_mk_e :: [Int] -> [E]
p205_mk_e :: [Int] -> [Edge [Int]]
p205_mk_e =
    let f :: a -> [a] -> Maybe ([a], [a])
f a
n [a]
s = if a
n forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [a]
s then forall a. a -> Maybe a
Just ([a
n],forall a. Ord a => [a] -> [a]
sort (a
n forall a. Eq a => a -> [a] -> [a]
`delete` [a]
s)) else forall a. Maybe a
Nothing
        g :: Int -> [Edge [Int]]
g Int
n = forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (forall {a}. Ord a => a -> [a] -> Maybe ([a], [a])
f Int
n) [[Int]]
bd_9_3_2_34
    in forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Int -> [Edge [Int]]
g

p205_gr :: [String]
p205_gr :: [String]
p205_gr =
    let o :: [Dot_Meta_Attr]
o = [(String
"graph:splines",String
"false"),(String
"node:shape",String
"box"),(String
"edge:len",String
"2.25")]
    in forall v.
Ord v =>
[Dot_Meta_Attr] -> (v -> String) -> [Edge v] -> [String]
gen_graph_ul [Dot_Meta_Attr]
o forall t. Show t => [t] -> String
set_pp ([Int] -> [Edge [Int]]
p205_mk_e [Int
0..Int
8])

-- * IO

-- > wr_graphs "/home/rohan/sw/hmt/data/dot/tj/oh/"
wr_graphs :: FilePath -> IO ()
wr_graphs :: String -> IO ()
wr_graphs String
dir = do
  let f :: (String, [String]) -> IO ()
f (String
nm,[String]
gr) = String -> String -> IO ()
writeFile (String
dir forall a. [a] -> [a] -> [a]
++ String
"tj_oh_" forall a. [a] -> [a] -> [a]
++ String
nm) ([String] -> String
unlines [String]
gr)
  (String, [String]) -> IO ()
f (String
"p012.1.dot",[String]
p12_c5_gr)
  (String, [String]) -> IO ()
f (String
"p012.2.dot",[String]
p12_euler_plane_gr)
  (String, [String]) -> IO ()
f (String
"p014.1.dot",[String]
p14_gr_u)
  (String, [String]) -> IO ()
f (String
"p014.2.dot",[String]
p14_gr)
  (String, [String]) -> IO ()
f (String
"p014.3.dot",[String]
p14_nrt_gr)
  (String, [String]) -> IO ()
f (String
"p031.dot",[String]
p31_gr)
  forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (String, [String]) -> IO ()
f [(String, [String])]
p114_gr_set
  (String, [String]) -> IO ()
f (String
"p125.dot",[String]
p125_gr)
  (String, [String]) -> IO ()
f (String
"p131.dot",[String]
p131_gr)
  forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (String, [String]) -> IO ()
f [(String, [String])]
p148_gr_set
  (String, [String]) -> IO ()
f (String
"p162.dot",[String]
p162_gr)
  forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (String, [String]) -> IO ()
f [(String, [String])]
p172_gr_set
  forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (String, [String]) -> IO ()
f [(String, [String])]
p177_gr_set
  (String, [String]) -> IO ()
f (String
"p178.1.dot",[String]
p178_gr_1)
  (String, [String]) -> IO ()
f (String
"p178.2.dot",[String]
p178_gr_2)
  (String, [String]) -> IO ()
f (String
"p196.dot",[String]
p196_gr)
  forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (String, [String]) -> IO ()
f (forall t u. [t] -> [u] -> [(t, u)]
zip [String
"p201.1.dot",String
"p201.2.dot",String
"p201.3.dot"] [[String]]
p201_gr_set)
  (String, [String]) -> IO ()
f (String
"p201.4.dot",[String]
p201_gr_join)
  (String, [String]) -> IO ()
f (String
"p205.dot",[String]
p205_gr)