{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE DeriveFoldable #-}
-- {-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE DeriveFunctor #-}
{-# language DeriveGeneric #-}
{-# language LambdaCase #-}
{-# language MultiParamTypeClasses #-}
{-# language GeneralizedNewtypeDeriving #-}
{-# language TemplateHaskell #-}
{-# options_ghc -Wno-unused-imports #-}
module Data.RPTree.Internal where

import Control.Exception (Exception(..))
import Control.Monad.IO.Class (MonadIO(..))
import Control.Monad.ST (runST)
import Data.Function ((&))
import Data.Foldable (fold, foldl')
import Data.Functor.Identity (Identity(..))
import Data.List (nub)
import Data.Monoid (Sum(..))
import Data.Ord (comparing)
import Data.Semigroup (Min(..), Max(..))
import Data.Typeable (Typeable)
import GHC.Generics (Generic)

-- containers
import qualified Data.IntMap as IM (IntMap)
-- deepseq
import Control.DeepSeq (NFData(..))
-- microlens
import Lens.Micro (Traversal', (.~), (^..), folded)
import Lens.Micro.TH (makeLensesFor, makeLensesWith, lensRules, generateSignatures)
-- mtl
import Control.Monad.State (MonadState(..), modify)
-- serialise
import Codec.Serialise (Serialise(..))
-- transformers
import Control.Monad.Trans.State (StateT(..), runStateT, evalStateT, State, runState, evalState)
-- vector
import qualified Data.Vector as V (Vector, replicateM, fromList)
import qualified Data.Vector.Generic as VG (Vector(..), map, sum, unfoldr, unfoldrM, length, replicateM, (!), take, drop, unzip, freeze, thaw, foldl, foldr, toList, zipWith, last, head)
import qualified Data.Vector.Unboxed as VU (Vector, Unbox, fromList, toList)
import qualified Data.Vector.Storable as VS (Vector)
-- vector-algorithms
import qualified Data.Vector.Algorithms.Merge as V (sortBy)


-- | Exceptions
data RPTError =
  EmptyResult String
  deriving (RPTError -> RPTError -> Bool
(RPTError -> RPTError -> Bool)
-> (RPTError -> RPTError -> Bool) -> Eq RPTError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RPTError -> RPTError -> Bool
$c/= :: RPTError -> RPTError -> Bool
== :: RPTError -> RPTError -> Bool
$c== :: RPTError -> RPTError -> Bool
Eq, Typeable)
instance Show RPTError where
  show :: RPTError -> String
show = \case
    EmptyResult String
str -> [String] -> String
unwords [String
str, String
": empty result"]
instance Exception RPTError

-- | Bounds around the cutting plane
data Margin a = Margin {
  Margin a -> Max a
cMarginLow :: Max a -- ^ lower bound on the cut point
  , Margin a -> Min a
cMarginHigh :: Min a -- ^ upper bound
                   } deriving (Margin a -> Margin a -> Bool
(Margin a -> Margin a -> Bool)
-> (Margin a -> Margin a -> Bool) -> Eq (Margin a)
forall a. Eq a => Margin a -> Margin a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Margin a -> Margin a -> Bool
$c/= :: forall a. Eq a => Margin a -> Margin a -> Bool
== :: Margin a -> Margin a -> Bool
$c== :: forall a. Eq a => Margin a -> Margin a -> Bool
Eq, Int -> Margin a -> ShowS
[Margin a] -> ShowS
Margin a -> String
(Int -> Margin a -> ShowS)
-> (Margin a -> String) -> ([Margin a] -> ShowS) -> Show (Margin a)
forall a. Show a => Int -> Margin a -> ShowS
forall a. Show a => [Margin a] -> ShowS
forall a. Show a => Margin a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Margin a] -> ShowS
$cshowList :: forall a. Show a => [Margin a] -> ShowS
show :: Margin a -> String
$cshow :: forall a. Show a => Margin a -> String
showsPrec :: Int -> Margin a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Margin a -> ShowS
Show, (forall x. Margin a -> Rep (Margin a) x)
-> (forall x. Rep (Margin a) x -> Margin a) -> Generic (Margin a)
forall x. Rep (Margin a) x -> Margin a
forall x. Margin a -> Rep (Margin a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (Margin a) x -> Margin a
forall a x. Margin a -> Rep (Margin a) x
$cto :: forall a x. Rep (Margin a) x -> Margin a
$cfrom :: forall a x. Margin a -> Rep (Margin a) x
Generic)
instance (Serialise a) => Serialise (Margin a)
getMargin :: Margin a -> (a, a)
getMargin :: Margin a -> (a, a)
getMargin (Margin Max a
ml Min a
mh) = (Max a -> a
forall a. Max a -> a
getMax Max a
ml, Min a -> a
forall a. Min a -> a
getMin Min a
mh)
instance (NFData a) => NFData (Margin a)
-- | Used for updating in a streaming setting
instance (Ord a) => Semigroup (Margin a) where
  Margin Max a
lo1 Min a
hi1 <> :: Margin a -> Margin a -> Margin a
<> Margin Max a
lo2 Min a
hi2 = Max a -> Min a -> Margin a
forall a. Max a -> Min a -> Margin a
Margin (Max a
lo1 Max a -> Max a -> Max a
forall a. Semigroup a => a -> a -> a
<> Max a
lo2) (Min a
hi1 Min a -> Min a -> Min a
forall a. Semigroup a => a -> a -> a
<> Min a
hi2)


-- | Sparse vectors with unboxed components
data SVector a = SV { SVector a -> Int
svDim :: !Int, SVector a -> Vector (Int, a)
svVec :: VU.Vector (Int, a) } deriving (SVector a -> SVector a -> Bool
(SVector a -> SVector a -> Bool)
-> (SVector a -> SVector a -> Bool) -> Eq (SVector a)
forall a. (Unbox a, Eq a) => SVector a -> SVector a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SVector a -> SVector a -> Bool
$c/= :: forall a. (Unbox a, Eq a) => SVector a -> SVector a -> Bool
== :: SVector a -> SVector a -> Bool
$c== :: forall a. (Unbox a, Eq a) => SVector a -> SVector a -> Bool
Eq, Eq (SVector a)
Eq (SVector a)
-> (SVector a -> SVector a -> Ordering)
-> (SVector a -> SVector a -> Bool)
-> (SVector a -> SVector a -> Bool)
-> (SVector a -> SVector a -> Bool)
-> (SVector a -> SVector a -> Bool)
-> (SVector a -> SVector a -> SVector a)
-> (SVector a -> SVector a -> SVector a)
-> Ord (SVector a)
SVector a -> SVector a -> Bool
SVector a -> SVector a -> Ordering
SVector a -> SVector a -> SVector a
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 a. (Unbox a, Ord a) => Eq (SVector a)
forall a. (Unbox a, Ord a) => SVector a -> SVector a -> Bool
forall a. (Unbox a, Ord a) => SVector a -> SVector a -> Ordering
forall a. (Unbox a, Ord a) => SVector a -> SVector a -> SVector a
min :: SVector a -> SVector a -> SVector a
$cmin :: forall a. (Unbox a, Ord a) => SVector a -> SVector a -> SVector a
max :: SVector a -> SVector a -> SVector a
$cmax :: forall a. (Unbox a, Ord a) => SVector a -> SVector a -> SVector a
>= :: SVector a -> SVector a -> Bool
$c>= :: forall a. (Unbox a, Ord a) => SVector a -> SVector a -> Bool
> :: SVector a -> SVector a -> Bool
$c> :: forall a. (Unbox a, Ord a) => SVector a -> SVector a -> Bool
<= :: SVector a -> SVector a -> Bool
$c<= :: forall a. (Unbox a, Ord a) => SVector a -> SVector a -> Bool
< :: SVector a -> SVector a -> Bool
$c< :: forall a. (Unbox a, Ord a) => SVector a -> SVector a -> Bool
compare :: SVector a -> SVector a -> Ordering
$ccompare :: forall a. (Unbox a, Ord a) => SVector a -> SVector a -> Ordering
$cp1Ord :: forall a. (Unbox a, Ord a) => Eq (SVector a)
Ord, (forall x. SVector a -> Rep (SVector a) x)
-> (forall x. Rep (SVector a) x -> SVector a)
-> Generic (SVector a)
forall x. Rep (SVector a) x -> SVector a
forall x. SVector a -> Rep (SVector a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (SVector a) x -> SVector a
forall a x. SVector a -> Rep (SVector a) x
$cto :: forall a x. Rep (SVector a) x -> SVector a
$cfrom :: forall a x. SVector a -> Rep (SVector a) x
Generic)
instance (VU.Unbox a, Serialise a) => Serialise (SVector a)
instance (VU.Unbox a, Show a) => Show (SVector a) where
  show :: SVector a -> String
show (SV Int
n Vector (Int, a)
vv) = [String] -> String
unwords [String
"SV", Int -> String
forall a. Show a => a -> String
show Int
n, [(Int, a)] -> String
forall a. Show a => a -> String
show (Vector (Int, a) -> [(Int, a)]
forall a. Unbox a => Vector a -> [a]
VU.toList Vector (Int, a)
vv)]
instance NFData (SVector a)

fromListSv :: VU.Unbox a => Int -> [(Int, a)] -> SVector a
fromListSv :: Int -> [(Int, a)] -> SVector a
fromListSv Int
n [(Int, a)]
ll = Int -> Vector (Int, a) -> SVector a
forall a. Int -> Vector (Int, a) -> SVector a
SV Int
n (Vector (Int, a) -> SVector a) -> Vector (Int, a) -> SVector a
forall a b. (a -> b) -> a -> b
$ [(Int, a)] -> Vector (Int, a)
forall a. Unbox a => [a] -> Vector a
VU.fromList [(Int, a)]
ll

-- | Dense vectors with unboxed components
newtype DVector a = DV { DVector a -> Vector a
dvVec :: VU.Vector a } deriving (DVector a -> DVector a -> Bool
(DVector a -> DVector a -> Bool)
-> (DVector a -> DVector a -> Bool) -> Eq (DVector a)
forall a. (Unbox a, Eq a) => DVector a -> DVector a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DVector a -> DVector a -> Bool
$c/= :: forall a. (Unbox a, Eq a) => DVector a -> DVector a -> Bool
== :: DVector a -> DVector a -> Bool
$c== :: forall a. (Unbox a, Eq a) => DVector a -> DVector a -> Bool
Eq, Eq (DVector a)
Eq (DVector a)
-> (DVector a -> DVector a -> Ordering)
-> (DVector a -> DVector a -> Bool)
-> (DVector a -> DVector a -> Bool)
-> (DVector a -> DVector a -> Bool)
-> (DVector a -> DVector a -> Bool)
-> (DVector a -> DVector a -> DVector a)
-> (DVector a -> DVector a -> DVector a)
-> Ord (DVector a)
DVector a -> DVector a -> Bool
DVector a -> DVector a -> Ordering
DVector a -> DVector a -> DVector a
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 a. (Unbox a, Ord a) => Eq (DVector a)
forall a. (Unbox a, Ord a) => DVector a -> DVector a -> Bool
forall a. (Unbox a, Ord a) => DVector a -> DVector a -> Ordering
forall a. (Unbox a, Ord a) => DVector a -> DVector a -> DVector a
min :: DVector a -> DVector a -> DVector a
$cmin :: forall a. (Unbox a, Ord a) => DVector a -> DVector a -> DVector a
max :: DVector a -> DVector a -> DVector a
$cmax :: forall a. (Unbox a, Ord a) => DVector a -> DVector a -> DVector a
>= :: DVector a -> DVector a -> Bool
$c>= :: forall a. (Unbox a, Ord a) => DVector a -> DVector a -> Bool
> :: DVector a -> DVector a -> Bool
$c> :: forall a. (Unbox a, Ord a) => DVector a -> DVector a -> Bool
<= :: DVector a -> DVector a -> Bool
$c<= :: forall a. (Unbox a, Ord a) => DVector a -> DVector a -> Bool
< :: DVector a -> DVector a -> Bool
$c< :: forall a. (Unbox a, Ord a) => DVector a -> DVector a -> Bool
compare :: DVector a -> DVector a -> Ordering
$ccompare :: forall a. (Unbox a, Ord a) => DVector a -> DVector a -> Ordering
$cp1Ord :: forall a. (Unbox a, Ord a) => Eq (DVector a)
Ord, (forall x. DVector a -> Rep (DVector a) x)
-> (forall x. Rep (DVector a) x -> DVector a)
-> Generic (DVector a)
forall x. Rep (DVector a) x -> DVector a
forall x. DVector a -> Rep (DVector a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (DVector a) x -> DVector a
forall a x. DVector a -> Rep (DVector a) x
$cto :: forall a x. Rep (DVector a) x -> DVector a
$cfrom :: forall a x. DVector a -> Rep (DVector a) x
Generic)
instance (VU.Unbox a, Serialise a) => Serialise (DVector a)
instance (VU.Unbox a, Show a) => Show (DVector a) where
  show :: DVector a -> String
show (DV Vector a
vv) = [String] -> String
unwords [String
"DV", [a] -> String
forall a. Show a => a -> String
show (Vector a -> [a]
forall a. Unbox a => Vector a -> [a]
VU.toList Vector a
vv)]

fromListDv :: VU.Unbox a => [a] -> DVector a
fromListDv :: [a] -> DVector a
fromListDv [a]
ll = Vector a -> DVector a
forall a. Vector a -> DVector a
DV (Vector a -> DVector a) -> Vector a -> DVector a
forall a b. (a -> b) -> a -> b
$ [a] -> Vector a
forall a. Unbox a => [a] -> Vector a
VU.fromList [a]
ll
toListDv :: (VU.Unbox a) => DVector a -> [a]
toListDv :: DVector a -> [a]
toListDv (DV Vector a
v) = Vector a -> [a]
forall a. Unbox a => Vector a -> [a]
VU.toList Vector a
v

-- | Internal
--
-- one projection vector per node (like @annoy@)
data RT v d a =
  RBin !d !(v d) !(RT v d a) !(RT v d a)
  | RTip { RT v d a -> a
_rData :: !a } deriving (RT v d a -> RT v d a -> Bool
(RT v d a -> RT v d a -> Bool)
-> (RT v d a -> RT v d a -> Bool) -> Eq (RT v d a)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (v :: * -> *) d a.
(Eq d, Eq a, Eq (v d)) =>
RT v d a -> RT v d a -> Bool
/= :: RT v d a -> RT v d a -> Bool
$c/= :: forall (v :: * -> *) d a.
(Eq d, Eq a, Eq (v d)) =>
RT v d a -> RT v d a -> Bool
== :: RT v d a -> RT v d a -> Bool
$c== :: forall (v :: * -> *) d a.
(Eq d, Eq a, Eq (v d)) =>
RT v d a -> RT v d a -> Bool
Eq, Int -> RT v d a -> ShowS
[RT v d a] -> ShowS
RT v d a -> String
(Int -> RT v d a -> ShowS)
-> (RT v d a -> String) -> ([RT v d a] -> ShowS) -> Show (RT v d a)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (v :: * -> *) d a.
(Show d, Show a, Show (v d)) =>
Int -> RT v d a -> ShowS
forall (v :: * -> *) d a.
(Show d, Show a, Show (v d)) =>
[RT v d a] -> ShowS
forall (v :: * -> *) d a.
(Show d, Show a, Show (v d)) =>
RT v d a -> String
showList :: [RT v d a] -> ShowS
$cshowList :: forall (v :: * -> *) d a.
(Show d, Show a, Show (v d)) =>
[RT v d a] -> ShowS
show :: RT v d a -> String
$cshow :: forall (v :: * -> *) d a.
(Show d, Show a, Show (v d)) =>
RT v d a -> String
showsPrec :: Int -> RT v d a -> ShowS
$cshowsPrec :: forall (v :: * -> *) d a.
(Show d, Show a, Show (v d)) =>
Int -> RT v d a -> ShowS
Show, (forall x. RT v d a -> Rep (RT v d a) x)
-> (forall x. Rep (RT v d a) x -> RT v d a) -> Generic (RT v d a)
forall x. Rep (RT v d a) x -> RT v d a
forall x. RT v d a -> Rep (RT v d a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (v :: * -> *) d a x. Rep (RT v d a) x -> RT v d a
forall (v :: * -> *) d a x. RT v d a -> Rep (RT v d a) x
$cto :: forall (v :: * -> *) d a x. Rep (RT v d a) x -> RT v d a
$cfrom :: forall (v :: * -> *) d a x. RT v d a -> Rep (RT v d a) x
Generic, a -> RT v d b -> RT v d a
(a -> b) -> RT v d a -> RT v d b
(forall a b. (a -> b) -> RT v d a -> RT v d b)
-> (forall a b. a -> RT v d b -> RT v d a) -> Functor (RT v d)
forall a b. a -> RT v d b -> RT v d a
forall a b. (a -> b) -> RT v d a -> RT v d b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
forall (v :: * -> *) d a b. a -> RT v d b -> RT v d a
forall (v :: * -> *) d a b. (a -> b) -> RT v d a -> RT v d b
<$ :: a -> RT v d b -> RT v d a
$c<$ :: forall (v :: * -> *) d a b. a -> RT v d b -> RT v d a
fmap :: (a -> b) -> RT v d a -> RT v d b
$cfmap :: forall (v :: * -> *) d a b. (a -> b) -> RT v d a -> RT v d b
Functor, RT v d a -> Bool
(a -> m) -> RT v d a -> m
(a -> b -> b) -> b -> RT v d a -> b
(forall m. Monoid m => RT v d m -> m)
-> (forall m a. Monoid m => (a -> m) -> RT v d a -> m)
-> (forall m a. Monoid m => (a -> m) -> RT v d a -> m)
-> (forall a b. (a -> b -> b) -> b -> RT v d a -> b)
-> (forall a b. (a -> b -> b) -> b -> RT v d a -> b)
-> (forall b a. (b -> a -> b) -> b -> RT v d a -> b)
-> (forall b a. (b -> a -> b) -> b -> RT v d a -> b)
-> (forall a. (a -> a -> a) -> RT v d a -> a)
-> (forall a. (a -> a -> a) -> RT v d a -> a)
-> (forall a. RT v d a -> [a])
-> (forall a. RT v d a -> Bool)
-> (forall a. RT v d a -> Int)
-> (forall a. Eq a => a -> RT v d a -> Bool)
-> (forall a. Ord a => RT v d a -> a)
-> (forall a. Ord a => RT v d a -> a)
-> (forall a. Num a => RT v d a -> a)
-> (forall a. Num a => RT v d a -> a)
-> Foldable (RT v d)
forall a. Eq a => a -> RT v d a -> Bool
forall a. Num a => RT v d a -> a
forall a. Ord a => RT v d a -> a
forall m. Monoid m => RT v d m -> m
forall a. RT v d a -> Bool
forall a. RT v d a -> Int
forall a. RT v d a -> [a]
forall a. (a -> a -> a) -> RT v d a -> a
forall m a. Monoid m => (a -> m) -> RT v d a -> m
forall b a. (b -> a -> b) -> b -> RT v d a -> b
forall a b. (a -> b -> b) -> b -> RT v d a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
forall (v :: * -> *) d a. Eq a => a -> RT v d a -> Bool
forall (v :: * -> *) d a. Num a => RT v d a -> a
forall (v :: * -> *) d a. Ord a => RT v d a -> a
forall (v :: * -> *) d m. Monoid m => RT v d m -> m
forall (v :: * -> *) d a. RT v d a -> Bool
forall (v :: * -> *) d a. RT v d a -> Int
forall (v :: * -> *) d a. RT v d a -> [a]
forall (v :: * -> *) d a. (a -> a -> a) -> RT v d a -> a
forall (v :: * -> *) d m a. Monoid m => (a -> m) -> RT v d a -> m
forall (v :: * -> *) d b a. (b -> a -> b) -> b -> RT v d a -> b
forall (v :: * -> *) d a b. (a -> b -> b) -> b -> RT v d a -> b
product :: RT v d a -> a
$cproduct :: forall (v :: * -> *) d a. Num a => RT v d a -> a
sum :: RT v d a -> a
$csum :: forall (v :: * -> *) d a. Num a => RT v d a -> a
minimum :: RT v d a -> a
$cminimum :: forall (v :: * -> *) d a. Ord a => RT v d a -> a
maximum :: RT v d a -> a
$cmaximum :: forall (v :: * -> *) d a. Ord a => RT v d a -> a
elem :: a -> RT v d a -> Bool
$celem :: forall (v :: * -> *) d a. Eq a => a -> RT v d a -> Bool
length :: RT v d a -> Int
$clength :: forall (v :: * -> *) d a. RT v d a -> Int
null :: RT v d a -> Bool
$cnull :: forall (v :: * -> *) d a. RT v d a -> Bool
toList :: RT v d a -> [a]
$ctoList :: forall (v :: * -> *) d a. RT v d a -> [a]
foldl1 :: (a -> a -> a) -> RT v d a -> a
$cfoldl1 :: forall (v :: * -> *) d a. (a -> a -> a) -> RT v d a -> a
foldr1 :: (a -> a -> a) -> RT v d a -> a
$cfoldr1 :: forall (v :: * -> *) d a. (a -> a -> a) -> RT v d a -> a
foldl' :: (b -> a -> b) -> b -> RT v d a -> b
$cfoldl' :: forall (v :: * -> *) d b a. (b -> a -> b) -> b -> RT v d a -> b
foldl :: (b -> a -> b) -> b -> RT v d a -> b
$cfoldl :: forall (v :: * -> *) d b a. (b -> a -> b) -> b -> RT v d a -> b
foldr' :: (a -> b -> b) -> b -> RT v d a -> b
$cfoldr' :: forall (v :: * -> *) d a b. (a -> b -> b) -> b -> RT v d a -> b
foldr :: (a -> b -> b) -> b -> RT v d a -> b
$cfoldr :: forall (v :: * -> *) d a b. (a -> b -> b) -> b -> RT v d a -> b
foldMap' :: (a -> m) -> RT v d a -> m
$cfoldMap' :: forall (v :: * -> *) d m a. Monoid m => (a -> m) -> RT v d a -> m
foldMap :: (a -> m) -> RT v d a -> m
$cfoldMap :: forall (v :: * -> *) d m a. Monoid m => (a -> m) -> RT v d a -> m
fold :: RT v d m -> m
$cfold :: forall (v :: * -> *) d m. Monoid m => RT v d m -> m
Foldable, Functor (RT v d)
Foldable (RT v d)
Functor (RT v d)
-> Foldable (RT v d)
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> RT v d a -> f (RT v d b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    RT v d (f a) -> f (RT v d a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> RT v d a -> m (RT v d b))
-> (forall (m :: * -> *) a.
    Monad m =>
    RT v d (m a) -> m (RT v d a))
-> Traversable (RT v d)
(a -> f b) -> RT v d a -> f (RT v d b)
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (v :: * -> *) d. Functor (RT v d)
forall (v :: * -> *) d. Foldable (RT v d)
forall (m :: * -> *) a. Monad m => RT v d (m a) -> m (RT v d a)
forall (f :: * -> *) a.
Applicative f =>
RT v d (f a) -> f (RT v d a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> RT v d a -> m (RT v d b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> RT v d a -> f (RT v d b)
forall (v :: * -> *) d (m :: * -> *) a.
Monad m =>
RT v d (m a) -> m (RT v d a)
forall (v :: * -> *) d (f :: * -> *) a.
Applicative f =>
RT v d (f a) -> f (RT v d a)
forall (v :: * -> *) d (m :: * -> *) a b.
Monad m =>
(a -> m b) -> RT v d a -> m (RT v d b)
forall (v :: * -> *) d (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> RT v d a -> f (RT v d b)
sequence :: RT v d (m a) -> m (RT v d a)
$csequence :: forall (v :: * -> *) d (m :: * -> *) a.
Monad m =>
RT v d (m a) -> m (RT v d a)
mapM :: (a -> m b) -> RT v d a -> m (RT v d b)
$cmapM :: forall (v :: * -> *) d (m :: * -> *) a b.
Monad m =>
(a -> m b) -> RT v d a -> m (RT v d b)
sequenceA :: RT v d (f a) -> f (RT v d a)
$csequenceA :: forall (v :: * -> *) d (f :: * -> *) a.
Applicative f =>
RT v d (f a) -> f (RT v d a)
traverse :: (a -> f b) -> RT v d a -> f (RT v d b)
$ctraverse :: forall (v :: * -> *) d (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> RT v d a -> f (RT v d b)
$cp2Traversable :: forall (v :: * -> *) d. Foldable (RT v d)
$cp1Traversable :: forall (v :: * -> *) d. Functor (RT v d)
Traversable)
makeLensesFor [("_rData", "rData")] ''RT
instance (NFData (v d), NFData d, NFData a) => NFData (RT v d a)



-- | Internal
--
-- one projection vector per tree level (as suggested in https://www.cs.helsinki.fi/u/ttonteri/pub/bigdata2016.pdf )
data RPT d a =
  Bin {
  RPT d a -> d
_rpThreshold :: !d
  , RPT d a -> Margin d
_rpMargin :: !(Margin d)
  , RPT d a -> RPT d a
_rpL :: !(RPT d a)
  , RPT d a -> RPT d a
_rpR :: !(RPT d a) }
  | Tip { RPT d a -> a
_rpData :: a }
  deriving (RPT d a -> RPT d a -> Bool
(RPT d a -> RPT d a -> Bool)
-> (RPT d a -> RPT d a -> Bool) -> Eq (RPT d a)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall d a. (Eq d, Eq a) => RPT d a -> RPT d a -> Bool
/= :: RPT d a -> RPT d a -> Bool
$c/= :: forall d a. (Eq d, Eq a) => RPT d a -> RPT d a -> Bool
== :: RPT d a -> RPT d a -> Bool
$c== :: forall d a. (Eq d, Eq a) => RPT d a -> RPT d a -> Bool
Eq, Int -> RPT d a -> ShowS
[RPT d a] -> ShowS
RPT d a -> String
(Int -> RPT d a -> ShowS)
-> (RPT d a -> String) -> ([RPT d a] -> ShowS) -> Show (RPT d a)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall d a. (Show d, Show a) => Int -> RPT d a -> ShowS
forall d a. (Show d, Show a) => [RPT d a] -> ShowS
forall d a. (Show d, Show a) => RPT d a -> String
showList :: [RPT d a] -> ShowS
$cshowList :: forall d a. (Show d, Show a) => [RPT d a] -> ShowS
show :: RPT d a -> String
$cshow :: forall d a. (Show d, Show a) => RPT d a -> String
showsPrec :: Int -> RPT d a -> ShowS
$cshowsPrec :: forall d a. (Show d, Show a) => Int -> RPT d a -> ShowS
Show, (forall x. RPT d a -> Rep (RPT d a) x)
-> (forall x. Rep (RPT d a) x -> RPT d a) -> Generic (RPT d a)
forall x. Rep (RPT d a) x -> RPT d a
forall x. RPT d a -> Rep (RPT d a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall d a x. Rep (RPT d a) x -> RPT d a
forall d a x. RPT d a -> Rep (RPT d a) x
$cto :: forall d a x. Rep (RPT d a) x -> RPT d a
$cfrom :: forall d a x. RPT d a -> Rep (RPT d a) x
Generic, a -> RPT d b -> RPT d a
(a -> b) -> RPT d a -> RPT d b
(forall a b. (a -> b) -> RPT d a -> RPT d b)
-> (forall a b. a -> RPT d b -> RPT d a) -> Functor (RPT d)
forall a b. a -> RPT d b -> RPT d a
forall a b. (a -> b) -> RPT d a -> RPT d b
forall d a b. a -> RPT d b -> RPT d a
forall d a b. (a -> b) -> RPT d a -> RPT d b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> RPT d b -> RPT d a
$c<$ :: forall d a b. a -> RPT d b -> RPT d a
fmap :: (a -> b) -> RPT d a -> RPT d b
$cfmap :: forall d a b. (a -> b) -> RPT d a -> RPT d b
Functor, RPT d a -> Bool
(a -> m) -> RPT d a -> m
(a -> b -> b) -> b -> RPT d a -> b
(forall m. Monoid m => RPT d m -> m)
-> (forall m a. Monoid m => (a -> m) -> RPT d a -> m)
-> (forall m a. Monoid m => (a -> m) -> RPT d a -> m)
-> (forall a b. (a -> b -> b) -> b -> RPT d a -> b)
-> (forall a b. (a -> b -> b) -> b -> RPT d a -> b)
-> (forall b a. (b -> a -> b) -> b -> RPT d a -> b)
-> (forall b a. (b -> a -> b) -> b -> RPT d a -> b)
-> (forall a. (a -> a -> a) -> RPT d a -> a)
-> (forall a. (a -> a -> a) -> RPT d a -> a)
-> (forall a. RPT d a -> [a])
-> (forall a. RPT d a -> Bool)
-> (forall a. RPT d a -> Int)
-> (forall a. Eq a => a -> RPT d a -> Bool)
-> (forall a. Ord a => RPT d a -> a)
-> (forall a. Ord a => RPT d a -> a)
-> (forall a. Num a => RPT d a -> a)
-> (forall a. Num a => RPT d a -> a)
-> Foldable (RPT d)
forall a. Eq a => a -> RPT d a -> Bool
forall a. Num a => RPT d a -> a
forall a. Ord a => RPT d a -> a
forall m. Monoid m => RPT d m -> m
forall a. RPT d a -> Bool
forall a. RPT d a -> Int
forall a. RPT d a -> [a]
forall a. (a -> a -> a) -> RPT d a -> a
forall d a. Eq a => a -> RPT d a -> Bool
forall d a. Num a => RPT d a -> a
forall d a. Ord a => RPT d a -> a
forall m a. Monoid m => (a -> m) -> RPT d a -> m
forall d m. Monoid m => RPT d m -> m
forall d a. RPT d a -> Bool
forall d a. RPT d a -> Int
forall d a. RPT d a -> [a]
forall b a. (b -> a -> b) -> b -> RPT d a -> b
forall a b. (a -> b -> b) -> b -> RPT d a -> b
forall d a. (a -> a -> a) -> RPT d a -> a
forall d m a. Monoid m => (a -> m) -> RPT d a -> m
forall d b a. (b -> a -> b) -> b -> RPT d a -> b
forall d a b. (a -> b -> b) -> b -> RPT d a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: RPT d a -> a
$cproduct :: forall d a. Num a => RPT d a -> a
sum :: RPT d a -> a
$csum :: forall d a. Num a => RPT d a -> a
minimum :: RPT d a -> a
$cminimum :: forall d a. Ord a => RPT d a -> a
maximum :: RPT d a -> a
$cmaximum :: forall d a. Ord a => RPT d a -> a
elem :: a -> RPT d a -> Bool
$celem :: forall d a. Eq a => a -> RPT d a -> Bool
length :: RPT d a -> Int
$clength :: forall d a. RPT d a -> Int
null :: RPT d a -> Bool
$cnull :: forall d a. RPT d a -> Bool
toList :: RPT d a -> [a]
$ctoList :: forall d a. RPT d a -> [a]
foldl1 :: (a -> a -> a) -> RPT d a -> a
$cfoldl1 :: forall d a. (a -> a -> a) -> RPT d a -> a
foldr1 :: (a -> a -> a) -> RPT d a -> a
$cfoldr1 :: forall d a. (a -> a -> a) -> RPT d a -> a
foldl' :: (b -> a -> b) -> b -> RPT d a -> b
$cfoldl' :: forall d b a. (b -> a -> b) -> b -> RPT d a -> b
foldl :: (b -> a -> b) -> b -> RPT d a -> b
$cfoldl :: forall d b a. (b -> a -> b) -> b -> RPT d a -> b
foldr' :: (a -> b -> b) -> b -> RPT d a -> b
$cfoldr' :: forall d a b. (a -> b -> b) -> b -> RPT d a -> b
foldr :: (a -> b -> b) -> b -> RPT d a -> b
$cfoldr :: forall d a b. (a -> b -> b) -> b -> RPT d a -> b
foldMap' :: (a -> m) -> RPT d a -> m
$cfoldMap' :: forall d m a. Monoid m => (a -> m) -> RPT d a -> m
foldMap :: (a -> m) -> RPT d a -> m
$cfoldMap :: forall d m a. Monoid m => (a -> m) -> RPT d a -> m
fold :: RPT d m -> m
$cfold :: forall d m. Monoid m => RPT d m -> m
Foldable, Functor (RPT d)
Foldable (RPT d)
Functor (RPT d)
-> Foldable (RPT d)
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> RPT d a -> f (RPT d b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    RPT d (f a) -> f (RPT d a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> RPT d a -> m (RPT d b))
-> (forall (m :: * -> *) a. Monad m => RPT d (m a) -> m (RPT d a))
-> Traversable (RPT d)
(a -> f b) -> RPT d a -> f (RPT d b)
forall d. Functor (RPT d)
forall d. Foldable (RPT d)
forall d (m :: * -> *) a. Monad m => RPT d (m a) -> m (RPT d a)
forall d (f :: * -> *) a.
Applicative f =>
RPT d (f a) -> f (RPT d a)
forall d (m :: * -> *) a b.
Monad m =>
(a -> m b) -> RPT d a -> m (RPT d b)
forall d (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> RPT d a -> f (RPT d b)
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a. Monad m => RPT d (m a) -> m (RPT d a)
forall (f :: * -> *) a. Applicative f => RPT d (f a) -> f (RPT d a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> RPT d a -> m (RPT d b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> RPT d a -> f (RPT d b)
sequence :: RPT d (m a) -> m (RPT d a)
$csequence :: forall d (m :: * -> *) a. Monad m => RPT d (m a) -> m (RPT d a)
mapM :: (a -> m b) -> RPT d a -> m (RPT d b)
$cmapM :: forall d (m :: * -> *) a b.
Monad m =>
(a -> m b) -> RPT d a -> m (RPT d b)
sequenceA :: RPT d (f a) -> f (RPT d a)
$csequenceA :: forall d (f :: * -> *) a.
Applicative f =>
RPT d (f a) -> f (RPT d a)
traverse :: (a -> f b) -> RPT d a -> f (RPT d b)
$ctraverse :: forall d (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> RPT d a -> f (RPT d b)
$cp2Traversable :: forall d. Foldable (RPT d)
$cp1Traversable :: forall d. Functor (RPT d)
Traversable)
instance (Serialise a, Serialise d) => Serialise (RPT d a)
makeLensesFor [("_rpData", "rpData")] ''RPT
instance (NFData v, NFData a) => NFData (RPT v a)

-- | Random projection trees
--
-- The first type parameter corresponds to a floating point scalar value, the second is the type of the data collected at the leaves of the tree (e.g. lists of vectors)
--
-- We keep them separate to leverage the Functor instance for postprocessing and visualization
--
-- One projection vector per tree level (as suggested in https://www.cs.helsinki.fi/u/ttonteri/pub/bigdata2016.pdf )
data RPTree d a = RPTree {
  RPTree d a -> Vector (SVector d)
_rpVectors :: V.Vector (SVector d) -- ^ one random projection vector per tree level
  , RPTree d a -> RPT d a
_rpTree :: RPT d a
                         } deriving (RPTree d a -> RPTree d a -> Bool
(RPTree d a -> RPTree d a -> Bool)
-> (RPTree d a -> RPTree d a -> Bool) -> Eq (RPTree d a)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall d a.
(Unbox d, Eq d, Eq a) =>
RPTree d a -> RPTree d a -> Bool
/= :: RPTree d a -> RPTree d a -> Bool
$c/= :: forall d a.
(Unbox d, Eq d, Eq a) =>
RPTree d a -> RPTree d a -> Bool
== :: RPTree d a -> RPTree d a -> Bool
$c== :: forall d a.
(Unbox d, Eq d, Eq a) =>
RPTree d a -> RPTree d a -> Bool
Eq, Int -> RPTree d a -> ShowS
[RPTree d a] -> ShowS
RPTree d a -> String
(Int -> RPTree d a -> ShowS)
-> (RPTree d a -> String)
-> ([RPTree d a] -> ShowS)
-> Show (RPTree d a)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall d a. (Unbox d, Show d, Show a) => Int -> RPTree d a -> ShowS
forall d a. (Unbox d, Show d, Show a) => [RPTree d a] -> ShowS
forall d a. (Unbox d, Show d, Show a) => RPTree d a -> String
showList :: [RPTree d a] -> ShowS
$cshowList :: forall d a. (Unbox d, Show d, Show a) => [RPTree d a] -> ShowS
show :: RPTree d a -> String
$cshow :: forall d a. (Unbox d, Show d, Show a) => RPTree d a -> String
showsPrec :: Int -> RPTree d a -> ShowS
$cshowsPrec :: forall d a. (Unbox d, Show d, Show a) => Int -> RPTree d a -> ShowS
Show, a -> RPTree d b -> RPTree d a
(a -> b) -> RPTree d a -> RPTree d b
(forall a b. (a -> b) -> RPTree d a -> RPTree d b)
-> (forall a b. a -> RPTree d b -> RPTree d a)
-> Functor (RPTree d)
forall a b. a -> RPTree d b -> RPTree d a
forall a b. (a -> b) -> RPTree d a -> RPTree d b
forall d a b. a -> RPTree d b -> RPTree d a
forall d a b. (a -> b) -> RPTree d a -> RPTree d b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> RPTree d b -> RPTree d a
$c<$ :: forall d a b. a -> RPTree d b -> RPTree d a
fmap :: (a -> b) -> RPTree d a -> RPTree d b
$cfmap :: forall d a b. (a -> b) -> RPTree d a -> RPTree d b
Functor, RPTree d a -> Bool
(a -> m) -> RPTree d a -> m
(a -> b -> b) -> b -> RPTree d a -> b
(forall m. Monoid m => RPTree d m -> m)
-> (forall m a. Monoid m => (a -> m) -> RPTree d a -> m)
-> (forall m a. Monoid m => (a -> m) -> RPTree d a -> m)
-> (forall a b. (a -> b -> b) -> b -> RPTree d a -> b)
-> (forall a b. (a -> b -> b) -> b -> RPTree d a -> b)
-> (forall b a. (b -> a -> b) -> b -> RPTree d a -> b)
-> (forall b a. (b -> a -> b) -> b -> RPTree d a -> b)
-> (forall a. (a -> a -> a) -> RPTree d a -> a)
-> (forall a. (a -> a -> a) -> RPTree d a -> a)
-> (forall a. RPTree d a -> [a])
-> (forall a. RPTree d a -> Bool)
-> (forall a. RPTree d a -> Int)
-> (forall a. Eq a => a -> RPTree d a -> Bool)
-> (forall a. Ord a => RPTree d a -> a)
-> (forall a. Ord a => RPTree d a -> a)
-> (forall a. Num a => RPTree d a -> a)
-> (forall a. Num a => RPTree d a -> a)
-> Foldable (RPTree d)
forall a. Eq a => a -> RPTree d a -> Bool
forall a. Num a => RPTree d a -> a
forall a. Ord a => RPTree d a -> a
forall m. Monoid m => RPTree d m -> m
forall a. RPTree d a -> Bool
forall a. RPTree d a -> Int
forall a. RPTree d a -> [a]
forall a. (a -> a -> a) -> RPTree d a -> a
forall d a. Eq a => a -> RPTree d a -> Bool
forall d a. Num a => RPTree d a -> a
forall d a. Ord a => RPTree d a -> a
forall m a. Monoid m => (a -> m) -> RPTree d a -> m
forall d m. Monoid m => RPTree d m -> m
forall d a. RPTree d a -> Bool
forall d a. RPTree d a -> Int
forall d a. RPTree d a -> [a]
forall b a. (b -> a -> b) -> b -> RPTree d a -> b
forall a b. (a -> b -> b) -> b -> RPTree d a -> b
forall d a. (a -> a -> a) -> RPTree d a -> a
forall d m a. Monoid m => (a -> m) -> RPTree d a -> m
forall d b a. (b -> a -> b) -> b -> RPTree d a -> b
forall d a b. (a -> b -> b) -> b -> RPTree d a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: RPTree d a -> a
$cproduct :: forall d a. Num a => RPTree d a -> a
sum :: RPTree d a -> a
$csum :: forall d a. Num a => RPTree d a -> a
minimum :: RPTree d a -> a
$cminimum :: forall d a. Ord a => RPTree d a -> a
maximum :: RPTree d a -> a
$cmaximum :: forall d a. Ord a => RPTree d a -> a
elem :: a -> RPTree d a -> Bool
$celem :: forall d a. Eq a => a -> RPTree d a -> Bool
length :: RPTree d a -> Int
$clength :: forall d a. RPTree d a -> Int
null :: RPTree d a -> Bool
$cnull :: forall d a. RPTree d a -> Bool
toList :: RPTree d a -> [a]
$ctoList :: forall d a. RPTree d a -> [a]
foldl1 :: (a -> a -> a) -> RPTree d a -> a
$cfoldl1 :: forall d a. (a -> a -> a) -> RPTree d a -> a
foldr1 :: (a -> a -> a) -> RPTree d a -> a
$cfoldr1 :: forall d a. (a -> a -> a) -> RPTree d a -> a
foldl' :: (b -> a -> b) -> b -> RPTree d a -> b
$cfoldl' :: forall d b a. (b -> a -> b) -> b -> RPTree d a -> b
foldl :: (b -> a -> b) -> b -> RPTree d a -> b
$cfoldl :: forall d b a. (b -> a -> b) -> b -> RPTree d a -> b
foldr' :: (a -> b -> b) -> b -> RPTree d a -> b
$cfoldr' :: forall d a b. (a -> b -> b) -> b -> RPTree d a -> b
foldr :: (a -> b -> b) -> b -> RPTree d a -> b
$cfoldr :: forall d a b. (a -> b -> b) -> b -> RPTree d a -> b
foldMap' :: (a -> m) -> RPTree d a -> m
$cfoldMap' :: forall d m a. Monoid m => (a -> m) -> RPTree d a -> m
foldMap :: (a -> m) -> RPTree d a -> m
$cfoldMap :: forall d m a. Monoid m => (a -> m) -> RPTree d a -> m
fold :: RPTree d m -> m
$cfold :: forall d m. Monoid m => RPTree d m -> m
Foldable, Functor (RPTree d)
Foldable (RPTree d)
Functor (RPTree d)
-> Foldable (RPTree d)
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> RPTree d a -> f (RPTree d b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    RPTree d (f a) -> f (RPTree d a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> RPTree d a -> m (RPTree d b))
-> (forall (m :: * -> *) a.
    Monad m =>
    RPTree d (m a) -> m (RPTree d a))
-> Traversable (RPTree d)
(a -> f b) -> RPTree d a -> f (RPTree d b)
forall d. Functor (RPTree d)
forall d. Foldable (RPTree d)
forall d (m :: * -> *) a.
Monad m =>
RPTree d (m a) -> m (RPTree d a)
forall d (f :: * -> *) a.
Applicative f =>
RPTree d (f a) -> f (RPTree d a)
forall d (m :: * -> *) a b.
Monad m =>
(a -> m b) -> RPTree d a -> m (RPTree d b)
forall d (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> RPTree d a -> f (RPTree d b)
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a. Monad m => RPTree d (m a) -> m (RPTree d a)
forall (f :: * -> *) a.
Applicative f =>
RPTree d (f a) -> f (RPTree d a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> RPTree d a -> m (RPTree d b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> RPTree d a -> f (RPTree d b)
sequence :: RPTree d (m a) -> m (RPTree d a)
$csequence :: forall d (m :: * -> *) a.
Monad m =>
RPTree d (m a) -> m (RPTree d a)
mapM :: (a -> m b) -> RPTree d a -> m (RPTree d b)
$cmapM :: forall d (m :: * -> *) a b.
Monad m =>
(a -> m b) -> RPTree d a -> m (RPTree d b)
sequenceA :: RPTree d (f a) -> f (RPTree d a)
$csequenceA :: forall d (f :: * -> *) a.
Applicative f =>
RPTree d (f a) -> f (RPTree d a)
traverse :: (a -> f b) -> RPTree d a -> f (RPTree d b)
$ctraverse :: forall d (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> RPTree d a -> f (RPTree d b)
$cp2Traversable :: forall d. Foldable (RPTree d)
$cp1Traversable :: forall d. Functor (RPTree d)
Traversable, (forall x. RPTree d a -> Rep (RPTree d a) x)
-> (forall x. Rep (RPTree d a) x -> RPTree d a)
-> Generic (RPTree d a)
forall x. Rep (RPTree d a) x -> RPTree d a
forall x. RPTree d a -> Rep (RPTree d a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall d a x. Rep (RPTree d a) x -> RPTree d a
forall d a x. RPTree d a -> Rep (RPTree d a) x
$cto :: forall d a x. Rep (RPTree d a) x -> RPTree d a
$cfrom :: forall d a x. RPTree d a -> Rep (RPTree d a) x
Generic)
instance (Serialise d, Serialise a, VU.Unbox d) => Serialise (RPTree d a)
makeLensesFor [("_rpTree", "rpTree")] ''RPTree
instance (NFData a, NFData d) => NFData (RPTree d a)

type RPForest d a = IM.IntMap (RPTree d a)

rpTreeData :: Traversal' (RPTree d a) a
rpTreeData :: (a -> f a) -> RPTree d a -> f (RPTree d a)
rpTreeData = (RPT d a -> f (RPT d a)) -> RPTree d a -> f (RPTree d a)
forall d a a. Lens (RPTree d a) (RPTree d a) (RPT d a) (RPT d a)
rpTree ((RPT d a -> f (RPT d a)) -> RPTree d a -> f (RPTree d a))
-> ((a -> f a) -> RPT d a -> f (RPT d a))
-> (a -> f a)
-> RPTree d a
-> f (RPTree d a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> f a) -> RPT d a -> f (RPT d a)
forall d a. Traversal' (RPT d a) a
rpData

leaves :: RPTree d a -> [a]
leaves :: RPTree d a -> [a]
leaves = (RPTree d a -> Getting (Endo [a]) (RPTree d a) a -> [a]
forall s a. s -> Getting (Endo [a]) s a -> [a]
^.. Getting (Endo [a]) (RPTree d a) a
forall d a. Traversal' (RPTree d a) a
rpTreeData)

-- | Number of tree levels
levels :: RPTree d a -> Int
levels :: RPTree d a -> Int
levels (RPTree Vector (SVector d)
v RPT d a
_) = Vector (SVector d) -> Int
forall (v :: * -> *) a. Vector v a => v a -> Int
VG.length Vector (SVector d)
v

-- | Set of data points used to construct the index
points :: Monoid m => RPTree d m -> m
points :: RPTree d m -> m
points (RPTree Vector (SVector d)
_ RPT d m
t) = RPT d m -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold RPT d m
t

-- -- points in 2d
-- data P a = P !a !a deriving (Eq, Show)

class Scale v where
  (.*) :: (VU.Unbox a, Num a) => a -> v a -> v a
instance Scale SVector where
  a
a .* :: a -> SVector a -> SVector a
.* (SV Int
n Vector (Int, a)
vv) = Int -> Vector (Int, a) -> SVector a
forall a. Int -> Vector (Int, a) -> SVector a
SV Int
n (Vector (Int, a) -> SVector a) -> Vector (Int, a) -> SVector a
forall a b. (a -> b) -> a -> b
$ a -> Vector (Int, a) -> Vector (Int, a)
forall (v :: * -> *) a b.
(Vector v (a, b), Num b) =>
b -> v (a, b) -> v (a, b)
scaleS a
a Vector (Int, a)
vv
instance Scale VU.Vector where
  a
a .* :: a -> Vector a -> Vector a
.* Vector a
v1 = a -> Vector a -> Vector a
forall (v :: * -> *) b. (Vector v b, Num b) => b -> v b -> v b
scaleD a
a Vector a
v1
instance Scale DVector where
  a
a .* :: a -> DVector a -> DVector a
.* (DV Vector a
v1) = Vector a -> DVector a
forall a. Vector a -> DVector a
DV (Vector a -> DVector a) -> Vector a -> DVector a
forall a b. (a -> b) -> a -> b
$ a -> Vector a -> Vector a
forall (v :: * -> *) b. (Vector v b, Num b) => b -> v b -> v b
scaleD a
a Vector a
v1

-- | Inner product spaces
--
-- This typeclass is provided as a convenience for library users to interface their own vector types.
class (Scale u, Scale v) => Inner u v where
  inner :: (VU.Unbox a, Num a) => u a -> v a -> a
  metricL2 :: (VU.Unbox a, Floating a) => u a -> v a -> a
  (^+^) :: (VU.Unbox a, Num a) => u a -> v a -> u a
  (^-^) :: (VU.Unbox a, Num a) => u a -> v a -> u a

instance Inner SVector SVector where
  inner :: SVector a -> SVector a -> a
inner (SV Int
_ Vector (Int, a)
v1) (SV Int
_ Vector (Int, a)
v2) = Vector (Int, a) -> Vector (Int, a) -> a
forall (u :: * -> *) a (v :: * -> *).
(Vector u (Int, a), Vector v (Int, a), Unbox a, Num a) =>
u (Int, a) -> v (Int, a) -> a
innerSS Vector (Int, a)
v1 Vector (Int, a)
v2
  metricL2 :: SVector a -> SVector a -> a
metricL2 (SV Int
_ Vector (Int, a)
v1) (SV Int
_ Vector (Int, a)
v2) = Vector (Int, a) -> Vector (Int, a) -> a
forall a (u :: * -> *) (v :: * -> *).
(Floating a, Vector u a, Unbox a, Vector u (Int, a),
 Vector v (Int, a)) =>
u (Int, a) -> v (Int, a) -> a
metricSSL2 Vector (Int, a)
v1 Vector (Int, a)
v2
  (SV Int
n Vector (Int, a)
v1) ^+^ :: SVector a -> SVector a -> SVector a
^+^ (SV Int
_ Vector (Int, a)
v2) = Int -> Vector (Int, a) -> SVector a
forall a. Int -> Vector (Int, a) -> SVector a
SV Int
n (Vector (Int, a) -> SVector a) -> Vector (Int, a) -> SVector a
forall a b. (a -> b) -> a -> b
$ Vector (Int, a) -> Vector (Int, a) -> Vector (Int, a)
forall (u :: * -> *) a (v :: * -> *).
(Vector u (Int, a), Vector v (Int, a), Unbox a, Num a) =>
u (Int, a) -> v (Int, a) -> u (Int, a)
sumSS Vector (Int, a)
v1 Vector (Int, a)
v2
  (SV Int
n Vector (Int, a)
v1) ^-^ :: SVector a -> SVector a -> SVector a
^-^ (SV Int
_ Vector (Int, a)
v2) = Int -> Vector (Int, a) -> SVector a
forall a. Int -> Vector (Int, a) -> SVector a
SV Int
n (Vector (Int, a) -> SVector a) -> Vector (Int, a) -> SVector a
forall a b. (a -> b) -> a -> b
$ Vector (Int, a) -> Vector (Int, a) -> Vector (Int, a)
forall (u :: * -> *) a (v :: * -> *).
(Vector u (Int, a), Vector v (Int, a), Unbox a, Num a) =>
u (Int, a) -> v (Int, a) -> u (Int, a)
diffSS Vector (Int, a)
v1 Vector (Int, a)
v2
instance Inner SVector VU.Vector where
  inner :: SVector a -> Vector a -> a
inner (SV Int
_ Vector (Int, a)
v1) Vector a
v2 = Vector (Int, a) -> Vector a -> a
forall a (u :: * -> *) (v :: * -> *).
(Num a, Vector u (Int, a), Vector v a, Unbox a) =>
u (Int, a) -> v a -> a
innerSD Vector (Int, a)
v1 Vector a
v2
  metricL2 :: SVector a -> Vector a -> a
metricL2 (SV Int
_ Vector (Int, a)
v1) Vector a
v2 = Vector (Int, a) -> Vector a -> a
forall a (v1 :: * -> *) (v2 :: * -> *).
(Floating a, Vector v1 a, Unbox a, Vector v1 (Int, a),
 Vector v2 a) =>
v1 (Int, a) -> v2 a -> a
metricSDL2 Vector (Int, a)
v1 Vector a
v2
  (SV Int
n Vector (Int, a)
v1) ^+^ :: SVector a -> Vector a -> SVector a
^+^ Vector a
v2 = Int -> Vector (Int, a) -> SVector a
forall a. Int -> Vector (Int, a) -> SVector a
SV Int
n (Vector (Int, a) -> SVector a) -> Vector (Int, a) -> SVector a
forall a b. (a -> b) -> a -> b
$ Vector (Int, a) -> Vector a -> Vector (Int, a)
forall (u :: * -> *) a (v :: * -> *).
(Vector u (Int, a), Vector v a, Unbox a, Num a) =>
u (Int, a) -> v a -> u (Int, a)
sumSD Vector (Int, a)
v1 Vector a
v2
  (SV Int
n Vector (Int, a)
v1) ^-^ :: SVector a -> Vector a -> SVector a
^-^ Vector a
v2 = Int -> Vector (Int, a) -> SVector a
forall a. Int -> Vector (Int, a) -> SVector a
SV Int
n (Vector (Int, a) -> SVector a) -> Vector (Int, a) -> SVector a
forall a b. (a -> b) -> a -> b
$ Vector (Int, a) -> Vector a -> Vector (Int, a)
forall (u :: * -> *) a (v :: * -> *).
(Vector u (Int, a), Vector v a, Unbox a, Num a) =>
u (Int, a) -> v a -> u (Int, a)
diffSD Vector (Int, a)
v1 Vector a
v2
instance Inner SVector DVector where
  inner :: SVector a -> DVector a -> a
inner (SV Int
_ Vector (Int, a)
v1) (DV Vector a
v2) = Vector (Int, a) -> Vector a -> a
forall a (u :: * -> *) (v :: * -> *).
(Num a, Vector u (Int, a), Vector v a, Unbox a) =>
u (Int, a) -> v a -> a
innerSD Vector (Int, a)
v1 Vector a
v2
  metricL2 :: SVector a -> DVector a -> a
metricL2 (SV Int
_ Vector (Int, a)
v1) (DV Vector a
v2) = Vector (Int, a) -> Vector a -> a
forall a (v1 :: * -> *) (v2 :: * -> *).
(Floating a, Vector v1 a, Unbox a, Vector v1 (Int, a),
 Vector v2 a) =>
v1 (Int, a) -> v2 a -> a
metricSDL2 Vector (Int, a)
v1 Vector a
v2
  (SV Int
n Vector (Int, a)
v1) ^+^ :: SVector a -> DVector a -> SVector a
^+^ (DV Vector a
v2) = Int -> Vector (Int, a) -> SVector a
forall a. Int -> Vector (Int, a) -> SVector a
SV Int
n (Vector (Int, a) -> SVector a) -> Vector (Int, a) -> SVector a
forall a b. (a -> b) -> a -> b
$ Vector (Int, a) -> Vector a -> Vector (Int, a)
forall (u :: * -> *) a (v :: * -> *).
(Vector u (Int, a), Vector v a, Unbox a, Num a) =>
u (Int, a) -> v a -> u (Int, a)
sumSD Vector (Int, a)
v1 Vector a
v2
  (SV Int
n Vector (Int, a)
v1) ^-^ :: SVector a -> DVector a -> SVector a
^-^ (DV Vector a
v2) = Int -> Vector (Int, a) -> SVector a
forall a. Int -> Vector (Int, a) -> SVector a
SV Int
n (Vector (Int, a) -> SVector a) -> Vector (Int, a) -> SVector a
forall a b. (a -> b) -> a -> b
$ Vector (Int, a) -> Vector a -> Vector (Int, a)
forall (u :: * -> *) a (v :: * -> *).
(Vector u (Int, a), Vector v a, Unbox a, Num a) =>
u (Int, a) -> v a -> u (Int, a)
diffSD Vector (Int, a)
v1 Vector a
v2
instance Inner DVector DVector where
  inner :: DVector a -> DVector a -> a
inner (DV Vector a
v1) (DV Vector a
v2) = Vector a -> Vector a -> a
forall (v :: * -> *) a. (Vector v a, Num a) => v a -> v a -> a
innerDD Vector a
v1 Vector a
v2
  metricL2 :: DVector a -> DVector a -> a
metricL2 (DV Vector a
v1) (DV Vector a
v2) = Vector a -> Vector a -> a
forall a (v :: * -> *). (Floating a, Vector v a) => v a -> v a -> a
metricDDL2 Vector a
v1 Vector a
v2
  DV Vector a
v1 ^+^ :: DVector a -> DVector a -> DVector a
^+^ DV Vector a
v2 = Vector a -> DVector a
forall a. Vector a -> DVector a
DV (Vector a -> DVector a) -> Vector a -> DVector a
forall a b. (a -> b) -> a -> b
$ (a -> a -> a) -> Vector a -> Vector a -> Vector a
forall (v :: * -> *) a b c.
(Vector v a, Vector v b, Vector v c) =>
(a -> b -> c) -> v a -> v b -> v c
VG.zipWith a -> a -> a
forall a. Num a => a -> a -> a
(+) Vector a
v1 Vector a
v2
  DV Vector a
v1 ^-^ :: DVector a -> DVector a -> DVector a
^-^ DV Vector a
v2 = Vector a -> DVector a
forall a. Vector a -> DVector a
DV (Vector a -> DVector a) -> Vector a -> DVector a
forall a b. (a -> b) -> a -> b
$ (a -> a -> a) -> Vector a -> Vector a -> Vector a
forall (v :: * -> *) a b c.
(Vector v a, Vector v b, Vector v c) =>
(a -> b -> c) -> v a -> v b -> v c
VG.zipWith (-) Vector a
v1 Vector a
v2

(/.) :: (Scale v, VU.Unbox a, Fractional a) => v a -> a -> v a
v a
v /. :: v a -> a -> v a
/. a
a = (a
1 a -> a -> a
forall a. Fractional a => a -> a -> a
/ a
a) a -> v a -> v a
forall (v :: * -> *) a.
(Scale v, Unbox a, Num a) =>
a -> v a -> v a
.* v a
v

normalize :: (VU.Unbox a, Inner v v, Floating a) => v a -> v a
normalize :: v a -> v a
normalize v a
v = v a
v v a -> a -> v a
forall (v :: * -> *) a.
(Scale v, Unbox a, Fractional a) =>
v a -> a -> v a
/. v a -> v a -> a
forall (u :: * -> *) (v :: * -> *) a.
(Inner u v, Unbox a, Floating a) =>
u a -> v a -> a
metricL2 v a
v v a
v


-- | sparse-sparse inner product
innerSS :: (VG.Vector u (Int, a), VG.Vector v (Int, a), VU.Unbox a, Num a) =>
           u (Int, a) -> v (Int, a) -> a
innerSS :: u (Int, a) -> v (Int, a) -> a
innerSS u (Int, a)
vv1 v (Int, a)
vv2 = Int -> Int -> a
go Int
0 Int
0
  where
    nz1 :: Int
nz1 = u (Int, a) -> Int
forall (v :: * -> *) a. Vector v a => v a -> Int
VG.length u (Int, a)
vv1
    nz2 :: Int
nz2 = v (Int, a) -> Int
forall (v :: * -> *) a. Vector v a => v a -> Int
VG.length v (Int, a)
vv2
    go :: Int -> Int -> a
go Int
i1 Int
i2
      | Int
i1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
nz1 Bool -> Bool -> Bool
|| Int
i2 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
nz2 = a
0
      | Bool
otherwise =
          let
            (Int
il, a
xl) = u (Int, a)
vv1 u (Int, a) -> Int -> (Int, a)
forall (v :: * -> *) a. Vector v a => v a -> Int -> a
VG.! Int
i1
            (Int
ir, a
xr) = v (Int, a)
vv2 v (Int, a) -> Int -> (Int, a)
forall (v :: * -> *) a. Vector v a => v a -> Int -> a
VG.! Int
i2
          in case Int
il Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` Int
ir of
            Ordering
EQ -> (a
xl a -> a -> a
forall a. Num a => a -> a -> a
* a
xr a -> a -> a
forall a. Num a => a -> a -> a
+) (a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
$ Int -> Int -> a
go (Int -> Int
forall a. Enum a => a -> a
succ Int
i1) (Int -> Int
forall a. Enum a => a -> a
succ Int
i2)
            Ordering
LT -> Int -> Int -> a
go (Int -> Int
forall a. Enum a => a -> a
succ Int
i1) Int
i2
            Ordering
GT -> Int -> Int -> a
go Int
i1 (Int -> Int
forall a. Enum a => a -> a
succ Int
i2)

-- | sparse-dense inner product
innerSD :: (Num a, VG.Vector u (Int, a), VG.Vector v a, VU.Unbox a) =>
           u (Int, a) -> v a -> a
innerSD :: u (Int, a) -> v a -> a
innerSD u (Int, a)
vv1 v a
vv2 = Int -> a
go Int
0
  where
    nz1 :: Int
nz1 = u (Int, a) -> Int
forall (v :: * -> *) a. Vector v a => v a -> Int
VG.length u (Int, a)
vv1
    nz2 :: Int
nz2 = v a -> Int
forall (v :: * -> *) a. Vector v a => v a -> Int
VG.length v a
vv2
    go :: Int -> a
go Int
i
      | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
nz1 Bool -> Bool -> Bool
|| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
nz2 = a
0
      | Bool
otherwise =
          let
            (Int
il, a
xl) = u (Int, a)
vv1 u (Int, a) -> Int -> (Int, a)
forall (v :: * -> *) a. Vector v a => v a -> Int -> a
VG.! Int
i
            xr :: a
xr       = v a
vv2 v a -> Int -> a
forall (v :: * -> *) a. Vector v a => v a -> Int -> a
VG.! Int
il
          in
            (a
xl a -> a -> a
forall a. Num a => a -> a -> a
* a
xr a -> a -> a
forall a. Num a => a -> a -> a
+) (a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
$ Int -> a
go (Int -> Int
forall a. Enum a => a -> a
succ Int
i)

innerDD :: (VG.Vector v a, Num a) => v a -> v a -> a
innerDD :: v a -> v a -> a
innerDD v a
v1 v a
v2 = v a -> a
forall (v :: * -> *) a. (Vector v a, Num a) => v a -> a
VG.sum (v a -> a) -> v a -> a
forall a b. (a -> b) -> a -> b
$ (a -> a -> a) -> v a -> v a -> v a
forall (v :: * -> *) a b c.
(Vector v a, Vector v b, Vector v c) =>
(a -> b -> c) -> v a -> v b -> v c
VG.zipWith a -> a -> a
forall a. Num a => a -> a -> a
(*) v a
v1 v a
v2


-- | Vector distance induced by the L2 norm (sparse-sparse)
metricSSL2 :: (Floating a, VG.Vector u a, VU.Unbox a, VG.Vector u (Int, a), VG.Vector v (Int, a)) =>
              u (Int, a) -> v (Int, a) -> a
metricSSL2 :: u (Int, a) -> v (Int, a) -> a
metricSSL2 u (Int, a)
u v (Int, a)
v = a -> a
forall a. Floating a => a -> a
sqrt (a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
$ u a -> a
forall (v :: * -> *) a. (Vector v a, Num a) => v a -> a
VG.sum (u a -> a) -> u a -> a
forall a b. (a -> b) -> a -> b
$ ((Int, a) -> a) -> u (Int, a) -> u a
forall (v :: * -> *) a b.
(Vector v a, Vector v b) =>
(a -> b) -> v a -> v b
VG.map (\(Int
_, a
x) -> a
x a -> a -> a
forall a. Floating a => a -> a -> a
** a
2) u (Int, a)
duv
  where
    duv :: u (Int, a)
duv = u (Int, a)
u u (Int, a) -> v (Int, a) -> u (Int, a)
forall (u :: * -> *) a (v :: * -> *).
(Vector u (Int, a), Vector v (Int, a), Unbox a, Num a) =>
u (Int, a) -> v (Int, a) -> u (Int, a)
`diffSS` v (Int, a)
v

-- | Vector distance induced by the L2 norm (sparse-dense)
metricSDL2 :: (Floating a, VG.Vector v1 a, VU.Unbox a,
                VG.Vector v1 (Int, a), VG.Vector v2 a) =>
              v1 (Int, a) -> v2 a -> a
metricSDL2 :: v1 (Int, a) -> v2 a -> a
metricSDL2 v1 (Int, a)
u v2 a
v = a -> a
forall a. Floating a => a -> a
sqrt (a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
$ v1 a -> a
forall (v :: * -> *) a. (Vector v a, Num a) => v a -> a
VG.sum (v1 a -> a) -> v1 a -> a
forall a b. (a -> b) -> a -> b
$ ((Int, a) -> a) -> v1 (Int, a) -> v1 a
forall (v :: * -> *) a b.
(Vector v a, Vector v b) =>
(a -> b) -> v a -> v b
VG.map (\(Int
_, a
x) -> a
x a -> a -> a
forall a. Floating a => a -> a -> a
** a
2) v1 (Int, a)
duv
  where
    duv :: v1 (Int, a)
duv = v1 (Int, a)
u v1 (Int, a) -> v2 a -> v1 (Int, a)
forall (u :: * -> *) a (v :: * -> *).
(Vector u (Int, a), Vector v a, Unbox a, Num a) =>
u (Int, a) -> v a -> u (Int, a)
`diffSD` v2 a
v

-- | Vector distance induced by the L2 norm (dense-dense)
metricDDL2 :: (Floating a, VG.Vector v a) => v a -> v a -> a
metricDDL2 :: v a -> v a -> a
metricDDL2 v a
u v a
v = a -> a
forall a. Floating a => a -> a
sqrt (a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
$ v a -> a
forall (v :: * -> *) a. (Vector v a, Num a) => v a -> a
VG.sum (v a -> a) -> v a -> a
forall a b. (a -> b) -> a -> b
$ (a -> a) -> v a -> v a
forall (v :: * -> *) a b.
(Vector v a, Vector v b) =>
(a -> b) -> v a -> v b
VG.map (a -> a -> a
forall a. Floating a => a -> a -> a
** a
2) v a
duv
  where
    duv :: v a
duv = (a -> a -> a) -> v a -> v a -> v a
forall (v :: * -> *) a b c.
(Vector v a, Vector v b, Vector v c) =>
(a -> b -> c) -> v a -> v b -> v c
VG.zipWith (-) v a
u v a
v

scaleD :: (VG.Vector v b, Num b) => b -> v b -> v b
scaleD :: b -> v b -> v b
scaleD b
a v b
vv = (b -> b) -> v b -> v b
forall (v :: * -> *) a b.
(Vector v a, Vector v b) =>
(a -> b) -> v a -> v b
VG.map (b -> b -> b
forall a. Num a => a -> a -> a
* b
a) v b
vv

scaleS :: (VG.Vector v (a, b), Num b) => b -> v (a, b) -> v (a, b)
scaleS :: b -> v (a, b) -> v (a, b)
scaleS b
a v (a, b)
vv = ((a, b) -> (a, b)) -> v (a, b) -> v (a, b)
forall (v :: * -> *) a b.
(Vector v a, Vector v b) =>
(a -> b) -> v a -> v b
VG.map (\(a
i, b
x) -> (a
i, b
a b -> b -> b
forall a. Num a => a -> a -> a
* b
x)) v (a, b)
vv

-- | Vector sum
sumSD :: (VG.Vector u (Int, a), VG.Vector v a, VU.Unbox a, Num a) =>
         u (Int, a) -> v a -> u (Int, a)
sumSD :: u (Int, a) -> v a -> u (Int, a)
sumSD = (a -> a -> a) -> u (Int, a) -> v a -> u (Int, a)
forall (u :: * -> *) a (v :: * -> *).
(Vector u (Int, a), Vector v a, Unbox a) =>
(a -> a -> a) -> u (Int, a) -> v a -> u (Int, a)
binSD (-)

-- | Vector sum
sumSS :: (VG.Vector u (Int, a), VG.Vector v (Int, a), VU.Unbox a, Num a) =>
         u (Int, a) -> v (Int, a) -> u (Int, a)
sumSS :: u (Int, a) -> v (Int, a) -> u (Int, a)
sumSS = (a -> a -> a) -> a -> u (Int, a) -> v (Int, a) -> u (Int, a)
forall (u :: * -> *) a (v :: * -> *).
(Vector u (Int, a), Vector v (Int, a), Unbox a) =>
(a -> a -> a) -> a -> u (Int, a) -> v (Int, a) -> u (Int, a)
binSS a -> a -> a
forall a. Num a => a -> a -> a
(+) a
0 

-- | Vector difference
diffSD :: (VG.Vector u (Int, a), VG.Vector v a, VU.Unbox a, Num a) =>
          u (Int, a) -> v a -> u (Int, a)
diffSD :: u (Int, a) -> v a -> u (Int, a)
diffSD = (a -> a -> a) -> u (Int, a) -> v a -> u (Int, a)
forall (u :: * -> *) a (v :: * -> *).
(Vector u (Int, a), Vector v a, Unbox a) =>
(a -> a -> a) -> u (Int, a) -> v a -> u (Int, a)
binSD (-)

-- | Vector difference
diffSS :: (VG.Vector u (Int, a), VG.Vector v (Int, a), VU.Unbox a, Num a) =>
          u (Int, a) -> v (Int, a) -> u (Int, a)
diffSS :: u (Int, a) -> v (Int, a) -> u (Int, a)
diffSS = (a -> a -> a) -> a -> u (Int, a) -> v (Int, a) -> u (Int, a)
forall (u :: * -> *) a (v :: * -> *).
(Vector u (Int, a), Vector v (Int, a), Unbox a) =>
(a -> a -> a) -> a -> u (Int, a) -> v (Int, a) -> u (Int, a)
binSS (-) a
0

-- | Binary operation on 'SVector' s
binSS :: (VG.Vector u (Int, a), VG.Vector v (Int, a), VU.Unbox a) =>
         (a -> a -> a) -> a -> u (Int, a) -> v (Int, a) -> u (Int, a)
binSS :: (a -> a -> a) -> a -> u (Int, a) -> v (Int, a) -> u (Int, a)
binSS a -> a -> a
f a
z u (Int, a)
vv1 v (Int, a)
vv2 = ((Int, Int) -> Maybe ((Int, a), (Int, Int)))
-> (Int, Int) -> u (Int, a)
forall (v :: * -> *) a b.
Vector v a =>
(b -> Maybe (a, b)) -> b -> v a
VG.unfoldr (Int, Int) -> Maybe ((Int, a), (Int, Int))
go (Int
0, Int
0)
  where
    nz1 :: Int
nz1 = u (Int, a) -> Int
forall (v :: * -> *) a. Vector v a => v a -> Int
VG.length u (Int, a)
vv1
    nz2 :: Int
nz2 = v (Int, a) -> Int
forall (v :: * -> *) a. Vector v a => v a -> Int
VG.length v (Int, a)
vv2
    go :: (Int, Int) -> Maybe ((Int, a), (Int, Int))
go (Int
i1, Int
i2)
      | Int
i1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
nz1 Bool -> Bool -> Bool
|| Int
i2 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
nz2 = Maybe ((Int, a), (Int, Int))
forall a. Maybe a
Nothing
      | Bool
otherwise =
          let
            (Int
il, a
xl) = u (Int, a)
vv1 u (Int, a) -> Int -> (Int, a)
forall (v :: * -> *) a. Vector v a => v a -> Int -> a
VG.! Int
i1
            (Int
ir, a
xr) = v (Int, a)
vv2 v (Int, a) -> Int -> (Int, a)
forall (v :: * -> *) a. Vector v a => v a -> Int -> a
VG.! Int
i2
          in case Int
il Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` Int
ir of
            Ordering
EQ -> ((Int, a), (Int, Int)) -> Maybe ((Int, a), (Int, Int))
forall a. a -> Maybe a
Just ((Int
il, a -> a -> a
f a
xl a
xr), (Int -> Int
forall a. Enum a => a -> a
succ Int
i1, Int -> Int
forall a. Enum a => a -> a
succ Int
i2))
            Ordering
LT -> ((Int, a), (Int, Int)) -> Maybe ((Int, a), (Int, Int))
forall a. a -> Maybe a
Just ((Int
il, a -> a -> a
f a
xl a
z ), (Int -> Int
forall a. Enum a => a -> a
succ Int
i1, Int
i2     ))
            Ordering
GT -> ((Int, a), (Int, Int)) -> Maybe ((Int, a), (Int, Int))
forall a. a -> Maybe a
Just ((Int
ir, a -> a -> a
f a
z  a
xr), (Int
i1     , Int -> Int
forall a. Enum a => a -> a
succ Int
i2))



binSD :: (VG.Vector u (Int, a), VG.Vector v a, VU.Unbox a) =>
         (a -> a -> a) -> u (Int, a) -> v a -> u (Int, a)
binSD :: (a -> a -> a) -> u (Int, a) -> v a -> u (Int, a)
binSD a -> a -> a
f u (Int, a)
vv1 v a
vv2 = (Int -> Maybe ((Int, a), Int)) -> Int -> u (Int, a)
forall (v :: * -> *) a b.
Vector v a =>
(b -> Maybe (a, b)) -> b -> v a
VG.unfoldr Int -> Maybe ((Int, a), Int)
go Int
0
  where
    nz1 :: Int
nz1 = u (Int, a) -> Int
forall (v :: * -> *) a. Vector v a => v a -> Int
VG.length u (Int, a)
vv1
    nz2 :: Int
nz2 = v a -> Int
forall (v :: * -> *) a. Vector v a => v a -> Int
VG.length v a
vv2
    go :: Int -> Maybe ((Int, a), Int)
go Int
i
      | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
nz1 Bool -> Bool -> Bool
|| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
nz2 = Maybe ((Int, a), Int)
forall a. Maybe a
Nothing
      | Bool
otherwise = ((Int, a), Int) -> Maybe ((Int, a), Int)
forall a. a -> Maybe a
Just ((Int
il, a
y), Int -> Int
forall a. Enum a => a -> a
succ Int
i)
          where
            (Int
il, a
xl) = u (Int, a)
vv1 u (Int, a) -> Int -> (Int, a)
forall (v :: * -> *) a. Vector v a => v a -> Int -> a
VG.! Int
i
            xr :: a
xr       = v a
vv2 v a -> Int -> a
forall (v :: * -> *) a. Vector v a => v a -> Int -> a
VG.! Int
il
            y :: a
y = a -> a -> a
f a
xl a
xr


-- | Partition the data wrt the median value of the inner product
partitionAtMedian :: (Ord a, Inner u v, VU.Unbox a, Fractional a) =>
                     u a -- ^ projection vector
                  -> V.Vector (v a) -- ^ dataset (3 or more elements)
                  -> (a, Margin a, V.Vector (v a), V.Vector (v a)) -- ^ median, margin, smaller, larger
partitionAtMedian :: u a -> Vector (v a) -> (a, Margin a, Vector (v a), Vector (v a))
partitionAtMedian u a
r Vector (v a)
xs = (a
thr, Margin a
margin, Vector (v a)
ll, Vector (v a)
rr)
  where
    (Vector (v a)
ll, Vector (v a)
rr) = (Int -> Vector (v a) -> Vector (v a)
forall (v :: * -> *) a. Vector v a => Int -> v a -> v a
VG.take Int
nh Vector (v a)
xs', Int -> Vector (v a) -> Vector (v a)
forall (v :: * -> *) a. Vector v a => Int -> v a -> v a
VG.drop Int
nh Vector (v a)
xs')
    -- (pjl, pjr) = (VG.head inns, VG.last inns) -- (min, max) inner product values
    (a
mgl, a
mgr) = (Vector a
inns Vector a -> Int -> a
forall (v :: * -> *) a. Vector v a => v a -> Int -> a
VG.! (Int
nh Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1), Vector a
inns Vector a -> Int -> a
forall (v :: * -> *) a. Vector v a => v a -> Int -> a
VG.! (Int
nh Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1))
    margin :: Margin a
margin = Max a -> Min a -> Margin a
forall a. Max a -> Min a -> Margin a
Margin (a -> Max a
forall a. a -> Max a
Max a
mgl) (a -> Min a
forall a. a -> Min a
Min a
mgr)
    -- marginL = mgl / (pjr - pjl) -- lower bound of margin, normalized to range
    -- marginR = mgr / (pjr - pjl) -- upper bound of margin, normalized to range
    thr :: a
thr = Vector a
inns Vector a -> Int -> a
forall (v :: * -> *) a. Vector v a => v a -> Int -> a
VG.! Int
nh -- inner product threshold
    n :: Int
n = Vector (v a) -> Int
forall (v :: * -> *) a. Vector v a => v a -> Int
VG.length Vector (v a)
xs -- total data size
    nh :: Int
nh = Int
n Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2 -- size of left partition
    projs :: Vector (v a, a)
projs = ((v a, a) -> a) -> Vector (v a, a) -> Vector (v a, a)
forall (v :: * -> *) a b.
(Vector v a, Ord b) =>
(a -> b) -> v a -> v a
sortByVG (v a, a) -> a
forall a b. (a, b) -> b
snd (Vector (v a, a) -> Vector (v a, a))
-> Vector (v a, a) -> Vector (v a, a)
forall a b. (a -> b) -> a -> b
$ (v a -> (v a, a)) -> Vector (v a) -> Vector (v a, a)
forall (v :: * -> *) a b.
(Vector v a, Vector v b) =>
(a -> b) -> v a -> v b
VG.map (\v a
x -> (v a
x, u a
r u a -> v a -> a
forall (u :: * -> *) (v :: * -> *) a.
(Inner u v, Unbox a, Num a) =>
u a -> v a -> a
`inner` v a
x)) Vector (v a)
xs
    (Vector (v a)
xs', Vector a
inns) = Vector (v a, a) -> (Vector (v a), Vector a)
forall (v :: * -> *) a b.
(Vector v a, Vector v b, Vector v (a, b)) =>
v (a, b) -> (v a, v b)
VG.unzip Vector (v a, a)
projs

sortByVG :: (VG.Vector v a, Ord b) => (a -> b) -> v a -> v a
sortByVG :: (a -> b) -> v a -> v a
sortByVG a -> b
f v a
v = (forall s. ST s (v a)) -> v a
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s (v a)) -> v a) -> (forall s. ST s (v a)) -> v a
forall a b. (a -> b) -> a -> b
$ do
  Mutable v s a
vm <- v a -> ST s (Mutable v (PrimState (ST s)) a)
forall (m :: * -> *) (v :: * -> *) a.
(PrimMonad m, Vector v a) =>
v a -> m (Mutable v (PrimState m) a)
VG.thaw v a
v
  Comparison a -> Mutable v (PrimState (ST s)) a -> ST s ()
forall (m :: * -> *) (v :: * -> * -> *) e.
(PrimMonad m, MVector v e) =>
Comparison e -> v (PrimState m) e -> m ()
V.sortBy ((a -> b) -> Comparison a
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing a -> b
f) Mutable v s a
Mutable v (PrimState (ST s)) a
vm
  Mutable v (PrimState (ST s)) a -> ST s (v a)
forall (m :: * -> *) (v :: * -> *) a.
(PrimMonad m, Vector v a) =>
Mutable v (PrimState m) a -> m (v a)
VG.freeze Mutable v s a
Mutable v (PrimState (ST s)) a
vm







-- data Avg a = Avg {
--   avgCount :: !(Sum Int)
--   , avgSum :: !(Sum a)
--                  }
-- average :: (Foldable t, Fractional a) => t a -> a
-- average = getAvg . foldl' bumpAvg mempty
-- bumpAvg :: Num a => Avg a -> a -> Avg a
-- bumpAvg aa x = Avg (Sum 1) (Sum x) <> aa
-- instance (Num a) => Semigroup (Avg a) where
--   Avg c0 s0 <> Avg c1 s1 = Avg (c0<>c1) (s0<>s1)
-- instance (Num a) => Monoid (Avg a) where
--   mempty = Avg mempty mempty
-- getAvg :: Fractional a => Avg a -> a
-- getAvg (Avg c s) = getSum s / fromIntegral (getSum c)


-- -- | Label a value with a unique identifier
-- -- labelId
-- newtype LabelT m a = LabelT {unLabelT :: StateT Integer m a} deriving (Functor, Applicative, Monad, MonadState Integer, MonadIO)
-- type Label = LabelT Identity
-- runLabelT :: (Monad m) => LabelT m a -> m a
-- runLabelT = flip evalStateT 0 . unLabelT
-- label :: Monad m => a -> LabelT m (Id a)
-- label x = LabelT $ do { i <- get ; put (i + 1); pure (Id x i)}
-- data Id a = Id { _idD :: a , _idL :: !Integer } deriving (Eq, Show, Functor, Foldable, Traversable, Generic)
-- instance NFData a => NFData (Id a)
-- makeLensesFor [("_idD", "idD")] ''Id
-- instance (Eq a) => Ord (Id a) where
--   Id _ u1 <= Id _ u2 = u1 <= u2