Safe Haskell | Safe-Inferred |
---|---|
Language | Haskell2010 |
- Geom (see Data.CG.Minus.Plain)
- Pt Set
- Lattice Design
- Lattice_Factors
- Rat (n,d)
- Rational
- Table
- Graph
- Zig-Zag
- Mos
- Mos/Log
- Stern-Brocot Tree
- M-Gen
- M3-Gen
- Scala
- http://anaphoria.com/1-3-5-7-9Genus.pdf
- http://anaphoria.com/earlylattices12.pdf
- http://anaphoria.com/earlylattices22.pdf
- http://anaphoria.com/diamond.pdf
- http://anaphoria.com/hel.pdf
- http://anaphoria.com/HexanyStellatesExpansions.pdf
- http://anaphoria.com/meru.pdf
- http://anaphoria.com/mos.pdf
- http://anaphoria.com/novavotreediamond.pdf (Novaro)
- http://anaphoria.com/Pelogflute.pdf
- http://anaphoria.com/xen1.pdf
- http://anaphoria.com/xen3b.pdf
- http://anaphoria.com/xen3bappendix.pdf
- http://anaphoria.com/xen456.pdf
- Gems
- Db
Erv Wilson, archives http://anaphoria.com/wilson.html
Synopsis
- type V2 n = (n, n)
- v2_map :: (t -> u) -> V2 t -> V2 u
- v2_zip :: (a -> b -> c) -> V2 a -> V2 b -> V2 c
- v2_add :: Num n => V2 n -> V2 n -> V2 n
- v2_sum :: Num n => [V2 n] -> V2 n
- v2_scale :: Num n => n -> V2 n -> V2 n
- pt_set_normalise_sym :: (Fractional n, Ord n) => [V2 n] -> [V2 n]
- type Lattice_Design n = (Int, [V2 n])
- ew_lc_std :: Num n => Lattice_Design n
- kg_lc_std :: Num n => Lattice_Design n
- ew_lc_tetradic :: Num n => Lattice_Design n
- type Lattice_Factors i = (Int, [i])
- type Lattice_Position = (Int, [Int])
- lc_pos_del :: Int -> Lattice_Position -> Lattice_Position
- lc_pos_to_pt :: (Fractional n, Ord n) => Lattice_Design n -> Lattice_Position -> V2 n
- pos_pp_ws :: Lattice_Position -> String
- lat_res :: Integral i => Lattice_Factors i -> Lattice_Position -> Ratio i
- type Rat = (Integer, Integer)
- rat_rem_oct :: Rat -> Rat
- rat_lift_1 :: (Rat -> Rat) -> Rational -> Rational
- rat_to_ratio :: Rat -> Rational
- rat_mediant :: Rat -> Rat -> Rat
- rat_pp :: Rat -> String
- r_rem_oct :: Rational -> Rational
- r_verify_oct :: Rational -> Rational
- r_seq_limit :: [Rational] -> Integer
- r_seq_factors :: [Rational] -> [Integer]
- rat_fact_lm :: Integer -> Rational -> Lattice_Position
- tbl_txt :: Bool -> Integer -> [Rational] -> [[String]]
- tbl_wr :: Bool -> [Rational] -> IO ()
- type Ew_Gr_Opt = (Maybe (Lattice_Design Rational, Maybe [Integer]), [Dot_Meta_Attr], Rational -> String)
- ew_gr_opt_pos :: Ew_Gr_Opt -> Bool
- ew_gr_r_pos :: Lattice_Design Rational -> Maybe [Integer] -> Rational -> Dot_Attr
- ew_gr_udot :: Ew_Gr_Opt -> Lbl Rational () -> [String]
- ew_gr_udot_wr :: Ew_Gr_Opt -> FilePath -> Lbl Rational () -> IO ()
- ew_gr_udot_wr_svg :: Ew_Gr_Opt -> FilePath -> Lbl Rational () -> IO ()
- zz_seq_1 :: (Eq n, Num n) => Int -> (n, n) -> (n, n) -> [(n, n)]
- zz_next :: (Eq n, Num n) => Int -> [(n, n)] -> [(n, n)]
- zz_recur :: (Eq n, Num n) => [Int] -> [(n, n)] -> [[(n, n)]]
- zz_seq :: (Eq n, Num n) => [Int] -> [[(n, n)]]
- gen_coprime :: Integral a => a -> [a]
- mos_2 :: Num n => n -> n -> (n, n)
- mos_step :: (Ord a, Num a) => (a, a) -> (a, a)
- mos_unfold :: (Ord b, Num b) => (b, b) -> [(b, b)]
- mos_verify :: Integral a => a -> a -> Bool
- mos :: (Ord b, Integral b) => b -> b -> [(b, b)]
- mos_seq :: (Ord b, Integral b) => b -> b -> [[b]]
- mos_cell_pp :: (Integral i, Show i) => i -> String
- mos_row_pp :: (Integral i, Show i) => [i] -> String
- mos_tbl_pp :: (Integral i, Show i) => [[i]] -> [String]
- mos_tbl_wr :: (Integral i, Show i) => [[i]] -> IO ()
- mos_recip_seq :: Double -> [(Int, Double)]
- mos_log :: Double -> [(Int, Double)]
- mos_log_kseq :: Double -> [Int]
- data SBT_DIV
- type Sbt_Node = (SBT_DIV, Rat, Rat, Rat)
- sbt_step :: Sbt_Node -> [Sbt_Node]
- sbt_root :: Sbt_Node
- sbt_half :: Sbt_Node
- sbt_from :: Sbt_Node -> [[Sbt_Node]]
- sbt_k_from :: Int -> Sbt_Node -> [[Sbt_Node]]
- sbt_node_to_edge :: Sbt_Node -> String
- sbt_node_elem :: Sbt_Node -> [Rat]
- sbt_dot :: [Sbt_Node] -> [String]
- (^.) :: Rational -> Int -> Rational
- r_normalise :: [Rational] -> [Rational]
- type M_Gen = (Rational, Rational, Int)
- m_gen_unfold :: M_Gen -> [Rational]
- m_gen_to_r :: [M_Gen] -> [Rational]
- type M3_Gen = (Rational, Int)
- m3_to_m :: M3_Gen -> M_Gen
- m3_gen_unfold :: M3_Gen -> [Rational]
- m3_gen_to_r :: [M3_Gen] -> [Rational]
- r_to_scale :: String -> String -> [Rational] -> Scale
- ew_scl_find_r :: [Rational] -> [Scale] -> [String]
- ew_1357_3_gen :: [M3_Gen]
- ew_1357_3_r :: [Rational]
- ew_1357_3_scl :: Scale
- ew_el12_7_r :: [Rational]
- ew_el12_7_scl :: Scale
- ew_el12_9_r :: [Rational]
- ew_el12_12_r :: [Rational]
- ew_el12_12_scl :: Scale
- ew_el22_2_r :: [Rational]
- ew_el22_3_r :: [Rational]
- ew_el22_4_r :: [Rational]
- ew_el22_5_r :: [Rational]
- ew_el22_6_r :: [Rational]
- ew_diamond_mk :: [Integer] -> [Rational]
- ew_diamond_12_gen :: [M3_Gen]
- ew_diamond_12_r :: [Rational]
- ew_diamond_13_r :: [Rational]
- hel_r_asc :: (Integer, Integer) -> [Rational]
- type HEL = ([Rational], [Rational])
- hel_1_i :: HEL
- hel_2_i :: HEL
- hel_3_i :: HEL
- hel_r :: HEL -> [[Rational]]
- ew_hel_12_r :: [Rational]
- ew_hel_12_scl :: Scale
- she_div :: Eq a => [a] -> [[[a]]]
- she_div_r :: [Rational] -> [Rational]
- she_mul_r :: [Rational] -> [Rational]
- she :: [Rational] -> [Rational]
- every_nth :: [t] -> Int -> [t]
- meru :: Num n => [[n]]
- meru_k :: Num n => Int -> [[n]]
- meru_1 :: Num n => Int -> [n]
- meru_1_direct :: Num n => [n]
- meru_2 :: Num n => Int -> [n]
- meru_2_direct :: Num n => [n]
- meru_3 :: Num n => Int -> [[n]]
- meru_3_seq :: Num n => Int -> [[n]]
- meru_3_direct :: Num n => [n]
- meru_4 :: Num n => Int -> [n]
- meru_4_direct :: Num n => [n]
- meru_5 :: Num n => Int -> [[n]]
- meru_5_seq :: Num n => Int -> [[n]]
- meru_5_direct :: Num n => [n]
- meru_6 :: Num n => Int -> [n]
- meru_6_direct :: Num n => [n]
- meru_7_direct :: Num n => [n]
- ew_mos_13_tanabe_r :: [Rational]
- ew_novarotreediamond_1 :: ([[Rational]], [[Rational]])
- ew_novarotreediamond_1_r :: [Rational]
- ew_novarotreediamond_1_scl :: Scale
- ew_Pelogflute_2_r :: Fractional n => [n]
- ew_Pelogflute_2_scl :: Scale
- xen1_fig3 :: (Sbt_Node, Int)
- xen1_fig4 :: (Sbt_Node, Int)
- ew_xen3b_3_gen :: [(Rational, Int)]
- ew_xen3b_3_r :: [Rational]
- ew_xen3b_3_scl :: Scale
- xen3b_9_i :: [[Rational]]
- xen3b_9_r :: [[Rational]]
- xen3b_13_i :: [[Rational]]
- xen3b_13_r :: [[Rational]]
- ew_xen3b_apx_gen :: [(Int, [M3_Gen])]
- ew_xen3b_apx_r :: [(Int, [Rational])]
- ew_xen456_7_gen :: [M3_Gen]
- ew_xen456_7_r :: [Rational]
- ew_xen456_9_gen :: [M3_Gen]
- ew_xen456_9_r :: [Rational]
- ew_xen456_9_scl :: Scale
- ew_poole_r :: [Rational]
- ew_poole_scl :: Scale
- ew_centaur17_r :: [Rational]
- ew_two_22_7_r :: [Rational]
- ew_two_22_7_scl :: Scale
- ew_scl_db :: [Scale]
Geom (see Data.CG.Minus.Plain)
Pt Set
pt_set_normalise_sym :: (Fractional n, Ord n) => [V2 n] -> [V2 n] Source #
Normalise set of points to lie in (-1,-1) - (1,1), scaling symetrically about (0,0)
pt_set_normalise_sym [(40,0),(0,40),(13,11),(-8,4)] == [(1,0),(0,1),(0.325,0.275),(-0.2,0.1)] pt_set_normalise_sym [(-10,0),(1,10)] == [(-1,0),(0.1,1)]
Lattice Design
type Lattice_Design n = (Int, [V2 n]) Source #
k-unit co-ordinates for k-lattice.
ew_lc_std :: Num n => Lattice_Design n Source #
Erv Wilson standard lattice, unit co-ordinates for 5-dimensions, ie. [3,5,7,11,13]
kg_lc_std :: Num n => Lattice_Design n Source #
Kraig Grady standard lattice, unit co-ordinates for 5-dimensions, ie. [3,5,7,11,13]
ew_lc_tetradic :: Num n => Lattice_Design n Source #
Erv Wilson tetradic lattice (3-lattice), used especially when working with hexanies or 7 limit tunings
Lattice_Factors
type Lattice_Factors i = (Int, [i]) Source #
A discrete k-lattice is described by a sequence of k-factors. Values are ordinarily though not necessarily primes beginning at three.
type Lattice_Position = (Int, [Int]) Source #
Positions in a k-lattice are given as a k-list of steps.
lc_pos_del :: Int -> Lattice_Position -> Lattice_Position Source #
Delete entry at index.
lc_pos_to_pt :: (Fractional n, Ord n) => Lattice_Design n -> Lattice_Position -> V2 n Source #
Resolve Lattice_Position against Lattice_Design to V2
pos_pp_ws :: Lattice_Position -> String Source #
White-space pretty printer for Lattice_Position.
pos_pp_ws (3,[0,-2,1]) == " 0 -2 1"
lat_res :: Integral i => Lattice_Factors i -> Lattice_Position -> Ratio i Source #
Given Lattice_Factors [X,Y,Z..] and Lattice_Position [x,y,z..], calculate the indicated ratio.
lat_res (2,[3,5]) (2,[-5,2]) == (5 * 5) / (3 * 3 * 3 * 3 * 3)
Rat (n,d)
rat_rem_oct :: Rat -> Rat Source #
Remove all octaves from n and d.
Rational
r_rem_oct :: Rational -> Rational Source #
Lifted rat_rem_oct
.
map ew_r_rem_oct [256/243,7/5,1/7] == [1/243,7/5,1/7]
r_verify_oct :: Rational -> Rational Source #
Assert that n is in [1,2).
r_seq_limit :: [Rational] -> Integer Source #
Find limit of set of ratios, ie. largest factor in either numerator or denominator.
r_seq_limit [1] == 1
r_seq_factors :: [Rational] -> [Integer] Source #
Find factors of set of ratios, ie. the union of all factor in both numerator & denominator.
r_seq_factors [1/3,5/7,9/8,13,27,31] == [2,3,5,7,13,31]
Table
rat_fact_lm :: Integer -> Rational -> Lattice_Position Source #
Vector of prime-factors up to limit.
map (rat_fact_lm 11) [3,5,7,2/11] == [(5,[0,1,0,0,0]),(5,[0,0,1,0,0]),(5,[0,0,0,1,0]),(5,[1,0,0,0,-1])]
Graph
type Ew_Gr_Opt = (Maybe (Lattice_Design Rational, Maybe [Integer]), [Dot_Meta_Attr], Rational -> String) Source #
(maybe (maybe lattice-design, maybe primes),gr-attr,vertex-pp)
ew_gr_opt_pos :: Ew_Gr_Opt -> Bool Source #
ew_gr_r_pos :: Lattice_Design Rational -> Maybe [Integer] -> Rational -> Dot_Attr Source #
ew_gr_udot :: Ew_Gr_Opt -> Lbl Rational () -> [String] Source #
lbl_to_udot
add position attribute if a Lattice_Design
is given.
Zig-Zag
Mos
gen_coprime :: Integral a => a -> [a] Source #
mos_step :: (Ord a, Num a) => (a, a) -> (a, a) Source #
Divide MOS, keeps retained value on same side
mos_step (5,7) == (5,2) mos_step (5,2) == (3,2) mos_step (3,2) == (1,2)
mos_unfold :: (Ord b, Num b) => (b, b) -> [(b, b)] Source #
mos_verify :: Integral a => a -> a -> Bool Source #
Mos/Log
mos_log_kseq :: Double -> [Int] Source #
Stern-Brocot Tree
sbt_node_to_edge :: Sbt_Node -> String Source #
sbt_node_elem :: Sbt_Node -> [Rat] Source #
M-Gen
r_normalise :: [Rational] -> [Rational] Source #
m_gen_unfold :: M_Gen -> [Rational] Source #
m_gen_to_r :: [M_Gen] -> [Rational] Source #
M3-Gen
m3_gen_unfold :: M3_Gen -> [Rational] Source #
m3_gen_to_r :: [M3_Gen] -> [Rational] Source #
Scala
http://anaphoria.com/1-3-5-7-9Genus.pdf
ew_1357_3_gen :: [M3_Gen] Source #
ew_1357_3_r :: [Rational] Source #
P.3 7-limit {Scala=nil}
db <- Scala.scl_load_db ew_scl_find_r (1 : ew_1357_3_r) db
http://anaphoria.com/earlylattices12.pdf
ew_el12_7_r :: [Rational] Source #
P.7 11-limit {Scala=nil}
ew_scl_find_r ew_el12_7_r db
ew_el12_9_r :: [Rational] Source #
P.9 7-limit {Scala=wilson_class}
ew_scl_find_r ew_el12_9_r db
ew_el12_12_r :: [Rational] Source #
P.12 11-limit {Scala=nil}
ew_scl_find_r ew_el12_12_r db
http://anaphoria.com/earlylattices22.pdf
ew_el22_2_r :: [Rational] Source #
P.2 11-limit {Scala=wilson_l4}
ew_scl_find_r ew_el22_2_r db
ew_el22_3_r :: [Rational] Source #
P.3 11-limit {Scala=wilson_l5}
ew_scl_find_r ew_el22_3_r db
ew_el22_4_r :: [Rational] Source #
P.4 11-limit {Scala=wilson_l3}
ew_scl_find_r ew_el22_4_r db
ew_el22_5_r :: [Rational] Source #
P.5 11-limit {Scala=wilson_l1}
ew_scl_find_r ew_el22_5_r db
ew_el22_6_r :: [Rational] Source #
P.6 11-limit {Scala=wilson_l2}
ew_scl_find_r ew_el22_6_r db
http://anaphoria.com/diamond.pdf
ew_diamond_mk :: [Integer] -> [Rational] Source #
ew_diamond_12_gen :: [M3_Gen] Source #
ew_diamond_12_r :: [Rational] Source #
P.7 & P.12 11-limit {Scala=partch_29}
1,3,5,7,9,11 diamond
ew_scl_find_r ew_diamond_12_r db -- partch_29
ew_diamond_13_r :: [Rational] Source #
P.10 & P.13 13-limit {Scala=novaro15}
1,3,5,7,9,11,13,15 diamond
ew_scl_find_r ew_diamond_13_r db -- novaro15
http://anaphoria.com/hel.pdf
ew_hel_12_r :: [Rational] Source #
P.12 {Scala=nil}
22-tone 23-limit Evangalina tuning (2001)
ew_scl_find_r ew_hel_12_r db
http://anaphoria.com/HexanyStellatesExpansions.pdf
she :: [Rational] -> [Rational] Source #
she = Stellate Hexany Expansions, P.10 {Scala=stelhex1,stelhex2,stelhex5,stelhex6}
she [1,3,5,7] == [1,21/20,15/14,35/32,9/8,5/4,21/16,35/24,3/2,49/32,25/16,105/64,7/4,15/8] mapM (flip ew_scl_find_r db . she) [[1,3,5,7],[1,3,5,9],[1,3,7,9],[1,3,5,11]] ew_scl_find_r (she [1,(5*7)/(3*3),1/(3 * 5),1/3]) db -- NIL
http://anaphoria.com/meru.pdf
meru_1_direct :: Num n => [n] Source #
meru_2 :: Num n => Int -> [n] Source #
Meru 2 = META-PELOG
map (sum . meru_2) [1 .. 14] == [1,1,1,2,3,4,6,9,13,19,28,41,60,88]
meru_2_direct :: Num n => [n] Source #
meru_3_seq :: Num n => Int -> [[n]] Source #
meru_3_direct :: Num n => [n] Source #
meru_4_direct :: Num n => [n] Source #
meru_5_seq :: Num n => Int -> [[n]] Source #
meru_5_direct :: Num n => [n] Source #
meru_6_direct :: Num n => [n] Source #
meru_7_direct :: Num n => [n] Source #
http://anaphoria.com/mos.pdf
ew_mos_13_tanabe_r :: [Rational] Source #
P.13, tanabe {Scala=chin_7}
ew_scl_find_r ew_mos_13_tanabe_r db
http://anaphoria.com/novavotreediamond.pdf (Novaro)
ew_novarotreediamond_1 :: ([[Rational]], [[Rational]]) Source #
ew_novarotreediamond_1_r :: [Rational] Source #
P.1 {Scala=nil}
23-tone 7-limit (2004)
ew_scl_find_r ew_novarotreediamond_1_r db
http://anaphoria.com/Pelogflute.pdf
ew_Pelogflute_2_r :: Fractional n => [n] Source #
P.2 {Scala=nil}
9-tone Pelog cycle (1988)
ew_scl_find_r ew_Pelogflute_2_r db
http://anaphoria.com/xen1.pdf
http://anaphoria.com/xen3b.pdf
ew_xen3b_3_gen :: [(Rational, Int)] Source #
P.3 Turkisk Baglama Scale {11-limit, Scala=nil}
ew_xen3b_3_r :: [Rational] Source #
xen3b_9_r :: [[Rational]] Source #
P.9 {SCALA 5=nil 7=ptolemy_idiat 12=nil 19=wilson2 31=wilson_31}
mapM ew_scl_find_r xen3b_9_r db
xen3b_13_i :: [[Rational]] Source #
xen3b_13_r :: [[Rational]] Source #
P.13 {SCALA 5=slendro5_2 7=ptolemy_diat2 12=nil 17=nil 22=wilson7_4}
http://anaphoria.com/xen3bappendix.pdf
ew_xen3b_apx_gen :: [(Int, [M3_Gen])] Source #
PP.1-2 {SCALA: 22=wilson7_4}
17,31,41 lattices from XEN3B (1975)
ew_xen3b_apx_r :: [(Int, [Rational])] Source #
http://anaphoria.com/xen456.pdf
ew_xen456_7_gen :: [M3_Gen] Source #
ew_xen456_7_r :: [Rational] Source #
ew_xen456_9_gen :: [M3_Gen] Source #
ew_xen456_9_r :: [Rational] Source #
P.9 {Scala=nil ; Scala:Rot=wilson11}
19-tone scale for the Clavichord-19 (1976)
ew_scl_find_r ew_xen456_9_r db
import qualified Music.Theory.List as List Scala.scl_find_ji List.is_subset ew_xen456_9_r db -- NIL
Gems
ew_poole_r :: [Rational] Source #
http://wilsonarchives.blogspot.com/2010/10/scale-for-rod-poole.html
13-limit 22-tone scale {Scala=nil}
ew_scl_find_r ew_poole_r db
ew_poole_scl :: Scale Source #
ew_centaur17_r :: [Rational] Source #
http://wilsonarchives.blogspot.com/2014/05/an-11-limit-centaur-implied-in-wilson.html
11-limit 17-tone scale {Scala=wilcent17}
ew_scl_find_r ew_centaur17_r db
ew_two_22_7_r :: [Rational] Source #
http://wilsonarchives.blogspot.com/2018/03/an-unusual-22-tone-7-limit-tuning.html
7-limit 22-tone scale {Scala=nil}
ew_scl_find_r ew_two_22_7_r db