-- | Erv Wilson, archives <http://anaphoria.com/wilson.html>
module Music.Theory.Tuning.Wilson where

import Control.Monad {- base -}
import Data.List {- base -}
import Data.Maybe {- base -}
import Data.Ord {- base -}
import Data.Ratio {- base -}
import Text.Printf {- base -}

import qualified Safe {- safe -}

import qualified Music.Theory.Array.Text as Text {- hmt-base -}
import qualified Music.Theory.Function as Function {- hmt-base -}
import qualified Music.Theory.Graph.Type as Graph {- hmt-base -}
import qualified Music.Theory.List as List {- hmt-base -}
import qualified Music.Theory.Math as Math {- hmt-base -}
import qualified Music.Theory.Math.Convert as Convert {- hmt-base -}
import qualified Music.Theory.Show as Show {- hmt-base -}
import qualified Music.Theory.Tuple as Tuple {- hmt-base -}

import qualified Music.Theory.Graph.Dot as Dot {- hmt -}
import qualified Music.Theory.Interval.Barlow_1987 as Barlow {- hmt -}
import qualified Music.Theory.Math.Oeis as OEIS {- hmt -}
import qualified Music.Theory.Math.Prime as Prime {- hmt -}
import qualified Music.Theory.Set.List as Set {- hmt -}
import qualified Music.Theory.Tuning as Tuning {- hmt -}
import qualified Music.Theory.Tuning.Scala as Scala {- hmt -}

-- * Geom (see "Data.CG.Minus.Plain")

type V2 n = (n,n)
v2_map :: (t -> u) -> V2 t -> V2 u
v2_map :: forall t u. (t -> u) -> V2 t -> V2 u
v2_map t -> u
f (t
a,t
b) = (t -> u
f t
a,t -> u
f t
b)
v2_zip :: (a -> b -> c) -> V2 a -> V2 b -> V2 c
v2_zip :: forall a b c. (a -> b -> c) -> V2 a -> V2 b -> V2 c
v2_zip a -> b -> c
f (a
i,a
j) (b
p,b
q) = (a -> b -> c
f a
i b
p,a -> b -> c
f a
j b
q)
v2_add :: Num n => V2 n -> V2 n -> V2 n
v2_add :: forall n. Num n => V2 n -> V2 n -> V2 n
v2_add = forall a b c. (a -> b -> c) -> V2 a -> V2 b -> V2 c
v2_zip forall a. Num a => a -> a -> a
(+)
v2_sum :: Num n => [V2 n] -> V2 n
v2_sum :: forall n. Num n => [V2 n] -> V2 n
v2_sum = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl forall n. Num n => V2 n -> V2 n -> V2 n
v2_add (n
0,n
0)
v2_scale :: Num n => n -> V2 n -> V2 n
v2_scale :: forall n. Num n => n -> V2 n -> V2 n
v2_scale n
n = forall t u. (t -> u) -> V2 t -> V2 u
v2_map (forall a. Num a => a -> a -> a
* n
n)

-- * Pt Set

{- | 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)]
-}
pt_set_normalise_sym :: (Fractional n,Ord n) => [V2 n] -> [V2 n]
pt_set_normalise_sym :: forall n. (Fractional n, Ord n) => [V2 n] -> [V2 n]
pt_set_normalise_sym [V2 n]
x =
  let z :: n
z = forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (forall a b. (a -> b) -> [a] -> [b]
map (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a. Ord a => a -> a -> a
max forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t u. (t -> u) -> V2 t -> V2 u
Function.bimap1 forall a. Num a => a -> a
abs) [V2 n]
x)
  in forall a b. (a -> b) -> [a] -> [b]
map (forall n. Num n => n -> V2 n -> V2 n
v2_scale (forall a. Fractional a => a -> a
recip n
z)) [V2 n]
x

-- * Lattice Design

-- | /k/-unit co-ordinates for /k/-lattice.
type Lattice_Design n = (Int,[V2 n])

-- | Erv Wilson standard lattice, unit co-ordinates for 5-dimensions, ie. [3,5,7,11,13]
--
-- <http://anaphoria.com/wilsontreasure.html>
ew_lc_std :: Num n => Lattice_Design n
ew_lc_std :: forall n. Num n => Lattice_Design n
ew_lc_std = (Int
5,[(n
20,n
0),(n
0,n
20),(n
4,n
3),(-n
3,n
4),(-n
1,n
2)])

-- | Kraig Grady standard lattice, unit co-ordinates for 5-dimensions, ie. [3,5,7,11,13]
--
-- <http://anaphoria.com/wilsontreasure.html>
kg_lc_std :: Num n => Lattice_Design n
kg_lc_std :: forall n. Num n => Lattice_Design n
kg_lc_std = (Int
5,[(n
40,n
0),(n
0,n
40),(n
13,n
11),(-n
14,n
18),(-n
8,n
4)])

-- | Erv Wilson tetradic lattice (3-lattice), used especially when working with hexanies or 7 limit tunings
--
-- <http://anaphoria.com/wilsontreasure.html>
ew_lc_tetradic :: Num n => Lattice_Design n
ew_lc_tetradic :: forall n. Num n => Lattice_Design n
ew_lc_tetradic = (Int
3,[(-n
4,-n
2),(n
6,n
1),(n
5,-n
2)])

-- * Lattice_Factors

-- | A discrete /k/-lattice is described by a sequence of /k/-factors.
--   Values are ordinarily though not necessarily primes beginning at three.
type Lattice_Factors i = (Int,[i])

-- | Positions in a /k/-lattice are given as a /k/-list of steps.
type Lattice_Position = (Int,[Int])

-- | Delete entry at index.
lc_pos_del :: Int -> Lattice_Position -> Lattice_Position
lc_pos_del :: Int -> Lattice_Position -> Lattice_Position
lc_pos_del Int
ix (Int
k,[Int]
x) = (Int
k forall a. Num a => a -> a -> a
- Int
1,forall a. Int -> [a] -> [a]
List.remove_ix Int
ix [Int]
x)

-- | Resolve Lattice_Position against Lattice_Design to V2
lc_pos_to_pt :: (Fractional n, Ord n) => Lattice_Design n -> Lattice_Position -> V2 n
lc_pos_to_pt :: forall n.
(Fractional n, Ord n) =>
Lattice_Design n -> Lattice_Position -> V2 n
lc_pos_to_pt (Int
_,[V2 n]
lc) (Int
_,[Int]
x) = forall n. Num n => [V2 n] -> V2 n
v2_sum (forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (forall n. Num n => n -> V2 n -> V2 n
v2_scale forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral) [Int]
x (forall n. (Fractional n, Ord n) => [V2 n] -> [V2 n]
pt_set_normalise_sym [V2 n]
lc))

-- | White-space pretty printer for Lattice_Position.
--
-- > pos_pp_ws (3,[0,-2,1]) == "  0 -2  1"
pos_pp_ws :: Lattice_Position -> String
pos_pp_ws :: Lattice_Position -> String
pos_pp_ws = let f :: t -> t
f t
x = forall r. PrintfType r => String -> r
printf String
"%3d" t
x in forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall {t} {t}. (PrintfArg t, PrintfType t) => t -> t
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd

-- | 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)
lat_res :: Integral i => Lattice_Factors i -> Lattice_Position -> Ratio i
lat_res :: forall i.
Integral i =>
Lattice_Factors i -> Lattice_Position -> Ratio i
lat_res (Int
_,[i]
p) (Int
_,[Int]
q) =
  let f :: a -> Int -> Ratio a
f a
i Int
j = case forall a. Ord a => a -> a -> Ordering
compare Int
j Int
0 of
                Ordering
GT -> (a
i forall a b. (Num a, Integral b) => a -> b -> a
^ Int -> Integer
Convert.int_to_integer Int
j) forall a. Integral a => a -> a -> Ratio a
% a
1
                Ordering
EQ -> Ratio a
1
                Ordering
LT -> a
1 forall a. Integral a => a -> a -> Ratio a
% (a
i forall a b. (Num a, Integral b) => a -> b -> a
^ forall a. Num a => a -> a
abs (Int -> Integer
Convert.int_to_integer Int
j))
  in forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
product (forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith forall {a}. Integral a => a -> Int -> Ratio a
f [i]
p [Int]
q)

-- * Rat (n,d)

-- | Ratio given as (/n/,/d/)
type Rat = (Integer,Integer)

-- | Remove all octaves from /n/ and /d/.
rat_rem_oct :: Rat -> Rat
rat_rem_oct :: Rat -> Rat
rat_rem_oct = forall t u. (t -> u) -> V2 t -> V2 u
Function.bimap1 (forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
product forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Eq a => a -> a -> Bool
/= Integer
2)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i. Integral i => (i, i) -> ([i], [i])
Prime.rat_prime_factors

-- | Lift 'Rat' function to 'Rational'.
rat_lift_1 :: (Rat -> Rat) -> Rational -> Rational
rat_lift_1 :: (Rat -> Rat) -> Rational -> Rational
rat_lift_1 Rat -> Rat
f = forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a. Integral a => a -> a -> Ratio a
(%) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rat -> Rat
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. Integral t => Ratio t -> (t, t)
Math.rational_nd

-- | Convert 'Rat' to 'Rational'
rat_to_ratio :: Rat -> Rational
rat_to_ratio :: Rat -> Rational
rat_to_ratio (Integer
n,Integer
d) = Integer
n forall a. Integral a => a -> a -> Ratio a
% Integer
d

-- | Mediant, ie. n1+n2/d1+d2
--
-- > rat_mediant (0,1) (1,2) == (1,3)
rat_mediant :: Rat -> Rat -> Rat
rat_mediant :: Rat -> Rat -> Rat
rat_mediant (Integer
n1,Integer
d1) (Integer
n2,Integer
d2) = (Integer
n1 forall a. Num a => a -> a -> a
+ Integer
n2,Integer
d1 forall a. Num a => a -> a -> a
+ Integer
d2)

-- | Rat written as n/d
rat_pp :: Rat -> String
rat_pp :: Rat -> String
rat_pp (Integer
n,Integer
d) = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [forall a. Show a => a -> String
show Integer
n,String
"/",forall a. Show a => a -> String
show Integer
d]

-- * Rational

-- | Lifted 'rat_rem_oct'.
--
-- > map ew_r_rem_oct [256/243,7/5,1/7] == [1/243,7/5,1/7]
r_rem_oct :: Rational -> Rational
r_rem_oct :: Rational -> Rational
r_rem_oct = (Rat -> Rat) -> Rational -> Rational
rat_lift_1 Rat -> Rat
rat_rem_oct

-- | Assert that /n/ is in [1,2).
r_verify_oct :: Rational -> Rational
r_verify_oct :: Rational -> Rational
r_verify_oct Rational
i = if Rational
i forall a. Ord a => a -> a -> Bool
>= Rational
1 Bool -> Bool -> Bool
&& Rational
i forall a. Ord a => a -> a -> Bool
< Rational
2 then Rational
i else forall a. HasCallStack => String -> a
error (forall a. Show a => a -> String
show (String
"r_verify_oct?",Rational
i))

-- | Find limit of set of ratios, ie. largest factor in either numerator or denominator.
--
-- > r_seq_limit [1] == 1
r_seq_limit :: [Rational] -> Integer
r_seq_limit :: [Rational] -> Integer
r_seq_limit = forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall i. Integral i => Ratio i -> i
Prime.rational_prime_limit

-- | 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]
r_seq_factors :: [Rational] -> [Integer]
r_seq_factors :: [Rational] -> [Integer]
r_seq_factors = 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 c. (a -> b -> c) -> (a, b) -> c
uncurry forall a. [a] -> [a] -> [a]
(++) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i. Integral i => Ratio i -> ([i], [i])
Prime.rational_prime_factors)

-- * Table

-- | 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])]
rat_fact_lm :: Integer -> Rational -> Lattice_Position
rat_fact_lm :: Integer -> Rational -> Lattice_Position
rat_fact_lm Integer
lm =
  let k :: Int
k = forall a. a -> Maybe a -> a
fromMaybe Int
1 (forall a. Integral a => a -> Maybe Int
Prime.prime_k Integer
lm) forall a. Num a => a -> a -> a
+ Int
1
  in (\[Int]
c -> (Int
k,[Int]
c)) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
     forall i. (Integral i, Show i) => Int -> (i, i) -> [Int]
Prime.rat_prime_factors_t Int
k forall b c a. (b -> c) -> (a -> b) -> a -> c
.
     forall t. Integral t => Ratio t -> (t, t)
Math.rational_nd

tbl_txt :: Bool -> Integer -> [Rational] -> [[String]]
tbl_txt :: Bool -> Integer -> [Rational] -> [[String]]
tbl_txt Bool
del Integer
lm_z [Rational]
rs =
  let lm :: Integer
lm = [Rational] -> Integer
r_seq_limit [Rational]
rs
      scl :: [Lattice_Position]
scl = forall a b. (a -> b) -> [a] -> [b]
map ((if Bool
del then Int -> Lattice_Position -> Lattice_Position
lc_pos_del Int
0 else forall a. a -> a
id) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Rational -> Lattice_Position
rat_fact_lm Integer
lm) [Rational]
rs
      cs :: [Double]
cs = forall a b. (a -> b) -> [a] -> [b]
map (forall i. Integral i => Ratio i -> Double
Tuning.ratio_to_cents forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. (Ord n, Fractional n) => n -> n
Tuning.fold_ratio_to_octave_err) [Rational]
rs
      hs :: [Double]
