{-# LANGUAGE RankNTypes #-}
{-# language DeriveAnyClass #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE DeriveFoldable #-}
-- {-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE DeriveFunctor #-}
{-# language DeriveGeneric #-}
{-# language LambdaCase #-}
{-# language MultiParamTypeClasses #-}
{-# language GeneralizedNewtypeDeriving #-}
{-# language TemplateHaskell #-}
{-# LANGUAGE BangPatterns        #-}
{-# 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.Bifoldable (Bifoldable(..))
import Data.Bifunctor (Bifunctor(..))
import Data.Bitraversable (Bitraversable(..))
import Data.Function ((&))
import Data.Foldable (fold, foldl', toList)
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)
import GHC.Stack (HasCallStack)

-- bytestring
import qualified Data.ByteString.Lazy as LBS (ByteString, toStrict, fromStrict)
-- containers
import qualified Data.IntMap.Strict as IM (IntMap, fromList)
-- deepseq
import Control.DeepSeq (NFData(..))
-- microlens
import Lens.Micro ((^..), Traversal', folded, Getting)
-- microlens-th
import Lens.Micro.TH (makeLensesFor)
-- serialise
import Codec.Serialise (Serialise(..), serialise, deserialiseOrFail)
-- 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, imap)
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)

-- | Pairing of a data item with its vector embedding
--
-- The vector is used internally for indexing
data Embed v e a = Embed {
  Embed v e a -> v e
eEmbed :: !(v e) -- ^ vector embedding
  , Embed v e a -> a
eData :: !a -- ^ data item
                       } deriving (Embed v e a -> Embed v e a -> Bool
(Embed v e a -> Embed v e a -> Bool)
-> (Embed v e a -> Embed v e a -> Bool) -> Eq (Embed v e a)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (v :: * -> *) e a.
(Eq a, Eq (v e)) =>
Embed v e a -> Embed v e a -> Bool
/= :: Embed v e a -> Embed v e a -> Bool
$c/= :: forall (v :: * -> *) e a.
(Eq a, Eq (v e)) =>
Embed v e a -> Embed v e a -> Bool
== :: Embed v e a -> Embed v e a -> Bool
$c== :: forall (v :: * -> *) e a.
(Eq a, Eq (v e)) =>
Embed v e a -> Embed v e a -> Bool
Eq, Eq (Embed v e a)
Eq (Embed v e a)
-> (Embed v e a -> Embed v e a -> Ordering)
-> (Embed v e a -> Embed v e a -> Bool)
-> (Embed v e a -> Embed v e a -> Bool)
-> (Embed v e a -> Embed v e a -> Bool)
-> (Embed v e a -> Embed v e a -> Bool)
-> (Embed v e a -> Embed v e a -> Embed v e a)
-> (Embed v e a -> Embed v e a -> Embed v e a)
-> Ord (Embed v e a)
Embed v e a -> Embed v e a -> Bool
Embed v e a -> Embed v e a -> Ordering
Embed v e a -> Embed v e a -> Embed v e 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 (v :: * -> *) e a. (Ord a, Ord (v e)) => Eq (Embed v e a)
forall (v :: * -> *) e a.
(Ord a, Ord (v e)) =>
Embed v e a -> Embed v e a -> Bool
forall (v :: * -> *) e a.
(Ord a, Ord (v e)) =>
Embed v e a -> Embed v e a -> Ordering
forall (v :: * -> *) e a.
(Ord a, Ord (v e)) =>
Embed v e a -> Embed v e a -> Embed v e a
min :: Embed v e a -> Embed v e a -> Embed v e a
$cmin :: forall (v :: * -> *) e a.
(Ord a, Ord (v e)) =>
Embed v e a -> Embed v e a -> Embed v e a
max :: Embed v e a -> Embed v e a -> Embed v e a
$cmax :: forall (v :: * -> *) e a.
(Ord a, Ord (v e)) =>
Embed v e a -> Embed v e a -> Embed v e a
>= :: Embed v e a -> Embed v e a -> Bool
$c>= :: forall (v :: * -> *) e a.
(Ord a, Ord (v e)) =>
Embed v e a -> Embed v e a -> Bool
> :: Embed v e a -> Embed v e a -> Bool
$c> :: forall (v :: * -> *) e a.
(Ord a, Ord (v e)) =>
Embed v e a -> Embed v e a -> Bool
<= :: Embed v e a -> Embed v e a -> Bool
$c<= :: forall (v :: * -> *) e a.
(Ord a, Ord (v e)) =>
Embed v e a -> Embed v e a -> Bool
< :: Embed v e a -> Embed v e a -> Bool
$c< :: forall (v :: * -> *) e a.
(Ord a, Ord (v e)) =>
Embed v e a -> Embed v e a -> Bool
compare :: Embed v e a -> Embed v e a -> Ordering
$ccompare :: forall (v :: * -> *) e a.
(Ord a, Ord (v e)) =>
Embed v e a -> Embed v e a -> Ordering
$cp1Ord :: forall (v :: * -> *) e a. (Ord a, Ord (v e)) => Eq (Embed v e a)
Ord, (forall x. Embed v e a -> Rep (Embed v e a) x)
-> (forall x. Rep (Embed v e a) x -> Embed v e a)
-> Generic (Embed v e a)
forall x. Rep (Embed v e a) x -> Embed v e a
forall x. Embed v e a -> Rep (Embed v e a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (v :: * -> *) e a x. Rep (Embed v e a) x -> Embed v e a
forall (v :: * -> *) e a x. Embed v e a -> Rep (Embed v e a) x
$cto :: forall (v :: * -> *) e a x. Rep (Embed v e a) x -> Embed v e a
$cfrom :: forall (v :: * -> *) e a x. Embed v e a -> Rep (Embed v e a) x
Generic, a -> Embed v e b -> Embed v e a
(a -> b) -> Embed v e a -> Embed v e b
(forall a b. (a -> b) -> Embed v e a -> Embed v e b)
-> (forall a b. a -> Embed v e b -> Embed v e a)
-> Functor (Embed v e)
forall a b. a -> Embed v e b -> Embed v e a
forall a b. (a -> b) -> Embed v e a -> Embed v e b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
forall (v :: * -> *) e a b. a -> Embed v e b -> Embed v e a
forall (v :: * -> *) e a b. (a -> b) -> Embed v e a -> Embed v e b
<$ :: a -> Embed v e b -> Embed v e a
$c<$ :: forall (v :: * -> *) e a b. a -> Embed v e b -> Embed v e a
fmap :: (a -> b) -> Embed v e a -> Embed v e b
$cfmap :: forall (v :: * -> *) e a b. (a -> b) -> Embed v e a -> Embed v e b
Functor)
instance (Show (v e), Show e, Show a) => Show (Embed v e a) where
  show :: Embed v e a -> String
show (Embed v e
v a
dat) = [String] -> String
unwords [v e -> String
forall a. Show a => a -> String
show v e
v, a -> String
forall a. Show a => a -> String
show a
dat]
instance (NFData (v e), NFData a) => NFData (Embed v e a)
instance (Serialise (v e), Serialise a) => Serialise (Embed v e a)

-- | 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, (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 Show a => Show (Margin a) where
  show :: Margin a -> String
show (Margin Max a
lo Min a
hi) = [String] -> String
unwords [String
"low", a -> String
forall a. Show a => a -> String
show (Max a -> a
forall a. Max a -> a
getMax Max a
lo), String
"high", a -> String
forall a. Show a => a -> String
show (Min a -> a
forall a. Min a -> a
getMin Min a
hi)]
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)
instance (Ord a, Num a) => Monoid (Margin a) where
  mempty :: Margin a
mempty = 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
0) (a -> Min a
forall a. a -> Min a
Min a
0)

-- | Sparse vectors with unboxed components
data SVector a = SV { SVector a -> Int
svDim :: {-# UNPACK #-} !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)

-- | (Unsafe) Pack a 'SVector' from its vector dimension and components
--
-- Note : the relevant invariants are not checked :
--
-- * vector components are _assumed_ to be in increasing order
--
-- * vector dimension is larger than any component index
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

-- | (Unsafe) Pack a 'SVector' from its vector dimension and components
--
-- Note : the relevant invariants are not checked :
--
-- * vector components are _assumed_ to be in increasing order
--
-- * vector dimension is larger than any component index
fromVectorSv :: Int -- ^ vector dimension
             -> VU.Vector (Int, a) -- ^ vector components (in increasing order)
             -> SVector a
fromVectorSv :: Int -> Vector (Int, a) -> SVector a
fromVectorSv = Int -> Vector (Int, a) -> SVector a
forall a. Int -> Vector (Int, a) -> SVector a
SV

-- | 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)]
instance NFData (DVector a)

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
fromVectorDv :: VU.Vector a -> DVector a
fromVectorDv :: Vector a -> DVector a
fromVectorDv = Vector a -> DVector a
forall a. Vector a -> DVector a
DV
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 tree level (as suggested in https://www.cs.helsinki.fi/u/ttonteri/pub/bigdata2016.pdf )
data RPT d l a =
  Bin {
  RPT d l a -> l
_rpLabel :: l
  , RPT d l a -> d
_rpThreshold ::  !d
  , RPT d l a -> Margin d
_rpMargin :: {-# UNPACK #-} !(Margin d)
  , RPT d l a -> RPT d l a
_rpL :: !(RPT d l a)
  , RPT d l a -> RPT d l a
_rpR :: !(RPT d l a) }
  | Tip {
      _rpLabel :: l
    , RPT d l a -> a
_rpData :: !a }
  deriving (RPT d l a -> RPT d l a -> Bool
(RPT d l a -> RPT d l a -> Bool)
-> (RPT d l a -> RPT d l a -> Bool) -> Eq (RPT d l a)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall d l a. (Eq l, Eq d, Eq a) => RPT d l a -> RPT d l a -> Bool
/= :: RPT d l a -> RPT d l a -> Bool
$c/= :: forall d l a. (Eq l, Eq d, Eq a) => RPT d l a -> RPT d l a -> Bool
== :: RPT d l a -> RPT d l a -> Bool
$c== :: forall d l a. (Eq l, Eq d, Eq a) => RPT d l a -> RPT d l a -> Bool
Eq, Int -> RPT d l a -> ShowS
[RPT d l a] -> ShowS
RPT d l a -> String
(Int -> RPT d l a -> ShowS)
-> (RPT d l a -> String)
-> ([RPT d l a] -> ShowS)
-> Show (RPT d l a)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall d l a. (Show l, Show d, Show a) => Int -> RPT d l a -> ShowS
forall d l a. (Show l, Show d, Show a) => [RPT d l a] -> ShowS
forall d l a. (Show l, Show d, Show a) => RPT d l a -> String
showList :: [RPT d l a] -> ShowS
$cshowList :: forall d l a. (Show l, Show d, Show a) => [RPT d l a] -> ShowS
show :: RPT d l a -> String
$cshow :: forall d l a. (Show l, Show d, Show a) => RPT d l a -> String
showsPrec :: Int -> RPT d l a -> ShowS
$cshowsPrec :: forall d l a. (Show l, Show d, Show a) => Int -> RPT d l a -> ShowS
Show, (forall x. RPT d l a -> Rep (RPT d l a) x)
-> (forall x. Rep (RPT d l a) x -> RPT d l a)
-> Generic (RPT d l a)
forall x. Rep (RPT d l a) x -> RPT d l a
forall x. RPT d l a -> Rep (RPT d l a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall d l a x. Rep (RPT d l a) x -> RPT d l a
forall d l a x. RPT d l a -> Rep (RPT d l a) x
$cto :: forall d l a x. Rep (RPT d l a) x -> RPT d l a
$cfrom :: forall d l a x. RPT d l a -> Rep (RPT d l a) x
Generic, a -> RPT d l b -> RPT d l a
(a -> b) -> RPT d l a -> RPT d l b
(forall a b. (a -> b) -> RPT d l a -> RPT d l b)
-> (forall a b. a -> RPT d l b -> RPT d l a) -> Functor (RPT d l)
forall a b. a -> RPT d l b -> RPT d l a
forall a b. (a -> b) -> RPT d l a -> RPT d l b
forall d l a b. a -> RPT d l b -> RPT d l a
forall d l a b. (a -> b) -> RPT d l a -> RPT d l 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 l b -> RPT d l a
$c<$ :: forall d l a b. a -> RPT d l b -> RPT d l a
fmap :: (a -> b) -> RPT d l a -> RPT d l b
$cfmap :: forall d l a b. (a -> b) -> RPT d l a -> RPT d l b
Functor, RPT d l a -> Bool
(a -> m) -> RPT d l a -> m
(a -> b -> b) -> b -> RPT d l a -> b
(forall m. Monoid m => RPT d l m -> m)
-> (forall m a. Monoid m => (a -> m) -> RPT d l a -> m)
-> (forall m a. Monoid m => (a -> m) -> RPT d l a -> m)
-> (forall a b. (a -> b -> b) -> b -> RPT d l a -> b)
-> (forall a b. (a -> b -> b) -> b -> RPT d l a -> b)
-> (forall b a. (b -> a -> b) -> b -> RPT d l a -> b)
-> (forall b a. (b -> a -> b) -> b -> RPT d l a -> b)
-> (forall a. (a -> a -> a) -> RPT d l a -> a)
-> (forall a. (a -> a -> a) -> RPT d l a -> a)
-> (forall a. RPT d l a -> [a])
-> (forall a. RPT d l a -> Bool)
-> (forall a. RPT d l a -> Int)
-> (forall a. Eq a => a -> RPT d l a -> Bool)
-> (forall a. Ord a => RPT d l a -> a)
-> (forall a. Ord a => RPT d l a -> a)
-> (forall a. Num a => RPT d l a -> a)
-> (forall a. Num a => RPT d l a -> a)
-> Foldable (RPT d l)
forall a. Eq a => a -> RPT d l a -> Bool
forall a. Num a => RPT d l a -> a
forall a. Ord a => RPT d l a -> a
forall m. Monoid m => RPT d l m -> m
forall a. RPT d l a -> Bool
forall a. RPT d l a -> Int
forall a. RPT d l a -> [a]
forall a. (a -> a -> a) -> RPT d l a -> a
forall m a. Monoid m => (a -> m) -> RPT d l a -> m
forall b a. (b -> a -> b) -> b -> RPT d l a -> b
forall a b. (a -> b -> b) -> b -> RPT d l a -> b
forall d l a. Eq a => a -> RPT d l a -> Bool
forall d l a. Num a => RPT d l a -> a
forall d l a. Ord a => RPT d l a -> a
forall d l m. Monoid m => RPT d l m -> m
forall d l a. RPT d l a -> Bool
forall d l a. RPT d l a -> Int
forall d l a. RPT d l a -> [a]
forall d l a. (a -> a -> a) -> RPT d l a -> a
forall d l m a. Monoid m => (a -> m) -> RPT d l a -> m
forall d l b a. (b -> a -> b) -> b -> RPT d l a -> b
forall d l a b. (a -> b -> b) -> b -> RPT d l 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 l a -> a
$cproduct :: forall d l a. Num a => RPT d l a -> a
sum :: RPT d l a -> a
$csum :: forall d l a. Num a => RPT d l a -> a
minimum :: RPT d l a -> a
$cminimum :: forall d l a. Ord a => RPT d l a -> a
maximum :: RPT d l a -> a
$cmaximum :: forall d l a. Ord a => RPT d l a -> a
elem :: a -> RPT d l a -> Bool
$celem :: forall d l a. Eq a => a -> RPT d l a -> Bool
length :: RPT d l a -> Int
$clength :: forall d l a. RPT d l a -> Int
null :: RPT d l a -> Bool
$cnull :: forall d l a. RPT d l a -> Bool
toList :: RPT d l a -> [a]
$ctoList :: forall d l a. RPT d l a -> [a]
foldl1 :: (a -> a -> a) -> RPT d l a -> a
$cfoldl1 :: forall d l a. (a -> a -> a) -> RPT d l a -> a
foldr1 :: (a -> a -> a) -> RPT d l a -> a
$cfoldr1 :: forall d l a. (a -> a -> a) -> RPT d l a -> a
foldl' :: (b -> a -> b) -> b -> RPT d l a -> b
$cfoldl' :: forall d l b a. (b -> a -> b) -> b -> RPT d l a -> b
foldl :: (b -> a -> b) -> b -> RPT d l a -> b
$cfoldl :: forall d l b a. (b -> a -> b) -> b -> RPT d l a -> b
foldr' :: (a -> b -> b) -> b -> RPT d l a -> b
$cfoldr' :: forall d l a b. (a -> b -> b) -> b -> RPT d l a -> b
foldr :: (a -> b -> b) -> b -> RPT d l a -> b
$cfoldr :: forall d l a b. (a -> b -> b) -> b -> RPT d l a -> b
foldMap' :: (a -> m) -> RPT d l a -> m
$cfoldMap' :: forall d l m a. Monoid m => (a -> m) -> RPT d l a -> m
foldMap :: (a -> m) -> RPT d l a -> m
$cfoldMap :: forall d l m a. Monoid m => (a -> m) -> RPT d l a -> m
fold :: RPT d l m -> m
$cfold :: forall d l m. Monoid m => RPT d l m -> m
Foldable, Functor (RPT d l)
Foldable (RPT d l)
Functor (RPT d l)
-> Foldable (RPT d l)
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> RPT d l a -> f (RPT d l b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    RPT d l (f a) -> f (RPT d l a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> RPT d l a -> m (RPT d l b))
-> (forall (m :: * -> *) a.
    Monad m =>
    RPT d l (m a) -> m (RPT d l a))
-> Traversable (RPT d l)
(a -> f b) -> RPT d l a -> f (RPT d l b)
forall d l. Functor (RPT d l)
forall d l. Foldable (RPT d l)
forall d l (m :: * -> *) a.
Monad m =>
RPT d l (m a) -> m (RPT d l a)
forall d l (f :: * -> *) a.
Applicative f =>
RPT d l (f a) -> f (RPT d l a)
forall d l (m :: * -> *) a b.
Monad m =>
(a -> m b) -> RPT d l a -> m (RPT d l b)
forall d l (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> RPT d l a -> f (RPT d l 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 l (m a) -> m (RPT d l a)
forall (f :: * -> *) a.
Applicative f =>
RPT d l (f a) -> f (RPT d l a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> RPT d l a -> m (RPT d l b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> RPT d l a -> f (RPT d l b)
sequence :: RPT d l (m a) -> m (RPT d l a)
$csequence :: forall d l (m :: * -> *) a.
Monad m =>
RPT d l (m a) -> m (RPT d l a)
mapM :: (a -> m b) -> RPT d l a -> m (RPT d l b)
$cmapM :: forall d l (m :: * -> *) a b.
Monad m =>
(a -> m b) -> RPT d l a -> m (RPT d l b)
sequenceA :: RPT d l (f a) -> f (RPT d l a)
$csequenceA :: forall d l (f :: * -> *) a.
Applicative f =>
RPT d l (f a) -> f (RPT d l a)
traverse :: (a -> f b) -> RPT d l a -> f (RPT d l b)
$ctraverse :: forall d l (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> RPT d l a -> f (RPT d l b)
$cp2Traversable :: forall d l. Foldable (RPT d l)
$cp1Traversable :: forall d l. Functor (RPT d l)
Traversable)
instance Bifunctor (RPT d) where
  bimap :: (a -> b) -> (c -> d) -> RPT d a c -> RPT d b d
bimap a -> b
f c -> d
g = \case
    Bin a
x d
thr Margin d
mg RPT d a c
tl RPT d a c
tr -> b -> d -> Margin d -> RPT d b d -> RPT d b d -> RPT d b d
forall d l a.
l -> d -> Margin d -> RPT d l a -> RPT d l a -> RPT d l a
Bin (a -> b
f a
x) d
thr Margin d
mg ((a -> b) -> (c -> d) -> RPT d a c -> RPT d b d
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap a -> b
f c -> d
g RPT d a c
tl) ((a -> b) -> (c -> d) -> RPT d a c -> RPT d b d
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap a -> b
f c -> d
g RPT d a c
tr)
    Tip a
x c
y -> b -> d -> RPT d b d
forall d l a. l -> a -> RPT d l a
Tip (a -> b
f a
x) (c -> d
g c
y)
instance Bifoldable (RPT d) where
  bifoldMap :: (a -> m) -> (b -> m) -> RPT d a b -> m
bifoldMap a -> m
f b -> m
g = \case
    Bin a
x d
_ Margin d
_ RPT d a b
tl RPT d a b
tr -> a -> m
f a
x m -> m -> m
forall a. Semigroup a => a -> a -> a
<> (a -> m) -> (b -> m) -> RPT d a b -> m
forall (p :: * -> * -> *) m a b.
(Bifoldable p, Monoid m) =>
(a -> m) -> (b -> m) -> p a b -> m
bifoldMap a -> m
f b -> m
g RPT d a b
tl m -> m -> m
forall a. Semigroup a => a -> a -> a
<> (a -> m) -> (b -> m) -> RPT d a b -> m
forall (p :: * -> * -> *) m a b.
(Bifoldable p, Monoid m) =>
(a -> m) -> (b -> m) -> p a b -> m
bifoldMap a -> m
f b -> m
g RPT d a b
tr
    Tip a
x b
y -> a -> m
f a
x m -> m -> m
forall a. Semigroup a => a -> a -> a
<> b -> m
g b
y
instance Bitraversable (RPT d) where
  bitraverse :: (a -> f c) -> (b -> f d) -> RPT d a b -> f (RPT d c d)
bitraverse a -> f c
f b -> f d
g = \case
    Bin a
x d
thr Margin d
mg RPT d a b
tl RPT d a b
tr -> c -> d -> Margin d -> RPT d c d -> RPT d c d -> RPT d c d
forall d l a.
l -> d -> Margin d -> RPT d l a -> RPT d l a -> RPT d l a
Bin (c -> d -> Margin d -> RPT d c d -> RPT d c d -> RPT d c d)
-> f c -> f (d -> Margin d -> RPT d c d -> RPT d c d -> RPT d c d)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f c
f a
x f (d -> Margin d -> RPT d c d -> RPT d c d -> RPT d c d)
-> f d -> f (Margin d -> RPT d c d -> RPT d c d -> RPT d c d)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> d -> f d
forall (f :: * -> *) a. Applicative f => a -> f a
pure d
thr f (Margin d -> RPT d c d -> RPT d c d -> RPT d c d)
-> f (Margin d) -> f (RPT d c d -> RPT d c d -> RPT d c d)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Margin d -> f (Margin d)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Margin d
mg f (RPT d c d -> RPT d c d -> RPT d c d)
-> f (RPT d c d) -> f (RPT d c d -> RPT d c d)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (a -> f c) -> (b -> f d) -> RPT d a b -> f (RPT d c d)
forall (t :: * -> * -> *) (f :: * -> *) a c b d.
(Bitraversable t, Applicative f) =>
(a -> f c) -> (b -> f d) -> t a b -> f (t c d)
bitraverse a -> f c
f b -> f d
g RPT d a b
tl f (RPT d c d -> RPT d c d) -> f (RPT d c d) -> f (RPT d c d)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (a -> f c) -> (b -> f d) -> RPT d a b -> f (RPT d c d)
forall (t :: * -> * -> *) (f :: * -> *) a c b d.
(Bitraversable t, Applicative f) =>
(a -> f c) -> (b -> f d) -> t a b -> f (t c d)
bitraverse a -> f c
f b -> f d
g RPT d a b
tr
    Tip a
x b
y -> c -> d -> RPT d c d
forall d l a. l -> a -> RPT d l a
Tip (c -> d -> RPT d c d) -> f c -> f (d -> RPT d c d)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f c
f a
x f (d -> RPT d c d) -> f d -> f (RPT d c d)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> b -> f d
g b
y
instance (Serialise a, Serialise l, Serialise d) => Serialise (RPT d l a)
makeLensesFor [("_rpData", "rpData"), ("_rpLabel", "rpLabel")] ''RPT
instance (NFData v, NFData l, NFData a) => NFData (RPT v l a)

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

-- | A random projection forest is an ordered set of 'RPTree's
--
-- This supports efficient updates of the ensemble in the streaming/online setting.
type RPForest d a = IM.IntMap (RPTree d () a)

-- | Serialise each tree in the 'RPForest' as a separate bytestring
serialiseRPForest :: (Serialise d, Serialise a, VU.Unbox d) =>
                     RPForest d a
                  -> [LBS.ByteString] -- ^ the order is undefined
serialiseRPForest :: RPForest d a -> [ByteString]
serialiseRPForest RPForest d a
tt = RPTree d () a -> ByteString
forall a. Serialise a => a -> ByteString
serialise (RPTree d () a -> ByteString) -> [RPTree d () a] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
`map` RPForest d a -> [RPTree d () a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList RPForest d a
tt

-- | Deserialise each tree in the 'RPForest' from a separate bytestring and reconstruct
deserialiseRPForest :: (Serialise d, Serialise a, VU.Unbox d) =>
                       [LBS.ByteString]
                    -> Either String (RPForest d a) -- ^ the order is undefined
deserialiseRPForest :: [ByteString] -> Either String (RPForest d a)
deserialiseRPForest [ByteString]
bss = case ByteString -> Either DeserialiseFailure (RPTree d () a)
forall a. Serialise a => ByteString -> Either DeserialiseFailure a
deserialiseOrFail (ByteString -> Either DeserialiseFailure (RPTree d () a))
-> [ByteString] -> Either DeserialiseFailure [RPTree d () a]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
`traverse` [ByteString]
bss of
  Left DeserialiseFailure
e -> String -> Either String (RPForest d a)
forall a b. a -> Either a b
Left (DeserialiseFailure -> String
forall a. Show a => a -> String
show DeserialiseFailure
e)
  Right [RPTree d () a]
xs -> RPForest d a -> Either String (RPForest d a)
forall a b. b -> Either a b
Right (RPForest d a -> Either String (RPForest d a))
-> RPForest d a -> Either String (RPForest d a)
forall a b. (a -> b) -> a -> b
$ [(Int, RPTree d () a)] -> RPForest d a
forall a. [(Int, a)] -> IntMap a
IM.fromList ([(Int, RPTree d () a)] -> RPForest d a)
-> [(Int, RPTree d () a)] -> RPForest d a
forall a b. (a -> b) -> a -> b
$ [Int] -> [RPTree d () a] -> [(Int, RPTree d () a)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0 ..] [RPTree d () a]
xs

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

-- | All data buckets stored at the leaves of the tree
leaves :: RPTree d l a -> [a]
leaves :: RPTree d l a -> [a]
leaves = (RPTree d l a -> Getting (Endo [a]) (RPTree d l a) a -> [a]
forall s a. s -> Getting (Endo [a]) s a -> [a]
^.. Getting (Endo [a]) (RPTree d l a) a
forall d l a. Traversal' (RPTree d l a) a
rpTreeData)

-- | Number of tree levels
levels :: RPTree d l a -> Int
levels :: RPTree d l a -> Int
levels (RPTree Vector (SVector d)
v RPT d l 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 l m -> m
points :: RPTree d l m -> m
points (RPTree Vector (SVector d)
_ RPT d l m
t) = RPT d l m -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold RPT d l m
t

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

-- | Scale a vector
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 -> v a
  (^-^) :: (VU.Unbox a, Num a) => u a -> v a -> v 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 (u :: * -> *) (v :: * -> *).
(Floating a, Unbox a, Vector u (Int, a), Vector v a) =>
u (Int, a) -> v a -> a
metricSDL2 Vector (Int, a)
v1 Vector a
v2
  (SV Int
_ Vector (Int, a)
v1) ^+^ :: SVector a -> Vector a -> Vector a
^+^ Vector a
v2 = Vector (Int, a) -> Vector a -> Vector a
forall (u :: * -> *) a (v :: * -> *).
(Vector u (Int, a), Vector v a, Unbox a, Num a) =>
u (Int, a) -> v a -> v a
sumSD Vector (Int, a)
v1 Vector a
v2
  (SV Int
_ Vector (Int, a)
v1) ^-^ :: SVector a -> Vector a -> Vector a
^-^ Vector a
v2 = Vector (Int, a) -> Vector a -> Vector a
forall (u :: * -> *) a (v :: * -> *).
(Vector u (Int, a), Vector v a, Unbox a, Num a) =>
u (Int, a) -> v a -> v 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 (u :: * -> *) (v :: * -> *).
(Floating a, Unbox a, Vector u (Int, a), Vector v a) =>
u (Int, a) -> v a -> a
metricSDL2 Vector (Int, a)
v1 Vector a
v2
  (SV Int
_ Vector (Int, a)
v1) ^+^ :: SVector 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
$ Vector (Int, a) -> Vector a -> Vector a
forall (u :: * -> *) a (v :: * -> *).
(Vector u (Int, a), Vector v a, Unbox a, Num a) =>
u (Int, a) -> v a -> v a
sumSD Vector (Int, a)
v1 Vector a
v2
  (SV Int
_ Vector (Int, a)
v1) ^-^ :: SVector 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
$ Vector (Int, a) -> Vector a -> Vector a
forall (u :: * -> *) a (v :: * -> *).
(Vector u (Int, a), Vector v a, Unbox a, Num a) =>
u (Int, a) -> v a -> v 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, VU.Unbox a, VG.Vector u (Int, a), VG.Vector v a) =>
              u (Int, a) -> v a -> a
metricSDL2 :: u (Int, a) -> v a -> a
metricSDL2 u (Int, 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 = u (Int, a)
u u (Int, a) -> v a -> v a
forall (u :: * -> *) a (v :: * -> *).
(Vector u (Int, a), Vector v a, Unbox a, Num a) =>
u (Int, a) -> v a -> v a
`diffSD` v 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 -> v a
sumSD :: u (Int, a) -> v a -> v a
sumSD = (a -> a -> a) -> a -> u (Int, a) -> v a -> v a
forall (v1 :: * -> *) a (v2 :: * -> *) p (v3 :: * -> *).
(Vector v1 a, Vector v2 p, Vector v3 (Int, p)) =>
(p -> p -> a) -> p -> v3 (Int, p) -> v2 p -> v1 a
binSDD a -> a -> a
forall a. Num a => a -> a -> a
(+) a
0

-- | 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 -> v a
diffSD :: u (Int, a) -> v a -> v a
diffSD = (a -> a -> a) -> a -> u (Int, a) -> v a -> v a
forall (v1 :: * -> *) a (v2 :: * -> *) p (v3 :: * -> *).
(Vector v1 a, Vector v2 p, Vector v3 (Int, p)) =>
(p -> p -> a) -> p -> v3 (Int, p) -> v2 p -> v1 a
binSDD (-) a
0

-- | 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))

-- | sparse * dense -> dense
--
-- e.g. vector sum, difference
binSDD :: (VG.Vector v1 a, VG.Vector v2 p, VG.Vector v3 (Int, p)) =>
          (p -> p -> a) -> p -> v3 (Int, p) -> v2 p -> v1 a
binSDD :: (p -> p -> a) -> p -> v3 (Int, p) -> v2 p -> v1 a
binSDD p -> p -> a
f p
z v3 (Int, p)
vv1 v2 p
vv2 = ((Int, Int) -> Maybe (a, (Int, Int))) -> (Int, Int) -> v1 a
forall (v :: * -> *) a b.
Vector v a =>
(b -> Maybe (a, b)) -> b -> v a
VG.unfoldr (Int, Int) -> Maybe (a, (Int, Int))
go (Int
0, Int
0)
  where
    nz1 :: Int
nz1 = v3 (Int, p) -> Int
forall (v :: * -> *) a. Vector v a => v a -> Int
VG.length v3 (Int, p)
vv1
    nz2 :: Int
nz2 = v2 p -> Int
forall (v :: * -> *) a. Vector v a => v a -> Int
VG.length v2 p
vv2
    go :: (Int, Int) -> Maybe (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 (a, (Int, Int))
forall a. Maybe a
Nothing
      | Bool
otherwise =
          let
            (Int
il, p
xl) = v3 (Int, p)
vv1 v3 (Int, p) -> Int -> (Int, p)
forall (v :: * -> *) a. Vector v a => v a -> Int -> a
VG.! Int
i1
            xr :: p
xr       = v2 p
vv2 v2 p -> Int -> p
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
i2 of
            Ordering
EQ -> (a, (Int, Int)) -> Maybe (a, (Int, Int))
forall a. a -> Maybe a
Just (p -> p -> a
f p
xl p
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 -> (a, (Int, Int)) -> Maybe (a, (Int, Int))
forall a. a -> Maybe a
Just (p -> p -> a
f p
xl p
z , (Int -> Int
forall a. Enum a => a -> a
succ Int
i1, Int
i2     ))
            Ordering
GT -> (a, (Int, Int)) -> Maybe (a, (Int, Int))
forall a. a -> Maybe a
Just (p -> p -> a
f p
z  p
xr, (Int
i1     , Int -> Int
forall a. Enum a => a -> a
succ Int
i2))

{-
-  b0
-  b1
a2 b2
-  b3
a4 b4
-}


type VE v a x = V.Vector (Embed v a x)


{-# SCC partitionAtMedian #-}
-- | 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 (Embed v a x) -- ^ dataset (3 or more elements)
  -> Maybe (a, Margin a, VE v a x, VE v a x) -- ^ median, margin, smaller, larger
partitionAtMedian :: u a
-> Vector (Embed v a x)
-> Maybe (a, Margin a, Vector (Embed v a x), Vector (Embed v a x))
partitionAtMedian u a
r Vector (Embed v a x)
xs
  | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
1 = Maybe (a, Margin a, Vector (Embed v a x), Vector (Embed v a x))
forall a. Maybe a
Nothing
  | Bool
otherwise = (a, Margin a, Vector (Embed v a x), Vector (Embed v a x))
-> Maybe (a, Margin a, Vector (Embed v a x), Vector (Embed v a x))
forall a. a -> Maybe a
Just (a
thr, Margin a
margin, Vector (Embed v a x)
ll, Vector (Embed v a x)
rr)
  where
    (Vector (Embed v a x)
ll, Vector (Embed v a x)
rr) = (Int -> Vector (Embed v a x) -> Vector (Embed v a x)
forall (v :: * -> *) a. Vector v a => Int -> v a -> v a
VG.take Int
nh Vector (Embed v a x)
xs', Int -> Vector (Embed v a x) -> Vector (Embed v a x)
forall (v :: * -> *) a. Vector v a => Int -> v a -> v a
VG.drop Int
nh Vector (Embed v a x)
xs')
    (a
mgl, a
mgr)
      | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
3 = (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))
      | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
2 = (Vector a
inns Vector a -> Int -> a
forall (v :: * -> *) a. Vector v a => v a -> Int -> a
VG.! Int
0, Vector a
inns Vector a -> Int -> a
forall (v :: * -> *) a. Vector v a => v a -> Int -> a
VG.! Int
1)
      | Bool
otherwise = let z :: a
z = Vector a
inns Vector a -> Int -> a
forall (v :: * -> *) a. Vector v a => v a -> Int -> a
VG.! Int
0 in (a
z, a
z) -- assuming at least 1 element
    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)
    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,  mgl < thr < mgr
    n :: Int
n = Vector (Embed v a x) -> Int
forall (v :: * -> *) a. Vector v a => v a -> Int
VG.length Vector (Embed v a x)
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 (Embed v a x, a)
projs = ((Embed v a x, a) -> a)
-> Vector (Embed v a x, a) -> Vector (Embed v a x, a)
forall (v :: * -> *) a b.
(Vector v a, Ord b) =>
(a -> b) -> v a -> v a
sortByVG (Embed v a x, a) -> a
forall a b. (a, b) -> b
snd (Vector (Embed v a x, a) -> Vector (Embed v a x, a))
-> Vector (Embed v a x, a) -> Vector (Embed v a x, a)
forall a b. (a -> b) -> a -> b
$ (Embed v a x -> (Embed v a x, a))
-> Vector (Embed v a x) -> Vector (Embed v a x, a)
forall (v :: * -> *) a b.
(Vector v a, Vector v b) =>
(a -> b) -> v a -> v b
VG.map (\Embed v a x
xe -> (Embed v a x
xe, 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` (Embed v a x -> v a
forall (v :: * -> *) e a. Embed v e a -> v e
eEmbed Embed v a x
xe))) Vector (Embed v a x)
xs
    (Vector (Embed v a x)
xs', Vector a
inns) = Vector (Embed v a x, a) -> (Vector (Embed v a x), 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 (Embed v a x, 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






-- -- FIXME the return type of a sparse-dense binary operation depends on the operator itself (S * D = S , S + D = D ), so 'binSD' must be changed
-- binSD :: (VG.Vector u (Int, a), VG.Vector v a) =>
--          (a -> a -> a) -> u (Int, a) -> v a -> u (Int, a)
-- binSD f vv1 vv2 = VG.unfoldr go 0
--   where
--     nz1 = VG.length vv1
--     nz2 = VG.length vv2
--     go i
--       | i >= nz1 || i >= nz2 = Nothing
--       | otherwise = Just ((il, y), succ i)
--           where
--             (il, xl) = vv1 VG.! i
--             xr       = vv2 VG.! il
--             y = f xl xr