module Music.Theory.Xenakis.Sieve where
import qualified Data.List as L
import Music.Theory.List
data Sieve = Empty
| L (Integer, Integer)
| Union Sieve Sieve
| Intersection Sieve Sieve
| Complement Sieve
deriving (Sieve -> Sieve -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Sieve -> Sieve -> Bool
$c/= :: Sieve -> Sieve -> Bool
== :: Sieve -> Sieve -> Bool
$c== :: Sieve -> Sieve -> Bool
Eq,Int -> Sieve -> ShowS
[Sieve] -> ShowS
Sieve -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Sieve] -> ShowS
$cshowList :: [Sieve] -> ShowS
show :: Sieve -> String
$cshow :: Sieve -> String
showsPrec :: Int -> Sieve -> ShowS
$cshowsPrec :: Int -> Sieve -> ShowS
Show)
union :: [Sieve] -> Sieve
union :: [Sieve] -> Sieve
union = forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 Sieve -> Sieve -> Sieve
Union
intersection :: [Sieve] -> Sieve
intersection :: [Sieve] -> Sieve
intersection = forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 Sieve -> Sieve -> Sieve
Intersection
(∪) :: Sieve -> Sieve -> Sieve
∪ :: Sieve -> Sieve -> Sieve
(∪) = Sieve -> Sieve -> Sieve
Union
(∩) :: Sieve -> Sieve -> Sieve
∩ :: Sieve -> Sieve -> Sieve
(∩) = Sieve -> Sieve -> Sieve
Intersection
c :: Sieve -> Sieve
c :: Sieve -> Sieve
c = Sieve -> Sieve
Complement
sieve_pp :: Sieve -> String
sieve_pp :: Sieve -> String
sieve_pp Sieve
s =
case Sieve
s of
Sieve
Empty -> String
"∅"
L (Integer
p,Integer
q) -> forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [forall a. Show a => a -> String
show Integer
p,String
".",forall a. Show a => a -> String
show Integer
q]
Union Sieve
p Sieve
q -> forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String
"(",Sieve -> String
sieve_pp Sieve
p,String
" ∪ ",Sieve -> String
sieve_pp Sieve
q,String
")"]
Intersection Sieve
p Sieve
q -> forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String
"(",Sieve -> String
sieve_pp Sieve
p,String
" ∩ ",Sieve -> String
sieve_pp Sieve
q,String
")"]
Complement Sieve
p -> forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String
"(∁ ",Sieve -> String
sieve_pp Sieve
p,String
")"]
l :: Integer -> Integer -> Sieve
l :: Integer -> Integer -> Sieve
l = forall a b c. ((a, b) -> c) -> a -> b -> c
curry (Integer, Integer) -> Sieve
L
(⋄) :: Integer -> Integer -> Sieve
⋄ :: Integer -> Integer -> Sieve
(⋄) = Integer -> Integer -> Sieve
l
infixl 3 ∪
infixl 4 ∩
infixl 5 ⋄
normalise :: Sieve -> Sieve
normalise :: Sieve -> Sieve
normalise Sieve
s =
case Sieve
s of
Sieve
Empty -> Sieve
Empty
L (Integer
m,Integer
i) -> (Integer, Integer) -> Sieve
L (Integer
m,Integer
i forall a. Integral a => a -> a -> a
`mod` Integer
m)
Union Sieve
s0 Sieve
s1 -> Sieve -> Sieve -> Sieve
Union (Sieve -> Sieve
normalise Sieve
s0) (Sieve -> Sieve
normalise Sieve
s1)
Intersection Sieve
s0 Sieve
s1 -> Sieve -> Sieve -> Sieve
Intersection (Sieve -> Sieve
normalise Sieve
s0) (Sieve -> Sieve
normalise Sieve
s1)
Complement Sieve
s' -> Sieve -> Sieve
Complement (Sieve -> Sieve
normalise Sieve
s')
is_normal :: Sieve -> Bool
is_normal :: Sieve -> Bool
is_normal Sieve
s = Sieve
s forall a. Eq a => a -> a -> Bool
== Sieve -> Sieve
normalise Sieve
s
element :: Sieve -> Integer -> Bool
element :: Sieve -> Integer -> Bool
element Sieve
s Integer
n =
case Sieve
s of
Sieve
Empty -> Bool
False
L (Integer
m,Integer
i) -> Integer
n forall a. Integral a => a -> a -> a
`mod` Integer
m forall a. Eq a => a -> a -> Bool
== Integer
i forall a. Integral a => a -> a -> a
`mod` Integer
m Bool -> Bool -> Bool
&& Integer
n forall a. Ord a => a -> a -> Bool
>= Integer
i
Union Sieve
s0 Sieve
s1 -> Sieve -> Integer -> Bool
element Sieve
s0 Integer
n Bool -> Bool -> Bool
|| Sieve -> Integer -> Bool
element Sieve
s1 Integer
n
Intersection Sieve
s0 Sieve
s1 -> Sieve -> Integer -> Bool
element Sieve
s0 Integer
n Bool -> Bool -> Bool
&& Sieve -> Integer -> Bool
element Sieve
s1 Integer
n
Complement Sieve
s' -> Bool -> Bool
not (Sieve -> Integer -> Bool
element Sieve
s' Integer
n)
i_complement :: [Integer] -> [Integer]
i_complement :: [Integer] -> [Integer]
i_complement =
let f :: t -> [t] -> [t]
f t
x [t]
s = case [t]
s of
[] -> [t
x ..]
t
e:[t]
s' -> case forall a. Ord a => a -> a -> Ordering
compare t
x t
e of
Ordering
LT -> t
x forall a. a -> [a] -> [a]
: t -> [t] -> [t]
f (t
x forall a. Num a => a -> a -> a
+ t
1) [t]
s
Ordering
EQ -> t -> [t] -> [t]
f (t
x forall a. Num a => a -> a -> a
+ t
1) [t]
s'
Ordering
GT -> forall a. HasCallStack => String -> a
error String
"i_complement"
in forall {t}. (Enum t, Ord t, Num t) => t -> [t] -> [t]
f Integer
0
build :: Sieve -> [Integer]
build :: Sieve -> [Integer]
build Sieve
s =
let u_f :: [Integer] -> [Integer]
u_f = forall a b. (a -> b) -> [a] -> [b]
map forall a. [a] -> a
head forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Eq a => [a] -> [[a]]
L.group
i_f :: [Integer] -> [Integer]
i_f = let g :: [a] -> [a]
g [a
x,a
_] = [a
x]
g [a]
_ = []
in forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall {a}. [a] -> [a]
g forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Eq a => [a] -> [[a]]
L.group
in case Sieve
s of
Sieve
Empty -> []
L (Integer
m,Integer
i) -> [Integer
i, Integer
iforall a. Num a => a -> a -> a
+Integer
m ..]
Union Sieve
s0 Sieve
s1 -> [Integer] -> [Integer]
u_f (forall a. Ord a => [a] -> [a] -> [a]
merge (Sieve -> [Integer]
build Sieve
s0) (Sieve -> [Integer]
build Sieve
s1))
Intersection Sieve
s0 Sieve
s1 -> [Integer] -> [Integer]
i_f (forall a. Ord a => [a] -> [a] -> [a]
merge (Sieve -> [Integer]
build Sieve
s0) (Sieve -> [Integer]
build Sieve
s1))
Complement Sieve
s' -> [Integer] -> [Integer]
i_complement (Sieve -> [Integer]
build Sieve
s')
buildn :: Int -> Sieve -> [Integer]
buildn :: Int -> Sieve -> [Integer]
buildn Int
n = forall a. Int -> [a] -> [a]
take Int
n forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sieve -> [Integer]
build forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sieve -> Sieve
reduce
differentiate :: (Num a) => [a] -> [a]
differentiate :: forall a. Num a => [a] -> [a]
differentiate [a]
x = forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (-) (forall {a}. [a] -> [a]
tail [a]
x) [a]
x
euclid :: (Integral a) => a -> a -> a
euclid :: forall a. Integral a => a -> a -> a
euclid a
i a
j =
let k :: a
k = a
i forall a. Integral a => a -> a -> a
`mod` a
j
in if a
k forall a. Eq a => a -> a -> Bool
== a
0 then a
j else forall a. Integral a => a -> a -> a
euclid a
j a
k
de_meziriac :: (Integral a) => a -> a -> a
de_meziriac :: forall a. Integral a => a -> a -> a
de_meziriac a
i a
j =
let f :: a -> a
f a
t = if (a
t forall a. Num a => a -> a -> a
* a
i) forall a. Integral a => a -> a -> a
`mod` a
j forall a. Eq a => a -> a -> Bool
/= a
1
then a -> a
f (a
t forall a. Num a => a -> a -> a
+ a
1)
else a
t
in if a
j forall a. Eq a => a -> a -> Bool
== a
1 then a
1 else a -> a
f a
1
reduce_intersection :: (Integral t) => (t,t) -> (t,t) -> Maybe (t,t)
reduce_intersection :: forall t. Integral t => (t, t) -> (t, t) -> Maybe (t, t)
reduce_intersection (t
m1,t
i1) (t
m2,t
i2) =
let d :: t
d = forall a. Integral a => a -> a -> a
euclid t
m1 t
m2
i1' :: t
i1' = t
i1 forall a. Integral a => a -> a -> a
`mod` t
m1
i2' :: t
i2' = t
i2 forall a. Integral a => a -> a -> a
`mod` t
m2
c1 :: t
c1 = t
m1 forall a. Integral a => a -> a -> a
`div` t
d
c2 :: t
c2 = t
m2 forall a. Integral a => a -> a -> a
`div` t
d
m3 :: t
m3 = t
d forall a. Num a => a -> a -> a
* t
c1 forall a. Num a => a -> a -> a
* t
c2
t :: t
t = forall a. Integral a => a -> a -> a
de_meziriac t
c1 t
c2
i3 :: t
i3 = (t
i1' forall a. Num a => a -> a -> a
+ t
t forall a. Num a => a -> a -> a
* (t
i2' forall a. Num a => a -> a -> a
- t
i1') forall a. Num a => a -> a -> a
* t
c1) forall a. Integral a => a -> a -> a
`mod` t
m3
in if t
d forall a. Eq a => a -> a -> Bool
/= t
1 Bool -> Bool -> Bool
&& (t
i1' forall a. Num a => a -> a -> a
- t
i2') forall a. Integral a => a -> a -> a
`mod` t
d forall a. Eq a => a -> a -> Bool
/= t
0
then forall a. Maybe a
Nothing
else forall a. a -> Maybe a
Just (t
m3,t
i3)
reduce :: Sieve -> Sieve
reduce :: Sieve -> Sieve
reduce Sieve
s =
let f :: (Sieve -> Sieve -> Sieve) -> Sieve -> Sieve -> Sieve
f Sieve -> Sieve -> Sieve
g Sieve
s1 Sieve
s2 =
let s1' :: Sieve
s1' = Sieve -> Sieve
reduce Sieve
s1
s2' :: Sieve
s2' = Sieve -> Sieve
reduce Sieve
s2
s' :: Sieve
s' = Sieve -> Sieve -> Sieve
g Sieve
s1' Sieve
s2'
in if Sieve
s1 forall a. Eq a => a -> a -> Bool
== Sieve
s1' Bool -> Bool -> Bool
&& Sieve
s2 forall a. Eq a => a -> a -> Bool
== Sieve
s2'
then Sieve
s'
else Sieve -> Sieve
reduce Sieve
s'
in case Sieve
s of
Sieve
Empty -> Sieve
Empty
L (Integer, Integer)
_ -> Sieve
s
Union Sieve
s1 Sieve
Empty -> Sieve
s1
Union Sieve
s1 Sieve
s2 -> (Sieve -> Sieve -> Sieve) -> Sieve -> Sieve -> Sieve
f Sieve -> Sieve -> Sieve
Union Sieve
s1 Sieve
s2
Intersection Sieve
s1 Sieve
Empty -> Sieve
s1
Intersection (L (Integer, Integer)
p) (L (Integer, Integer)
q) -> forall b a. b -> (a -> b) -> Maybe a -> b
maybe Sieve
Empty (Integer, Integer) -> Sieve
L (forall t. Integral t => (t, t) -> (t, t) -> Maybe (t, t)
reduce_intersection (Integer, Integer)
p (Integer, Integer)
q)
Intersection Sieve
s1 Sieve
s2 -> (Sieve -> Sieve -> Sieve) -> Sieve -> Sieve -> Sieve
f Sieve -> Sieve -> Sieve
Intersection Sieve
s1 Sieve
s2
Complement Sieve
s' -> Sieve -> Sieve
Complement (Sieve -> Sieve
reduce Sieve
s')
psappha_flint_c :: [Sieve]
psappha_flint_c :: [Sieve]
psappha_flint_c =
let s0 :: Sieve
s0 = (Integer
8Integer -> Integer -> Sieve
⋄Integer
0Sieve -> Sieve -> Sieve
∪Integer
8Integer -> Integer -> Sieve
⋄Integer
1Sieve -> Sieve -> Sieve
∪Integer
8Integer -> Integer -> Sieve
⋄Integer
7)Sieve -> Sieve -> Sieve
∩(Integer
5Integer -> Integer -> Sieve
⋄Integer
1Sieve -> Sieve -> Sieve
∪Integer
5Integer -> Integer -> Sieve
⋄Integer
3)
s1 :: Sieve
s1 = (Integer
8Integer -> Integer -> Sieve
⋄Integer
0Sieve -> Sieve -> Sieve
∪Integer
8Integer -> Integer -> Sieve
⋄Integer
1Sieve -> Sieve -> Sieve
∪Integer
8Integer -> Integer -> Sieve
⋄Integer
2)Sieve -> Sieve -> Sieve
∩Integer
5Integer -> Integer -> Sieve
⋄Integer
0
s2 :: Sieve
s2 = Integer
8Integer -> Integer -> Sieve
⋄Integer
3Sieve -> Sieve -> Sieve
∩(Integer
5Integer -> Integer -> Sieve
⋄Integer
0Sieve -> Sieve -> Sieve
∪Integer
5Integer -> Integer -> Sieve
⋄Integer
1Sieve -> Sieve -> Sieve
∪Integer
5Integer -> Integer -> Sieve
⋄Integer
2Sieve -> Sieve -> Sieve
∪Integer
5Integer -> Integer -> Sieve
⋄Integer
3Sieve -> Sieve -> Sieve
∪Integer
5Integer -> Integer -> Sieve
⋄Integer
4)
s3 :: Sieve
s3 = Integer
8Integer -> Integer -> Sieve
⋄Integer
4Sieve -> Sieve -> Sieve
∩(Integer
5Integer -> Integer -> Sieve
⋄Integer
0Sieve -> Sieve -> Sieve
∪Integer
5Integer -> Integer -> Sieve
⋄Integer
1Sieve -> Sieve -> Sieve
∪Integer
5Integer -> Integer -> Sieve
⋄Integer
2Sieve -> Sieve -> Sieve
∪Integer
5Integer -> Integer -> Sieve
⋄Integer
3Sieve -> Sieve -> Sieve
∪Integer
5Integer -> Integer -> Sieve
⋄Integer
4)
s4 :: Sieve
s4 = (Integer
8Integer -> Integer -> Sieve
⋄Integer
5Sieve -> Sieve -> Sieve
∪Integer
8Integer -> Integer -> Sieve
⋄Integer
6)Sieve -> Sieve -> Sieve
∩(Integer
5Integer -> Integer -> Sieve
⋄Integer
2Sieve -> Sieve -> Sieve
∪Integer
5Integer -> Integer -> Sieve
⋄Integer
3Sieve -> Sieve -> Sieve
∪Integer
5Integer -> Integer -> Sieve
⋄Integer
4)
s5 :: Sieve
s5 = Integer
8Integer -> Integer -> Sieve
⋄Integer
1Sieve -> Sieve -> Sieve
∩Integer
5Integer -> Integer -> Sieve
⋄Integer
2
s6 :: Sieve
s6 = Integer
8Integer -> Integer -> Sieve
⋄Integer
6Sieve -> Sieve -> Sieve
∩Integer
5Integer -> Integer -> Sieve
⋄Integer
1
in [Sieve
s0, Sieve
s1, Sieve
s2, Sieve
s3, Sieve
s4, Sieve
s5, Sieve
s6]
psappha_flint :: Sieve
psappha_flint :: Sieve
psappha_flint = [Sieve] -> Sieve
union [Sieve]
psappha_flint_c
a_r_squibbs_c :: [Sieve]
a_r_squibbs_c :: [Sieve]
a_r_squibbs_c =
[Integer
8Integer -> Integer -> Sieve
⋄Integer
0Sieve -> Sieve -> Sieve
∩(Integer
11Integer -> Integer -> Sieve
⋄Integer
0Sieve -> Sieve -> Sieve
∪Integer
11Integer -> Integer -> Sieve
⋄Integer
4Sieve -> Sieve -> Sieve
∪Integer
11Integer -> Integer -> Sieve
⋄Integer
5Sieve -> Sieve -> Sieve
∪Integer
11Integer -> Integer -> Sieve
⋄Integer
6Sieve -> Sieve -> Sieve
∪Integer
11Integer -> Integer -> Sieve
⋄Integer
10)
,Integer
8Integer -> Integer -> Sieve
⋄Integer
1Sieve -> Sieve -> Sieve
∩(Integer
11Integer -> Integer -> Sieve
⋄Integer
2Sieve -> Sieve -> Sieve
∪Integer
11Integer -> Integer -> Sieve
⋄Integer
3Sieve -> Sieve -> Sieve
∪Integer
11Integer -> Integer -> Sieve
⋄Integer
6Sieve -> Sieve -> Sieve
∪Integer
11Integer -> Integer -> Sieve
⋄Integer
7Sieve -> Sieve -> Sieve
∪Integer
11Integer -> Integer -> Sieve
⋄Integer
9)
,Integer
8Integer -> Integer -> Sieve
⋄Integer
2Sieve -> Sieve -> Sieve
∩(Integer
11Integer -> Integer -> Sieve
⋄Integer
0Sieve -> Sieve -> Sieve
∪Integer
11Integer -> Integer -> Sieve
⋄Integer
1Sieve -> Sieve -> Sieve
∪Integer
11Integer -> Integer -> Sieve
⋄Integer
2Sieve -> Sieve -> Sieve
∪Integer
11Integer -> Integer -> Sieve
⋄Integer
3Sieve -> Sieve -> Sieve
∪Integer
11Integer -> Integer -> Sieve
⋄Integer
5Sieve -> Sieve -> Sieve
∪Integer
11Integer -> Integer -> Sieve
⋄Integer
10)
,Integer
8Integer -> Integer -> Sieve
⋄Integer
3Sieve -> Sieve -> Sieve
∩(Integer
11Integer -> Integer -> Sieve
⋄Integer
1Sieve -> Sieve -> Sieve
∪Integer
11Integer -> Integer -> Sieve
⋄Integer
2Sieve -> Sieve -> Sieve
∪Integer
11Integer -> Integer -> Sieve
⋄Integer
3Sieve -> Sieve -> Sieve
∪Integer
11Integer -> Integer -> Sieve
⋄Integer
4Sieve -> Sieve -> Sieve
∪Integer
11Integer -> Integer -> Sieve
⋄Integer
10)
,Integer
8Integer -> Integer -> Sieve
⋄Integer
4Sieve -> Sieve -> Sieve
∩(Integer
11Integer -> Integer -> Sieve
⋄Integer
0Sieve -> Sieve -> Sieve
∪Integer
11Integer -> Integer -> Sieve
⋄Integer
4Sieve -> Sieve -> Sieve
∪Integer
11Integer -> Integer -> Sieve
⋄Integer
8)
,Integer
8Integer -> Integer -> Sieve
⋄Integer
5Sieve -> Sieve -> Sieve
∩(Integer
11Integer -> Integer -> Sieve
⋄Integer
0Sieve -> Sieve -> Sieve
∪Integer
11Integer -> Integer -> Sieve
⋄Integer
2Sieve -> Sieve -> Sieve
∪Integer
11Integer -> Integer -> Sieve
⋄Integer
3Sieve -> Sieve -> Sieve
∪Integer
11Integer -> Integer -> Sieve
⋄Integer
7Sieve -> Sieve -> Sieve
∪Integer
11Integer -> Integer -> Sieve
⋄Integer
9Sieve -> Sieve -> Sieve
∪Integer
11Integer -> Integer -> Sieve
⋄Integer
10)
,Integer
8Integer -> Integer -> Sieve
⋄Integer
6Sieve -> Sieve -> Sieve
∩(Integer
11Integer -> Integer -> Sieve
⋄Integer
1Sieve -> Sieve -> Sieve
∪Integer
11Integer -> Integer -> Sieve
⋄Integer
3Sieve -> Sieve -> Sieve
∪Integer
11Integer -> Integer -> Sieve
⋄Integer
5Sieve -> Sieve -> Sieve
∪Integer
11Integer -> Integer -> Sieve
⋄Integer
7Sieve -> Sieve -> Sieve
∪Integer
11Integer -> Integer -> Sieve
⋄Integer
8Sieve -> Sieve -> Sieve
∪Integer
11Integer -> Integer -> Sieve
⋄Integer
9)
,Integer
8Integer -> Integer -> Sieve
⋄Integer
7Sieve -> Sieve -> Sieve
∩(Integer
11Integer -> Integer -> Sieve
⋄Integer
1Sieve -> Sieve -> Sieve
∪Integer
11Integer -> Integer -> Sieve
⋄Integer
3Sieve -> Sieve -> Sieve
∪Integer
11Integer -> Integer -> Sieve
⋄Integer
6Sieve -> Sieve -> Sieve
∪Integer
11Integer -> Integer -> Sieve
⋄Integer
7Sieve -> Sieve -> Sieve
∪Integer
11Integer -> Integer -> Sieve
⋄Integer
8Sieve -> Sieve -> Sieve
∪Integer
11Integer -> Integer -> Sieve
⋄Integer
10)]
a_r_squibbs :: Sieve
a_r_squibbs :: Sieve
a_r_squibbs = [Sieve] -> Sieve
union [Sieve]
a_r_squibbs_c