module Numeric.Interpolation.NodeList (
T(Interval, Node),
fromList,
toList,
singleton,
lookup,
) where
import Data.Tuple.HT (mapFst)
import Data.Traversable (Traversable, traverse)
import Data.Foldable (Foldable, foldMap)
import Data.Monoid (mempty, (<>))
import Control.Applicative (liftA3, pure)
import Prelude hiding (lookup)
data T x y = Interval | Node (x, y) (T x y) (T x y)
deriving (T x y -> T x y -> Bool
(T x y -> T x y -> Bool) -> (T x y -> T x y -> Bool) -> Eq (T x y)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall x y. (Eq x, Eq y) => T x y -> T x y -> Bool
/= :: T x y -> T x y -> Bool
$c/= :: forall x y. (Eq x, Eq y) => T x y -> T x y -> Bool
== :: T x y -> T x y -> Bool
$c== :: forall x y. (Eq x, Eq y) => T x y -> T x y -> Bool
Eq, Eq (T x y)
Eq (T x y)
-> (T x y -> T x y -> Ordering)
-> (T x y -> T x y -> Bool)
-> (T x y -> T x y -> Bool)
-> (T x y -> T x y -> Bool)
-> (T x y -> T x y -> Bool)
-> (T x y -> T x y -> T x y)
-> (T x y -> T x y -> T x y)
-> Ord (T x y)
T x y -> T x y -> Bool
T x y -> T x y -> Ordering
T x y -> T x y -> T x y
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 y. (Ord x, Ord y) => Eq (T x y)
forall x y. (Ord x, Ord y) => T x y -> T x y -> Bool
forall x y. (Ord x, Ord y) => T x y -> T x y -> Ordering
forall x y. (Ord x, Ord y) => T x y -> T x y -> T x y
min :: T x y -> T x y -> T x y
$cmin :: forall x y. (Ord x, Ord y) => T x y -> T x y -> T x y
max :: T x y -> T x y -> T x y
$cmax :: forall x y. (Ord x, Ord y) => T x y -> T x y -> T x y
>= :: T x y -> T x y -> Bool
$c>= :: forall x y. (Ord x, Ord y) => T x y -> T x y -> Bool
> :: T x y -> T x y -> Bool
$c> :: forall x y. (Ord x, Ord y) => T x y -> T x y -> Bool
<= :: T x y -> T x y -> Bool
$c<= :: forall x y. (Ord x, Ord y) => T x y -> T x y -> Bool
< :: T x y -> T x y -> Bool
$c< :: forall x y. (Ord x, Ord y) => T x y -> T x y -> Bool
compare :: T x y -> T x y -> Ordering
$ccompare :: forall x y. (Ord x, Ord y) => T x y -> T x y -> Ordering
$cp1Ord :: forall x y. (Ord x, Ord y) => Eq (T x y)
Ord, Int -> T x y -> ShowS
[T x y] -> ShowS
T x y -> String
(Int -> T x y -> ShowS)
-> (T x y -> String) -> ([T x y] -> ShowS) -> Show (T x y)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall x y. (Show x, Show y) => Int -> T x y -> ShowS
forall x y. (Show x, Show y) => [T x y] -> ShowS
forall x y. (Show x, Show y) => T x y -> String
showList :: [T x y] -> ShowS
$cshowList :: forall x y. (Show x, Show y) => [T x y] -> ShowS
show :: T x y -> String
$cshow :: forall x y. (Show x, Show y) => T x y -> String
showsPrec :: Int -> T x y -> ShowS
$cshowsPrec :: forall x y. (Show x, Show y) => Int -> T x y -> ShowS
Show)
instance Functor (T x) where
fmap :: (a -> b) -> T x a -> T x b
fmap a -> b
f =
let go :: T x a -> T x b
go T x a
Interval = T x b
forall x y. T x y
Interval
go (Node (x
x,a
y) T x a
l T x a
r) = (x, b) -> T x b -> T x b -> T x b
forall x y. (x, y) -> T x y -> T x y -> T x y
Node (x
x, a -> b
f a
y) (T x a -> T x b
go T x a
l) (T x a -> T x b
go T x a
r)
in T x a -> T x b
forall x. T x a -> T x b
go
instance Foldable (T x) where
foldMap :: (a -> m) -> T x a -> m
foldMap a -> m
f =
let go :: T x a -> m
go T x a
Interval = m
forall a. Monoid a => a
mempty
go (Node (x
_x,a
y) T x a
l T x a
r) = T x a -> m
go T x a
l m -> m -> m
forall a. Semigroup a => a -> a -> a
<> a -> m
f a
y m -> m -> m
forall a. Semigroup a => a -> a -> a
<> T x a -> m
go T x a
r
in T x a -> m
forall x. T x a -> m
go
instance Traversable (T x) where
traverse :: (a -> f b) -> T x a -> f (T x b)
traverse a -> f b
f =
let go :: T x a -> f (T x b)
go T x a
Interval = T x b -> f (T x b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure T x b
forall x y. T x y
Interval
go (Node (x
x,a
y) T x a
l0 T x a
r0) =
(T x b -> b -> T x b -> T x b)
-> f (T x b) -> f b -> f (T x b) -> f (T x b)
forall (f :: * -> *) a b c d.
Applicative f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
liftA3 (\T x b
l b
m T x b
r -> (x, b) -> T x b -> T x b -> T x b
forall x y. (x, y) -> T x y -> T x y -> T x y
Node (x
x,b
m) T x b
l T x b
r) (T x a -> f (T x b)
go T x a
l0) (a -> f b
f a
y) (T x a -> f (T x b)
go T x a
r0)
in T x a -> f (T x b)
forall x. T x a -> f (T x b)
go
fromList :: [(x,y)] -> T x y
fromList :: [(x, y)] -> T x y
fromList =
let merge :: T x y -> [((x, y), T x y)] -> (T x y, [((x, y), T x y)])
merge T x y
n0 [((x, y), T x y)]
xys0 =
case [((x, y), T x y)]
xys0 of
((x, y)
xy0,T x y
n1):((x, y)
xy1,T x y
n2):[((x, y), T x y)]
xys ->
((x, y) -> T x y -> T x y -> T x y
forall x y. (x, y) -> T x y -> T x y -> T x y
Node (x, y)
xy0 T x y
n0 T x y
n1,
(((x, y), T x y) -> [((x, y), T x y)] -> [((x, y), T x y)])
-> (((x, y), T x y), [((x, y), T x y)]) -> [((x, y), T x y)]
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (:) ((((x, y), T x y), [((x, y), T x y)]) -> [((x, y), T x y)])
-> (((x, y), T x y), [((x, y), T x y)]) -> [((x, y), T x y)]
forall a b. (a -> b) -> a -> b
$ (T x y -> ((x, y), T x y))
-> (T x y, [((x, y), T x y)])
-> (((x, y), T x y), [((x, y), T x y)])
forall a c b. (a -> c) -> (a, b) -> (c, b)
mapFst ((,) (x, y)
xy1) ((T x y, [((x, y), T x y)])
-> (((x, y), T x y), [((x, y), T x y)]))
-> (T x y, [((x, y), T x y)])
-> (((x, y), T x y), [((x, y), T x y)])
forall a b. (a -> b) -> a -> b
$ T x y -> [((x, y), T x y)] -> (T x y, [((x, y), T x y)])
merge T x y
n2 [((x, y), T x y)]
xys)
((x, y)
xy0,T x y
n1):[] -> ((x, y) -> T x y -> T x y -> T x y
forall x y. (x, y) -> T x y -> T x y -> T x y
Node (x, y)
xy0 T x y
n0 T x y
n1, [])
[] -> (T x y
n0, [])
rep :: (T x y, [((x, y), T x y)]) -> T x y
rep (T x y
n,[((x, y), T x y)]
xyns) = if [((x, y), T x y)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [((x, y), T x y)]
xyns then T x y
n else (T x y, [((x, y), T x y)]) -> T x y
rep ((T x y, [((x, y), T x y)]) -> T x y)
-> (T x y, [((x, y), T x y)]) -> T x y
forall a b. (a -> b) -> a -> b
$ T x y -> [((x, y), T x y)] -> (T x y, [((x, y), T x y)])
forall x y.
T x y -> [((x, y), T x y)] -> (T x y, [((x, y), T x y)])
merge T x y
n [((x, y), T x y)]
xyns
in (T x y, [((x, y), T x y)]) -> T x y
forall x y. (T x y, [((x, y), T x y)]) -> T x y
rep ((T x y, [((x, y), T x y)]) -> T x y)
-> ([(x, y)] -> (T x y, [((x, y), T x y)])) -> [(x, y)] -> T x y
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T x y -> [((x, y), T x y)] -> (T x y, [((x, y), T x y)])
forall x y.
T x y -> [((x, y), T x y)] -> (T x y, [((x, y), T x y)])
merge T x y
forall x y. T x y
Interval ([((x, y), T x y)] -> (T x y, [((x, y), T x y)]))
-> ([(x, y)] -> [((x, y), T x y)])
-> [(x, y)]
-> (T x y, [((x, y), T x y)])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((x, y) -> ((x, y), T x y)) -> [(x, y)] -> [((x, y), T x y)]
forall a b. (a -> b) -> [a] -> [b]
map (((x, y) -> T x y -> ((x, y), T x y))
-> T x y -> (x, y) -> ((x, y), T x y)
forall a b c. (a -> b -> c) -> b -> a -> c
flip (,) T x y
forall x y. T x y
Interval)
singleton :: x -> y -> T x y
singleton :: x -> y -> T x y
singleton x
x y
y = (x, y) -> T x y -> T x y -> T x y
forall x y. (x, y) -> T x y -> T x y -> T x y
Node (x
x,y
y) T x y
forall x y. T x y
Interval T x y
forall x y. T x y
Interval
toList :: T x y -> [(x,y)]
toList :: T x y -> [(x, y)]
toList =
let go :: T x y -> [(x, y)]
go T x y
Interval = []
go (Node (x, y)
p T x y
l T x y
r) = T x y -> [(x, y)]
go T x y
l [(x, y)] -> [(x, y)] -> [(x, y)]
forall a. [a] -> [a] -> [a]
++ (x, y)
p (x, y) -> [(x, y)] -> [(x, y)]
forall a. a -> [a] -> [a]
: T x y -> [(x, y)]
go T x y
r
in T x y -> [(x, y)]
forall x y. T x y -> [(x, y)]
go
lookup :: Ord x => T x y -> x -> (Maybe (x,y), Maybe (x,y))
lookup :: T x y -> x -> (Maybe (x, y), Maybe (x, y))
lookup T x y
nodes0 x
x0 =
let go :: Maybe (x, y)
-> Maybe (x, y) -> T x y -> (Maybe (x, y), Maybe (x, y))
go Maybe (x, y)
lb Maybe (x, y)
rb T x y
Interval = (Maybe (x, y)
lb, Maybe (x, y)
rb)
go Maybe (x, y)
lb Maybe (x, y)
rb (Node n :: (x, y)
n@(x
x,y
_y) T x y
ln T x y
rn) =
if x
x0x -> x -> Bool
forall a. Ord a => a -> a -> Bool
>=x
x
then Maybe (x, y)
-> Maybe (x, y) -> T x y -> (Maybe (x, y), Maybe (x, y))
go ((x, y) -> Maybe (x, y)
forall a. a -> Maybe a
Just (x, y)
n) Maybe (x, y)
rb T x y
rn
else Maybe (x, y)
-> Maybe (x, y) -> T x y -> (Maybe (x, y), Maybe (x, y))
go Maybe (x, y)
lb ((x, y) -> Maybe (x, y)
forall a. a -> Maybe a
Just (x, y)
n) T x y
ln
in Maybe (x, y)
-> Maybe (x, y) -> T x y -> (Maybe (x, y), Maybe (x, y))
forall y.
Maybe (x, y)
-> Maybe (x, y) -> T x y -> (Maybe (x, y), Maybe (x, y))
go Maybe (x, y)
forall a. Maybe a
Nothing Maybe (x, y)
forall a. Maybe a
Nothing T x y
nodes0