```-- | A `SortedVector` is a vector that maintains the invariant that all elements are sorted.  Whenever an element is added/removed, the vector is automatically adjusted.  Because element positions can be changed in this way, it does not make sense to index the vector by specific locations.

module HLearn.DataStructures.SortedVector
( SortedVector
)
where

import Control.Applicative
import Control.DeepSeq
import qualified Data.Foldable as F
import Data.List
import Debug.Trace
import GHC.TypeLits
import qualified Data.Vector as V

import qualified Control.ConstraintKinds as CK

import Data.Prunable
import HLearn.Algebra

-------------------------------------------------------------------------------
-- data types

newtype SortedVector a = SortedVector { vector :: V.Vector a}

bst2list :: SortedVector a -> [a]
bst2list (SortedVector vec) = V.toList vec

elem :: (Ord a) => a -> (SortedVector a) -> Bool
elem a (SortedVector vec) = go 0 (V.length vec - 1)
where
go lower upper
| lower==upper      = (vec V.! lower)==a
| a > (vec V.! mid) = go (mid+1) upper
| a < (vec V.! mid) = go lower (mid-1)
| otherwise         = True -- a==(vec V.! mid)
where mid = floor \$ (fromIntegral \$ lower+upper)/2

instance (NFData a) => NFData (SortedVector a) where
rnf (SortedVector v) = rnf v

-------------------------------------------------------------------------------
-- Algebra

instance (Ord a) => Abelian (SortedVector a)
instance (Ord a) => Monoid (SortedVector a) where
{-# INLINE mempty #-}
mempty = SortedVector \$ V.empty

{-# INLINE mappend #-}
(SortedVector va) `mappend` (SortedVector vb) = SortedVector \$ V.fromList \$ merge2 (V.toList va) (V.toList vb)
where
merge2 xs [] = xs
merge2 [] ys = ys
merge2 (x:xs) (y:ys) =
case compare x y of
LT        -> x: merge2 xs (y:ys)
otherwise -> y: merge2 (x:xs) ys

instance (Ord a, Invertible a) => Group (SortedVector a) where
{-# INLINE inverse #-}
inverse (SortedVector vec) = SortedVector \$ V.map mkinverse vec

---------------------------------------

instance ({-Ord (IndexType dp), Ord dp-}) => Index (SortedVector dp) where
type IndexType (SortedVector dp) = TreeIndex
type IndexResult (SortedVector dp) = SortedVector dp
(!) (SortedVector vec) TreeLeft  = SortedVector \$ V.take (floor \$ (fromIntegral \$ V.length \$ vec)/2) \$ vec
(!) (SortedVector vec) TreeRight = SortedVector \$ V.drop (floor \$ (fromIntegral \$ V.length \$ vec)/2) \$ vec

instance Prunable SortedVector where
prunefoldr p f b v@(SortedVector vec)
| V.length vec == 1 = f (vec V.! 0) b
| otherwise = if p b (SortedVector vec) TreeLeft
then goright
else prunefoldr p f goright (v ! TreeLeft)

where
goright = if p b (SortedVector vec) TreeRight
then b
else prunefoldr p f b (v ! TreeRight)

search_cata :: (Eq dp) => dp -> dp -> Bool -> Bool
search_cata query dp bool = query==dp || bool

search_prune :: (Ord dp) => dp -> Bool -> SortedVector dp -> TreeIndex -> Bool
search_prune query _ v TreeLeft  = (vector v) V.! (floor \$ (fromIntegral \$ V.length \$ vector v)/2) < query
search_prune query _ v TreeRight = (vector v) V.! (floor \$ (fromIntegral \$ V.length \$ vector v)/2) > query

binarySearch :: (Ord dp) => dp -> SortedVector dp -> Bool
binarySearch query sv = prunefoldr (search_prune query) (search_cata query) False sv

instance F.Foldable SortedVector where
foldr f b (SortedVector vec) = V.foldr f b vec

instance CK.Functor SortedVector where
type FunctorConstraint SortedVector a = Ord a
fmap f (SortedVector v) = SortedVector . V.fromList . sort . V.toList \$ fmap f v

instance CK.Pointed SortedVector where
point = SortedVector . V.singleton

instance CK.Applicative SortedVector where
(<*>) = undefined

--     type MonadConstraint SortedVector a = Ord a
return = SortedVector . V.singleton
(>>=) = flip concatMapa

concatMapa :: (Ord a, Ord b) => (a -> SortedVector b) -> SortedVector a -> SortedVector b
concatMapa f v = reduce \$ CK.fmap f v

join :: SortedVector (SortedVector a) -> SortedVector a
join = undefined

-------------------------------------------------------------------------------
-- Training

instance (Ord a) => HomTrainer (SortedVector a) where
type Datapoint (SortedVector a) = a
train1dp dp = SortedVector \$ V.singleton dp
```