hs = forall a b. (a -> b) -> [a] -> [b]
map (forall a b. (Integral a, Fractional b) => (a -> b) -> Ratio a -> b
Barlow.harmonicity_r forall a b. (Integral a, Fractional b) => a -> b
Barlow.barlow) [Rational]
rs :: [Double]
      f :: (a, Lattice_Position, Rational, t, t) -> [String]
f (a
k,Lattice_Position
x,Rational
r,t
c,t
h) = [forall a. Show a => a -> String
show a
k
                      ,if Integer
lm forall a. Ord a => a -> a -> Bool
<= Integer
lm_z then Lattice_Position -> String
pos_pp_ws Lattice_Position
x else String
"..."
                      ,Rational -> String
Show.ratio_pp Rational
r
                      ,forall t. Real t => Int -> t -> String
Show.real_pp Int
2 t
c
                      ,forall t. Real t => Int -> t -> String
Show.real_pp_unicode Int
2 t
h]
  in forall a b. (a -> b) -> [a] -> [b]
map (forall a. a -> [a] -> [a]
intersperse String
"=" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a} {t} {t}.
(Show a, Real t, Real t) =>
(a, Lattice_Position, Rational, t, t) -> [String]
f) (forall a b c d e.
[a] -> [b] -> [c] -> [d] -> [e] -> [(a, b, c, d, e)]
zip5 [Int
0::Int ..] [Lattice_Position]
scl [Rational]
rs [Double]
cs [Double]
hs)

-- > tbl_wr False [1,7/6,5/4,4/3,3/2]
-- > tbl_wr True [1,3,1/5,15/31]
tbl_wr :: Bool -> [Rational] -> IO ()
tbl_wr :: Bool -> [Rational] -> IO ()
tbl_wr Bool
del = String -> IO ()
putStr forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
unlines forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text_Table_Opt -> [[String]] -> [String]
Text.table_pp (Bool
False,Bool
True,Bool
False,String
" ",Bool
False) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Integer -> [Rational] -> [[String]]
tbl_txt Bool
del Integer
31

-- * Graph

-- | (maybe (maybe lattice-design, maybe primes),gr-attr,vertex-pp)
type Ew_Gr_Opt = (Maybe (Lattice_Design Rational,Maybe [Integer]),[Dot.Dot_Meta_Attr],Rational -> String)

ew_gr_opt_pos :: Ew_Gr_Opt -> Bool
ew_gr_opt_pos :: Ew_Gr_Opt -> Bool
ew_gr_opt_pos (Maybe (Lattice_Design Rational, Maybe [Integer])
lc_m,[Dot_Meta_Attr]
_,Rational -> String
_) = forall a. Maybe a -> Bool
isJust Maybe (Lattice_Design Rational, Maybe [Integer])
lc_m

-- > map (ew_gr_r_pos ew_lc_std (Just [3,5,31])) [3,5,31]
ew_gr_r_pos :: Lattice_Design Rational -> Maybe [Integer] -> Rational -> Dot.Dot_Attr
ew_gr_r_pos :: Lattice_Design Rational
-> Maybe [Integer] -> Rational -> Dot_Meta_Attr
ew_gr_r_pos (Int
k,[V2 Rational]
lc) Maybe [Integer]
primes_l =
  let f :: b -> (b, b) -> (b, b)
f b
m (b
x,b
y) = (b
m forall a. Num a => a -> a -> a
* b
x,b
m forall a. Num a => a -> a -> a
* b
y)
  in forall n. (Show n, Real n) => (n, n) -> Dot_Meta_Attr
Dot.node_pos_attr forall b c a. (b -> c) -> (a -> b) -> a -> c
.
     forall n. Num n => n -> V2 n -> V2 n
f Rational
160 forall b c a. (b -> c) -> (a -> b) -> a -> c
.
     forall n.
(Fractional n, Ord n) =>
Lattice_Design n -> Lattice_Position -> V2 n
lc_pos_to_pt (Int
k,[V2 Rational]
lc) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
     (\[Int]
c -> (Int
k,[Int]
c)) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
     -- this is a little subtle, tail removes the '2' slot from rational_prime_factors_t
     forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a. [a] -> [a]
tail forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i. (Integral i, Show i) => Int -> Ratio i -> [Int]
Prime.rational_prime_factors_t (Int
k forall a. Num a => a -> a -> a
+ Int
1)) forall i. (Integral i, Show i) => [i] -> Ratio i -> [Int]
Prime.rational_prime_factors_c Maybe [Integer]
primes_l

-- | 'Dot.lbl_to_udot' add position attribute if a 'Lattice_Design' is given.
ew_gr_udot :: Ew_Gr_Opt -> Graph.Lbl Rational () -> [String]
ew_gr_udot :: Ew_Gr_Opt -> Lbl Rational () -> [String]
ew_gr_udot (Maybe (Lattice_Design Rational, Maybe [Integer])
lc_m,[Dot_Meta_Attr]
attr,Rational -> String
v_pp) =
  let (String
e,Rational -> Maybe Dot_Meta_Attr
p_f) = case Maybe (Lattice_Design Rational, Maybe [Integer])
lc_m of
                  Maybe (Lattice_Design Rational, Maybe [Integer])
Nothing -> (String
"sfdp",forall a b. a -> b -> a
const forall a. Maybe a
Nothing)
                  Just (Lattice_Design Rational
lc,Maybe [Integer]
primes_l) -> (String
"neato",forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lattice_Design Rational
-> Maybe [Integer] -> Rational -> Dot_Meta_Attr
ew_gr_r_pos Lattice_Design Rational
lc Maybe [Integer]
primes_l)
  in forall v e. [Dot_Meta_Attr] -> Graph_Pp v e -> Lbl v e -> [String]
Dot.lbl_to_udot
     ([(String
"graph:layout",String
e),(String
"node:shape",String
"plain")] forall a. [a] -> [a] -> [a]
++ [Dot_Meta_Attr]
attr) -- ("graph:K","0.6") ("edge:len","1.0")
     (\(Int
_,Rational
v) -> forall a. Maybe a -> [a] -> [a]
List.mcons (Rational -> Maybe Dot_Meta_Attr
p_f Rational
v) [(String
"label",Rational -> String
v_pp Rational
v)]
     ,forall a b. a -> b -> a
const [])

-- | 'writeFile' of 'ew_gr_udot'
ew_gr_udot_wr :: Ew_Gr_Opt -> FilePath -> Graph.Lbl Rational () -> IO ()
ew_gr_udot_wr :: Ew_Gr_Opt -> String -> Lbl Rational () -> IO ()
ew_gr_udot_wr Ew_Gr_Opt
opt String
fn = String -> String -> IO ()
writeFile String
fn forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
unlines forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ew_Gr_Opt -> Lbl Rational () -> [String]
ew_gr_udot Ew_Gr_Opt
opt

ew_gr_udot_wr_svg :: Ew_Gr_Opt -> FilePath -> Graph.Lbl Rational () -> IO ()
ew_gr_udot_wr_svg :: Ew_Gr_Opt -> String -> Lbl Rational () -> IO ()
ew_gr_udot_wr_svg Ew_Gr_Opt
opt String
fn Lbl Rational ()
gr = do
  Ew_Gr_Opt -> String -> Lbl Rational () -> IO ()
ew_gr_udot_wr Ew_Gr_Opt
opt String
fn Lbl Rational ()
gr
  forall (f :: * -> *) a. Functor f => f a -> f ()
void ([String] -> String -> IO ()
Dot.dot_to_svg (if Ew_Gr_Opt -> Bool
ew_gr_opt_pos Ew_Gr_Opt
opt then [String
"-n"] else []) String
fn)

-- * Zig-Zag

zz_seq_1 :: (Eq n,Num n) => Int -> (n,n) -> (n,n) -> [(n,n)]
zz_seq_1 :: forall n. (Eq n, Num n) => Int -> (n, n) -> (n, n) -> [(n, n)]
zz_seq_1 Int
k (n
p,n
q) (n
n,n
d) = if Int
k forall a. Eq a => a -> a -> Bool
== Int
0 then [(n
n,n
d)] else (n
n,n
d) forall a. a -> [a] -> [a]
: forall n. (Eq n, Num n) => Int -> (n, n) -> (n, n) -> [(n, n)]
zz_seq_1 (Int
k forall a. Num a => a -> a -> a
- Int
1) (n
p,n
q) (n
nforall a. Num a => a -> a -> a
+n
p,n
dforall a. Num a => a -> a -> a
+n
q)

-- > zz_next 3 [(0,1),(1,1)] == [(1,1),(1,2),(1,3),(1,4)]
zz_next :: (Eq n, Num n) => Int -> [(n,n)] -> [(n,n)]
zz_next :: forall n. (Eq n, Num n) => Int -> [(n, n)] -> [(n, n)]
zz_next Int
k [(n, n)]
p =
  case forall a. [a] -> [a]
reverse [(n, n)]
p of
    (n, n)
i:(n, n)
j:[(n, n)]
_ -> forall n. (Eq n, Num n) => Int -> (n, n) -> (n, n) -> [(n, n)]
zz_seq_1 Int
k (n, n)
j (n, n)
i
    [(n, n)]
_ -> forall a. HasCallStack => String -> a
error String
"zz_next?"

zz_recur :: (Eq n, Num n) => [Int] -> [(n,n)] -> [[(n,n)]]
zz_recur :: forall n. (Eq n, Num n) => [Int] -> [(n, n)] -> [[(n, n)]]
zz_recur [Int]
k_seq [(n, n)]
p =
  case [Int]
k_seq of
    [] -> []
    Int
k:[Int]
k_rem -> let r :: [(n, n)]
r = forall n. (Eq n, Num n) => Int -> [(n, n)] -> [(n, n)]
zz_next Int
k [(n, n)]
p in [(n, n)]
r forall a. a -> [a] -> [a]
: forall n. (Eq n, Num n) => [Int] -> [(n, n)] -> [[(n, n)]]
zz_recur [Int]
k_rem [(n, n)]
r

-- > zz_seq [3,9,2,2,4,6,2,1,1,3]
-- > zz_seq [2,4,2,158]
-- > zz_seq [1,1,4,2,1,3,1,6,2]
zz_seq :: (Eq n, Num n) => [Int] -> [[(n, n)]]
zz_seq :: forall n. (Eq n, Num n) => [Int] -> [[(n, n)]]
zz_seq [Int]
k_seq = forall n. (Eq n, Num n) => [Int] -> [(n, n)] -> [[(n, n)]]
zz_recur [Int]
k_seq [(n
0,n
1),(n
1,n
1)]

-- * Mos

-- > gen_coprime 12 == [1,5]
-- > gen_coprime 49 == [1..24] \\ [7,14,21]
gen_coprime :: Integral a => a -> [a]
gen_coprime :: forall a. Integral a => a -> [a]
gen_coprime a
x = forall a. (a -> Bool) -> [a] -> [a]
filter (\a
y -> forall a. Integral a => a -> a -> a
gcd a
y a
x forall a. Eq a => a -> a -> Bool
== a
1) [a
1 .. (a
x forall a. Integral a => a -> a -> a
`div` a
2)]

-- > mos_2 12 5 == (5,7)
mos_2 :: Num n => n -> n -> (n,n)
mos_2 :: forall n. Num n => n -> n -> (n, n)
mos_2 n
p n
g = (n
g,n
p forall a. Num a => a -> a -> a
- n
g)

-- | 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_step :: (Ord a, Num a) => (a, a) -> (a, a)
mos_step :: forall a. (Ord a, Num a) => (a, a) -> (a, a)
mos_step (a
i,a
j) = if a
i forall a. Ord a => a -> a -> Bool
< a
j then (a
i,a
j forall a. Num a => a -> a -> a
- a
i) else (a
i forall a. Num a => a -> a -> a
- a
j,a
j)

-- > mos_unfold (5,7)  == [(5,7),(5,2),(3,2),(1,2)]
-- > mos_unfold (41,17) == [(41,17),(24,17),(7,17),(7,10),(7,3),(4,3),(1,3),(1,2)]
mos_unfold :: (Ord b, Num b) => (b, b) -> [(b, b)]
mos_unfold :: forall b. (Ord b, Num b) => (b, b) -> [(b, b)]
mos_unfold (b, b)
x =
  let y :: (b, b)
y = forall a. (Ord a, Num a) => (a, a) -> (a, a)
mos_step (b, b)
x
  in if forall n. Num n => (n, n) -> n
Tuple.t2_sum (b, b)
y forall a. Eq a => a -> a -> Bool
== b
3 then [(b, b)
x,(b, b)
y] else (b, b)
x forall a. a -> [a] -> [a]
: forall b. (Ord b, Num b) => (b, b) -> [(b, b)]
mos_unfold (b, b)
y

mos_verify :: Integral a => a -> a -> Bool
mos_verify :: forall a. Integral a => a -> a -> Bool
mos_verify a
p a
g =
  let x :: a
x = if a
g forall a. Ord a => a -> a -> Bool
> (a
p forall a. Integral a => a -> a -> a
`div` a
2) then a
p forall a. Integral a => a -> a -> a
`mod` a
g else a
g
  in a
x forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` forall a. Integral a => a -> [a]
gen_coprime a
p

-- > mos 12 5 == [(5,7),(5,2),(3,2),(1,2)]
mos :: (Ord b, Integral b) => b -> b -> [(b, b)]
mos :: forall b. (Ord b, Integral b) => b -> b -> [(b, b)]
mos b
p b
g = if forall a. Integral a => a -> a -> Bool
mos_verify b
p b
g then forall b. (Ord b, Num b) => (b, b) -> [(b, b)]
mos_unfold (forall n. Num n => n -> n -> (n, n)
mos_2 b
p b
g) else forall a. HasCallStack => String -> a
error String
"mos?"

-- > mos_seq 12 5 == [[5,7],[5,5,2],[3,2,3,2,2],[1,2,2,1,2,2,2]]
-- > mos_seq 41 17 !! 4 == [3,3,4,3,4,3,3,4,3,4,3,4]
-- > map length (mos_seq 49 27) == [2,3,5,7,9,11,20,29]
mos_seq :: (Ord b, Integral b) => b -> b -> [[b]]
mos_seq :: forall b. (Ord b, Integral b) => b -> b -> [[b]]
mos_seq b
p b
g =
  let step_f :: (b, b) -> t b -> [b]
step_f (b
i,b
j) = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\b
x -> if b
x forall a. Eq a => a -> a -> Bool
== b
i forall a. Num a => a -> a -> a
+ b
j then [b
i,b
j] else [b
x])
      recur_f :: [(b, b)] -> [b] -> [[b]]
recur_f [(b, b)]
x [b]
l = if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(b, b)]
x then [[b]
l] else [b]
l forall a. a -> [a] -> [a]
: [(b, b)] -> [b] -> [[b]]
recur_f (forall a. [a] -> [a]
tail [(b, b)]
x) (forall {t :: * -> *} {b}.
(Foldable t, Eq b, Num b) =>
(b, b) -> t b -> [b]
step_f (forall a. [a] -> a
head [(b, b)]
x) [b]
l)
      ((b
i0,b
j0), [(b, b)]
r) = forall a. [a] -> (a, [a])
List.headTail (forall b. (Ord b, Integral b) => b -> b -> [(b, b)]
mos b
p b
g)
  in forall {b}. (Eq b, Num b) => [(b, b)] -> [b] -> [[b]]
recur_f [(b, b)]
r [b
i0,b
j0]

mos_cell_pp :: (Integral i,Show i) => i -> String
mos_cell_pp :: forall i. (Integral i, Show i) => i -> String
mos_cell_pp i
x = let s :: String
s = forall a. Show a => a -> String
show i
x in String
s forall a. [a] -> [a] -> [a]
++ forall i a. Integral i => i -> a -> [a]
genericReplicate (i
x forall a. Num a => a -> a -> a
- forall i a. Num i => [a] -> i
genericLength String
s) Char
'-'

mos_row_pp :: (Integral i,Show i) => [i] -> String
mos_row_pp :: forall i. (Integral i, Show i) => [i] -> String
mos_row_pp = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall i. (Integral i, Show i) => i -> String
mos_cell_pp

mos_tbl_pp :: (Integral i,Show i) => [[i]] -> [String]
mos_tbl_pp :: forall i. (Integral i, Show i) => [[i]] -> [String]
mos_tbl_pp = forall a b. (a -> b) -> [a] -> [b]
map forall i. (Integral i, Show i) => [i] -> String
mos_row_pp

-- > mos_tbl_wr (mos_seq 49 27)
mos_tbl_wr :: (Integral i,Show i) => [[i]] -> IO ()
mos_tbl_wr :: forall i. (Integral i, Show i) => [[i]] -> IO ()
mos_tbl_wr = String -> IO ()
putStrLn forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
unlines forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i. (Integral i, Show i) => [[i]] -> [String]
mos_tbl_pp

-- * Mos/Log

mos_recip_seq :: Double -> [(Int,Double)]
mos_recip_seq :: Double -> [(Int, Double)]
mos_recip_seq Double
x = let y :: Int
y = forall a b. (RealFrac a, Integral b) => a -> b
truncate Double
x in (Int
y,Double
x) forall a. a -> [a] -> [a]
: Double -> [(Int, Double)]
mos_recip_seq (forall a. Fractional a => a -> a
recip (Double
x forall a. Num a => a -> a -> a
- forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
y))

-- > take 3 (mos_log (5/4)) == [(3,3.10628371950539),(9,9.408778735385603),(2,2.4463112031908785)]
mos_log :: Double -> [(Int,Double)]
mos_log :: Double -> [(Int, Double)]
mos_log Double
r = Double -> [(Int, Double)]
mos_recip_seq (forall a. Fractional a => a -> a
recip (forall a. Floating a => a -> a -> a
logBase Double
2 Double
r))

-- > take 9 (mos_log_kseq 1.465571232) == [1,1,4,2,1,3,1,6,2]
mos_log_kseq :: Double -> [Int]
mos_log_kseq :: Double -> [Int]
mos_log_kseq = forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> [(Int, Double)]
mos_log

-- * Stern-Brocot Tree

data SBT_DIV = NIL | LHS | RHS deriving (Int -> SBT_DIV -> ShowS
[SBT_DIV] -> ShowS
SBT_DIV -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SBT_DIV] -> ShowS
$cshowList :: [SBT_DIV] -> ShowS
show :: SBT_DIV -> String
$cshow :: SBT_DIV -> String
showsPrec :: Int -> SBT_DIV -> ShowS
$cshowsPrec :: Int -> SBT_DIV -> ShowS
Show)
type Sbt_Node = (SBT_DIV,Rat,Rat,Rat)

sbt_step :: Sbt_Node -> [Sbt_Node]
sbt_step :: Sbt_Node -> [Sbt_Node]
sbt_step (SBT_DIV
_,Rat
l,Rat
m,Rat
r) = [(SBT_DIV
LHS,Rat
l,Rat -> Rat -> Rat
rat_mediant Rat
l Rat
m, Rat
m),(SBT_DIV
RHS,Rat
m,Rat -> Rat -> Rat
rat_mediant Rat
m Rat
r,Rat
r)]

-- sbt = stern-brocot tree
sbt_root :: Sbt_Node
sbt_root :: Sbt_Node
sbt_root = (SBT_DIV
NIL,(Integer
0,Integer
1),(Integer
1,Integer
1),(Integer
1,Integer
0))

sbt_half :: Sbt_Node
sbt_half :: Sbt_Node
sbt_half = (SBT_DIV
NIL,(Integer
0,Integer
1),(Integer
1,Integer
2),(Integer
1,Integer
1))

-- > sbt_from sbt_root
sbt_from :: Sbt_Node -> [[Sbt_Node]]
sbt_from :: Sbt_Node -> [[Sbt_Node]]
sbt_from = forall a. (a -> a) -> a -> [a]
iterate (forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Sbt_Node -> [Sbt_Node]
sbt_step) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. Monad m => a -> m a
return

sbt_k_from :: Int -> Sbt_Node -> [[Sbt_Node]]
sbt_k_from :: Int -> Sbt_Node -> [[Sbt_Node]]
sbt_k_from Int
k = forall a. Int -> [a] -> [a]
take Int
k forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sbt_Node -> [[Sbt_Node]]
sbt_from

sbt_node_to_edge :: Sbt_Node -> String
sbt_node_to_edge :: Sbt_Node -> String
sbt_node_to_edge (SBT_DIV
dv,Rat
l,Rat
m,Rat
r) =
  let edge_pp :: Rat -> Rat -> t
edge_pp Rat
p Rat
q = forall r. PrintfType r => String -> r
printf String
"\"%s\" -- \"%s\"" (Rat -> String
rat_pp Rat
p) (Rat -> String
rat_pp Rat
q)
  in case SBT_DIV
dv of
       SBT_DIV
NIL -> String
""
       SBT_DIV
LHS -> forall {t}. PrintfType t => Rat -> Rat -> t
edge_pp Rat
r Rat
m
       SBT_DIV
RHS -> forall {t}. PrintfType t => Rat -> Rat -> t
edge_pp Rat
l Rat
m

sbt_node_elem :: Sbt_Node -> [Rat]
sbt_node_elem :: Sbt_Node -> [Rat]
sbt_node_elem (SBT_DIV
dv,Rat
l,Rat
m,Rat
r) =
  case SBT_DIV
dv of
    SBT_DIV
NIL -> [Rat
l,Rat
m,Rat
r]
    SBT_DIV
_ -> [Rat
m]

sbt_dot :: [Sbt_Node] -> [String]
sbt_dot :: [Sbt_Node] -> [String]
sbt_dot [Sbt_Node]
n =
  let e :: [String]
e = forall a b. (a -> b) -> [a] -> [b]
map Sbt_Node -> String
sbt_node_to_edge [Sbt_Node]
n
  in forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[String
"graph {",String
"node [shape=plain]"],[String]
e,[String
"}"]]

-- * M-Gen

(^.) :: Rational -> Int -> Rational
^. :: Rational -> Int -> Rational
(^.) = forall a b. (Num a, Integral b) => a -> b -> a
(^)

r_normalise :: [Rational] -> [Rational]
r_normalise :: [Rational] -> [Rational]
r_normalise = forall a. Eq a => [a] -> [a]
nub forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn forall n. (Ord n, Fractional n) => n -> n
Tuning.fold_ratio_to_octave_err

-- | (ratio,multiplier,steps)
type M_Gen = (Rational,Rational,Int)

m_gen_unfold :: M_Gen -> [Rational]
m_gen_unfold :: M_Gen -> [Rational]
m_gen_unfold (Rational
r,Rational
m,Int
n) = forall a. Int -> [a] -> [a]
take Int
n (forall a. (a -> a) -> a -> [a]
iterate (forall a. Num a => a -> a -> a
* Rational
m) Rational
r)

m_gen_to_r :: [M_Gen] -> [Rational]
m_gen_to_r :: [M_Gen] -> [Rational]
m_gen_to_r = [Rational] -> [Rational]
r_normalise forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap M_Gen -> [Rational]
m_gen_unfold

-- * M3-Gen

-- | (ratio,M3-steps)
type M3_Gen = (Rational,Int)

m3_to_m :: M3_Gen -> M_Gen
m3_to_m :: M3_Gen -> M_Gen
m3_to_m (Rational
r,Int
n) = (Rational
r,Rational
3,Int
n)

-- > map m3_gen_unfold [(3,4),(21/9,4),(15/9,4),(35/9,3),(21/5,4),(27/5,3)]
m3_gen_unfold :: M3_Gen -> [Rational]
m3_gen_unfold :: M3_Gen -> [Rational]
m3_gen_unfold = M_Gen -> [Rational]
m_gen_unfold forall b c a. (b -> c) -> (a -> b) -> a -> c
. M3_Gen -> M_Gen
m3_to_m

m3_gen_to_r :: [M3_Gen] -> [Rational]
m3_gen_to_r :: [M3_Gen] -> [Rational]
m3_gen_to_r = [Rational] -> [Rational]
r_normalise forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap M3_Gen -> [Rational]
m3_gen_unfold

-- * Scala

r_to_scale :: String -> String -> [Rational] -> Scala.Scale
r_to_scale :: String -> String -> [Rational] -> Scale
r_to_scale String
nm String
dsc [Rational]
r =
  let r' :: [Rational]
r' = forall a b. (a -> b) -> [a] -> [b]
map forall n. (Ord n, Fractional n) => n -> n
Tuning.fold_ratio_to_octave_err (forall a. [a] -> [a]
tail [Rational]
r) forall a. [a] -> [a] -> [a]
++ [Rational
2]
  in if [Rational]
r forall a. [a] -> Int -> a
!! Int
0 forall a. Eq a => a -> a -> Bool
/= Rational
1 Bool -> Bool -> Bool
|| Bool -> Bool
not (forall a. Ord a => [a] -> Bool
List.is_ascending [Rational]
r')
     then forall a. HasCallStack => String -> a
error String
"r_to_scale?"
     else (String
nm,String
dsc,forall (t :: * -> *) a. Foldable t => t a -> Int
length [Rational]
r,forall a b. (a -> b) -> [a] -> [b]
map forall a b. b -> Either a b
Right [Rational]
r')

ew_scl_find_r :: [Rational] -> [Scala.Scale] -> [String]
ew_scl_find_r :: [Rational] -> [Scale] -> [String]
ew_scl_find_r [Rational]
r =
  let set_eq :: [a] -> [a] -> Bool
set_eq [a]
x [a]
y = forall a. Ord a => [a] -> [a]
sort [a]
x forall a. Eq a => a -> a -> Bool
== forall a. Ord a => [a] -> [a]
sort [a]
y
      r' :: [Rational]
r' = forall a b. (a -> b) -> [a] -> [b]
map forall n. (Ord n, Fractional n) => n -> n
Tuning.fold_ratio_to_octave_err [Rational]
r
  in if forall a. [a] -> a
head [Rational]
r' forall a. Eq a => a -> a -> Bool
/= Rational
1
     then forall a. HasCallStack => String -> a
error String
"ew_scl_find_r?: r'0 /= 1"
     else forall a b. (a -> b) -> [a] -> [b]
map Scale -> String
Scala.scale_name forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Rational] -> [Rational] -> Bool)
-> [Rational] -> [Scale] -> [Scale]
Scala.scl_find_ji forall {a}. Ord a => [a] -> [a] -> Bool
set_eq ([Rational]
r' forall a. [a] -> [a] -> [a]
++ [Rational
2])

-- * <http://anaphoria.com/1-3-5-7-9Genus.pdf>

ew_1357_3_gen :: [M3_Gen]
ew_1357_3_gen :: [M3_Gen]
ew_1357_3_gen = [(Rational
3,Int
4),(Rational
21forall a. Fractional a => a -> a -> a
/Rational
9,Int
4),(Rational
15forall a. Fractional a => a -> a -> a
/Rational
9,Int
4),(Rational
35forall a. Fractional a => a -> a -> a
/Rational
9,Int
3),(Rational
21forall a. Fractional a => a -> a -> a
/Rational
5,Int
4),(Rational
27forall a. Fractional a => a -> a -> a
/Rational
5,Int
3)]

{- | P.3 7-limit {Scala=nil}

> db <- Scala.scl_load_db
> ew_scl_find_r (1 : ew_1357_3_r) db
-}
ew_1357_3_r :: [Rational]
ew_1357_3_r :: [Rational]
ew_1357_3_r = [Rational] -> [Rational]
r_normalise (forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap M3_Gen -> [Rational]
m3_gen_unfold [M3_Gen]
ew_1357_3_gen)

ew_1357_3_scl :: Scala.Scale
ew_1357_3_scl :: Scale
ew_1357_3_scl = String -> String -> [Rational] -> Scale
r_to_scale String
"ew_1357_3" String
"EW, 1-3-5-7-9Genus.pdf, P.3" (Rational
1 forall a. a -> [a] -> [a]
: [Rational]
ew_1357_3_r)

-- * <http://anaphoria.com/earlylattices12.pdf>

{- | P.7 11-limit {Scala=nil}

> ew_scl_find_r ew_el12_7_r db
-}
ew_el12_7_r :: [Rational]
ew_el12_7_r :: [Rational]
ew_el12_7_r = [Rational
1,Rational
5forall a. Fractional a => a -> a -> a
/(Rational
7forall a. Num a => a -> a -> a
*Rational
11),Rational
1forall a. Fractional a => a -> a -> a
/Rational
7,Rational
7forall a. Num a => a -> a -> a
*Rational
11,Rational
7forall a. Num a => a -> a -> a
*Rational
11forall a. Num a => a -> a -> a
*Rational
11forall a. Fractional a => a -> a -> a
/Rational
5,Rational
11,Rational
5forall a. Fractional a => a -> a -> a
/Rational
7,Rational
1forall a. Fractional a => a -> a -> a
/Rational
11,Rational
7forall a. Num a => a -> a -> a
*Rational
11forall a. Num a => a -> a -> a
*Rational
11,Rational
1forall a. Fractional a => a -> a -> a
/(Rational
7forall a. Num a => a -> a -> a
*Rational
11),Rational
11forall a. Num a => a -> a -> a
*Rational
11,Rational
7forall a. Num a => a -> a -> a
*Rational
11forall a. Fractional a => a -> a -> a
/Rational
5]

ew_el12_7_scl :: Scala.Scale
ew_el12_7_scl :: Scale
ew_el12_7_scl = String -> String -> [Rational] -> Scale
r_to_scale String
"ew_el12_7" String
"EW, earlylattices12.pdf, P.7" [Rational]
ew_el12_7_r

{- | P.9 7-limit {Scala=wilson_class}

> ew_scl_find_r ew_el12_9_r db
-}
ew_el12_9_r :: [Rational]
ew_el12_9_r :: [Rational]
ew_el12_9_r = [Rational
1,Rational
5forall a. Num a => a -> a -> a
*Rational
5forall a. Fractional a => a -> a -> a
/Rational
3,Rational
7forall a. Fractional a => a -> a -> a
/(Rational
5forall a. Num a => a -> a -> a
*Rational
5),Rational
7forall a. Fractional a => a -> a -> a
/Rational
3,Rational
5,Rational
1forall a. Fractional a => a -> a -> a
/Rational
3,Rational
7forall a. Fractional a => a -> a -> a
/Rational
5,Rational
5forall a. Num a => a -> a -> a
*Rational
7forall a. Fractional a => a -> a -> a
/Rational
3,Rational
1forall a. Fractional a => a -> a -> a
/Rational
5,Rational
5forall a. Fractional a => a -> a -> a
/Rational
3,Rational
7,Rational
7forall a. Fractional a => a -> a -> a
/(Rational
3forall a. Num a => a -> a -> a
*Rational
5)]

--ew_el12_9_scl :: Scala.Scale
--ew_el12_9_scl = r_to_scale "ew_el12_9" "EW, earlylattices12.pdf, P.9" ew_el12_9_r

{- | P.12 11-limit {Scala=nil}

> ew_scl_find_r ew_el12_12_r db
-}
ew_el12_12_r :: [Rational]
ew_el12_12_r :: [Rational]
ew_el12_12_r = [Rational
1,Rational
3forall a. Num a => a -> a -> a
*Rational
3forall a. Num a => a -> a -> a
*Rational
5forall a. Fractional a => a -> a -> a
/Rational
11,Rational
3forall a. Fractional a => a -> a -> a
/Rational
11,Rational
7forall a. Fractional a => a -> a -> a
/Rational
3,Rational
5,Rational
7forall a. Fractional a => a -> a -> a
/Rational
11,Rational
3forall a. Num a => a -> a -> a
*Rational
5forall a. Fractional a => a -> a -> a
/Rational
11,Rational
5forall a. Num a => a -> a -> a
*Rational
7forall a. Fractional a => a -> a -> a
/Rational
3,Rational
7forall a. Fractional a => a -> a -> a
/(Rational
3forall a. Num a => a -> a -> a
*Rational
3),Rational
5forall a. Num a => a -> a -> a
*Rational
7forall a. Fractional a => a -> a -> a
/Rational
11,Rational
7forall a. Fractional a => a -> a -> a
/(Rational
3forall a. Num a => a -> a -> a
*Rational
11),Rational
3forall a. Num a => a -> a -> a
*Rational
5]

ew_el12_12_scl :: Scala.Scale
ew_el12_12_scl :: Scale
ew_el12_12_scl = String -> String -> [Rational] -> Scale
r_to_scale String
"ew_el12_12" String
"EW, earlylattices12.pdf, P.12" [Rational]
ew_el12_12_r

-- * <http://anaphoria.com/earlylattices22.pdf>

{- | P.2 11-limit {Scala=wilson_l4}

> ew_scl_find_r ew_el22_2_r db
-}
ew_el22_2_r :: [Rational]
ew_el22_2_r :: [Rational]
ew_el22_2_r =
  [Rational
1,Rational
7forall a. Num a => a -> a -> a
*Rational
7forall a. Fractional a => a -> a -> a
/Rational
3,Rational
3forall a. Num a => a -> a -> a
*Rational
7forall a. Fractional a => a -> a -> a
/Rational
5,Rational
5forall a. Fractional a => a -> a -> a
/(Rational
3forall a. Num a => a -> a -> a
*Rational
3),Rational
1forall a. Fractional a => a -> a -> a
/Rational
7,Rational
7forall a. Fractional a => a -> a -> a
/Rational
3,Rational
3forall a. Fractional a => a -> a -> a
/Rational
5,Rational
5,Rational
5forall a. Num a => a -> a -> a
*Rational
7forall a. Fractional a => a -> a -> a
/(Rational
3forall a. Num a => a -> a -> a
*Rational
3forall a. Num a => a -> a -> a
*Rational
3),Rational
1forall a. Fractional a => a -> a -> a
/Rational
3,Rational
7forall a. Num a => a -> a -> a
*Rational
7forall a. Fractional a => a -> a -> a
/(Rational
3forall a. Num a => a -> a -> a
*Rational
3)
  ,Rational
7forall a. Fractional a => a -> a -> a
/Rational
5,Rational
5forall a. Num a => a -> a -> a
*Rational
7forall a. Fractional a => a -> a -> a
/Rational
3,Rational
3,Rational
7forall a. Fractional a => a -> a -> a
/(Rational
3forall a. Num a => a -> a -> a
*Rational
3),Rational
1forall a. Fractional a => a -> a -> a
/Rational
5,Rational
5forall a. Fractional a => a -> a -> a
/Rational
3,Rational
3forall a. Fractional a => a -> a -> a
/Rational
7,Rational
7,Rational
3forall a. Num a => a -> a -> a
*Rational
3forall a. Fractional a => a -> a -> a
/Rational
5,Rational
7forall a. Fractional a => a -> a -> a
/(Rational
3forall a. Num a => a -> a -> a
*Rational
5),Rational
5forall a. Num a => a -> a -> a
*Rational
7forall a. Fractional a => a -> a -> a
/(Rational
3forall a. Num a => a -> a -> a
*Rational
3)]

{- | P.3 11-limit {Scala=wilson_l5}

> ew_scl_find_r ew_el22_3_r db
-}
ew_el22_3_r :: [Rational]
ew_el22_3_r :: [Rational]
ew_el22_3_r =
  [Rational
1,Rational
7forall a. Num a => a -> a -> a
*Rational
7forall a. Fractional a => a -> a -> a
/Rational
3,Rational
7forall a. Num a => a -> a -> a
*Rational
11forall a. Fractional a => a -> a -> a
/(Rational
3forall a. Num a => a -> a -> a
*Rational
3),Rational
3forall a. Fractional a => a -> a -> a
/Rational
11,Rational
1forall a. Fractional a => a -> a -> a
/Rational
7,Rational
7forall a. Fractional a => a -> a -> a
/Rational
3,Rational
3forall a. Fractional a => a -> a -> a
/Rational
5,Rational
5,Rational
7forall a. Fractional a => a -> a -> a
/Rational
11,Rational
1forall a. Fractional a => a -> a -> a
/Rational
3,Rational
7forall a. Num a => a -> a -> a
*Rational
7forall a. Fractional a => a -> a -> a
/(Rational
3forall a. Num a => a -> a -> a
*Rational
3)
  ,Rational
7forall a. Fractional a => a -> a -> a
/Rational
5,Rational
5forall a. Num a => a -> a -> a
*Rational
7forall a. Fractional a => a -> a -> a
/Rational
3,Rational
3,Rational
7forall a. Fractional a => a -> a -> a
/(Rational
3forall a. Num a => a -> a -> a
*Rational
3),Rational
1forall a. Fractional a => a -> a -> a
/Rational
5,Rational
5forall a. Fractional a => a -> a -> a
/Rational
3,Rational
3forall a. Fractional a => a -> a -> a
/Rational
7,Rational
7,Rational
11forall a. Fractional a => a -> a -> a
/Rational
3,Rational
7forall a. Fractional a => a -> a -> a
/(Rational
3forall a. Num a => a -> a -> a
*Rational
5),Rational
5forall a. Num a => a -> a -> a
*Rational
7forall a. Fractional a => a -> a -> a
/(Rational
3forall a. Num a => a -> a -> a
*Rational
3)]

{- | P.4 11-limit {Scala=wilson_l3}

> ew_scl_find_r ew_el22_4_r db
-}
ew_el22_4_r :: [Rational]
ew_el22_4_r :: [Rational]
ew_el22_4_r =
  [Rational
1,Rational
3forall a. Num a => a -> a -> a
*Rational
11,Rational
3forall a. Num a => a -> a -> a
*Rational
7forall a. Fractional a => a -> a -> a
/Rational
5,Rational
5forall a. Num a => a -> a -> a
*Rational
7,Rational
3forall a. Num a => a -> a -> a
*Rational
3,Rational
7forall a. Fractional a => a -> a -> a
/Rational
3,Rational
3forall a. Fractional a => a -> a -> a
/Rational
5,Rational
5,Rational
7forall a. Fractional a => a -> a -> a
/Rational
11,Rational
3forall a. Num a => a -> a -> a
*Rational
7,Rational
11
  ,Rational
7forall a. Fractional a => a -> a -> a
/Rational
5,Rational
5forall a. Num a => a -> a -> a
*Rational
7forall a. Fractional a => a -> a -> a
/Rational
3,Rational
3,Rational
7forall a. Fractional a => a -> a -> a
/(Rational
3forall a. Num a => a -> a -> a
*Rational
3),Rational
1forall a. Fractional a => a -> a -> a
/Rational
5,Rational
3forall a. Num a => a -> a -> a
*Rational
5forall a. Num a => a -> a -> a
*Rational
7,Rational
3forall a. Num a => a -> a -> a
*Rational
3forall a. Num a => a -> a -> a
*Rational
3,Rational
7,Rational
3forall a. Num a => a -> a -> a
*Rational
3forall a. Fractional a => a -> a -> a
/Rational
5,Rational
3forall a. Num a => a -> a -> a
*Rational
5,Rational
3forall a. Num a => a -> a -> a
*Rational
7forall a. Fractional a => a -> a -> a
/Rational
11]

{- | P.5 11-limit {Scala=wilson_l1}

> ew_scl_find_r ew_el22_5_r db
-}
ew_el22_5_r :: [Rational]
ew_el22_5_r :: [Rational]
ew_el22_5_r =
  [Rational
1,Rational
3forall a. Num a => a -> a -> a
*Rational
11,Rational
3forall a. Num a => a -> a -> a
*Rational
7forall a. Fractional a => a -> a -> a
/Rational
5,Rational
5forall a. Num a => a -> a -> a
*Rational
7,Rational
3forall a. Num a => a -> a -> a
*Rational
3,Rational
7forall a. Fractional a => a -> a -> a
/Rational
3,Rational
7forall a. Num a => a -> a -> a
*Rational
11,Rational
5,Rational
3forall a. Num a => a -> a -> a
*Rational
5forall a. Num a => a -> a -> a
*Rational
11,Rational
3forall a. Num a => a -> a -> a
*Rational
7,Rational
11
  ,Rational
7forall a. Fractional a => a -> a -> a
/Rational
5,Rational
3forall a. Num a => a -> a -> a
*Rational
7forall a. Num a => a -> a -> a
*Rational
11forall a. Fractional a => a -> a -> a
/Rational
5,Rational
3,Rational
3forall a. Num a => a -> a -> a
*Rational
3forall a. Num a => a -> a -> a
*Rational
11,Rational
7forall a. Num a => a -> a -> a
*Rational
11forall a. Fractional a => a -> a -> a
/Rational
3,Rational
3forall a. Num a => a -> a -> a
*Rational
11forall a. Fractional a => a -> a -> a
/Rational
5,Rational
5forall a. Num a => a -> a -> a
*Rational
11,Rational
7,Rational
3forall a. Num a => a -> a -> a
*Rational
7forall a. Num a => a -> a -> a
*Rational
11,Rational
3forall a. Num a => a -> a -> a
*Rational
5,Rational
7forall a. Num a => a -> a -> a
*Rational
11forall a. Fractional a => a -> a -> a
/Rational
5]

{- | P.6 11-limit {Scala=wilson_l2}

> ew_scl_find_r ew_el22_6_r db
-}
ew_el22_6_r :: [Rational]
ew_el22_6_r :: [Rational]
ew_el22_6_r =
  [Rational
1,Rational
7forall a. Num a => a -> a -> a
*Rational
7forall a. Fractional a => a -> a -> a
/Rational
3,Rational
7forall a. Num a => a -> a -> a
*Rational
11forall a. Fractional a => a -> a -> a
/(Rational
3forall a. Num a => a -> a -> a
*Rational
3),Rational
11forall a. Fractional a => a -> a -> a
/Rational
5,Rational
3forall a. Num a => a -> a -> a
*Rational
3,Rational
7forall a. Fractional a => a -> a -> a
/Rational
3,Rational
7forall a. Num a => a -> a -> a
*Rational
11,Rational
5,Rational
7forall a. Num a => a -> a -> a
*Rational
11forall a. Fractional a => a -> a -> a
/(Rational
3forall a. Num a => a -> a -> a
*Rational
5),Rational
1forall a. Fractional a => a -> a -> a
/Rational
3,Rational
11
  ,Rational
7forall a. Num a => a -> a -> a
*Rational
11forall a. Fractional a => a -> a -> a
/(Rational
3forall a. Num a => a -> a -> a
*Rational
3forall a. Num a => a -> a -> a
*Rational
3),Rational
5forall a. Num a => a -> a -> a
*Rational
7forall a. Fractional a => a -> a -> a
/Rational
3,Rational
3,Rational
11forall a. Fractional a => a -> a -> a
/Rational
7,Rational
7forall a. Num a => a -> a -> a
*Rational
11forall a. Fractional a => a -> a -> a
/Rational
3,Rational
5forall a. Fractional a => a -> a -> a
/Rational
3,Rational
7forall a. Num a => a -> a -> a
*Rational
11forall a. Fractional a => a -> a -> a
/(Rational
3forall a. Num a => a -> a -> a
*Rational
3forall a. Num a => a -> a -> a
*Rational
5),Rational
7,Rational
11forall a. Fractional a => a -> a -> a
/Rational
3,Rational
3forall a. Num a => a -> a -> a
*Rational
5,Rational
7forall a. Num a => a -> a -> a
*Rational
11forall a. Fractional a => a -> a -> a
/Rational
5]

-- * <http://anaphoria.com/diamond.pdf>

ew_diamond_mk :: [Integer] -> [Rational]
ew_diamond_mk :: [Integer] -> [Rational]
ew_diamond_mk [Integer]
u = [Rational] -> [Rational]
r_normalise [Integer
x forall a. Integral a => a -> a -> Ratio a
% Integer
y | Integer
x <- [Integer]
u, Integer
y <- [Integer]
u]

-- > m3_gen_to_r ew_diamond_12_gen == ew_diamond_12_r
ew_diamond_12_gen :: [M3_Gen]
ew_diamond_12_gen :: [M3_Gen]
ew_diamond_12_gen =
  [(Rational
1forall a. Fractional a => a -> a -> a
/(Rational
3Rational -> Int -> Rational
^.Int
2),Int
5),(Rational
5forall a. Fractional a => a -> a -> a
/(Rational
3Rational -> Int -> Rational
^.Int
2),Int
3),(Rational
7forall a. Fractional a => a -> a -> a
/(Rational
3Rational -> Int -> Rational
^.Int
2),Int
3),(Rational
11forall a. Fractional a => a -> a -> a
/(Rational
3Rational -> Int -> Rational
^.Int
2),Int
3)
  ,(Rational
1forall a. Fractional a => a -> a -> a
/Rational
5,Int
3),(Rational
1forall a. Fractional a => a -> a -> a
/Rational
7,Int
3),(Rational
1forall a. Fractional a => a -> a -> a
/Rational
11,Int
3)
  ,(Rational
5forall a. Fractional a => a -> a -> a
/Rational
7,Int
1),(Rational
5forall a. Fractional a => a -> a -> a
/Rational
11,Int
1),(Rational
7forall a. Fractional a => a -> a -> a
/Rational
5,Int
1),(Rational
7forall a. Fractional a => a -> a -> a
/Rational
11,Int
1),(Rational
11forall a. Fractional a => a -> a -> a
/Rational
5,Int
1),(Rational
11forall a. Fractional a => a -> a -> a
/Rational
7,Int
1)]

{- | 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_12_r :: [Rational]
ew_diamond_12_r :: [Rational]
ew_diamond_12_r = [Integer] -> [Rational]
ew_diamond_mk [Integer
1,Integer
3,Integer
5,Integer
7,Integer
9,Integer
11]

{- | 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
-}
ew_diamond_13_r :: [Rational]
ew_diamond_13_r :: [Rational]
ew_diamond_13_r = [Integer] -> [Rational]
ew_diamond_mk [Integer
1,Integer
3,Integer
5,Integer
7,Integer
9,Integer
11,Integer
13,Integer
15]

-- * <http://anaphoria.com/hel.pdf>

hel_r_asc :: (Integer,Integer) -> [Rational]
hel_r_asc :: Rat -> [Rational]
hel_r_asc (Integer
n,Integer
d) = Integer
nforall a. Integral a => a -> a -> Ratio a
%Integer
d forall a. a -> [a] -> [a]
: Rat -> [Rational]
hel_r_asc (Integer
nforall a. Num a => a -> a -> a
+Integer
1,Integer
dforall a. Num a => a -> a -> a
+Integer
1)

type HEL = ([Rational],[Rational])

-- | P.6
hel_1_i :: HEL
hel_1_i :: HEL
hel_1_i =
  let i :: [Rational]
i = forall a. Int -> [a] -> [a]
take Int
6 (Rat -> [Rational]
hel_r_asc (Integer
7,Integer
6))
  in (forall a. Int -> [a] -> [a]
take Int
5 [Rational]
i,forall a. Int -> [a] -> [a]
take Int
5 (forall a. Int -> [a] -> [a]
List.rotate_left Int
2 [Rational]
i))

-- | P.6
hel_2_i :: HEL
hel_2_i :: HEL
hel_2_i =
  let i :: [Rational]
i = forall a. Int -> [a] -> [a]
take Int
10 (Rat -> [Rational]
hel_r_asc (Integer
9,Integer
8))
  in (forall a. Int -> [a] -> [a]
take Int
8 (forall a. Int -> [a] -> [a]
List.rotate_left Int
3 (forall a. [a] -> [a]
tail [Rational]
i))
     ,forall a. Int -> [a] -> [a]
take Int
7 [Rational]
i)

-- | P.10
hel_3_i :: HEL
hel_3_i :: HEL
hel_3_i =
  let i :: [Rational]
i = forall a. Int -> [a] -> [a]
take Int
16 (Rat -> [Rational]
hel_r_asc (Integer
15,Integer
14))
  in (forall a. Int -> [a] -> [a]
take Int
13 (forall a. Int -> [a] -> [a]
List.rotate_left Int
6 (forall a. Int -> [a] -> [a]
take Int
14 [Rational]
i)),forall a. Int -> [a] -> [a]
take Int
14 (forall a. [a] -> [a]
tail [Rational]
i))

hel_r :: HEL -> [[Rational]]
hel_r :: HEL -> [[Rational]]
hel_r ([Rational]
p,[Rational]
q) =
  let i_to_r :: [Rational] -> [Rational]
i_to_r = forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanl forall a. Num a => a -> a -> a
(*) Rational
1
  in [[Rational] -> [Rational]
i_to_r [Rational]
p,[Rational] -> [Rational]
i_to_r [Rational]
q,[Rational] -> [Rational]
r_normalise (forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Rational] -> [Rational]
i_to_r [Rational]
p,[Rational] -> [Rational]
i_to_r [Rational]
q])]

{- | P.12 {Scala=nil}

22-tone 23-limit Evangalina tuning (2001)

> ew_scl_find_r ew_hel_12_r db
-}
ew_hel_12_r :: [Rational]
ew_hel_12_r :: [Rational]
ew_hel_12_r =
  [Rational
1,Rational
3forall a. Num a => a -> a -> a
*Rational
3forall a. Num a => a -> a -> a
*Rational
3forall a. Num a => a -> a -> a
*Rational
5,Rational
13forall a. Fractional a => a -> a -> a
/Rational
3,Rational
5forall a. Fractional a => a -> a -> a
/(Rational
3forall a. Num a => a -> a -> a
*Rational
3),Rational
3forall a. Num a => a -> a -> a
*Rational
3,Rational
7forall a. Fractional a => a -> a -> a
/Rational
3,Rational
11forall a. Fractional a => a -> a -> a
/(Rational
3forall a. Num a => a -> a -> a
*Rational
3),Rational
5,Rational
3forall a. Num a => a -> a -> a
*Rational
3forall a. Num a => a -> a -> a
*Rational
3forall a. Num a => a -> a -> a
*Rational
3,Rational
1forall a. Fractional a => a -> a -> a
/Rational
3,Rational
11
  ,Rational
3forall a. Num a => a -> a -> a
*Rational
3forall a. Num a => a -> a -> a
*Rational
5,Rational
17forall a. Fractional a => a -> a -> a
/Rational
3,Rational
3,Rational
3forall a. Num a => a -> a -> a
*Rational
3forall a. Num a => a -> a -> a
*Rational
3forall a. Num a => a -> a -> a
*Rational
3forall a. Num a => a -> a -> a
*Rational
5,Rational
13,Rational
5forall a. Fractional a => a -> a -> a
/Rational
3,Rational
3forall a. Num a => a -> a -> a
*Rational
3forall a. Num a => a -> a -> a
*Rational
3,Rational
7,Rational
11forall a. Fractional a => a -> a -> a
/Rational
3,Rational
3forall a. Num a => a -> a -> a
*Rational
5,Rational
23forall a. Fractional a => a -> a -> a
/Rational
3]

ew_hel_12_scl :: Scala.Scale
ew_hel_12_scl :: Scale
ew_hel_12_scl = String -> String -> [Rational] -> Scale
r_to_scale String
"ew_hel_12" String
"EW, hel.pdf, P.12" [Rational]
ew_hel_12_r

-- * <http://anaphoria.com/HexanyStellatesExpansions.pdf>

-- > she_div "ABCD" == [["BCD","A"],["ACD","B"],["ABD","C"],["ABC","D"]]
she_div :: Eq a => [a] -> [[[a]]]
she_div :: forall a. Eq a => [a] -> [[[a]]]
she_div [a]
x =
  let f :: [[a]] -> Bool
f = (forall a. Eq a => a -> a -> Bool
== [Int
1,forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
x forall a. Num a => a -> a -> a
- Int
1]) 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 a b. (a -> b) -> [a] -> [b]
map forall (t :: * -> *) a. Foldable t => t a -> Int
length
  in forall a b. (a -> b) -> [a] -> [b]
map (forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (forall a. a -> Down a
Down forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Int
length)) (forall a. (a -> Bool) -> [a] -> [a]
filter forall {a}. [[a]] -> Bool
f (forall a. Eq a => [a] -> [[[a]]]
Set.partitions [a]
x))

-- > she_div_r [1,3,5,7] == [105,35/3,21/5,15/7]
she_div_r :: [Rational] -> [Rational]
she_div_r :: [Rational] -> [Rational]
she_div_r =
  let f :: [[a]] -> a
f [[a]]
x =
        case [[a]]
x of
          [[a
a,a
b,a
c],[a
d]] -> (a
a forall a. Num a => a -> a -> a
* a
b forall a. Num a => a -> a -> a
* a
c) forall a. Fractional a => a -> a -> a
/ a
d
          [[a]]
_ -> forall a. HasCallStack => String -> a
error String
"she_div?"
  in forall a b. (a -> b) -> [a] -> [b]
map forall {a}. Fractional a => [[a]] -> a
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Eq a => [a] -> [[[a]]]
she_div

-- > she_mul_r [1,3,5,7] == [1,3,5,7,9,15,21,25,35,49]
she_mul_r :: [Rational] -> [Rational]
she_mul_r :: [Rational] -> [Rational]
she_mul_r [Rational]
r = [Rational
x forall a. Num a => a -> a -> a
* Rational
y | Rational
x <- [Rational]
r,Rational
y <- [Rational]
r,Rational
x forall a. Ord a => a -> a -> Bool
<= Rational
y]

{- | 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
-}
she :: [Rational] -> [Rational]
she :: [Rational] -> [Rational]
she [Rational]
r = forall a. Eq a => [a] -> [a]
nub (forall a. Ord a => [a] -> [a]
sort (forall a b. (a -> b) -> [a] -> [b]
map forall n. (Ord n, Fractional n) => n -> n
Tuning.fold_ratio_to_octave_err ([Rational] -> [Rational]
she_mul_r [Rational]
r forall a. [a] -> [a] -> [a]
++ [Rational] -> [Rational]
she_div_r [Rational]
r)))

-- * <http://anaphoria.com/meru.pdf>

-- > map (every_nth "abcdef") [1..3] == ["abcdef","ace","ad"]
every_nth :: [t] -> Int -> [t]
every_nth :: forall t. [t] -> Int -> [t]
every_nth [t]
l Int
k =
  case [t]
l of
    [] -> []
    t
x:[t]
_ -> t
x forall a. a -> [a] -> [a]
: forall t. [t] -> Int -> [t]
every_nth (forall a. Int -> [a] -> [a]
drop Int
k [t]
l) Int
k

meru :: Num n => [[n]]
meru :: forall n. Num n => [[n]]
meru =
  let f :: [c] -> [c]
f [c]
xs = forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith forall a. Num a => a -> a -> a
(+) (c
0 forall a. a -> [a] -> [a]
: [c]
xs) ([c]
xs forall a. [a] -> [a] -> [a]
++ [c
0])
  in forall a. (a -> a) -> a -> [a]
iterate forall {c}. Num c => [c] -> [c]
f [n
1]

-- > meru_k 13
meru_k :: Num n => Int -> [[n]]
meru_k :: forall n. Num n => Int -> [[n]]
meru_k Int
k = forall a. Int -> [a] -> [a]
take Int
k forall n. Num n => [[n]]
meru

-- > map (sum . meru_1) [1 .. 13] == [1,1,2,3,5,8,13,21,34,55,89,144,233]
meru_1 :: Num n => Int -> [n]
meru_1 :: forall n. Num n => Int -> [n]
meru_1 Int
k = forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (forall a b c. (a -> b -> c) -> b -> a -> c
flip (forall a. a -> [a] -> Int -> a
Safe.atDef n
0)) [Int
0..] (forall a. [a] -> [a]
reverse (forall n. Num n => Int -> [[n]]
meru_k Int
k))

-- > take 13 meru_1_direct == [1,1,2,3,5,8,13,21,34,55,89,144,233]
meru_1_direct :: Num n => [n]
meru_1_direct :: forall n. Num n => [n]
meru_1_direct = forall a. [a] -> [a]
tail forall n. Num n => [n]
OEIS.a000045

-- | 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 :: Num n => Int -> [n]
meru_2 :: forall n. Num n => Int -> [n]
meru_2 Int
k = forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (forall a b c. (a -> b -> c) -> b -> a -> c
flip (forall a. a -> [a] -> Int -> a
Safe.atDef n
0)) [Int
0..] (forall t. [t] -> Int -> [t]
every_nth (forall a. [a] -> [a]
reverse (forall n. Num n => Int -> [[n]]
meru_k Int
k)) Int
2)

-- > take 14 meru_2_direct == [1,1,1,2,3,4,6,9,13,19,28,41,60,88]
meru_2_direct :: Num n => [n]
meru_2_direct :: forall n. Num n => [n]
meru_2_direct = forall n. Num n => [n]
OEIS.a000930

-- | meru_3 = META-SLENDRO
meru_3 :: Num n => Int -> [[n]]
meru_3 :: forall n. Num n => Int -> [[n]]
meru_3 Int
k =
  let f :: [[c]] -> [c]
f [[c]]
t = forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (forall a b c. (a -> b -> c) -> b -> a -> c
flip (forall a. a -> [a] -> Int -> a
Safe.atDef c
0)) [Int
0,Int
2..] [[c]]
t
      t0 :: [[n]]
t0 = forall a. [a] -> [a]
reverse (forall n. Num n => Int -> [[n]]
meru_k Int
k)
      t1 :: [[n]]
t1 = forall a b. (a -> b) -> [a] -> [b]
map forall a. [a] -> [a]
tail [[n]]
t0
  in [forall {c}. Num c => [[c]] -> [c]
f [[n]]
t0,forall {c}. Num c => [[c]] -> [c]
f [[n]]
t1]

-- > map sum (meru_3_seq 13) == [1,0,1,1,1,2,2,3,4,5,7,9,12,16,21,28,37,49,65,86,114,151,200,265,351,465]
meru_3_seq :: Num n => Int -> [[n]]
meru_3_seq :: forall n. Num n => Int -> [[n]]
meru_3_seq Int
k = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall n. Num n => Int -> [[n]]
meru_3 [Int
1 .. Int
k]

-- > take 26 meru_3_direct == [1,0,1,1,1,2,2,3,4,5,7,9,12,16,21,28,37,49,65,86,114,151,200,265,351,465]
meru_3_direct :: Num n => [n]
meru_3_direct :: forall n. Num n => [n]
meru_3_direct = forall a. Int -> [a] -> [a]
drop Int
3 forall n. Num n => [n]
OEIS.a000931

-- > map (sum . meru_4) [1 .. 13] == [1,1,1,1,2,3,4,5,7,10,14,19,26]
meru_4 :: Num n => Int -> [n]
meru_4 :: forall n. Num n => Int -> [n]
meru_4 Int
k = forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (forall a b c. (a -> b -> c) -> b -> a -> c
flip (forall a. a -> [a] -> Int -> a
Safe.atDef n
0)) [Int
0..] (forall t. [t] -> Int -> [t]
every_nth (forall a. [a] -> [a]
reverse (forall n. Num n => Int -> [[n]]
meru_k Int
k)) Int
3)

-- > take 31 meru_4_direct == map (sum . meru_4) [1 .. 31]
meru_4_direct :: Num n => [n]
meru_4_direct :: forall n. Num n => [n]
meru_4_direct = forall a. [a] -> [a]
tail forall n. Num n => [n]
OEIS.a003269

-- > map meru_5 [1..4]
meru_5 :: Num n => Int -> [[n]]
meru_5 :: forall n. Num n => Int -> [[n]]
meru_5 Int
k =
  let f :: [[c]] -> [c]
f [[c]]
t = forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (forall a b c. (a -> b -> c) -> b -> a -> c
flip (forall a. a -> [a] -> Int -> a
Safe.atDef c
0)) [Int
0,Int
3..] [[c]]
t
      t0 :: [[n]]
t0 = forall a. [a] -> [a]
reverse (forall n. Num n => Int -> [[n]]
meru_k Int
k)
  in forall a b. (a -> b) -> [a] -> [b]
map (\Int
n -> forall {c}. Num c => [[c]] -> [c]
f (forall a b. (a -> b) -> [a] -> [b]
map (forall a. Int -> [a] -> [a]
drop Int
n) [[n]]
t0)) [Int
0 .. Int
2]

-- > map sum (meru_5_seq 13)
meru_5_seq :: Num n => Int -> [[n]]
meru_5_seq :: forall n. Num n => Int -> [[n]]
meru_5_seq Int
k = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall n. Num n => Int -> [[n]]
meru_5 [Int
1 .. Int
k]

-- > take 39 meru_5_direct == map sum (meru_5_seq 13)
meru_5_direct :: Num n => [n]
meru_5_direct :: forall n. Num n => [n]
meru_5_direct = forall n. Num n => [n]
OEIS.a017817

-- > map (sum . meru_6) [1 .. 21] == [1,1,1,1,1,2,3,4,5,6,8,11,15,20,26,34,45,60,80,106,140]
meru_6 :: Num n => Int -> [n]
meru_6 :: forall n. Num n => Int -> [n]
meru_6 Int
k = forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (forall a b c. (a -> b -> c) -> b -> a -> c
flip (forall a. a -> [a] -> Int -> a
Safe.atDef n
0)) [Int
0..] (forall t. [t] -> Int -> [t]
every_nth (forall a. [a] -> [a]
reverse (forall n. Num n => Int -> [[n]]
meru_k Int
k)) Int
4)

-- > take 21 meru_6_direct == map (sum . meru_6) [1 .. 21]
meru_6_direct :: Num n => [n]
meru_6_direct :: forall n. Num n => [n]
meru_6_direct = forall n. Num n => [n]
OEIS.a003520

-- > take 26 meru_7_direct == [0,1,0,1,0,1,1,1,2,1,3,2,4,4,5,7,7,11,11,16,18,23,29,34,45,52]
meru_7_direct :: Num n => [n]
meru_7_direct :: forall n. Num n => [n]
meru_7_direct = forall n. Num n => [n]
OEIS.a001687

-- * <http://anaphoria.com/mos.pdf>

{- | P.13, tanabe {Scala=chin_7}

> ew_scl_find_r ew_mos_13_tanabe_r db
-}
ew_mos_13_tanabe_r :: [Rational]
ew_mos_13_tanabe_r :: [Rational]
ew_mos_13_tanabe_r = [Rational
1,Rational
9forall a. Fractional a => a -> a -> a
/Rational
8,Rational
81forall a. Fractional a => a -> a -> a
/Rational
64,Rational
4forall a. Fractional a => a -> a -> a
/Rational
3,Rational
3forall a. Fractional a => a -> a -> a
/Rational
2,Rational
27forall a. Fractional a => a -> a -> a
/Rational
16,Rational
243forall a. Fractional a => a -> a -> a
/Rational
128]

-- * <http://anaphoria.com/novavotreediamond.pdf> (Novaro)

ew_novarotreediamond_1 :: ([[Rational]],[[Rational]])
ew_novarotreediamond_1 :: ([[Rational]], [[Rational]])
ew_novarotreediamond_1 =
  let rem_oct :: [t] -> [t]
rem_oct [t]
x = if forall a. [a] -> a
last [t]
x forall a. Eq a => a -> a -> Bool
/= t
2 then forall a. HasCallStack => String -> a
error String
"rem_oct?" else forall a. [a] -> [a]
List.drop_last [t]
x
      add_oct :: [a] -> [a]
add_oct [a]
x = if forall a. [a] -> a
last [a]
x forall a. Ord a => a -> a -> Bool
>= a
2 then forall a. HasCallStack => String -> a
error String
"add_oct?" else [a]
x forall a. [a] -> [a] -> [a]
++ [a
2]
      r_to_i :: [Rational] -> [Rational]
r_to_i = forall t u. (t -> t -> u) -> [t] -> [u]
List.d_dx_by forall a. Fractional a => a -> a -> a
(/) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a}. (Ord a, Num a) => [a] -> [a]
add_oct
      i_to_r :: [Rational] -> [Rational]
i_to_r = forall {t}. (Eq t, Num t) => [t] -> [t]
rem_oct forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanl forall a. Num a => a -> a -> a
(*) Rational
1
      r_0 :: [Rational]
r_0 = [Rational
1,Rational
5forall a. Fractional a => a -> a -> a
/Rational
4,Rational
4forall a. Fractional a => a -> a -> a
/Rational
3,Rational
3forall a. Fractional a => a -> a -> a
/Rational
2,Rational
5forall a. Fractional a => a -> a -> a
/Rational
3,Rational
7forall a. Fractional a => a -> a -> a
/Rational
4]
      i_0 :: [Rational]
i_0 = [Rational] -> [Rational]
r_to_i [Rational]
r_0
      i :: [[Rational]]
i = forall a. [a] -> [[a]]
List.rotations [Rational]
i_0
  in ([[Rational]]
i,forall a b. (a -> b) -> [a] -> [b]
map [Rational] -> [Rational]
i_to_r [[Rational]]
i)

{- | P.1 {Scala=nil}

23-tone 7-limit (2004)

> ew_scl_find_r ew_novarotreediamond_1_r db
-}
ew_novarotreediamond_1_r :: [Rational]
ew_novarotreediamond_1_r :: [Rational]
ew_novarotreediamond_1_r = [Rational] -> [Rational]
r_normalise (forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (forall a b. (a, b) -> b
snd ([[Rational]], [[Rational]])
ew_novarotreediamond_1))

ew_novarotreediamond_1_scl :: Scala.Scale
ew_novarotreediamond_1_scl :: Scale
ew_novarotreediamond_1_scl = String -> String -> [Rational] -> Scale
r_to_scale String
"ew_novarotreediamond_1" String
"EW, novavotreediamond.pdf, P.1" [Rational]
ew_novarotreediamond_1_r

-- * <http://anaphoria.com/Pelogflute.pdf>

{- | P.2 {Scala=nil}

9-tone Pelog cycle (1988)

> ew_scl_find_r ew_Pelogflute_2_r db
-}
ew_Pelogflute_2_r :: Fractional n => [n]
ew_Pelogflute_2_r :: forall n. Fractional n => [n]
ew_Pelogflute_2_r = [n
1,n
16forall a. Fractional a => a -> a -> a
/n
15,n
64forall a. Fractional a => a -> a -> a
/n
55,n
5forall a. Fractional a => a -> a -> a
/n
4,n
4forall a. Fractional a => a -> a -> a
/n
3,n
16forall a. Fractional a => a -> a -> a
/n
11,n
8forall a. Fractional a => a -> a -> a
/n
5,n
128forall a. Fractional a => a -> a -> a
/n
75,n
20forall a. Fractional a => a -> a -> a
/n
11]

ew_Pelogflute_2_scl :: Scala.Scale
ew_Pelogflute_2_scl :: Scale
ew_Pelogflute_2_scl = String -> String -> [Rational] -> Scale
r_to_scale String
"ew_Pelogflute_2" String
"EW, Pelogflute.pdf, P.2" forall n. Fractional n => [n]
ew_Pelogflute_2_r


-- * <http://anaphoria.com/xen1.pdf>

-- | P.9, Fig. 3
xen1_fig3 :: (Sbt_Node,Int)
xen1_fig3 :: (Sbt_Node, Int)
xen1_fig3 = ((SBT_DIV
NIL,(Integer
1,Integer
3),(Integer
2,Integer
5),(Integer
1,Integer
2)),Int
5)

-- | P.9, Fig. 4
xen1_fig4 :: (Sbt_Node,Int)
xen1_fig4 :: (Sbt_Node, Int)
xen1_fig4 = ((SBT_DIV
NIL,(Integer
2,Integer
5),(Integer
5,Integer
12),(Integer
3,Integer
7)),Int
5)

-- * <http://anaphoria.com/xen3b.pdf>

-- | P.3 Turkisk Baglama Scale {11-limit, Scala=nil}
ew_xen3b_3_gen :: [(Rational,Int)]
ew_xen3b_3_gen :: [M3_Gen]
ew_xen3b_3_gen = [(Rational
1forall a. Fractional a => a -> a -> a
/(Rational
3Rational -> Int -> Rational
^.Int
6),Int
12),(Rational
1forall a. Fractional a => a -> a -> a
/Rational
11,Int
2),(Rational
5forall a. Fractional a => a -> a -> a
/Rational
3,Int
3)]

ew_xen3b_3_r :: [Rational]
ew_xen3b_3_r :: [Rational]
ew_xen3b_3_r = [M3_Gen] -> [Rational]
m3_gen_to_r [M3_Gen]
ew_xen3b_3_gen

ew_xen3b_3_scl :: Scala.Scale
ew_xen3b_3_scl :: Scale
ew_xen3b_3_scl = String -> String -> [Rational] -> Scale
r_to_scale String
"ew_xen3b_3" String
"EW, xen3b.pdf, P.3" [Rational]
ew_xen3b_3_r

-- > map length xen3b_9_i == [5,7,12,19,31]
xen3b_9_i :: [[Rational]]
xen3b_9_i :: [[Rational]]
xen3b_9_i =
  [[Rational
6forall a. Fractional a => a -> a -> a
/Rational
5,                                             Rational
10forall a. Fractional a => a -> a -> a
/Rational
9,                          Rational
9forall a. Fractional a => a -> a -> a
/Rational
8,                           Rational
6forall a. Fractional a => a -> a -> a
/Rational
5,                                             Rational
10forall a. Fractional a => a -> a -> a
/Rational
9]
  ,[Rational
16forall a. Fractional a => a -> a -> a
/Rational
15,Rational
9forall a. Fractional a => a -> a -> a
/Rational
8,                                       Rational
10forall a. Fractional a => a -> a -> a
/Rational
9,                          Rational
9forall a. Fractional a => a -> a -> a
/Rational
8,                           Rational
16forall a. Fractional a => a -> a -> a
/Rational
15,Rational
9forall a. Fractional a => a -> a -> a
/Rational
8,                                       Rational
10forall a. Fractional a => a -> a -> a
/Rational
9]
  ,[Rational
16forall a. Fractional a => a -> a -> a
/Rational
15,Rational
135forall a. Fractional a => a -> a -> a
/Rational
128,Rational
16forall a. Fractional a => a -> a -> a
/Rational
15,                             Rational
25forall a. Fractional a => a -> a -> a
/Rational
24,Rational
16forall a. Fractional a => a -> a -> a
/Rational
15,                   Rational
16forall a. Fractional a => a -> a -> a
/Rational
15,Rational
135forall a. Fractional a => a -> a -> a
/Rational
128,                 Rational
16forall a. Fractional a => a -> a -> a
/Rational
15,Rational
135forall a. Fractional a => a -> a -> a
/Rational
128,Rational
16forall a. Fractional a => a -> a -> a
/Rational
15,                             Rational
25forall a. Fractional a => a -> a -> a
/Rational
24,Rational
16forall a. Fractional a => a -> a -> a
/Rational
15]
  ,[Rational
28forall a. Fractional a => a -> a -> a
/Rational
27,Rational
36forall a. Fractional a => a -> a -> a
/Rational
35,Rational
135forall a. Fractional a => a -> a -> a
/Rational
128,Rational
28forall a. Fractional a => a -> a -> a
/Rational
27,Rational
36forall a. Fractional a => a -> a -> a
/Rational
35,                 Rational
25forall a. Fractional a => a -> a -> a
/Rational
24,Rational
28forall a. Fractional a => a -> a -> a
/Rational
27,Rational
36forall a. Fractional a => a -> a -> a
/Rational
35,             Rational
28forall a. Fractional a => a -> a -> a
/Rational
27,Rational
36forall a. Fractional a => a -> a -> a
/Rational
35,Rational
135forall a. Fractional a => a -> a -> a
/Rational
128,           Rational
28forall a. Fractional a => a -> a -> a
/Rational
27,Rational
36forall a. Fractional a => a -> a -> a
/Rational
35,Rational
135forall a. Fractional a => a -> a -> a
/Rational
128,Rational
28forall a. Fractional a => a -> a -> a
/Rational
27,Rational
36forall a. Fractional a => a -> a -> a
/Rational
35,                 Rational
25forall a. Fractional a => a -> a -> a
/Rational
24,Rational
28forall a. Fractional a => a -> a -> a
/Rational
27,Rational
36forall a. Fractional a => a -> a -> a
/Rational
35]
  ,[Rational
64forall a. Fractional a => a -> a -> a
/Rational
63,Rational
49forall a. Fractional a => a -> a -> a
/Rational
48,Rational
36forall a. Fractional a => a -> a -> a
/Rational
35,Rational
45forall a. Fractional a => a -> a -> a
/Rational
44,Rational
33forall a. Fractional a => a -> a -> a
/Rational
32,Rational
64forall a. Fractional a => a -> a -> a
/Rational
63,Rational
49forall a. Fractional a => a -> a -> a
/Rational
48,Rational
36forall a. Fractional a => a -> a -> a
/Rational
35, Rational
45forall a. Fractional a => a -> a -> a
/Rational
44,Rational
55forall a. Fractional a => a -> a -> a
/Rational
54,Rational
64forall a. Fractional a => a -> a -> a
/Rational
63,Rational
49forall a. Fractional a => a -> a -> a
/Rational
48,Rational
36forall a. Fractional a => a -> a -> a
/Rational
35, Rational
64forall a. Fractional a => a -> a -> a
/Rational
63,Rational
49forall a. Fractional a => a -> a -> a
/Rational
48,Rational
36forall a. Fractional a => a -> a -> a
/Rational
35,Rational
45forall a. Fractional a => a -> a -> a
/Rational
44,Rational
33forall a. Fractional a => a -> a -> a
/Rational
32, Rational
64forall a. Fractional a => a -> a -> a
/Rational
63,Rational
49forall a. Fractional a => a -> a -> a
/Rational
48,Rational
36forall a. Fractional a => a -> a -> a
/Rational
35,Rational
45forall a. Fractional a => a -> a -> a
/Rational
44,Rational
33forall a. Fractional a => a -> a -> a
/Rational
32,Rational
64forall a. Fractional a => a -> a -> a
/Rational
63,Rational
49forall a. Fractional a => a -> a -> a
/Rational
48,Rational
36forall a. Fractional a => a -> a -> a
/Rational
35, Rational
45forall a. Fractional a => a -> a -> a
/Rational
44,Rational
55forall a. Fractional a => a -> a -> a
/Rational
54,Rational
64forall a. Fractional a => a -> a -> a
/Rational
63,Rational
49forall a. Fractional a => a -> a -> a
/Rational
48,Rational
36forall a. Fractional a => a -> a -> a
/Rational
35]]

{- | 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_9_r :: [[Rational]]
xen3b_9_r :: [[Rational]]
xen3b_9_r = forall a b. (a -> b) -> [a] -> [b]
map (forall a. [a] -> [a]
List.drop_last forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanl forall a. Num a => a -> a -> a
(*) Rational
1) [[Rational]]
xen3b_9_i

-- > map length xen3b_13_i == [5,7,12,17,22]
xen3b_13_i :: [[Rational]]
xen3b_13_i :: [[Rational]]
xen3b_13_i =
  [[Rational
7forall a. Fractional a => a -> a -> a
/Rational
6,                           Rational
8forall a. Fractional a => a -> a -> a
/Rational
7,                     Rational
9forall a. Fractional a => a -> a -> a
/Rational
8,                     Rational
7forall a. Fractional a => a -> a -> a
/Rational
6,                           Rational
8forall a. Fractional a => a -> a -> a
/Rational
7]
  ,[Rational
28forall a. Fractional a => a -> a -> a
/Rational
27,Rational
9forall a. Fractional a => a -> a -> a
/Rational
8,                     Rational
8forall a. Fractional a => a -> a -> a
/Rational
7,                     Rational
9forall a. Fractional a => a -> a -> a
/Rational
8,                     Rational
28forall a. Fractional a => a -> a -> a
/Rational
27,Rational
9forall a. Fractional a => a -> a -> a
/Rational
8,                     Rational
8forall a. Fractional a => a -> a -> a
/Rational
7]
  ,[Rational
28forall a. Fractional a => a -> a -> a
/Rational
27,Rational
243forall a. Fractional a => a -> a -> a
/Rational
224,Rational
28forall a. Fractional a => a -> a -> a
/Rational
27,           Rational
10forall a. Fractional a => a -> a -> a
/Rational
9,Rational
36forall a. Fractional a => a -> a -> a
/Rational
35,              Rational
28forall a. Fractional a => a -> a -> a
/Rational
27,Rational
243forall a. Fractional a => a -> a -> a
/Rational
224,           Rational
28forall a. Fractional a => a -> a -> a
/Rational
27,Rational
243forall a. Fractional a => a -> a -> a
/Rational
224,Rational
28forall a. Fractional a => a -> a -> a
/Rational
27,           Rational
10forall a. Fractional a => a -> a -> a
/Rational
9,Rational
36forall a. Fractional a => a -> a -> a
/Rational
35]
  ,[Rational
28forall a. Fractional a => a -> a -> a
/Rational
27,Rational
36forall a. Fractional a => a -> a -> a
/Rational
35,Rational
135forall a. Fractional a => a -> a -> a
/Rational
128,Rational
28forall a. Fractional a => a -> a -> a
/Rational
27,     Rational
36forall a. Fractional a => a -> a -> a
/Rational
35,Rational
175forall a. Fractional a => a -> a -> a
/Rational
162,Rational
36forall a. Fractional a => a -> a -> a
/Rational
35,     Rational
28forall a. Fractional a => a -> a -> a
/Rational
27,Rational
36forall a. Fractional a => a -> a -> a
/Rational
35,Rational
135forall a. Fractional a => a -> a -> a
/Rational
128,     Rational
28forall a. Fractional a => a -> a -> a
/Rational
27,Rational
36forall a. Fractional a => a -> a -> a
/Rational
35,Rational
135forall a. Fractional a => a -> a -> a
/Rational
128,Rational
28forall a. Fractional a => a -> a -> a
/Rational
27,     Rational
36forall a. Fractional a => a -> a -> a
/Rational
35,Rational
175forall a. Fractional a => a -> a -> a
/Rational
162,Rational
36forall a. Fractional a => a -> a -> a
/Rational
35]
  ,[Rational
28forall a. Fractional a => a -> a -> a
/Rational
27,Rational
36forall a. Fractional a => a -> a -> a
/Rational
35,Rational
25forall a. Fractional a => a -> a -> a
/Rational
24,Rational
81forall a. Fractional a => a -> a -> a
/Rational
80,Rational
28forall a. Fractional a => a -> a -> a
/Rational
27, Rational
36forall a. Fractional a => a -> a -> a
/Rational
35,Rational
25forall a. Fractional a => a -> a -> a
/Rational
24,Rational
28forall a. Fractional a => a -> a -> a
/Rational
27,Rational
36forall a. Fractional a => a -> a -> a
/Rational
35, Rational
28forall a. Fractional a => a -> a -> a
/Rational
27,Rational
36forall a. Fractional a => a -> a -> a
/Rational
35,Rational
25forall a. Fractional a => a -> a -> a
/Rational
24,Rational
81forall a. Fractional a => a -> a -> a
/Rational
80, Rational
28forall a. Fractional a => a -> a -> a
/Rational
27,Rational
36forall a. Fractional a => a -> a -> a
/Rational
35,Rational
25forall a. Fractional a => a -> a -> a
/Rational
24,Rational
81forall a. Fractional a => a -> a -> a
/Rational
80,Rational
28forall a. Fractional a => a -> a -> a
/Rational
27, Rational
36forall a. Fractional a => a -> a -> a
/Rational
35,Rational
25forall a. Fractional a => a -> a -> a
/Rational
24,Rational
28forall a. Fractional a => a -> a -> a
/Rational
27,Rational
36forall a. Fractional a => a -> a -> a
/Rational
35]]

-- | P.13 {SCALA 5=slendro5_2 7=ptolemy_diat2 12=nil 17=nil 22=wilson7_4}
xen3b_13_r :: [[Rational]]
xen3b_13_r :: [[Rational]]
xen3b_13_r = forall a b. (a -> b) -> [a] -> [b]
map (forall a. [a] -> [a]
List.drop_last forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanl forall a. Num a => a -> a -> a
(*) Rational
1) [[Rational]]
xen3b_13_i

-- * <http://anaphoria.com/xen3bappendix.pdf>

{- | PP.1-2 {SCALA: 22=wilson7_4}

17,31,41 lattices from XEN3B (1975)
-}
ew_xen3b_apx_gen :: [(Int,[M3_Gen])]
ew_xen3b_apx_gen :: [(Int, [M3_Gen])]
ew_xen3b_apx_gen =
  [(Int
17,[(Rational
1forall a. Fractional a => a -> a -> a
/Rational
729,Int
12)
       ,(Rational
5forall a. Fractional a => a -> a -> a
/Rational
3,Int
3)
       ,(Rational
11,Int
2)])
  ,(Int
31,[(Rational
1forall a. Fractional a => a -> a -> a
/Rational
3,Int
5)
       ,(Rational
5,Int
2),(Rational
1forall a. Fractional a => a -> a -> a
/(Rational
5forall a. Num a => a -> a -> a
*(Rational
3Rational -> Int -> Rational
^.Int
2)),Int
5)
       ,(Rational
7forall a. Fractional a => a -> a -> a
/(Rational
3Rational -> Int -> Rational
^.Int
4),Int
5),(Rational
1forall a. Fractional a => a -> a -> a
/(Rational
7forall a. Num a => a -> a -> a
*(Rational
3Rational -> Int -> Rational
^.Int
4)),Int
5)
       ,(Rational
1forall a. Fractional a => a -> a -> a
/Rational
11,Int
5)
       ,((Rational
1forall a. Fractional a => a -> a -> a
/Rational
3)forall a. Num a => a -> a -> a
*(Rational
1forall a. Fractional a => a -> a -> a
/Rational
7)forall a. Num a => a -> a -> a
*Rational
5,Int
2)
       ,((Rational
1forall a. Fractional a => a -> a -> a
/(Rational
7forall a. Num a => a -> a -> a
*(Rational
3Rational -> Int -> Rational
^.Int
3))) forall a. Num a => a -> a -> a
* Rational
5,Int
2)])
  ,(Int
41,[(Rational
1forall a. Fractional a => a -> a -> a
/(Rational
3Rational -> Int -> Rational
^.Int
6),Int
12)
       ,(Rational
5forall a. Fractional a => a -> a -> a
/(Rational
3Rational -> Int -> Rational
^.Int
3),Int
5),(Rational
1forall a. Fractional a => a -> a -> a
/(Rational
5forall a. Num a => a -> a -> a
*(Rational
3Rational -> Int -> Rational
^.Int
2)),Int
5)
       ,(Rational
7forall a. Fractional a => a -> a -> a
/(Rational
3Rational -> Int -> Rational
^.Int
4),Int
7),(Rational
1forall a. Fractional a => a -> a -> a
/(Rational
7forall a. Num a => a -> a -> a
*(Rational
3Rational -> Int -> Rational
^.Int
3)),Int
7)
       ,(Rational
11,Int
5)])
  ,(Int
22,[(Rational
1forall a. Fractional a => a -> a -> a
/Rational
3,Int
5)
       ,(Rational
5forall a. Fractional a => a -> a -> a
/(Rational
3Rational -> Int -> Rational
^.Int
3),Int
5),(Rational
1forall a. Fractional a => a -> a -> a
/(Rational
5forall a. Num a => a -> a -> a
*(Rational
3Rational -> Int -> Rational
^.Int
2)),Int
5)
       ,(Rational
7forall a. Fractional a => a -> a -> a
/(Rational
3Rational -> Int -> Rational
^.Int
4),Int
5)
       ,(Rational
7forall a. Fractional a => a -> a -> a
/(Rational
3Rational -> Int -> Rational
^.Int
3)forall a. Num a => a -> a -> a
*Rational
5,Int
2)])]

ew_xen3b_apx_r :: [(Int,[Rational])]
ew_xen3b_apx_r :: [(Int, [Rational])]
ew_xen3b_apx_r =
  let f :: (a, t M3_Gen) -> (a, [Rational])
f (a
k,t M3_Gen
g) = (a
k,[Rational] -> [Rational]
r_normalise (forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap M3_Gen -> [Rational]
m3_gen_unfold t M3_Gen
g))
  in forall a b. (a -> b) -> [a] -> [b]
map forall {t :: * -> *} {a}.
Foldable t =>
(a, t M3_Gen) -> (a, [Rational])
f [(Int, [M3_Gen])]
ew_xen3b_apx_gen

-- * <http://anaphoria.com/xen456.pdf>

ew_xen456_7_gen :: [M3_Gen]
ew_xen456_7_gen :: [M3_Gen]
ew_xen456_7_gen = [(Rational
25forall a. Fractional a => a -> a -> a
/Rational
24,Int
4),(Rational
5forall a. Fractional a => a -> a -> a
/Rational
3,Int
4),(Rational
4forall a. Fractional a => a -> a -> a
/Rational
3,Int
4),(Rational
16forall a. Fractional a => a -> a -> a
/Rational
15,Int
4),(Rational
32forall a. Fractional a => a -> a -> a
/Rational
25,Int
3)]

{- P.7 {Scala=wilson1}

19-tone "A Scale for Scott" (1976)

> ew_scl_find_r ew_xen456_7_r db -- wilson1
-}
ew_xen456_7_r :: [Rational]
ew_xen456_7_r :: [Rational]
ew_xen456_7_r = [M3_Gen] -> [Rational]
m3_gen_to_r [M3_Gen]
ew_xen456_7_gen

ew_xen456_9_gen :: [M3_Gen]
ew_xen456_9_gen :: [M3_Gen]
ew_xen456_9_gen =
  [(Rational
1forall a. Fractional a => a -> a -> a
/(Rational
3Rational -> Int -> Rational
^.Int
3),Int
4)
  ,(Rational
1forall a. Fractional a => a -> a -> a
/(Rational
5forall a. Num a => a -> a -> a
*(Rational
3Rational -> Int -> Rational
^.Int
2)),Int
3)
  ,(Rational
1forall a. Fractional a => a -> a -> a
/(Rational
7forall a. Num a => a -> a -> a
*Rational
3),Int
3)
  ,(Rational
1forall a. Fractional a => a -> a -> a
/Rational
11,Int
3)
  ,(Rational
5forall a. Fractional a => a -> a -> a
/(Rational
11forall a. Num a => a -> a -> a
*Rational
3),Int
4)
  ,(Rational
7forall a. Fractional a => a -> a -> a
/Rational
11,Int
2)]

{- | 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 {- hmt -}
> Scala.scl_find_ji List.is_subset ew_xen456_9_r db -- NIL
-}
ew_xen456_9_r :: [Rational]
ew_xen456_9_r :: [Rational]
ew_xen456_9_r = [M3_Gen] -> [Rational]
m3_gen_to_r [M3_Gen]
ew_xen456_9_gen

ew_xen456_9_scl :: Scala.Scale
ew_xen456_9_scl :: Scale
ew_xen456_9_scl = String -> String -> [Rational] -> Scale
r_to_scale String
"ew_xen456_9" String
"EW, xen456.pdf, P.9" [Rational]
ew_xen456_9_r

-- * Gems

{- | <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_r :: [Rational]
ew_poole_r :: [Rational]
ew_poole_r =
  [Rational
1,Rational
11forall a. Num a => a -> a -> a
*Rational
3,Rational
7forall a. Num a => a -> a -> a
*Rational
3forall a. Fractional a => a -> a -> a
/Rational
5,Rational
13forall a. Fractional a => a -> a -> a
/Rational
3,Rational
3forall a. Num a => a -> a -> a
*Rational
3,Rational
7forall a. Fractional a => a -> a -> a
/Rational
3,Rational
11forall a. Fractional a => a -> a -> a
/(Rational
3forall a. Num a => a -> a -> a
*Rational
3),Rational
5,Rational
7forall a. Fractional a => a -> a -> a
/Rational
11,Rational
1forall a. Fractional a => a -> a -> a
/Rational
3
  ,Rational
11,Rational
7forall a. Fractional a => a -> a -> a
/Rational
5,Rational
13forall a. Fractional a => a -> a -> a
/(Rational
3forall a. Num a => a -> a -> a
*Rational
3),Rational
3,Rational
7forall a. Fractional a => a -> a -> a
/(Rational
3forall a. Num a => a -> a -> a
*Rational
3),Rational
11forall a. Fractional a => a -> a -> a
/(Rational
3forall a. Num a => a -> a -> a
*Rational
3forall a. Num a => a -> a -> a
*Rational
3),Rational
5forall a. Fractional a => a -> a -> a
/Rational
3,Rational
3forall a. Num a => a -> a -> a
*Rational
3forall a. Num a => a -> a -> a
*Rational
3,Rational
7,Rational
11forall a. Fractional a => a -> a -> a
/Rational
3,Rational
5forall a. Num a => a -> a -> a
*Rational
3,Rational
7forall a. Num a => a -> a -> a
*Rational
3forall a. Fractional a => a -> a -> a
/Rational
11]

ew_poole_scl :: Scala.Scale
ew_poole_scl :: Scale
ew_poole_scl = String -> String -> [Rational] -> Scale
r_to_scale String
"ew_poole" String
"EW, 2010/10/scale-for-rod-poole.html" [Rational]
ew_poole_r

{- | <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_centaur17_r :: [Rational]
ew_centaur17_r :: [Rational]
ew_centaur17_r = [Rational
1,Rational
11forall a. Fractional a => a -> a -> a
/(Rational
3forall a. Num a => a -> a -> a
*Rational
7),Rational
11forall a. Fractional a => a -> a -> a
/Rational
5,Rational
3forall a. Num a => a -> a -> a
*Rational
3,Rational
7forall a. Fractional a => a -> a -> a
/Rational
3,Rational
11forall a. Fractional a => a -> a -> a
/(Rational
3forall a. Num a => a -> a -> a
*Rational
3),Rational
5,Rational
1forall a. Fractional a => a -> a -> a
/Rational
3,Rational
11,Rational
11forall a. Fractional a => a -> a -> a
/(Rational
3forall a. Num a => a -> a -> a
*Rational
5),Rational
3,Rational
11forall a. Fractional a => a -> a -> a
/Rational
7,Rational
11forall a. Fractional a => a -> a -> a
/(Rational
3forall a. Num a => a -> a -> a
*Rational
3forall a. Num a => a -> a -> a
*Rational
3),Rational
5forall a. Fractional a => a -> a -> a
/Rational
3,Rational
7,Rational
11forall a. Fractional a => a -> a -> a
/Rational
3,Rational
3forall a. Num a => a -> a -> a
*Rational
5]

{- | <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
-}
ew_two_22_7_r :: [Rational]
ew_two_22_7_r :: [Rational]
ew_two_22_7_r =
  [Rational
1,Rational
9forall a. Fractional a => a -> a -> a
/Rational
35,Rational
1forall a. Fractional a => a -> a -> a
/Rational
15,Rational
35,Rational
9,Rational
7forall a. Fractional a => a -> a -> a
/Rational
3,Rational
3forall a. Fractional a => a -> a -> a
/Rational
5,Rational
315,Rational
245forall a. Fractional a => a -> a -> a
/Rational
3,Rational
21,Rational
27forall a. Fractional a => a -> a -> a
/Rational
5
  ,Rational
7forall a. Fractional a => a -> a -> a
/Rational
5,Rational
735,Rational
189,Rational
49,Rational
63forall a. Fractional a => a -> a -> a
/Rational
5,Rational
5forall a. Fractional a => a -> a -> a
/Rational
3,Rational
3forall a. Fractional a => a -> a -> a
/Rational
7,Rational
1forall a. Fractional a => a -> a -> a
/Rational
9,Rational
1forall a. Fractional a => a -> a -> a
/Rational
35,Rational
15,Rational
35forall a. Fractional a => a -> a -> a
/Rational
9]

ew_two_22_7_scl :: Scala.Scale
ew_two_22_7_scl :: Scale
ew_two_22_7_scl = String -> String -> [Rational] -> Scale
r_to_scale String
"ew_two_22_7" String
"EW, 2018/03/an-unusual-22-tone-7-limit-tuning.html" [Rational]
ew_two_22_7_r

-- * Db

{- | Scales /not/ present in the standard scala file set.

> mapM_ (Scala.scale_wr_dir "/home/rohan/sw/hmt/data/scl/") ew_scl_db
> map Scala.scale_name ew_scl_db
-}
ew_scl_db :: [Scala.Scale]
ew_scl_db :: [Scale]
ew_scl_db =
  [Scale
ew_1357_3_scl
  ,Scale
ew_el12_7_scl
  ,Scale
ew_el12_12_scl
  ,Scale
ew_hel_12_scl
  ,Scale
ew_novarotreediamond_1_scl
  ,Scale
ew_Pelogflute_2_scl
  ,Scale
ew_xen3b_3_scl
  ,Scale
ew_xen456_9_scl
  ,Scale
ew_poole_scl
  ,Scale
ew_two_22_7_scl
  ]

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