{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE DeriveFunctor #-}
{-# language DeriveGeneric #-}
{-# language LambdaCase #-}
{-# language GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiWayIf #-}
{-# options_ghc -Wno-unused-imports #-}
{-# options_ghc -Wno-unused-top-binds #-}
module Data.RPTree (
tree
, forest
, rpTreeCfg, RPTreeConfig(..)
, knn
, knnPQ
, serialiseRPForest
, deserialiseRPForest
, recallWith
, leaves, levels, points, candidates
, treeStats, treeSize, leafSizes
, RPTreeStats
, Embed(..)
, RPTree, RPForest
, SVector, fromListSv, fromVectorSv
, DVector, fromListDv, fromVectorDv
, Inner(..), Scale(..)
, innerSS, innerSD, innerDD
, metricSSL2, metricSDL2
, scaleS, scaleD
, writeCsv
, writeDot
, BenchConfig(..), normalSparse2
, liftC
, randSeed
, dataSource
, datS, datD
, sparse, dense
, normal2, circle2d
) where
import Control.Monad (replicateM)
import Control.Monad.IO.Class (MonadIO(..))
import Data.Foldable (Foldable(..), maximumBy, minimumBy)
import Data.Functor.Identity (Identity(..))
import Data.List (partition, sortBy)
import Data.Maybe (maybeToList)
import Data.Monoid (Sum(..))
import Data.Ord (comparing)
import Data.Semigroup (Min(..))
import GHC.Generics (Generic)
import GHC.Word (Word64)
import Data.Sequence (Seq, (|>))
import qualified Data.Map as M (Map, fromList, toList, foldrWithKey, insert, insertWith, intersection)
import qualified Data.Set as S (Set, fromList, intersection, insert)
import Control.DeepSeq (NFData(..))
import qualified Data.Heap as H (Heap, fromList, insert, Entry(..), empty, group, viewMin, map)
import Control.Monad.Trans.State (StateT(..), runStateT, evalStateT, State, runState, evalState, get, put)
import Control.Monad.Trans.Class (MonadTrans(..))
import qualified Data.Vector as V (Vector, replicateM, fromList)
import qualified Data.Vector.Generic as VG (Vector(..), unfoldrM, length, replicateM, (!), map, freeze, thaw, take, drop, unzip, foldl, fromList)
import qualified Data.Vector.Unboxed as VU (Vector, Unbox, fromList)
import qualified Data.Vector.Storable as VS (Vector)
import qualified Data.Vector.Algorithms.Merge as V (sortBy)
import Data.RPTree.Conduit (tree, forest, dataSource, liftC, rpTreeCfg, RPTreeConfig(..))
import Data.RPTree.Gen (sparse, dense, normal2, normalSparse2, circle2d)
import Data.RPTree.Internal (RPTree(..), RPForest, RPT(..), Embed(..), leaves, levels, points, Inner(..), Scale(..), scaleS, scaleD, (/.), innerDD, innerSD, innerSS, metricSSL2, metricSDL2, SVector(..), fromListSv, fromVectorSv, DVector(..), fromListDv, fromVectorDv, partitionAtMedian, Margin, getMargin, sortByVG, serialiseRPForest, deserialiseRPForest)
import Data.RPTree.Internal.Testing (BenchConfig(..), randSeed, datS, datD)
import Data.RPTree.Draw (writeDot, writeCsv)
knn :: (Ord p, Inner SVector v, VU.Unbox d, Real d) =>
(u d -> v d -> p)
-> Int
-> RPForest d (V.Vector (Embed u d x))
-> v d
-> V.Vector (p, Embed u d x)
knn :: (u d -> v d -> p)
-> Int
-> RPForest d (Vector (Embed u d x))
-> v d
-> Vector (p, Embed u d x)
knn u d -> v d -> p
distf Int
k RPForest d (Vector (Embed u d x))
tts v d
q = Int -> Vector (p, Embed u d x) -> Vector (p, Embed u d x)
forall (v :: * -> *) a. Vector v a => Int -> v a -> v a
VG.take Int
k (Vector (p, Embed u d x) -> Vector (p, Embed u d x))
-> Vector (p, Embed u d x) -> Vector (p, Embed u d x)
forall a b. (a -> b) -> a -> b
$ ((p, Embed u d x) -> p)
-> Vector (p, Embed u d x) -> Vector (p, Embed u d x)
forall (v :: * -> *) a b.
(Vector v a, Ord b) =>
(a -> b) -> v a -> v a
sortByVG (p, Embed u d x) -> p
forall a b. (a, b) -> a
fst Vector (p, Embed u d x)
cs
where
cs :: Vector (p, Embed u d x)
cs = (Embed u d x -> (p, Embed u d x))
-> Vector (Embed u d x) -> Vector (p, Embed u d x)
forall (v :: * -> *) a b.
(Vector v a, Vector v b) =>
(a -> b) -> v a -> v b
VG.map (\Embed u d x
xe -> (Embed u d x -> u d
forall (v :: * -> *) e a. Embed v e a -> v e
eEmbed Embed u d x
xe u d -> v d -> p
`distf` v d
q, Embed u d x
xe)) (Vector (Embed u d x) -> Vector (p, Embed u d x))
-> Vector (Embed u d x) -> Vector (p, Embed u d x)
forall a b. (a -> b) -> a -> b
$ IntMap (Vector (Embed u d x)) -> Vector (Embed u d x)
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold (IntMap (Vector (Embed u d x)) -> Vector (Embed u d x))
-> IntMap (Vector (Embed u d x)) -> Vector (Embed u d x)
forall a b. (a -> b) -> a -> b
$ (RPTree d () (Vector (Embed u d x)) -> v d -> Vector (Embed u d x)
forall (v :: * -> *) d xs l.
(Inner SVector v, Unbox d, Ord d, Num d, Semigroup xs) =>
RPTree d l xs -> v d -> xs
`candidates` v d
q) (RPTree d () (Vector (Embed u d x)) -> Vector (Embed u d x))
-> RPForest d (Vector (Embed u d x))
-> IntMap (Vector (Embed u d x))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RPForest d (Vector (Embed u d x))
tts
knnPQ :: (Ord p, Inner SVector v, VU.Unbox d, Real d) =>
(u d -> v d -> p)
-> Int
-> RPForest d (V.Vector (Embed u d x))
-> v d
-> V.Vector (p, Embed u d x)
knnPQ :: (u d -> v d -> p)
-> Int
-> RPForest d (Vector (Embed u d x))
-> v d
-> Vector (p, Embed u d x)
knnPQ u d -> v d -> p
distf Int
k RPForest d (Vector (Embed u d x))
tts v d
q = [(p, Embed u d x)] -> Vector (p, Embed u d x)
forall (v :: * -> *) a. Vector v a => [a] -> v a
VG.fromList ([(p, Embed u d x)] -> Vector (p, Embed u d x))
-> [(p, Embed u d x)] -> Vector (p, Embed u d x)
forall a b. (a -> b) -> a -> b
$ Int -> [(p, Embed u d x)] -> [(p, Embed u d x)]
forall a. Int -> [a] -> [a]
take Int
k ([(p, Embed u d x)] -> [(p, Embed u d x)])
-> [(p, Embed u d x)] -> [(p, Embed u d x)]
forall a b. (a -> b) -> a -> b
$ (Entry p (Embed u d x) -> (p, Embed u d x))
-> [Entry p (Embed u d x)] -> [(p, Embed u d x)]
forall a b. (a -> b) -> [a] -> [b]
map (\(H.Entry p
p Embed u d x
x) -> (p
p , Embed u d x
x)) ([Entry p (Embed u d x)] -> [(p, Embed u d x)])
-> [Entry p (Embed u d x)] -> [(p, Embed u d x)]
forall a b. (a -> b) -> a -> b
$ Heap (Entry p (Embed u d x)) -> [Entry p (Embed u d x)]
forall a. Ord a => Heap a -> [a]
nub Heap (Entry p (Embed u d x))
h
where
xs :: Vector (Embed u d x)
xs = IntMap (Vector (Embed u d x)) -> Vector (Embed u d x)
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold (IntMap (Vector (Embed u d x)) -> Vector (Embed u d x))
-> IntMap (Vector (Embed u d x)) -> Vector (Embed u d x)
forall a b. (a -> b) -> a -> b
$ (RPTree d () (Vector (Embed u d x)) -> v d -> Vector (Embed u d x)
forall (v :: * -> *) d xs l.
(Inner SVector v, Unbox d, Ord d, Num d, Semigroup xs) =>
RPTree d l xs -> v d -> xs
`candidates` v d
q) (RPTree d () (Vector (Embed u d x)) -> Vector (Embed u d x))
-> RPForest d (Vector (Embed u d x))
-> IntMap (Vector (Embed u d x))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RPForest d (Vector (Embed u d x))
tts
h :: Heap (Entry p (Embed u d x))
h = (Heap (Entry p (Embed u d x))
-> Embed u d x -> Heap (Entry p (Embed u d x)))
-> Heap (Entry p (Embed u d x))
-> Vector (Embed u d x)
-> Heap (Entry p (Embed u d x))
forall (v :: * -> *) b a.
Vector v b =>
(a -> b -> a) -> a -> v b -> a
VG.foldl Heap (Entry p (Embed u d x))
-> Embed u d x -> Heap (Entry p (Embed u d x))
forall a.
Heap (Entry p (Embed u d a))
-> Embed u d a -> Heap (Entry p (Embed u d a))
insf Heap (Entry p (Embed u d x))
forall a. Heap a
H.empty Vector (Embed u d x)
xs
insf :: Heap (Entry p (Embed u d a))
-> Embed u d a -> Heap (Entry p (Embed u d a))
insf Heap (Entry p (Embed u d a))
acc Embed u d a
x = Entry p (Embed u d a)
-> Heap (Entry p (Embed u d a)) -> Heap (Entry p (Embed u d a))
forall a. Ord a => a -> Heap a -> Heap a
H.insert (p -> Embed u d a -> Entry p (Embed u d a)
forall p a. p -> a -> Entry p a
H.Entry p
p Embed u d a
x) Heap (Entry p (Embed u d a))
acc
where
p :: p
p = Embed u d a -> u d
forall (v :: * -> *) e a. Embed v e a -> v e
eEmbed Embed u d a
x u d -> v d -> p
`distf` v d
q
nub :: (Ord a) => H.Heap a -> [a]
nub :: Heap a -> [a]
nub = (Maybe a -> [a]) -> Heap (Maybe a) -> [a]
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Maybe a -> [a]
forall a. Maybe a -> [a]
maybeToList (Heap (Maybe a) -> [a])
-> (Heap a -> Heap (Maybe a)) -> Heap a -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Heap a -> Maybe a) -> Heap (Heap a) -> Heap (Maybe a)
forall b a. Ord b => (a -> b) -> Heap a -> Heap b
H.map Heap a -> Maybe a
forall b. Heap b -> Maybe b
view (Heap (Heap a) -> Heap (Maybe a))
-> (Heap a -> Heap (Heap a)) -> Heap a -> Heap (Maybe a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Heap a -> Heap (Heap a)
forall a. Heap a -> Heap (Heap a)
H.group
where
view :: Heap b -> Maybe b
view Heap b
h = (b, Heap b) -> b
forall a b. (a, b) -> a
fst ((b, Heap b) -> b) -> Maybe (b, Heap b) -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Heap b -> Maybe (b, Heap b)
forall a. Heap a -> Maybe (a, Heap a)
H.viewMin Heap b
h
type PQueue p a = H.Heap (H.Entry p a)
recallWith :: (Inner SVector v, VU.Unbox d, Fractional b, Ord d, Ord a, Ord x, Ord (u d), Num d) =>
(u d -> v d -> a)
-> RPForest d (V.Vector (Embed u d x))
-> Int
-> v d
-> b
recallWith :: (u d -> v d -> a)
-> RPForest d (Vector (Embed u d x)) -> Int -> v d -> b
recallWith u d -> v d -> a
distf RPForest d (Vector (Embed u d x))
tt Int
k v d
q = IntMap b -> b
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum IntMap b
rs b -> b -> b
forall a. Fractional a => a -> a -> a
/ Int -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n
where
rs :: IntMap b
rs = (RPTree d () (Vector (Embed u d x)) -> b)
-> RPForest d (Vector (Embed u d x)) -> IntMap b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\RPTree d () (Vector (Embed u d x))
t -> (u d -> v d -> a)
-> RPTree d () (Vector (Embed u d x)) -> Int -> v d -> b
forall (v :: * -> *) d p a x (u :: * -> *) l.
(Inner SVector v, Ord d, Unbox d, Fractional p, Ord a, Ord x,
Ord (u d), Num d) =>
(u d -> v d -> a)
-> RPTree d l (Vector (Embed u d x)) -> Int -> v d -> p
recallWith1 u d -> v d -> a
distf RPTree d () (Vector (Embed u d x))
t Int
k v d
q) RPForest d (Vector (Embed u d x))
tt
n :: Int
n = RPForest d (Vector (Embed u d x)) -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length RPForest d (Vector (Embed u d x))
tt
recallWith1 :: (Inner SVector v, Ord d, VU.Unbox d, Fractional p, Ord a, Ord x, Ord (u d), Num d) =>
(u d -> v d -> a)
-> RPTree d l (V.Vector (Embed u d x))
-> Int
-> v d
-> p
recallWith1 :: (u d -> v d -> a)
-> RPTree d l (Vector (Embed u d x)) -> Int -> v d -> p
recallWith1 u d -> v d -> a
distf RPTree d l (Vector (Embed u d x))
tt Int
k v d
q = Int -> p
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Set (Embed u d x) -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Set (Embed u d x)
aintk) p -> p -> p
forall a. Fractional a => a -> a -> a
/ Int -> p
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
k
where
aintk :: Set (Embed u d x)
aintk = Set (Embed u d x)
aa Set (Embed u d x) -> Set (Embed u d x) -> Set (Embed u d x)
forall a. Ord a => Set a -> Set a -> Set a
`S.intersection` Set (Embed u d x)
kk
aa :: Set (Embed u d x)
aa = Vector (Embed u d x) -> Set (Embed u d x)
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> Set a
set (Vector (Embed u d x) -> Set (Embed u d x))
-> Vector (Embed u d x) -> Set (Embed u d x)
forall a b. (a -> b) -> a -> b
$ RPTree d l (Vector (Embed u d x)) -> v d -> Vector (Embed u d x)
forall (v :: * -> *) d xs l.
(Inner SVector v, Unbox d, Ord d, Num d, Semigroup xs) =>
RPTree d l xs -> v d -> xs
candidates RPTree d l (Vector (Embed u d x))
tt v d
q
kk :: Set (Embed u d x)
kk = [Embed u d x] -> Set (Embed u d x)
forall a. Ord a => [a] -> Set a
S.fromList ([Embed u d x] -> Set (Embed u d x))
-> [Embed u d x] -> Set (Embed u d x)
forall a b. (a -> b) -> a -> b
$ ((Embed u d x, a) -> Embed u d x)
-> [(Embed u d x, a)] -> [Embed u d x]
forall a b. (a -> b) -> [a] -> [b]
map (Embed u d x, a) -> Embed u d x
forall a b. (a, b) -> a
fst ([(Embed u d x, a)] -> [Embed u d x])
-> [(Embed u d x, a)] -> [Embed u d x]
forall a b. (a -> b) -> a -> b
$ Int -> [(Embed u d x, a)] -> [(Embed u d x, a)]
forall a. Int -> [a] -> [a]
take Int
k [(Embed u d x, a)]
dists
dists :: [(Embed u d x, a)]
dists = ((Embed u d x, a) -> (Embed u d x, a) -> Ordering)
-> [(Embed u d x, a)] -> [(Embed u d x, a)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (((Embed u d x, a) -> a)
-> (Embed u d x, a) -> (Embed u d x, a) -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (Embed u d x, a) -> a
forall a b. (a, b) -> b
snd) ([(Embed u d x, a)] -> [(Embed u d x, a)])
-> [(Embed u d x, a)] -> [(Embed u d x, a)]
forall a b. (a -> b) -> a -> b
$ Vector (Embed u d x, a) -> [(Embed u d x, a)]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Vector (Embed u d x, a) -> [(Embed u d x, a)])
-> Vector (Embed u d x, a) -> [(Embed u d x, a)]
forall a b. (a -> b) -> a -> b
$ (Embed u d x -> (Embed u d x, a))
-> Vector (Embed u d x) -> Vector (Embed u d x, a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Embed u d x
x -> (Embed u d x
x, Embed u d x -> u d
forall (v :: * -> *) e a. Embed v e a -> v e
eEmbed Embed u d x
x u d -> v d -> a
`distf` v d
q)) Vector (Embed u d x)
xs
xs :: Vector (Embed u d x)
xs = RPTree d l (Vector (Embed u d x)) -> Vector (Embed u d x)
forall m d l. Monoid m => RPTree d l m -> m
points RPTree d l (Vector (Embed u d x))
tt
set :: (Foldable t, Ord a) => t a -> S.Set a
set :: t a -> Set a
set = (Set a -> a -> Set a) -> Set a -> t a -> Set a
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl ((a -> Set a -> Set a) -> Set a -> a -> Set a
forall a b c. (a -> b -> c) -> b -> a -> c
flip a -> Set a -> Set a
forall a. Ord a => a -> Set a -> Set a
S.insert) Set a
forall a. Monoid a => a
mempty
{-# SCC candidates #-}
candidates :: (Inner SVector v, VU.Unbox d, Ord d, Num d, Semigroup xs) =>
RPTree d l xs
-> v d
-> xs
candidates :: RPTree d l xs -> v d -> xs
candidates (RPTree Vector (SVector d)
rvs RPT d l xs
tt) v d
x = Int -> RPT d l xs -> xs
forall a l. Semigroup a => Int -> RPT d l a -> a
go Int
0 RPT d l xs
tt
where
go :: Int -> RPT d l a -> a
go Int
_ (Tip l
_ a
xs) = a
xs
go Int
ixLev (Bin l
_ d
thr Margin d
margin RPT d l a
ltree RPT d l a
rtree) =
let
(d
mglo, d
mghi) = Margin d -> (d, d)
forall a. Margin a -> (a, a)
getMargin Margin d
margin
r :: SVector d
r = Vector (SVector d)
rvs Vector (SVector d) -> Int -> SVector d
forall (v :: * -> *) a. Vector v a => v a -> Int -> a
VG.! Int
ixLev
proj :: d
proj = SVector d
r SVector d -> v d -> d
forall (u :: * -> *) (v :: * -> *) a.
(Inner u v, Unbox a, Num a) =>
u a -> v a -> a
`inner` v d
x
i' :: Int
i' = Int -> Int
forall a. Enum a => a -> a
succ Int
ixLev
dl :: d
dl = d -> d
forall a. Num a => a -> a
abs (d
mglo d -> d -> d
forall a. Num a => a -> a -> a
- d
proj)
dr :: d
dr = d -> d
forall a. Num a => a -> a
abs (d
mghi d -> d -> d
forall a. Num a => a -> a -> a
- d
proj)
in
if | d
proj d -> d -> Bool
forall a. Ord a => a -> a -> Bool
< d
thr Bool -> Bool -> Bool
&&
d
dl d -> d -> Bool
forall a. Ord a => a -> a -> Bool
> d
dr -> Int -> RPT d l a -> a
go Int
i' RPT d l a
ltree a -> a -> a
forall a. Semigroup a => a -> a -> a
<> Int -> RPT d l a -> a
go Int
i' RPT d l a
rtree
| d
proj d -> d -> Bool
forall a. Ord a => a -> a -> Bool
< d
thr -> Int -> RPT d l a -> a
go Int
i' RPT d l a
ltree
| d
proj d -> d -> Bool
forall a. Ord a => a -> a -> Bool
> d
thr Bool -> Bool -> Bool
&&
d
dl d -> d -> Bool
forall a. Ord a => a -> a -> Bool
< d
dr -> Int -> RPT d l a -> a
go Int
i' RPT d l a
ltree a -> a -> a
forall a. Semigroup a => a -> a -> a
<> Int -> RPT d l a -> a
go Int
i' RPT d l a
rtree
| Bool
otherwise -> Int -> RPT d l a -> a
go Int
i' RPT d l a
rtree
data RPTreeStats = RPTreeStats {
RPTreeStats -> Int
rptsLength :: Int
} deriving (RPTreeStats -> RPTreeStats -> Bool
(RPTreeStats -> RPTreeStats -> Bool)
-> (RPTreeStats -> RPTreeStats -> Bool) -> Eq RPTreeStats
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RPTreeStats -> RPTreeStats -> Bool
$c/= :: RPTreeStats -> RPTreeStats -> Bool
== :: RPTreeStats -> RPTreeStats -> Bool
$c== :: RPTreeStats -> RPTreeStats -> Bool
Eq, Int -> RPTreeStats -> ShowS
[RPTreeStats] -> ShowS
RPTreeStats -> String
(Int -> RPTreeStats -> ShowS)
-> (RPTreeStats -> String)
-> ([RPTreeStats] -> ShowS)
-> Show RPTreeStats
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RPTreeStats] -> ShowS
$cshowList :: [RPTreeStats] -> ShowS
show :: RPTreeStats -> String
$cshow :: RPTreeStats -> String
showsPrec :: Int -> RPTreeStats -> ShowS
$cshowsPrec :: Int -> RPTreeStats -> ShowS
Show)
treeStats :: RPTree d l a -> RPTreeStats
treeStats :: RPTree d l a -> RPTreeStats
treeStats (RPTree Vector (SVector d)
_ RPT d l a
tt) = Int -> RPTreeStats
RPTreeStats Int
l
where
l :: Int
l = RPT d l a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length RPT d l a
tt
treeSize :: (Foldable t) => RPTree d l (t a) -> Int
treeSize :: RPTree d l (t a) -> Int
treeSize = RPT d l Int -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum (RPT d l Int -> Int)
-> (RPTree d l (t a) -> RPT d l Int) -> RPTree d l (t a) -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RPTree d l (t a) -> RPT d l Int
forall (t :: * -> *) d l a.
Foldable t =>
RPTree d l (t a) -> RPT d l Int
leafSizes
leafSizes :: Foldable t => RPTree d l (t a) -> RPT d l Int
leafSizes :: RPTree d l (t a) -> RPT d l Int
leafSizes (RPTree Vector (SVector d)
_ RPT d l (t a)
tt) = t a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (t a -> Int) -> RPT d l (t a) -> RPT d l Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RPT d l (t a)
tt