module Data.Interval.Borel (
Borel,
borel,
intervalSet,
Data.Interval.Borel.empty,
singleton,
Data.Interval.Borel.null,
insert,
whole,
cutout,
clip,
member,
notMember,
union,
unions,
difference,
symmetricDifference,
complement,
intersection,
intersections,
hull,
) where
import Algebra.Heyting
import Algebra.Lattice
import Data.Interval (Interval)
import Data.Interval qualified as I
import Data.OneOrTwo (OneOrTwo (..))
import Data.Semiring (Ring, Semiring)
import Data.Semiring qualified as Semiring
import Data.Set qualified as Set
newtype Borel x = Borel (Set (Interval x))
deriving (Borel x -> Borel x -> Bool
(Borel x -> Borel x -> Bool)
-> (Borel x -> Borel x -> Bool) -> Eq (Borel x)
forall x. Ord x => Borel x -> Borel x -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Borel x -> Borel x -> Bool
$c/= :: forall x. Ord x => Borel x -> Borel x -> Bool
== :: Borel x -> Borel x -> Bool
$c== :: forall x. Ord x => Borel x -> Borel x -> Bool
Eq, Eq (Borel x)
Eq (Borel x)
-> (Borel x -> Borel x -> Ordering)
-> (Borel x -> Borel x -> Bool)
-> (Borel x -> Borel x -> Bool)
-> (Borel x -> Borel x -> Bool)
-> (Borel x -> Borel x -> Bool)
-> (Borel x -> Borel x -> Borel x)
-> (Borel x -> Borel x -> Borel x)
-> Ord (Borel x)
Borel x -> Borel x -> Bool
Borel x -> Borel x -> Ordering
Borel x -> Borel x -> Borel x
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall x. Ord x => Eq (Borel x)
forall x. Ord x => Borel x -> Borel x -> Bool
forall x. Ord x => Borel x -> Borel x -> Ordering
forall x. Ord x => Borel x -> Borel x -> Borel x
min :: Borel x -> Borel x -> Borel x
$cmin :: forall x. Ord x => Borel x -> Borel x -> Borel x
max :: Borel x -> Borel x -> Borel x
$cmax :: forall x. Ord x => Borel x -> Borel x -> Borel x
>= :: Borel x -> Borel x -> Bool
$c>= :: forall x. Ord x => Borel x -> Borel x -> Bool
> :: Borel x -> Borel x -> Bool
$c> :: forall x. Ord x => Borel x -> Borel x -> Bool
<= :: Borel x -> Borel x -> Bool
$c<= :: forall x. Ord x => Borel x -> Borel x -> Bool
< :: Borel x -> Borel x -> Bool
$c< :: forall x. Ord x => Borel x -> Borel x -> Bool
compare :: Borel x -> Borel x -> Ordering
$ccompare :: forall x. Ord x => Borel x -> Borel x -> Ordering
$cp1Ord :: forall x. Ord x => Eq (Borel x)
Ord, Int -> Borel x -> ShowS
[Borel x] -> ShowS
Borel x -> String
(Int -> Borel x -> ShowS)
-> (Borel x -> String) -> ([Borel x] -> ShowS) -> Show (Borel x)
forall x. (Ord x, Show x) => Int -> Borel x -> ShowS
forall x. (Ord x, Show x) => [Borel x] -> ShowS
forall x. (Ord x, Show x) => Borel x -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Borel x] -> ShowS
$cshowList :: forall x. (Ord x, Show x) => [Borel x] -> ShowS
show :: Borel x -> String
$cshow :: forall x. (Ord x, Show x) => Borel x -> String
showsPrec :: Int -> Borel x -> ShowS
$cshowsPrec :: forall x. (Ord x, Show x) => Int -> Borel x -> ShowS
Show, (forall x. Borel x -> Rep (Borel x) x)
-> (forall x. Rep (Borel x) x -> Borel x) -> Generic (Borel x)
forall x. Rep (Borel x) x -> Borel x
forall x. Borel x -> Rep (Borel x) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall x x. Rep (Borel x) x -> Borel x
forall x x. Borel x -> Rep (Borel x) x
$cto :: forall x x. Rep (Borel x) x -> Borel x
$cfrom :: forall x x. Borel x -> Rep (Borel x) x
Generic, Typeable)
instance (Ord x) => One (Borel x) where
type OneItem _ = Interval x
one :: OneItem (Borel x) -> Borel x
one = OneItem (Borel x) -> Borel x
forall x. Ord x => Interval x -> Borel x
singleton
instance (Ord x) => Semigroup (Borel x) where
Borel Set (Interval x)
is <> :: Borel x -> Borel x -> Borel x
<> Borel Set (Interval x)
js = Set (Interval x) -> Borel x
forall x. Set (Interval x) -> Borel x
Borel (Set (Interval x) -> Set (Interval x)
forall x. Ord x => Set (Interval x) -> Set (Interval x)
unionsSet (Set (Interval x)
is Set (Interval x) -> Set (Interval x) -> Set (Interval x)
forall a. Semigroup a => a -> a -> a
<> Set (Interval x)
js))
instance (Ord x) => Monoid (Borel x) where mempty :: Borel x
mempty = Set (Interval x) -> Borel x
forall x. Set (Interval x) -> Borel x
Borel Set (Interval x)
forall a. Monoid a => a
mempty
instance (Ord x, Lattice x) => Lattice (Borel x) where
\/ :: Borel x -> Borel x -> Borel x
(\/) = Borel x -> Borel x -> Borel x
forall x. Ord x => Borel x -> Borel x -> Borel x
union
/\ :: Borel x -> Borel x -> Borel x
(/\) = Borel x -> Borel x -> Borel x
forall x. Ord x => Borel x -> Borel x -> Borel x
intersection
instance (Ord x, Lattice x) => BoundedMeetSemiLattice (Borel x) where
top :: Borel x
top = Borel x
forall x. Ord x => Borel x
whole
instance (Ord x, Lattice x) => BoundedJoinSemiLattice (Borel x) where
bottom :: Borel x
bottom = Borel x
forall a. Monoid a => a
mempty
instance (Ord x, Lattice x) => Heyting (Borel x) where
Borel x
x ==> :: Borel x -> Borel x -> Borel x
==> Borel x
y = Borel x -> Borel x
forall x. Ord x => Borel x -> Borel x
complement Borel x
x Borel x -> Borel x -> Borel x
forall a. Lattice a => a -> a -> a
\/ Borel x
y
instance (Ord x, Lattice x) => Semiring (Borel x) where
plus :: Borel x -> Borel x -> Borel x
plus = Borel x -> Borel x -> Borel x
forall x. Ord x => Borel x -> Borel x -> Borel x
symmetricDifference
times :: Borel x -> Borel x -> Borel x
times = Borel x -> Borel x -> Borel x
forall x. Ord x => Borel x -> Borel x -> Borel x
intersection
zero :: Borel x
zero = Borel x
forall a. Monoid a => a
mempty
one :: Borel x
one = Borel x
forall x. Ord x => Borel x
whole
instance (Ord x, Lattice x) => Ring (Borel x) where
negate :: Borel x -> Borel x
negate = Borel x -> Borel x
forall x. Ord x => Borel x -> Borel x
complement
borel :: (Ord x) => [Interval x] -> Borel x
borel :: [Interval x] -> Borel x
borel = Set (Interval x) -> Borel x
forall x. Set (Interval x) -> Borel x
Borel (Set (Interval x) -> Borel x)
-> ([Interval x] -> Set (Interval x)) -> [Interval x] -> Borel x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Interval x] -> Set (Interval x)
forall a. Ord a => [a] -> Set a
Set.fromList ([Interval x] -> Set (Interval x))
-> ([Interval x] -> [Interval x])
-> [Interval x]
-> Set (Interval x)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Interval x] -> [Interval x]
forall x. Ord x => [Interval x] -> [Interval x]
I.unions
intervalSet :: (Ord x) => Borel x -> Set (Interval x)
intervalSet :: Borel x -> Set (Interval x)
intervalSet (Borel Set (Interval x)
is) = Set (Interval x) -> Set (Interval x)
forall x. Ord x => Set (Interval x) -> Set (Interval x)
unionsSet Set (Interval x)
is
unionsSet :: (Ord x) => Set (Interval x) -> Set (Interval x)
unionsSet :: Set (Interval x) -> Set (Interval x)
unionsSet = [Interval x] -> Set (Interval x)
forall a. Eq a => [a] -> Set a
Set.fromAscList ([Interval x] -> Set (Interval x))
-> (Set (Interval x) -> [Interval x])
-> Set (Interval x)
-> Set (Interval x)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Interval x] -> [Interval x]
forall x. Ord x => [Interval x] -> [Interval x]
I.unionsAsc ([Interval x] -> [Interval x])
-> (Set (Interval x) -> [Interval x])
-> Set (Interval x)
-> [Interval x]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set (Interval x) -> [Interval x]
forall a. Set a -> [a]
Set.toAscList
empty :: (Ord x) => Borel x
empty :: Borel x
empty = Set (Interval x) -> Borel x
forall x. Set (Interval x) -> Borel x
Borel Set (Interval x)
forall a. Set a
Set.empty
singleton :: (Ord x) => Interval x -> Borel x
singleton :: Interval x -> Borel x
singleton Interval x
x = Set (Interval x) -> Borel x
forall x. Set (Interval x) -> Borel x
Borel (Interval x -> Set (Interval x)
forall a. a -> Set a
Set.singleton Interval x
x)
null :: Borel x -> Bool
null :: Borel x -> Bool
null (Borel Set (Interval x)
is) = Set (Interval x) -> Bool
forall a. Set a -> Bool
Set.null Set (Interval x)
is
insert :: (Ord x) => Interval x -> Borel x -> Borel x
insert :: Interval x -> Borel x -> Borel x
insert Interval x
i (Borel Set (Interval x)
is) = Set (Interval x) -> Borel x
forall x. Set (Interval x) -> Borel x
Borel (Set (Interval x) -> Set (Interval x)
forall x. Ord x => Set (Interval x) -> Set (Interval x)
unionsSet (Interval x -> Set (Interval x) -> Set (Interval x)
forall a. Ord a => a -> Set a -> Set a
Set.insert Interval x
i Set (Interval x)
is))
whole :: (Ord x) => Borel x
whole :: Borel x
whole = Set (Interval x) -> Borel x
forall x. Set (Interval x) -> Borel x
Borel (OneItem (Set (Interval x)) -> Set (Interval x)
forall x. One x => OneItem x -> x
Prelude.one OneItem (Set (Interval x))
forall x. Ord x => Interval x
I.Whole)
cutout :: (Ord x) => Interval x -> Borel x -> Borel x
cutout :: Interval x -> Borel x -> Borel x
cutout Interval x
i (Borel Set (Interval x)
is) =
((Interval x -> Borel x) -> Set (Interval x) -> Borel x)
-> Set (Interval x) -> (Interval x -> Borel x) -> Borel x
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Interval x -> Borel x) -> Set (Interval x) -> Borel x
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Set (Interval x)
is ((Interval x -> Borel x) -> Borel x)
-> (Interval x -> Borel x) -> Borel x
forall a b. (a -> b) -> a -> b
$
(Interval x -> Interval x -> Maybe (OneOrTwo (Interval x))
forall x.
Ord x =>
Interval x -> Interval x -> Maybe (OneOrTwo (Interval x))
I.\\ Interval x
i) (Interval x -> Maybe (OneOrTwo (Interval x)))
-> (Maybe (OneOrTwo (Interval x)) -> Borel x)
-> Interval x
-> Borel x
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> \case
Maybe (OneOrTwo (Interval x))
Nothing -> Borel x
forall a. Monoid a => a
mempty
Just (One Interval x
j) -> [Interval x] -> Borel x
forall x. Ord x => [Interval x] -> Borel x
borel [Interval x
j]
Just (Two Interval x
j Interval x
k) -> [Interval x] -> Borel x
forall x. Ord x => [Interval x] -> Borel x
borel [Interval x
j, Interval x
k]
member :: (Ord x) => x -> Borel x -> Bool
member :: x -> Borel x -> Bool
member x
x (Borel Set (Interval x)
is) = (Interval x -> Bool) -> Set (Interval x) -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (x -> Interval x -> Bool
forall x. Ord x => x -> Interval x -> Bool
I.within x
x) Set (Interval x)
is
notMember :: (Ord x) => x -> Borel x -> Bool
notMember :: x -> Borel x -> Bool
notMember x
x = Bool -> Bool
not (Bool -> Bool) -> (Borel x -> Bool) -> Borel x -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. x -> Borel x -> Bool
forall x. Ord x => x -> Borel x -> Bool
member x
x
union :: (Ord x) => Borel x -> Borel x -> Borel x
union :: Borel x -> Borel x -> Borel x
union = Borel x -> Borel x -> Borel x
forall a. Semigroup a => a -> a -> a
(<>)
unions :: (Ord x) => [Borel x] -> Borel x
unions :: [Borel x] -> Borel x
unions = [Borel x] -> Borel x
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold
difference :: (Ord x) => Borel x -> Borel x -> Borel x
difference :: Borel x -> Borel x -> Borel x
difference Borel x
is (Borel Set (Interval x)
js) = (Interval x -> Borel x -> Borel x)
-> Borel x -> Set (Interval x) -> Borel x
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Interval x -> Borel x -> Borel x
forall x. Ord x => Interval x -> Borel x -> Borel x
cutout Borel x
is Set (Interval x)
js
symmetricDifference :: (Ord x) => Borel x -> Borel x -> Borel x
symmetricDifference :: Borel x -> Borel x -> Borel x
symmetricDifference Borel x
is Borel x
js = Borel x -> Borel x -> Borel x
forall x. Ord x => Borel x -> Borel x -> Borel x
difference Borel x
is Borel x
js Borel x -> Borel x -> Borel x
forall a. Semigroup a => a -> a -> a
<> Borel x -> Borel x -> Borel x
forall x. Ord x => Borel x -> Borel x -> Borel x
difference Borel x
js Borel x
is
complement :: (Ord x) => Borel x -> Borel x
complement :: Borel x -> Borel x
complement = Borel x -> Borel x -> Borel x
forall x. Ord x => Borel x -> Borel x -> Borel x
difference Borel x
forall x. Ord x => Borel x
whole
clip :: (Ord x) => Interval x -> Borel x -> Borel x
clip :: Interval x -> Borel x -> Borel x
clip Interval x
i (Borel Set (Interval x)
js) =
(Interval x -> Borel x -> Borel x)
-> Borel x -> Set (Interval x) -> Borel x
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Borel x -> Borel x -> Borel x
forall a. Semigroup a => a -> a -> a
(<>) (Borel x -> Borel x -> Borel x)
-> (Interval x -> Borel x) -> Interval x -> Borel x -> Borel x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Borel x -> (Interval x -> Borel x) -> Maybe (Interval x) -> Borel x
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Borel x
forall a. Monoid a => a
mempty Interval x -> Borel x
forall x. One x => OneItem x -> x
one (Maybe (Interval x) -> Borel x)
-> (Interval x -> Maybe (Interval x)) -> Interval x -> Borel x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Interval x -> Interval x -> Maybe (Interval x)
forall x. Ord x => Interval x -> Interval x -> Maybe (Interval x)
I.intersect Interval x
i) Borel x
forall a. Monoid a => a
mempty Set (Interval x)
js
intersection :: (Ord x) => Borel x -> Borel x -> Borel x
intersection :: Borel x -> Borel x -> Borel x
intersection Borel x
is (Borel Set (Interval x)
js) = (Interval x -> Borel x) -> Set (Interval x) -> Borel x
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Interval x -> Borel x -> Borel x
forall x. Ord x => Interval x -> Borel x -> Borel x
`clip` Borel x
is) Set (Interval x)
js
intersections :: (Ord x) => [Borel x] -> Borel x
intersections :: [Borel x] -> Borel x
intersections [] = Borel x
forall a. Monoid a => a
mempty
intersections [Borel x
i] = Borel x
i
intersections (Borel x
i : Borel x
j : [Borel x]
js) = Borel x -> Borel x -> Borel x
forall x. Ord x => Borel x -> Borel x -> Borel x
intersection (Borel x -> Borel x -> Borel x
forall x. Ord x => Borel x -> Borel x -> Borel x
intersection Borel x
i Borel x
j) ([Borel x] -> Borel x
forall x. Ord x => [Borel x] -> Borel x
intersections [Borel x]
js)
hull :: (Ord x) => Borel x -> Maybe (Interval x)
hull :: Borel x -> Maybe (Interval x)
hull (Borel Set (Interval x)
is)
| Set (Interval x) -> Bool
forall a. Set a -> Bool
Set.null Set (Interval x)
is = Maybe (Interval x)
forall a. Maybe a
Nothing
| Bool
otherwise = Interval x -> Maybe (Interval x)
forall a. a -> Maybe a
Just (Interval x -> Maybe (Interval x))
-> Interval x -> Maybe (Interval x)
forall a b. (a -> b) -> a -> b
$ (Interval x -> Set (Interval x) -> Interval x)
-> (Interval x, Set (Interval x)) -> Interval x
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ((Interval x -> Interval x -> Interval x)
-> Interval x -> Set (Interval x) -> Interval x
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Interval x -> Interval x -> Interval x
forall x. Ord x => Interval x -> Interval x -> Interval x
I.hull) (Set (Interval x) -> (Interval x, Set (Interval x))
forall a. Set a -> (a, Set a)
Set.deleteFindMin Set (Interval x)
is)