{-# LANGUAGE RebindableSyntax #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
module NumHask.Space.Range
( Range (..),
gridSensible,
stepSensible,
)
where
import Data.Distributive as D
import Data.Functor.Apply (Apply (..))
import Data.Functor.Classes
import Data.Functor.Rep
import GHC.Show (show)
import NumHask.Prelude hiding (show)
import NumHask.Space.Types as S
data Range a = Range a a
deriving (Range a -> Range a -> Bool
(Range a -> Range a -> Bool)
-> (Range a -> Range a -> Bool) -> Eq (Range a)
forall a. Eq a => Range a -> Range a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => Range a -> Range a -> Bool
== :: Range a -> Range a -> Bool
$c/= :: forall a. Eq a => Range a -> Range a -> Bool
/= :: Range a -> Range a -> Bool
Eq, (forall x. Range a -> Rep (Range a) x)
-> (forall x. Rep (Range a) x -> Range a) -> Generic (Range a)
forall x. Rep (Range a) x -> Range a
forall x. Range a -> Rep (Range a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (Range a) x -> Range a
forall a x. Range a -> Rep (Range a) x
$cfrom :: forall a x. Range a -> Rep (Range a) x
from :: forall x. Range a -> Rep (Range a) x
$cto :: forall a x. Rep (Range a) x -> Range a
to :: forall x. Rep (Range a) x -> Range a
Generic)
instance Eq1 Range where
liftEq :: forall a b. (a -> b -> Bool) -> Range a -> Range b -> Bool
liftEq a -> b -> Bool
f (Range a
a a
b) (Range b
c b
d) = a -> b -> Bool
f a
a b
c Bool -> Bool -> Bool
&& a -> b -> Bool
f a
b b
d
instance (Show a) => Show (Range a) where
show :: Range a -> String
show (Range a
a a
b) = String
"Range " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> a -> String
forall a. Show a => a -> String
show a
a String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> a -> String
forall a. Show a => a -> String
show a
b
instance Functor Range where
fmap :: forall a b. (a -> b) -> Range a -> Range b
fmap a -> b
f (Range a
a a
b) = b -> b -> Range b
forall a. a -> a -> Range a
Range (a -> b
f a
a) (a -> b
f a
b)
instance Apply Range where
Range a -> b
fa a -> b
fb <.> :: forall a b. Range (a -> b) -> Range a -> Range b
<.> Range a
a a
b = b -> b -> Range b
forall a. a -> a -> Range a
Range (a -> b
fa a
a) (a -> b
fb a
b)
instance Applicative Range where
pure :: forall a. a -> Range a
pure a
a = a -> a -> Range a
forall a. a -> a -> Range a
Range a
a a
a
(Range a -> b
fa a -> b
fb) <*> :: forall a b. Range (a -> b) -> Range a -> Range b
<*> Range a
a a
b = b -> b -> Range b
forall a. a -> a -> Range a
Range (a -> b
fa a
a) (a -> b
fb a
b)
instance Foldable Range where
foldMap :: forall m a. Monoid m => (a -> m) -> Range a -> m
foldMap a -> m
f (Range a
a a
b) = a -> m
f a
a m -> m -> m
forall a. Monoid a => a -> a -> a
`mappend` a -> m
f a
b
instance Traversable Range where
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Range a -> f (Range b)
traverse a -> f b
f (Range a
a a
b) = b -> b -> Range b
forall a. a -> a -> Range a
Range (b -> b -> Range b) -> f b -> f (b -> Range b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
f a
a f (b -> Range b) -> f b -> f (Range b)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> a -> f b
f a
b
instance D.Distributive Range where
collect :: forall (f :: * -> *) a b.
Functor f =>
(a -> Range b) -> f a -> Range (f b)
collect a -> Range b
f f a
x = f b -> f b -> Range (f b)
forall a. a -> a -> Range a
Range (Range b -> b
forall {a}. Range a -> a
getL (Range b -> b) -> (a -> Range b) -> a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a -> Range b
f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f a
x) (Range b -> b
forall {a}. Range a -> a
getR (Range b -> b) -> (a -> Range b) -> a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a -> Range b
f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f a
x)
where
getL :: Range a -> a
getL (Range a
l a
_) = a
l
getR :: Range a -> a
getR (Range a
_ a
r) = a
r
instance Representable Range where
type Rep Range = Bool
tabulate :: forall a. (Rep Range -> a) -> Range a
tabulate Rep Range -> a
f = a -> a -> Range a
forall a. a -> a -> Range a
Range (Rep Range -> a
f Bool
Rep Range
False) (Rep Range -> a
f Bool
Rep Range
True)
index :: forall a. Range a -> Rep Range -> a
index (Range a
l a
_) Bool
Rep Range
False = a
l
index (Range a
_ a
r) Bool
Rep Range
True = a
r
instance (Ord a) => JoinSemiLattice (Range a) where
\/ :: Range a -> Range a -> Range a
(\/) = (a -> a -> a) -> Range a -> Range a -> Range a
forall (f :: * -> *) a b c.
Representable f =>
(a -> b -> c) -> f a -> f b -> f c
liftR2 a -> a -> a
forall a. Ord a => a -> a -> a
min
instance (Ord a) => MeetSemiLattice (Range a) where
/\ :: Range a -> Range a -> Range a
(/\) = (a -> a -> a) -> Range a -> Range a -> Range a
forall (f :: * -> *) a b c.
Representable f =>
(a -> b -> c) -> f a -> f b -> f c
liftR2 a -> a -> a
forall a. Ord a => a -> a -> a
max
instance (Ord a) => Space (Range a) where
type Element (Range a) = a
lower :: Range a -> Element (Range a)
lower (Range a
l a
_) = a
Element (Range a)
l
upper :: Range a -> Element (Range a)
upper (Range a
_ a
u) = a
Element (Range a)
u
>.< :: Element (Range a) -> Element (Range a) -> Range a
(>.<) = a -> a -> Range a
Element (Range a) -> Element (Range a) -> Range a
forall a. a -> a -> Range a
Range
instance (Field a, Ord a, FromIntegral a Int) => FieldSpace (Range a) where
type Grid (Range a) = Int
grid :: Pos -> Range a -> Grid (Range a) -> [Element (Range a)]
grid Pos
o Range a
s Grid (Range a)
n = (a -> a -> a
forall a. Additive a => a -> a -> a
+ a -> a -> Bool -> a
forall a. a -> a -> Bool -> a
bool a
forall a. Additive a => a
zero (a
step a -> a -> a
forall a. Divisive a => a -> a -> a
/ a
forall a. (Multiplicative a, Additive a) => a
two) (Pos
o Pos -> Pos -> Bool
forall a. Eq a => a -> a -> Bool
== Pos
MidPos)) (a -> a) -> [a] -> [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [a]
posns
where
posns :: [a]
posns = (Range a -> Element (Range a)
forall s. Space s => s -> Element s
lower Range a
s +) (a -> a) -> (Int -> a) -> Int -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (a
step *) (a -> a) -> (Int -> a) -> Int -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Int -> a
forall a b. FromIntegral a b => b -> a
fromIntegral (Int -> a) -> [Int] -> [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Int
i0 .. Int
i1]
step :: a
step = a -> a -> a
forall a. Divisive a => a -> a -> a
(/) (Range a -> Element (Range a)
forall s. (Space s, Subtractive (Element s)) => s -> Element s
width Range a
s) (Int -> a
forall a b. FromIntegral a b => b -> a
fromIntegral Int
Grid (Range a)
n)
(Int
i0, Int
i1) = case Pos
o of
Pos
OuterPos -> (Int
0, Int
Grid (Range a)
n)
Pos
InnerPos -> (Int
1, Int
Grid (Range a)
n Int -> Int -> Int
forall a. Subtractive a => a -> a -> a
- Int
1)
Pos
LowerPos -> (Int
0, Int
Grid (Range a)
n Int -> Int -> Int
forall a. Subtractive a => a -> a -> a
- Int
1)
Pos
UpperPos -> (Int
1, Int
Grid (Range a)
n)
Pos
MidPos -> (Int
0, Int
Grid (Range a)
n Int -> Int -> Int
forall a. Subtractive a => a -> a -> a
- Int
1)
gridSpace :: Range a -> Grid (Range a) -> [Range a]
gridSpace Range a
r Grid (Range a)
n = (a -> a -> Range a) -> [a] -> [a] -> [Range a]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith a -> a -> Range a
forall a. a -> a -> Range a
Range [a]
[Element (Range a)]
ps (Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
drop Int
1 [a]
[Element (Range a)]
ps)
where
ps :: [Element (Range a)]
ps = Pos -> Range a -> Grid (Range a) -> [Element (Range a)]
forall s. FieldSpace s => Pos -> s -> Grid s -> [Element s]
grid Pos
OuterPos Range a
r Grid (Range a)
n
instance (Ord a) => Semigroup (Range a) where
<> :: Range a -> Range a -> Range a
(<>) Range a
a Range a
b = Union (Range a) -> Range a
forall a. Union a -> a
getUnion (Range a -> Union (Range a)
forall a. a -> Union a
Union Range a
a Union (Range a) -> Union (Range a) -> Union (Range a)
forall a. Semigroup a => a -> a -> a
<> Range a -> Union (Range a)
forall a. a -> Union a
Union Range a
b)
instance (Additive a, Ord a) => Additive (Range a) where
(Range a
l a
u) + :: Range a -> Range a -> Range a
+ (Range a
l' a
u') = [Element (Range a)] -> Range a
forall s (f :: * -> *).
(Space s, Traversable f) =>
f (Element s) -> s
unsafeSpace1 [a
l a -> a -> a
forall a. Additive a => a -> a -> a
+ a
l', a
u a -> a -> a
forall a. Additive a => a -> a -> a
+ a
u']
zero :: Range a
zero = a -> a -> Range a
forall a. a -> a -> Range a
Range a
forall a. Additive a => a
zero a
forall a. Additive a => a
zero
instance (Subtractive a, Ord a) => Subtractive (Range a) where
negate :: Range a -> Range a
negate (Range a
l a
u) = a -> a
forall a. Subtractive a => a -> a
negate a
u Element (Range a) -> Element (Range a) -> Range a
forall s. Space s => Element s -> Element s -> s
... a -> a
forall a. Subtractive a => a -> a
negate a
l
instance (Field a, Ord a) => Multiplicative (Range a) where
Range a
a * :: Range a -> Range a -> Range a
* Range a
b = Range a -> Range a -> Bool -> Range a
forall a. a -> a -> Bool -> a
bool (a -> a -> Range a
forall a. a -> a -> Range a
Range (a
m a -> a -> a
forall a. Subtractive a => a -> a -> a
- a
r a -> a -> a
forall a. Divisive a => a -> a -> a
/ (a
forall a. Multiplicative a => a
one a -> a -> a
forall a. Additive a => a -> a -> a
+ a
forall a. Multiplicative a => a
one)) (a
m a -> a -> a
forall a. Additive a => a -> a -> a
+ a
r a -> a -> a
forall a. Divisive a => a -> a -> a
/ (a
forall a. Multiplicative a => a
one a -> a -> a
forall a. Additive a => a -> a -> a
+ a
forall a. Multiplicative a => a
one))) Range a
forall a. Additive a => a
zero (Range a
a Range a -> Range a -> Bool
forall a. Eq a => a -> a -> Bool
== Range a
forall a. Additive a => a
zero Bool -> Bool -> Bool
|| Range a
b Range a -> Range a -> Bool
forall a. Eq a => a -> a -> Bool
== Range a
forall a. Additive a => a
zero)
where
m :: a
m = Range a -> Element (Range a)
forall s. (Space s, Field (Element s)) => s -> Element s
mid Range a
a a -> a -> a
forall a. Additive a => a -> a -> a
+ Range a -> Element (Range a)
forall s. (Space s, Field (Element s)) => s -> Element s
mid Range a
b
r :: a
r = Range a -> Element (Range a)
forall s. (Space s, Subtractive (Element s)) => s -> Element s
width Range a
a a -> a -> a
forall a. Multiplicative a => a -> a -> a
* Range a -> Element (Range a)
forall s. (Space s, Subtractive (Element s)) => s -> Element s
width Range a
b
one :: Range a
one = a -> a -> Range a
forall a. a -> a -> Range a
Range (a -> a
forall a. Subtractive a => a -> a
negate a
forall a. Multiplicative a => a
one a -> a -> a
forall a. Divisive a => a -> a -> a
/ (a
forall a. Multiplicative a => a
one a -> a -> a
forall a. Additive a => a -> a -> a
+ a
forall a. Multiplicative a => a
one)) (a
forall a. Multiplicative a => a
one a -> a -> a
forall a. Divisive a => a -> a -> a
/ (a
forall a. Multiplicative a => a
one a -> a -> a
forall a. Additive a => a -> a -> a
+ a
forall a. Multiplicative a => a
one))
instance (Ord a, Field a) => Divisive (Range a) where
recip :: Range a -> Range a
recip Range a
a = Range a -> Range a -> Bool -> Range a
forall a. a -> a -> Bool -> a
bool (a -> a -> Range a
forall a. a -> a -> Range a
Range (-a
Element (Range a)
m a -> a -> a
forall a. Subtractive a => a -> a -> a
- a
forall a. Multiplicative a => a
one a -> a -> a
forall a. Divisive a => a -> a -> a
/ (a
forall a. (Multiplicative a, Additive a) => a
two a -> a -> a
forall a. Multiplicative a => a -> a -> a
* a
Element (Range a)
r)) (-a
Element (Range a)
m a -> a -> a
forall a. Additive a => a -> a -> a
+ a
forall a. Multiplicative a => a
one a -> a -> a
forall a. Divisive a => a -> a -> a
/ (a
forall a. (Multiplicative a, Additive a) => a
two a -> a -> a
forall a. Multiplicative a => a -> a -> a
* a
Element (Range a)
r))) Range a
forall a. Additive a => a
zero (a
Element (Range a)
r a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
forall a. Additive a => a
zero)
where
m :: Element (Range a)
m = Range a -> Element (Range a)
forall s. (Space s, Field (Element s)) => s -> Element s
mid Range a
a
r :: Element (Range a)
r = Range a -> Element (Range a)
forall s. (Space s, Subtractive (Element s)) => s -> Element s
width Range a
a
instance (Field a, Ord a) => Basis (Range a) where
type Mag (Range a) = Range a
type Base (Range a) = a
basis :: Range a -> Base (Range a)
basis (Range a
l a
u) = a -> a -> Bool -> a
forall a. a -> a -> Bool -> a
bool (a -> a
forall a. Subtractive a => a -> a
negate a
forall a. Multiplicative a => a
one) a
forall a. Multiplicative a => a
one (a
u a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
l)
magnitude :: Range a -> Mag (Range a)
magnitude (Range a
l a
u) = Range a -> Range a -> Bool -> Range a
forall a. a -> a -> Bool -> a
bool (a
Element (Range a)
u Element (Range a) -> Element (Range a) -> Range a
forall s. Space s => Element s -> Element s -> s
... a
Element (Range a)
l) (a
Element (Range a)
l Element (Range a) -> Element (Range a) -> Range a
forall s. Space s => Element s -> Element s -> s
... a
Element (Range a)
u) (a
u a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
l)
stepSensible :: Pos -> Double -> Int -> Double
stepSensible :: Pos -> Double -> Int -> Double
stepSensible Pos
tp Double
span' Int
n =
Double
step Double -> Double -> Double
forall a. Additive a => a -> a -> a
+ Double -> Double -> Bool -> Double
forall a. a -> a -> Bool -> a
bool Double
0 (Double
step Double -> Double -> Double
forall a. Divisive a => a -> a -> a
/ Double
2) (Pos
tp Pos -> Pos -> Bool
forall a. Eq a => a -> a -> Bool
== Pos
MidPos)
where
step' :: Double
step' = Double
10.0 Double -> Int -> Double
forall b a.
(Ord b, Divisive a, Subtractive b, Integral b) =>
a -> b -> a
^^ Double -> Whole Double
forall a. QuotientField a => a -> Whole a
floor (Double -> Double -> Double
forall a. ExpField a => a -> a -> a
logBase Double
10 (Double
span' Double -> Double -> Double
forall a. Divisive a => a -> a -> a
/ Int -> Double
forall a b. FromIntegral a b => b -> a
fromIntegral Int
n))
err :: Double
err = Int -> Double
forall a b. FromIntegral a b => b -> a
fromIntegral Int
n Double -> Double -> Double
forall a. Divisive a => a -> a -> a
/ Double
span' Double -> Double -> Double
forall a. Multiplicative a => a -> a -> a
* Double
step'
step :: Double
step
| Double
err Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= Double
0.15 = Double
10.0 Double -> Double -> Double
forall a. Multiplicative a => a -> a -> a
* Double
step'
| Double
err Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= Double
0.35 = Double
5.0 Double -> Double -> Double
forall a. Multiplicative a => a -> a -> a
* Double
step'
| Double
err Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= Double
0.75 = Double
2.0 Double -> Double -> Double
forall a. Multiplicative a => a -> a -> a
* Double
step'
| Bool
otherwise = Double
step'
gridSensible ::
Pos ->
Bool ->
Range Double ->
Int ->
[Double]
gridSensible :: Pos -> Bool -> Range Double -> Int -> [Double]
gridSensible Pos
tp Bool
inside r :: Range Double
r@(Range Double
l Double
u) Int
n =
[Double] -> [Double] -> Bool -> [Double]
forall a. a -> a -> Bool -> a
bool
( ([Double] -> [Double])
-> ([Double] -> [Double]) -> Bool -> [Double] -> [Double]
forall a. a -> a -> Bool -> a
bool [Double] -> [Double]
forall a. a -> a
forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id ((Double -> Bool) -> [Double] -> [Double]
forall a. (a -> Bool) -> [a] -> [a]
filter (Element (Range Double) -> Range Double -> Bool
forall s. Space s => Element s -> s -> Bool
`memberOf` Range Double
r)) Bool
inside ([Double] -> [Double]) -> [Double] -> [Double]
forall a b. (a -> b) -> a -> b
$
(Double -> Double -> Double
forall a. Additive a => a -> a -> a
+ Double -> Double -> Bool -> Double
forall a. a -> a -> Bool -> a
bool Double
0 (Double
step Double -> Double -> Double
forall a. Divisive a => a -> a -> a
/ Double
2) (Pos
tp Pos -> Pos -> Bool
forall a. Eq a => a -> a -> Bool
== Pos
MidPos)) (Double -> Double) -> [Double] -> [Double]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Double]
posns
)
[Double
l Double -> Double -> Double
forall a. Subtractive a => a -> a -> a
- Double
0.5, Double
l Double -> Double -> Double
forall a. Additive a => a -> a -> a
+ Double
0.5]
(Double
span' Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== Double
forall a. Additive a => a
zero)
where
posns :: [Double]
posns = (Double
first' +) (Double -> Double) -> (Int -> Double) -> Int -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Double
step *) (Double -> Double) -> (Int -> Double) -> Int -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Int -> Double
forall a b. FromIntegral a b => b -> a
fromIntegral (Int -> Double) -> [Int] -> [Double]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Int
i0 .. Int
i1]
span' :: Double
span' = Double
u Double -> Double -> Double
forall a. Subtractive a => a -> a -> a
- Double
l
step :: Double
step = Pos -> Double -> Int -> Double
stepSensible Pos
tp Double
span' Int
n
first' :: Double
first' = Double
step Double -> Double -> Double
forall a. Multiplicative a => a -> a -> a
* Int -> Double
forall a b. FromIntegral a b => b -> a
fromIntegral (Double -> Whole Double
forall a. QuotientField a => a -> Whole a
floor (Double
l Double -> Double -> Double
forall a. Divisive a => a -> a -> a
/ Double
step Double -> Double -> Double
forall a. Additive a => a -> a -> a
+ Double
1e-6))
last' :: Double
last' = Double
step Double -> Double -> Double
forall a. Multiplicative a => a -> a -> a
* Int -> Double
forall a b. FromIntegral a b => b -> a
fromIntegral (Double -> Whole Double
forall a. QuotientField a => a -> Whole a
ceiling (Double
u Double -> Double -> Double
forall a. Divisive a => a -> a -> a
/ Double
step Double -> Double -> Double
forall a. Subtractive a => a -> a -> a
- Double
1e-6))
n' :: Whole Double
n' = Double -> Whole Double
forall a. QuotientField a => a -> Whole a
round ((Double
last' Double -> Double -> Double
forall a. Subtractive a => a -> a -> a
- Double
first') Double -> Double -> Double
forall a. Divisive a => a -> a -> a
/ Double
step)
(Int
i0, Int
i1) =
case Pos
tp of
Pos
OuterPos -> (Int
0, Int
Whole Double
n')
Pos
InnerPos -> (Int
1, Int
Whole Double
n' Int -> Int -> Int
forall a. Subtractive a => a -> a -> a
- Int
1)
Pos
LowerPos -> (Int
0, Int
Whole Double
n' Int -> Int -> Int
forall a. Subtractive a => a -> a -> a
- Int
1)
Pos
UpperPos -> (Int
1, Int
Whole Double
n')
Pos
MidPos -> (Int
0, Int
Whole Double
n' Int -> Int -> Int
forall a. Subtractive a => a -> a -> a
- Int
1)