module Factory.Data.Interval(
Interval,
closedUnitInterval,
mkBounded,
elem',
normalise,
product',
shift,
splitAt',
toList,
getMinBound,
getMaxBound,
precisely,
isReversed
) where
import Control.Arrow((***), (&&&))
import qualified Control.Parallel.Strategies
import qualified Data.Monoid
import qualified Data.Ratio
import qualified Data.Tuple
import qualified ToolShed.Data.Pair
type Interval endPoint = (endPoint, endPoint)
{-# INLINE getMinBound #-}
getMinBound :: Interval endPoint -> endPoint
getMinBound :: Interval endPoint -> endPoint
getMinBound = Interval endPoint -> endPoint
forall a b. (a, b) -> a
fst
{-# INLINE getMaxBound #-}
getMaxBound :: Interval endPoint -> endPoint
getMaxBound :: Interval endPoint -> endPoint
getMaxBound = Interval endPoint -> endPoint
forall a b. (a, b) -> b
snd
closedUnitInterval :: Num n => Interval n
closedUnitInterval :: Interval n
closedUnitInterval = (n
0, n
1)
mkBounded :: Bounded endPoint => Interval endPoint
mkBounded :: Interval endPoint
mkBounded = (endPoint
forall a. Bounded a => a
minBound, endPoint
forall a. Bounded a => a
maxBound)
precisely :: endPoint -> Interval endPoint
precisely :: endPoint -> Interval endPoint
precisely = endPoint -> endPoint
forall a. a -> a
id (endPoint -> endPoint)
-> (endPoint -> endPoint) -> endPoint -> Interval endPoint
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& endPoint -> endPoint
forall a. a -> a
id
shift :: Num endPoint
=> endPoint
-> Interval endPoint
-> Interval endPoint
shift :: endPoint -> Interval endPoint -> Interval endPoint
shift endPoint
i = (endPoint -> endPoint) -> Interval endPoint -> Interval endPoint
forall a b. (a -> b) -> (a, a) -> (b, b)
ToolShed.Data.Pair.mirror (endPoint -> endPoint -> endPoint
forall a. Num a => a -> a -> a
+ endPoint
i)
elem' :: Ord endPoint => endPoint -> Interval endPoint -> Bool
elem' :: endPoint -> Interval endPoint -> Bool
elem' endPoint
x = (Bool -> Bool -> Bool) -> (Bool, Bool) -> Bool
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Bool -> Bool -> Bool
(&&) ((Bool, Bool) -> Bool)
-> (Interval endPoint -> (Bool, Bool)) -> Interval endPoint -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((endPoint -> endPoint -> Bool
forall a. Ord a => a -> a -> Bool
<= endPoint
x) (endPoint -> Bool)
-> (endPoint -> Bool) -> Interval endPoint -> (Bool, Bool)
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** (endPoint
x endPoint -> endPoint -> Bool
forall a. Ord a => a -> a -> Bool
<=))
isReversed :: Ord endPoint => Interval endPoint -> Bool
isReversed :: Interval endPoint -> Bool
isReversed = (endPoint -> endPoint -> Bool) -> Interval endPoint -> Bool
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry endPoint -> endPoint -> Bool
forall a. Ord a => a -> a -> Bool
(>)
normalise :: Ord endPoint => Interval endPoint -> Interval endPoint
normalise :: Interval endPoint -> Interval endPoint
normalise Interval endPoint
b
| Interval endPoint -> Bool
forall endPoint. Ord endPoint => Interval endPoint -> Bool
isReversed Interval endPoint
b = Interval endPoint -> Interval endPoint
forall a b. (a, b) -> (b, a)
Data.Tuple.swap Interval endPoint
b
| Bool
otherwise = Interval endPoint
b
splitAt' :: (
Enum endPoint,
Ord endPoint,
Show endPoint
) => endPoint -> Interval endPoint -> (Interval endPoint, Interval endPoint)
splitAt' :: endPoint
-> Interval endPoint -> (Interval endPoint, Interval endPoint)
splitAt' endPoint
i interval :: Interval endPoint
interval@(endPoint
l, endPoint
r)
| ((endPoint -> Bool) -> Bool) -> [endPoint -> Bool] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((endPoint -> Bool) -> endPoint -> Bool
forall a b. (a -> b) -> a -> b
$ endPoint
i) [(endPoint -> endPoint -> Bool
forall a. Ord a => a -> a -> Bool
< endPoint
l), (endPoint -> endPoint -> Bool
forall a. Ord a => a -> a -> Bool
>= endPoint
r)] = [Char] -> (Interval endPoint, Interval endPoint)
forall a. HasCallStack => [Char] -> a
error ([Char] -> (Interval endPoint, Interval endPoint))
-> [Char] -> (Interval endPoint, Interval endPoint)
forall a b. (a -> b) -> a -> b
$ [Char]
"Factory.Data.Interval.splitAt':\tunsuitable index=" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ endPoint -> [Char]
forall a. Show a => a -> [Char]
show endPoint
i [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" for interval=" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Interval endPoint -> [Char]
forall a. Show a => a -> [Char]
show Interval endPoint
interval [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"."
| Bool
otherwise = ((endPoint
l, endPoint
i), (endPoint -> endPoint
forall a. Enum a => a -> a
succ endPoint
i, endPoint
r))
{-# INLINE getLength #-}
getLength :: Integral endPoint => Interval endPoint -> endPoint
getLength :: Interval endPoint -> endPoint
getLength (endPoint
l, endPoint
r) = endPoint -> endPoint
forall a. Enum a => a -> a
succ endPoint
r endPoint -> endPoint -> endPoint
forall a. Num a => a -> a -> a
- endPoint
l
{-# INLINE toList #-}
toList :: Enum endPoint => Interval endPoint -> [endPoint]
toList :: Interval endPoint -> [endPoint]
toList = (endPoint -> endPoint -> [endPoint])
-> Interval endPoint -> [endPoint]
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry endPoint -> endPoint -> [endPoint]
forall a. Enum a => a -> a -> [a]
enumFromTo
divideAndConquer :: (Data.Monoid.Monoid monoid, Integral i, Show i)
=> (i -> monoid)
-> Data.Ratio.Ratio i
-> i
-> Interval i
-> monoid
divideAndConquer :: (i -> monoid) -> Ratio i -> i -> Interval i -> monoid
divideAndConquer i -> monoid
monoidConstructor Ratio i
ratio i
minLength
| ((Ratio i -> Bool) -> Bool) -> [Ratio i -> Bool] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((Ratio i -> Bool) -> Ratio i -> Bool
forall a b. (a -> b) -> a -> b
$ Ratio i
ratio) [
(Ratio i -> Ratio i -> Bool
forall a. Ord a => a -> a -> Bool
< Ratio i
0),
(Ratio i -> Ratio i -> Bool
forall a. Ord a => a -> a -> Bool
>= Ratio i
1)
] = [Char] -> Interval i -> monoid
forall a. HasCallStack => [Char] -> a
error ([Char] -> Interval i -> monoid) -> [Char] -> Interval i -> monoid
forall a b. (a -> b) -> a -> b
$ [Char]
"Factory.Data.Interval.divideAndConquer:\tunsuitable ratio='" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Ratio i -> [Char]
forall a. Show a => a -> [Char]
show Ratio i
ratio [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"'."
| i
minLength i -> i -> Bool
forall a. Ord a => a -> a -> Bool
< i
1 = [Char] -> Interval i -> monoid
forall a. HasCallStack => [Char] -> a
error ([Char] -> Interval i -> monoid) -> [Char] -> Interval i -> monoid
forall a b. (a -> b) -> a -> b
$ [Char]
"Factory.Data.Interval.divideAndConquer:\tunsuitable minLength=" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ i -> [Char]
forall a. Show a => a -> [Char]
show i
minLength [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"."
| Bool
otherwise = Interval i -> monoid
slave
where
slave :: Interval i -> monoid
slave interval :: Interval i
interval@(i
l, i
r)
| Interval i -> i
forall endPoint. Integral endPoint => Interval endPoint -> endPoint
getLength Interval i
interval i -> i -> Bool
forall a. Ord a => a -> a -> Bool
<= i
minLength = [monoid] -> monoid
forall a. Monoid a => [a] -> a
Data.Monoid.mconcat ([monoid] -> monoid) -> ([i] -> [monoid]) -> [i] -> monoid
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (i -> monoid) -> [i] -> [monoid]
forall a b. (a -> b) -> [a] -> [b]
map i -> monoid
monoidConstructor ([i] -> monoid) -> [i] -> monoid
forall a b. (a -> b) -> a -> b
$ Interval i -> [i]
forall endPoint. Enum endPoint => Interval endPoint -> [endPoint]
toList Interval i
interval
| Bool
otherwise = (monoid -> monoid -> monoid) -> (monoid, monoid) -> monoid
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry monoid -> monoid -> monoid
forall a. Monoid a => a -> a -> a
Data.Monoid.mappend ((monoid, monoid) -> monoid)
-> ((Interval i, Interval i) -> (monoid, monoid))
-> (Interval i, Interval i)
-> monoid
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Strategy (monoid, monoid) -> (monoid, monoid) -> (monoid, monoid)
forall a. Strategy a -> a -> a
Control.Parallel.Strategies.withStrategy (
Strategy monoid -> Strategy monoid -> Strategy (monoid, monoid)
forall a b. Strategy a -> Strategy b -> Strategy (a, b)
Control.Parallel.Strategies.parTuple2 Strategy monoid
forall a. Strategy a
Control.Parallel.Strategies.rseq Strategy monoid
forall a. Strategy a
Control.Parallel.Strategies.rseq
) ((monoid, monoid) -> (monoid, monoid))
-> ((Interval i, Interval i) -> (monoid, monoid))
-> (Interval i, Interval i)
-> (monoid, monoid)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Interval i -> monoid)
-> (Interval i, Interval i) -> (monoid, monoid)
forall a b. (a -> b) -> (a, a) -> (b, b)
ToolShed.Data.Pair.mirror Interval i -> monoid
slave ((Interval i, Interval i) -> monoid)
-> (Interval i, Interval i) -> monoid
forall a b. (a -> b) -> a -> b
$ i -> Interval i -> (Interval i, Interval i)
forall endPoint.
(Enum endPoint, Ord endPoint, Show endPoint) =>
endPoint
-> Interval endPoint -> (Interval endPoint, Interval endPoint)
splitAt' (
i
l i -> i -> i
forall a. Num a => a -> a -> a
+ (i
r i -> i -> i
forall a. Num a => a -> a -> a
- i
l) i -> i -> i
forall a. Num a => a -> a -> a
* Ratio i -> i
forall a. Ratio a -> a
Data.Ratio.numerator Ratio i
ratio i -> i -> i
forall a. Integral a => a -> a -> a
`div` Ratio i -> i
forall a. Ratio a -> a
Data.Ratio.denominator Ratio i
ratio
) Interval i
interval
product' :: (Integral i, Show i)
=> Data.Ratio.Ratio i
-> i
-> Interval i
-> i
product' :: Ratio i -> i -> Interval i -> i
product' Ratio i
ratio i
minLength Interval i
interval
| i -> Interval i -> Bool
forall endPoint.
Ord endPoint =>
endPoint -> Interval endPoint -> Bool
elem' i
0 Interval i
interval = i
0
| Bool
otherwise = Product i -> i
forall a. Product a -> a
Data.Monoid.getProduct (Product i -> i) -> Product i -> i
forall a b. (a -> b) -> a -> b
$ (i -> Product i) -> Ratio i -> i -> Interval i -> Product i
forall monoid i.
(Monoid monoid, Integral i, Show i) =>
(i -> monoid) -> Ratio i -> i -> Interval i -> monoid
divideAndConquer i -> Product i
forall a. a -> Product a
Data.Monoid.Product Ratio i
ratio i
minLength Interval i
interval