{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE TupleSections #-}

-- |

-- Module      : Data.SparseVector.Strict

-- Copyright   : (c) Matt Hunzinger, 2025

-- License     : BSD-style (see the LICENSE file in the distribution)

--

-- Maintainer  : matt@hunzinger.me

-- Stability   : provisional

-- Portability : non-portable (GHC extensions)

module Data.SparseVector.Strict
  ( -- * Sparse vectors

    SparseVector (..),

    -- * Construction

    empty,
    emptyWith,

    -- ** Operations

    insert,
    lookup,
    delete,
    mapWithKey,
    mapAccum,

    -- ** Intersection

    intersection,
    intersectionWith,
    intersectionWithKey,
    intersectionVec,
    intersectionVecWith,
    intersectionVecWithKey,

    -- ** Conversion

    fromList,
    toList,
    toPairList,
    fromVector,
    toVector,
    freeze,
    unsafeFreeze,
    thaw,
    unsafeThaw,
  )
where

import Control.DeepSeq
import Control.Monad
import Control.Monad.State.Strict
import Data.Maybe
import Data.SparseVector.Strict.Mutable (MSparseVector (..))
import Data.Vector.Mutable (PrimMonad (..))
import Data.Vector.Strict (Vector)
import qualified Data.Vector.Strict as V
import Prelude hiding (lookup)

-- | Sparse n-dimensional vector.

--

-- A sparse vector is defined as a @Vector (Bool, a)@,

-- where @(Bool, a)@ is a cell for an element in the sparse vector.

-- The Bool indicates whether the cell contains a valid element.

--

-- Inserting elements at some dimension @n@ will grow the vector up to @n@,

-- using @(False, defaultVal)@ to create empty cells.

newtype SparseVector a = SparseVector {forall a. SparseVector a -> Vector (Bool, a)
unSparseVector :: Vector (Bool, a)}
  deriving (Int -> SparseVector a -> ShowS
[SparseVector a] -> ShowS
SparseVector a -> String
(Int -> SparseVector a -> ShowS)
-> (SparseVector a -> String)
-> ([SparseVector a] -> ShowS)
-> Show (SparseVector a)
forall a. Show a => Int -> SparseVector a -> ShowS
forall a. Show a => [SparseVector a] -> ShowS
forall a. Show a => SparseVector a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> SparseVector a -> ShowS
showsPrec :: Int -> SparseVector a -> ShowS
$cshow :: forall a. Show a => SparseVector a -> String
show :: SparseVector a -> String
$cshowList :: forall a. Show a => [SparseVector a] -> ShowS
showList :: [SparseVector a] -> ShowS
Show, SparseVector a -> SparseVector a -> Bool
(SparseVector a -> SparseVector a -> Bool)
-> (SparseVector a -> SparseVector a -> Bool)
-> Eq (SparseVector a)
forall a. Eq a => SparseVector a -> SparseVector a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => SparseVector a -> SparseVector a -> Bool
== :: SparseVector a -> SparseVector a -> Bool
$c/= :: forall a. Eq a => SparseVector a -> SparseVector a -> Bool
/= :: SparseVector a -> SparseVector a -> Bool
Eq, SparseVector a -> ()
(SparseVector a -> ()) -> NFData (SparseVector a)
forall a. NFData a => SparseVector a -> ()
forall a. (a -> ()) -> NFData a
$crnf :: forall a. NFData a => SparseVector a -> ()
rnf :: SparseVector a -> ()
NFData)

instance Functor SparseVector where
  fmap :: forall a b. (a -> b) -> SparseVector a -> SparseVector b
fmap a -> b
f (SparseVector Vector (Bool, a)
v) = Vector (Bool, b) -> SparseVector b
forall a. Vector (Bool, a) -> SparseVector a
SparseVector (Vector (Bool, b) -> SparseVector b)
-> Vector (Bool, b) -> SparseVector b
forall a b. (a -> b) -> a -> b
$ ((Bool, a) -> (Bool, b)) -> Vector (Bool, a) -> Vector (Bool, b)
forall a b. (a -> b) -> Vector a -> Vector b
V.map (\(Bool
present, a
val) -> (Bool
present, a -> b
f a
val)) Vector (Bool, a)
v
  {-# INLINE fmap #-}

instance Foldable SparseVector where
  foldr :: forall a b. (a -> b -> b) -> b -> SparseVector a -> b
foldr a -> b -> b
f b
acc (SparseVector Vector (Bool, a)
v) = ((Bool, a) -> b -> b) -> b -> Vector (Bool, a) -> b
forall a b. (a -> b -> b) -> b -> Vector a -> b
V.foldr (\(Bool
present, a
val) b
acc' -> if Bool
present then a -> b -> b
f a
val b
acc' else b
acc') b
acc Vector (Bool, a)
v
  {-# INLINE foldr #-}

-- Note: Semigroup requires a default value for combining vectors of different lengths

-- We'll need to modify the interface to support this properly


-- | Empty sparse vector with a default value.

emptyWith :: a -> SparseVector a
emptyWith :: forall a. a -> SparseVector a
emptyWith a
_ = Vector (Bool, a) -> SparseVector a
forall a. Vector (Bool, a) -> SparseVector a
SparseVector Vector (Bool, a)
forall a. Vector a
V.empty
{-# INLINE emptyWith #-}

-- | Empty sparse vector (requires a default value for operations that need it).

empty :: SparseVector a
empty :: forall a. SparseVector a
empty = Vector (Bool, a) -> SparseVector a
forall a. Vector (Bool, a) -> SparseVector a
SparseVector Vector (Bool, a)
forall a. Vector a
V.empty
{-# INLINE empty #-}

-- | Insert an element at a given index into a `SparseVector`.

--

-- Inserting elements at some dimension @n@ will grow the vector up to @n@,

-- using @(False, defaultVal)@ to create empty cells.

--

-- >>> insert 0 'a' 'x' empty

-- SparseVector {unSparseVector = [(True, 'a')]}

--

-- >>> insert 2 'b' 'x' empty

-- SparseVector {unSparseVector = [(False, 'x'), (False, 'x'), (True, 'b')]}

insert :: Int -> a -> SparseVector a -> SparseVector a
insert :: forall a. Int -> a -> SparseVector a -> SparseVector a
insert Int
index a
a (SparseVector Vector (Bool, a)
vec) =
  let len :: Int
len = Vector (Bool, a) -> Int
forall a. Vector a -> Int
V.length Vector (Bool, a)
vec
   in Vector (Bool, a) -> SparseVector a
forall a. Vector (Bool, a) -> SparseVector a
SparseVector (Vector (Bool, a) -> SparseVector a)
-> Vector (Bool, a) -> SparseVector a
forall a b. (a -> b) -> a -> b
$
        if Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
index Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
          then Vector (Bool, a) -> [(Int, (Bool, a))] -> Vector (Bool, a)
forall a. Vector a -> [(Int, a)] -> Vector a
V.unsafeUpd Vector (Bool, a)
vec [(Int
index, (Bool
True, a
a))]
          else Vector (Bool, a) -> (Bool, a) -> Vector (Bool, a)
forall a. Vector a -> a -> Vector a
V.snoc (Vector (Bool, a)
vec Vector (Bool, a) -> Vector (Bool, a) -> Vector (Bool, a)
forall a. Vector a -> Vector a -> Vector a
V.++ Int -> (Bool, a) -> Vector (Bool, a)
forall a. Int -> a -> Vector a
V.replicate (Int
index Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
len) (Bool
False, a
forall a. HasCallStack => a
undefined)) (Bool
True, a
a)
{-# INLINE insert #-}

-- | Lookup an element at a given index in a `SparseVector`.

lookup :: Int -> SparseVector a -> Maybe a
lookup :: forall a. Int -> SparseVector a -> Maybe a
lookup Int
i (SparseVector Vector (Bool, a)
v) =
  case Vector (Bool, a)
v Vector (Bool, a) -> Int -> Maybe (Bool, a)
forall a. Vector a -> Int -> Maybe a
V.!? Int
i of
    Just (Bool
True, a
val) -> a -> Maybe a
forall a. a -> Maybe a
Just a
val
    Maybe (Bool, a)
_ -> Maybe a
forall a. Maybe a
Nothing
{-# INLINE lookup #-}

-- | Delete an index from a `SparseVector`, replacing its cell with @(False, defaultVal)@.

delete :: Int -> SparseVector a -> SparseVector a
delete :: forall a. Int -> SparseVector a -> SparseVector a
delete Int
index (SparseVector Vector (Bool, a)
vec) =
  Vector (Bool, a) -> SparseVector a
forall a. Vector (Bool, a) -> SparseVector a
SparseVector (Vector (Bool, a) -> SparseVector a)
-> Vector (Bool, a) -> SparseVector a
forall a b. (a -> b) -> a -> b
$ Vector (Bool, a) -> [(Int, (Bool, a))] -> Vector (Bool, a)
forall a. Vector a -> [(Int, a)] -> Vector a
V.unsafeUpd Vector (Bool, a)
vec [(Int
index, (Bool
False, a
forall a. HasCallStack => a
undefined))]
{-# INLINE delete #-}

mapWithKey :: (Int -> a -> b) -> SparseVector a -> SparseVector b
mapWithKey :: forall a b. (Int -> a -> b) -> SparseVector a -> SparseVector b
mapWithKey Int -> a -> b
f (SparseVector Vector (Bool, a)
v) =
  let go :: (Int, (Bool, a)) -> (Bool, b)
go (Int
i, (Bool
present, a
val)) = (Bool
present, if Bool
present then Int -> a -> b
f Int
i a
val else b
forall a. HasCallStack => a
undefined)
   in Vector (Bool, b) -> SparseVector b
forall a. Vector (Bool, a) -> SparseVector a
SparseVector ((Int, (Bool, a)) -> (Bool, b)
go ((Int, (Bool, a)) -> (Bool, b))
-> Vector (Int, (Bool, a)) -> Vector (Bool, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Vector (Bool, a) -> Vector (Int, (Bool, a))
forall a. Vector a -> Vector (Int, a)
V.indexed Vector (Bool, a)
v)
{-# INLINE mapWithKey #-}

mapAccum :: (a -> b -> (a, c)) -> a -> SparseVector b -> (a, SparseVector c)
mapAccum :: forall a b c.
(a -> b -> (a, c)) -> a -> SparseVector b -> (a, SparseVector c)
mapAccum a -> b -> (a, c)
f a
a (SparseVector Vector (Bool, b)
v) =
  let f' :: (Bool, b) -> m (Bool, c)
f' (Bool
True, b
b) = do
        a
acc <- m a
forall s (m :: * -> *). MonadState s m => m s
get
        let (a
acc', c
c) = a -> b -> (a, c)
f a
acc b
b
        a -> m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put a
acc'
        (Bool, c) -> m (Bool, c)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
True, c
c)
      f' (Bool
False, b
_) = (Bool, c) -> m (Bool, c)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
False, c
forall a. HasCallStack => a
undefined)
      (Vector (Bool, c)
v', a
a') = State a (Vector (Bool, c)) -> a -> (Vector (Bool, c), a)
forall s a. State s a -> s -> (a, s)
runState (((Bool, b) -> StateT a Identity (Bool, c))
-> Vector (Bool, b) -> State a (Vector (Bool, c))
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Vector a -> m (Vector b)
V.mapM (Bool, b) -> StateT a Identity (Bool, c)
forall {m :: * -> *}. MonadState a m => (Bool, b) -> m (Bool, c)
f' Vector (Bool, b)
v) a
a
   in (a
a', Vector (Bool, c) -> SparseVector c
forall a. Vector (Bool, a) -> SparseVector a
SparseVector Vector (Bool, c)
v')

-- For intersection operations, we need to handle the case where vectors have different lengths

-- and we need default values for padding


intersection :: SparseVector a -> SparseVector b -> SparseVector a
intersection :: forall a b. SparseVector a -> SparseVector b -> SparseVector a
intersection SparseVector a
sv1 SparseVector b
sv2 = (a -> b -> a) -> SparseVector a -> SparseVector b -> SparseVector a
forall a b c.
(a -> b -> c) -> SparseVector a -> SparseVector b -> SparseVector c
intersectionWith a -> b -> a
forall a b. a -> b -> a
const SparseVector a
sv1 SparseVector b
sv2

intersectionWith :: (a -> b -> c) -> SparseVector a -> SparseVector b -> SparseVector c
intersectionWith :: forall a b c.
(a -> b -> c) -> SparseVector a -> SparseVector b -> SparseVector c
intersectionWith a -> b -> c
f = (Int -> a -> b -> c)
-> SparseVector a -> SparseVector b -> SparseVector c
forall a b c.
(Int -> a -> b -> c)
-> SparseVector a -> SparseVector b -> SparseVector c
intersectionWithKey ((a -> b -> c) -> Int -> a -> b -> c
forall a b. a -> b -> a
const a -> b -> c
f)

intersectionWithKey :: (Int -> a -> b -> c) -> SparseVector a -> SparseVector b -> SparseVector c
intersectionWithKey :: forall a b c.
(Int -> a -> b -> c)
-> SparseVector a -> SparseVector b -> SparseVector c
intersectionWithKey Int -> a -> b -> c
f (SparseVector Vector (Bool, a)
a) (SparseVector Vector (Bool, b)
b) =
  let (Vector (Bool, a)
as, Vector (Bool, b)
bs) =
        if Vector (Bool, a) -> Int
forall a. Vector a -> Int
V.length Vector (Bool, a)
a Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Vector (Bool, b) -> Int
forall a. Vector a -> Int
V.length Vector (Bool, b)
b
          then (Vector (Bool, a)
a, Vector (Bool, b)
b Vector (Bool, b) -> Vector (Bool, b) -> Vector (Bool, b)
forall a. Vector a -> Vector a -> Vector a
V.++ Int -> (Bool, b) -> Vector (Bool, b)
forall a. Int -> a -> Vector a
V.replicate (Vector (Bool, a) -> Int
forall a. Vector a -> Int
V.length Vector (Bool, a)
a Int -> Int -> Int
forall a. Num a => a -> a -> a
- Vector (Bool, b) -> Int
forall a. Vector a -> Int
V.length Vector (Bool, b)
b) (Bool
False, b
forall a. HasCallStack => a
undefined))
          else (Vector (Bool, a)
a Vector (Bool, a) -> Vector (Bool, a) -> Vector (Bool, a)
forall a. Vector a -> Vector a -> Vector a
V.++ Int -> (Bool, a) -> Vector (Bool, a)
forall a. Int -> a -> Vector a
V.replicate (Vector (Bool, b) -> Int
forall a. Vector a -> Int
V.length Vector (Bool, b)
b Int -> Int -> Int
forall a. Num a => a -> a -> a
- Vector (Bool, a) -> Int
forall a. Vector a -> Int
V.length Vector (Bool, a)
a) (Bool
False, a
forall a. HasCallStack => a
undefined), Vector (Bool, b)
b)
      go :: (Int, ((Bool, a), (Bool, b))) -> (Bool, c)
go (Int
i, ((Bool
True, a
a'), (Bool
True, b
b'))) = (Bool
True, Int -> a -> b -> c
f Int
i a
a' b
b')
      go (Int, ((Bool, a), (Bool, b)))
_ = (Bool
False, c
forall a. HasCallStack => a
undefined)
   in Vector (Bool, c) -> SparseVector c
forall a. Vector (Bool, a) -> SparseVector a
SparseVector (Vector (Bool, c) -> SparseVector c)
-> (Vector ((Bool, a), (Bool, b)) -> Vector (Bool, c))
-> Vector ((Bool, a), (Bool, b))
-> SparseVector c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, ((Bool, a), (Bool, b))) -> (Bool, c))
-> Vector (Int, ((Bool, a), (Bool, b))) -> Vector (Bool, c)
forall a b. (a -> b) -> Vector a -> Vector b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int, ((Bool, a), (Bool, b))) -> (Bool, c)
go (Vector (Int, ((Bool, a), (Bool, b))) -> Vector (Bool, c))
-> (Vector ((Bool, a), (Bool, b))
    -> Vector (Int, ((Bool, a), (Bool, b))))
-> Vector ((Bool, a), (Bool, b))
-> Vector (Bool, c)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector ((Bool, a), (Bool, b))
-> Vector (Int, ((Bool, a), (Bool, b)))
forall a. Vector a -> Vector (Int, a)
V.indexed (Vector ((Bool, a), (Bool, b)) -> SparseVector c)
-> Vector ((Bool, a), (Bool, b)) -> SparseVector c
forall a b. (a -> b) -> a -> b
$ Vector (Bool, a)
-> Vector (Bool, b) -> Vector ((Bool, a), (Bool, b))
forall a b. Vector a -> Vector b -> Vector (a, b)
V.zip Vector (Bool, a)
as Vector (Bool, b)
bs

intersectionVec :: SparseVector a -> SparseVector b -> Vector a
intersectionVec :: forall a b. SparseVector a -> SparseVector b -> Vector a
intersectionVec = (a -> b -> a) -> SparseVector a -> SparseVector b -> Vector a
forall a b c.
(a -> b -> c) -> SparseVector a -> SparseVector b -> Vector c
intersectionVecWith a -> b -> a
forall a b. a -> b -> a
const
{-# INLINE intersectionVec #-}

intersectionVecWith :: (a -> b -> c) -> SparseVector a -> SparseVector b -> Vector c
intersectionVecWith :: forall a b c.
(a -> b -> c) -> SparseVector a -> SparseVector b -> Vector c
intersectionVecWith = (Int -> a -> b -> c)
-> SparseVector a -> SparseVector b -> Vector c
forall a b c.
(Int -> a -> b -> c)
-> SparseVector a -> SparseVector b -> Vector c
intersectionVecWithKey ((Int -> a -> b -> c)
 -> SparseVector a -> SparseVector b -> Vector c)
-> ((a -> b -> c) -> Int -> a -> b -> c)
-> (a -> b -> c)
-> SparseVector a
-> SparseVector b
-> Vector c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> b -> c) -> Int -> a -> b -> c
forall a b. a -> b -> a
const
{-# INLINE intersectionVecWith #-}

intersectionVecWithKey :: (Int -> a -> b -> c) -> SparseVector a -> SparseVector b -> Vector c
intersectionVecWithKey :: forall a b c.
(Int -> a -> b -> c)
-> SparseVector a -> SparseVector b -> Vector c
intersectionVecWithKey Int -> a -> b -> c
f (SparseVector Vector (Bool, a)
a) (SparseVector Vector (Bool, b)
b) = (Int -> ((Bool, a), (Bool, b)) -> Maybe c)
-> Vector ((Bool, a), (Bool, b)) -> Vector c
forall a b. (Int -> a -> Maybe b) -> Vector a -> Vector b
V.imapMaybe Int -> ((Bool, a), (Bool, b)) -> Maybe c
go (Vector ((Bool, a), (Bool, b)) -> Vector c)
-> Vector ((Bool, a), (Bool, b)) -> Vector c
forall a b. (a -> b) -> a -> b
$ Vector (Bool, a)
-> Vector (Bool, b) -> Vector ((Bool, a), (Bool, b))
forall a b. Vector a -> Vector b -> Vector (a, b)
V.zip Vector (Bool, a)
a Vector (Bool, b)
b
  where
    go :: Int -> ((Bool, a), (Bool, b)) -> Maybe c
go Int
i ((Bool
True, a
a'), (Bool
True, b
b')) = c -> Maybe c
forall a. a -> Maybe a
Just (c -> Maybe c) -> c -> Maybe c
forall a b. (a -> b) -> a -> b
$ Int -> a -> b -> c
f Int
i a
a' b
b'
    go Int
_ ((Bool, a), (Bool, b))
_ = Maybe c
forall a. Maybe a
Nothing
{-# INLINE intersectionVecWithKey #-}

fromList :: [(Int, a)] -> SparseVector a
fromList :: forall a. [(Int, a)] -> SparseVector a
fromList [(Int, a)]
xs = ((Int, a) -> SparseVector a -> SparseVector a)
-> SparseVector a -> [(Int, a)] -> SparseVector a
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\(Int
i, a
a) -> Int -> a -> SparseVector a -> SparseVector a
forall a. Int -> a -> SparseVector a -> SparseVector a
insert Int
i a
a) SparseVector a
forall a. SparseVector a
empty [(Int, a)]
xs

toList :: SparseVector a -> [Maybe a]
toList :: forall a. SparseVector a -> [Maybe a]
toList (SparseVector Vector (Bool, a)
v) = Vector (Maybe a) -> [Maybe a]
forall a. Vector a -> [a]
V.toList (Vector (Maybe a) -> [Maybe a]) -> Vector (Maybe a) -> [Maybe a]
forall a b. (a -> b) -> a -> b
$ ((Bool, a) -> Maybe a) -> Vector (Bool, a) -> Vector (Maybe a)
forall a b. (a -> b) -> Vector a -> Vector b
V.map (\(Bool
present, a
val) -> if Bool
present then a -> Maybe a
forall a. a -> Maybe a
Just a
val else Maybe a
forall a. Maybe a
Nothing) Vector (Bool, a)
v
{-# INLINE toList #-}

toPairList :: SparseVector a -> [(Bool, a)]
toPairList :: forall a. SparseVector a -> [(Bool, a)]
toPairList (SparseVector Vector (Bool, a)
v) = Vector (Bool, a) -> [(Bool, a)]
forall a. Vector a -> [a]
V.toList Vector (Bool, a)
v
{-# INLINE toPairList #-}

fromVector :: Vector a -> SparseVector a
fromVector :: forall a. Vector a -> SparseVector a
fromVector Vector a
v = Vector (Bool, a) -> SparseVector a
forall a. Vector (Bool, a) -> SparseVector a
SparseVector (Vector (Bool, a) -> SparseVector a)
-> Vector (Bool, a) -> SparseVector a
forall a b. (a -> b) -> a -> b
$ (a -> (Bool, a)) -> Vector a -> Vector (Bool, a)
forall a b. (a -> b) -> Vector a -> Vector b
V.map (Bool
True,) Vector a
v

toVector :: SparseVector a -> Vector a
toVector :: forall a. SparseVector a -> Vector a
toVector (SparseVector Vector (Bool, a)
v) = ((Bool, a) -> Maybe a) -> Vector (Bool, a) -> Vector a
forall a b. (a -> Maybe b) -> Vector a -> Vector b
V.mapMaybe (\(Bool
present, a
val) -> if Bool
present then a -> Maybe a
forall a. a -> Maybe a
Just a
val else Maybe a
forall a. Maybe a
Nothing) Vector (Bool, a)
v

-- | Freeze a `MSparseVector` into a `SparseVector`.

freeze :: (PrimMonad m) => MSparseVector (PrimState m) a -> m (SparseVector a)
freeze :: forall (m :: * -> *) a.
PrimMonad m =>
MSparseVector (PrimState m) a -> m (SparseVector a)
freeze (MSparseVector MVector (PrimState m) (Bool, a)
vec) = do
  Vector (Bool, a)
vec' <- MVector (PrimState m) (Bool, a) -> m (Vector (Bool, a))
forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> m (Vector a)
V.freeze MVector (PrimState m) (Bool, a)
vec
  SparseVector a -> m (SparseVector a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (SparseVector a -> m (SparseVector a))
-> SparseVector a -> m (SparseVector a)
forall a b. (a -> b) -> a -> b
$ Vector (Bool, a) -> SparseVector a
forall a. Vector (Bool, a) -> SparseVector a
SparseVector Vector (Bool, a)
vec'
{-# INLINE freeze #-}

-- | Unfreeze a `SparseVector` into a `MSparseVector`.

thaw :: (PrimMonad m) => SparseVector a -> m (MSparseVector (PrimState m) a)
thaw :: forall (m :: * -> *) a.
PrimMonad m =>
SparseVector a -> m (MSparseVector (PrimState m) a)
thaw (SparseVector Vector (Bool, a)
vec) = do
  MVector (PrimState m) (Bool, a)
vec' <- Vector (Bool, a) -> m (MVector (PrimState m) (Bool, a))
forall (m :: * -> *) a.
PrimMonad m =>
Vector a -> m (MVector (PrimState m) a)
V.thaw Vector (Bool, a)
vec
  MSparseVector (PrimState m) a -> m (MSparseVector (PrimState m) a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (MSparseVector (PrimState m) a
 -> m (MSparseVector (PrimState m) a))
-> MSparseVector (PrimState m) a
-> m (MSparseVector (PrimState m) a)
forall a b. (a -> b) -> a -> b
$ MVector (PrimState m) (Bool, a) -> MSparseVector (PrimState m) a
forall s a. MVector s (Bool, a) -> MSparseVector s a
MSparseVector MVector (PrimState m) (Bool, a)
vec'
{-# INLINE thaw #-}

-- | Freeze a `MSparseVector` into a `SparseVector`.

unsafeFreeze :: (PrimMonad m) => MSparseVector (PrimState m) a -> m (SparseVector a)
unsafeFreeze :: forall (m :: * -> *) a.
PrimMonad m =>
MSparseVector (PrimState m) a -> m (SparseVector a)
unsafeFreeze (MSparseVector MVector (PrimState m) (Bool, a)
vec) = do
  !Vector (Bool, a)
vec' <- MVector (PrimState m) (Bool, a) -> m (Vector (Bool, a))
forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> m (Vector a)
V.unsafeFreeze MVector (PrimState m) (Bool, a)
vec
  SparseVector a -> m (SparseVector a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (SparseVector a -> m (SparseVector a))
-> SparseVector a -> m (SparseVector a)
forall a b. (a -> b) -> a -> b
$ Vector (Bool, a) -> SparseVector a
forall a. Vector (Bool, a) -> SparseVector a
SparseVector Vector (Bool, a)
vec'
{-# INLINE unsafeFreeze #-}

-- | Unfreeze a `SparseVector` into a `MSparseVector`.

unsafeThaw :: (PrimMonad m) => SparseVector a -> m (MSparseVector (PrimState m) a)
unsafeThaw :: forall (m :: * -> *) a.
PrimMonad m =>
SparseVector a -> m (MSparseVector (PrimState m) a)
unsafeThaw (SparseVector Vector (Bool, a)
vec) = do
  !MVector (PrimState m) (Bool, a)
vec' <- Vector (Bool, a) -> m (MVector (PrimState m) (Bool, a))
forall (m :: * -> *) a.
PrimMonad m =>
Vector a -> m (MVector (PrimState m) a)
V.unsafeThaw Vector (Bool, a)
vec
  MSparseVector (PrimState m) a -> m (MSparseVector (PrimState m) a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (MSparseVector (PrimState m) a
 -> m (MSparseVector (PrimState m) a))
-> MSparseVector (PrimState m) a
-> m (MSparseVector (PrimState m) a)
forall a b. (a -> b) -> a -> b
$ MVector (PrimState m) (Bool, a) -> MSparseVector (PrimState m) a
forall s a. MVector s (Bool, a) -> MSparseVector s a
MSparseVector MVector (PrimState m) (Bool, a)
vec'
{-# INLINE unsafeThaw #-}