module Music.Theory.Bjorklund where
import Data.List.Split
import qualified Music.Theory.List as T
type BJORKLUND_ST a = ((Int,Int),([[a]],[[a]]))
bjorklund_left_f :: BJORKLUND_ST a -> BJORKLUND_ST a
bjorklund_left_f :: forall a. BJORKLUND_ST a -> BJORKLUND_ST a
bjorklund_left_f ((Int
i,Int
j),([[a]]
xs,[[a]]
ys)) =
let ([[a]]
xs',[[a]]
xs'') = forall a. Int -> [a] -> ([a], [a])
splitAt Int
j [[a]]
xs
in ((Int
j,Int
iforall a. Num a => a -> a -> a
-Int
j),(forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith forall a. [a] -> [a] -> [a]
(++) [[a]]
xs' [[a]]
ys,[[a]]
xs''))
bjorklund_right_f :: BJORKLUND_ST a -> BJORKLUND_ST a
bjorklund_right_f :: forall a. BJORKLUND_ST a -> BJORKLUND_ST a
bjorklund_right_f ((Int
i,Int
j),([[a]]
xs,[[a]]
ys)) =
let ([[a]]
ys',[[a]]
ys'') = forall a. Int -> [a] -> ([a], [a])
splitAt Int
i [[a]]
ys
in ((Int
i,Int
jforall a. Num a => a -> a -> a
-Int
i),(forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith forall a. [a] -> [a] -> [a]
(++) [[a]]
xs [[a]]
ys',[[a]]
ys''))
bjorklund_f :: BJORKLUND_ST a -> BJORKLUND_ST a
bjorklund_f :: forall a. BJORKLUND_ST a -> BJORKLUND_ST a
bjorklund_f ((Int, Int)
n,([[a]], [[a]])
x) =
let (Int
i,Int
j) = (Int, Int)
n
in if forall a. Ord a => a -> a -> a
min Int
i Int
j forall a. Ord a => a -> a -> Bool
<= Int
1
then ((Int, Int)
n,([[a]], [[a]])
x)
else forall a. BJORKLUND_ST a -> BJORKLUND_ST a
bjorklund_f (if Int
i forall a. Ord a => a -> a -> Bool
> Int
j then forall a. BJORKLUND_ST a -> BJORKLUND_ST a
bjorklund_left_f ((Int, Int)
n,([[a]], [[a]])
x) else forall a. BJORKLUND_ST a -> BJORKLUND_ST a
bjorklund_right_f ((Int, Int)
n,([[a]], [[a]])
x))
bjorklund :: (Int,Int) -> [Bool]
bjorklund :: (Int, Int) -> [Bool]
bjorklund (Int
i,Int
j') =
let j :: Int
j = Int
j' forall a. Num a => a -> a -> a
- Int
i
x :: [[Bool]]
x = forall a. Int -> a -> [a]
replicate Int
i [Bool
True]
y :: [[Bool]]
y = forall a. Int -> a -> [a]
replicate Int
j [Bool
False]
((Int, Int)
_,([[Bool]]
x',[[Bool]]
y')) = forall a. BJORKLUND_ST a -> BJORKLUND_ST a
bjorklund_f ((Int
i,Int
j),([[Bool]]
x,[[Bool]]
y))
in forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Bool]]
x' forall a. [a] -> [a] -> [a]
++ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Bool]]
y'
bjorklund_r :: Int -> (Int, Int) -> [Bool]
bjorklund_r :: Int -> (Int, Int) -> [Bool]
bjorklund_r Int
n = forall a. Int -> [a] -> [a]
T.rotate_right Int
n forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, Int) -> [Bool]
bjorklund
euler_pp_f :: (Bool -> Char) -> (Int,Int) -> String
euler_pp_f :: (Bool -> Char) -> (Int, Int) -> String
euler_pp_f Bool -> Char
f (Int, Int)
e =
let r :: [Bool]
r = (Int, Int) -> [Bool]
bjorklund (Int, Int)
e
in forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String
"E",forall a. Show a => a -> String
show (Int, Int)
e,String
" [",forall a b. (a -> b) -> [a] -> [b]
map Bool -> Char
f [Bool]
r,String
"] ",[Bool] -> String
iseq_str [Bool]
r]
euler_pp_unicode :: (Int, Int) -> String
euler_pp_unicode :: (Int, Int) -> String
euler_pp_unicode = (Bool -> Char) -> (Int, Int) -> String
euler_pp_f Bool -> Char
xdot_unicode
euler_pp_ascii :: (Int, Int) -> String
euler_pp_ascii :: (Int, Int) -> String
euler_pp_ascii = (Bool -> Char) -> (Int, Int) -> String
euler_pp_f Bool -> Char
xdot_ascii
xdot_ascii :: Bool -> Char
xdot_ascii :: Bool -> Char
xdot_ascii Bool
x = if Bool
x then Char
'x' else Char
'.'
xdot_unicode :: Bool -> Char
xdot_unicode :: Bool -> Char
xdot_unicode Bool
x = if Bool
x then Char
'×' else Char
'·'
iseq :: [Bool] -> [Int]
iseq :: [Bool] -> [Int]
iseq = let f :: (a -> Bool) -> [a] -> [[a]]
f = forall a. Splitter a -> [a] -> [[a]]
split forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Splitter a -> Splitter a
keepDelimsL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> Splitter a
whenElt in forall a. [a] -> [a]
tail 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a}. (a -> Bool) -> [a] -> [[a]]
f (forall a. Eq a => a -> a -> Bool
== Bool
True)
iseq_str :: [Bool] -> String
iseq_str :: [Bool] -> String
iseq_str = let f :: t a -> String
f t a
xs = String
"(" forall a. [a] -> [a] -> [a]
++ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall a. Show a => a -> String
show t a
xs forall a. [a] -> [a] -> [a]
++ String
")" in forall {t :: * -> *} {a}. (Foldable t, Show a) => t a -> String
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Bool] -> [Int]
iseq