module Data.RangeSpace (
Range (..)
, Bounds
, Span
, toBounds
, fromBounds
, fromBoundsC
, newRange
, rangeStart
, rangeEnd
, range
, toSpan
, fromSpan
, fromSpanC
, range2D
, fromRange2D
#if !MIN_VERSION_vector_space_points(0,1,2)
, unPoint
#endif
, unionBounds
, translateRange
, unionRange
, maskRange
, inRange
, inOrdRange
, compareRange
, extentX
, extentY
, module X
, module V
)
where
import Data.RangeSpace.TwoD as X
import Data.Basis as V
import Data.VectorSpace as V
import Data.AffineSpace as V
import Data.AffineSpace.Point as V
import Control.Applicative
import Control.Arrow ((***))
import Data.Semigroup
import Data.List (zipWith4)
#if MIN_VERSION_vector_space_points(0,1,2)
#else
unPoint :: Point v -> v
unPoint (P v) = v
#endif
data Range t = Range !t !t
deriving (Eq, Show, Ord, Functor)
instance Applicative Range where
pure a = Range a a
(Range minf maxf) <*> (Range minv maxv) = Range (minf minv) (maxf maxv)
instance (BasisRange t) => Semigroup (Range t) where
(<>) = unionRange
type Bounds t = (t,t)
type Span t = (t, Diff t)
unRange :: Range t -> (t,t)
unRange (Range t1 t2) = (t1,t2)
toBounds :: (Ord t) => Range t -> Bounds t
toBounds (Range s0 s1) = if s1 >= s0
then (s0,s1)
else (s1,s0)
toSpan :: (AffineSpace t) => Range t -> (t, Diff t)
toSpan (Range s0 s1) = (s0, s1 .-. s0)
fromSpan :: (AffineSpace t) => Span t -> Range t
fromSpan (s0,dur) = Range s0 (s0 .+^ dur)
fromSpanC :: (AffineSpace t) => t -> Diff t -> Range t
fromSpanC = curry fromSpan
fromBounds :: (Ord t) => Bounds t -> Range t
fromBounds (minT,maxT)
| maxT >= minT = Range minT maxT
| otherwise = Range maxT minT
fromBoundsC :: (Ord t) => t -> t -> Range t
fromBoundsC = curry fromBounds
rangeStart :: (Ord t) => Range t -> t
rangeStart = fst . toBounds
rangeEnd :: (Ord t) => Range t -> t
rangeEnd = snd . toBounds
range :: (AffineSpace t) => Range t -> Diff t
range = snd . toSpan
translateRange :: AffineSpace t => Diff t -> Range t -> Range t
translateRange t rng = (.+^ t) <$> rng
type BasisRange t = (Ord t, AffineSpace t, HasBasis (Diff t)
,Ord (Scalar (Diff t)), Num (Scalar (Diff t)))
newRange :: BasisRange t => t -> t -> Range t
newRange start stop = unionRange (Range start start) (Range stop stop)
unionBounds :: BasisRange t => Bounds t -> Bounds t -> Bounds t
unionBounds r1 r2 = unRange $ unionRange (fromBounds r1) (fromBounds r2)
unionRange :: BasisRange t => Range t -> Range t -> Range t
unionRange r0 r1 =
Range (adjust combineMin min0 min1) (adjust combineMax max0 max1)
where
combineMin dif = min dif 0
combineMax dif = max dif 0
adjust f orig s = (orig .+^) . recompose . map (fmap f)
. decompose $ s .-. orig
(min0,max0) = toBounds r0
(min1,max1) = toBounds r1
maskRange :: (Eq (Basis (Diff t)), BasisRange t)
=> Range t
-> Range t
-> Range t
maskRange restriction orig = uncurry Range newBounds
where
combine (b0,minDiff) (b1,maxDiff) (b2,minCheck) (b3,maxCheck)
| b0 == b1 && b0 == b2 && b0 == b3 =
if minCheck > 0 || maxCheck < 0
then ((b0, minDiff), (b0, negate maxCheck))
else ((b0, max 0 minDiff), (b0, min 0 maxDiff))
| otherwise = error "Data.RangeSpace.maskRange: basis decompositions must be deterministically ordered"
(minAdj,maxAdj) = (recompose *** recompose) $ unzip pairs
newBounds = (oMin .+^ minAdj, oMax .+^ maxAdj)
pairs = zipWith4 combine (decompose $ rMin .-. oMin)
(decompose $ rMax .-. oMax)
(decompose $ oMin .-. rMax)
(decompose $ oMax .-. rMin)
(oMin,oMax) = toBounds orig
(rMin,rMax) = toBounds restriction
range2D :: (Ord a, Ord b)
=> Range a -> Range b -> Range (D2V a b)
range2D r1 r2 = Range (D2V min1 min2) (D2V max1 max2)
where
(min1,max1) = toBounds r1
(min2,max2) = toBounds r2
fromRange2D :: (Ord a, Ord b)
=> Range (D2V a b) -> (Range a, Range b)
fromRange2D (Range (D2V minX minY) (D2V maxX maxY)) =
(fromBoundsC minX maxX, fromBoundsC minY maxY)
extentX :: (Ord b, Ord a)
=> Range (Point (D2V a b)) -> Range a
extentX = fst . fromRange2D . fmap unPoint
extentY :: (Ord b, Ord a)
=> Range (Point (D2V a b)) -> Range b
extentY = snd . fromRange2D . fmap unPoint
inRange :: (BasisRange a, Eq (Basis (Diff a)))
=> a
-> Range a
-> Bool
inRange val rng = all f $ zip (decompose pVec) (decompose rVec)
where
f ((b1,ppart), (b2,rpart))
| b1 == b2 = ppart >= 0 && rpart ppart >= 0
| otherwise = error "Data.RangeSpace.inRange: basis decompositions must be deterministically ordered"
pVec = val .-. start
rVec = stop .-. start
(start, stop) = toBounds rng
inOrdRange :: Ord a => a -> Range a -> Bool
inOrdRange val rng = val >= start && val <= stop
where
(start,stop) = toBounds rng
compareRange :: Ord a => a -> Range a -> Ordering
compareRange val rng = case (compare val start, compare val stop) of
(LT, _) -> LT
(_, GT) -> GT
_ -> EQ
where
(start,stop) = toBounds rng