{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE InstanceSigs #-}

-- |

-- Module      : Data.SparseVector.Unboxed

-- 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.Unboxed
  ( -- * Sparse vectors

    SparseVector (..),

    -- * Construction

    empty,

    -- ** Operations

    insert,
    lookup,
    delete,
    mapWithKey,
    mapAccum,

    -- ** Functor-like operations (with Unbox constraints)

    svMap,

    -- ** Foldable-like operations (with Unbox constraints)

    svFoldr,
    svFoldl,
    svLength,
    svNull,

    -- ** Intersection

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

    -- ** Conversion

    fromList,
    toList,
    fromVector,
    toVector,

    -- ** Mutations

    freeze,
    unsafeFreeze,
    thaw,
    unsafeThaw,
  )
where

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

-- | Sparse n-dimensional vector using unboxed vectors.

--

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

-- The element type @a@ must have an @Unbox@ instance, and @(Bool, a)@ must also have an @Unbox@ instance.

--

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

-- Standalone deriving instances  

deriving instance (Show a, Unbox a) => Show (SparseVector a)
deriving instance (Eq a, Unbox a) => Eq (SparseVector a)
deriving instance (Unbox a) => NFData (SparseVector a)

-- | Map a function over a SparseVector (requires Unbox constraints)

svMap :: (Unbox a, Unbox b) => (a -> b) -> SparseVector a -> SparseVector b
svMap :: forall a b.
(Unbox a, Unbox b) =>
(a -> b) -> SparseVector a -> SparseVector b
svMap 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. (Unbox a, Unbox 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 svMap #-}

-- | Fold a SparseVector from the right (requires Unbox constraints)  

svFoldr :: (Unbox a) => (a -> b -> b) -> b -> SparseVector a -> b
svFoldr :: forall a b. Unbox a => (a -> b -> b) -> b -> SparseVector a -> b
svFoldr a -> b -> b
f b
acc (SparseVector Vector (Bool, a)
v) = ((Bool, a) -> b -> b) -> b -> Vector (Bool, a) -> b
forall a b. Unbox a => (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 svFoldr #-}

-- | Fold a SparseVector from the left (requires Unbox constraints)

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

-- | Get the number of actual elements (non-empty cells) in a SparseVector

svLength :: (Unbox a) => SparseVector a -> Int
svLength :: forall a. Unbox a => SparseVector a -> Int
svLength (SparseVector Vector (Bool, a)
v) = Vector (Bool, a) -> Int
forall a. Unbox a => Vector a -> Int
V.length (((Bool, a) -> Bool) -> Vector (Bool, a) -> Vector (Bool, a)
forall a. Unbox a => (a -> Bool) -> Vector a -> Vector a
V.filter (Bool, a) -> Bool
forall a b. (a, b) -> a
fst Vector (Bool, a)
v)
{-# INLINE svLength #-}

-- | Check if a SparseVector has no actual elements

svNull :: (Unbox a) => SparseVector a -> Bool
svNull :: forall a. Unbox a => SparseVector a -> Bool
svNull (SparseVector Vector (Bool, a)
v) = ((Bool, a) -> Bool) -> Vector (Bool, a) -> Bool
forall a. Unbox a => (a -> Bool) -> Vector a -> Bool
V.all (Bool -> Bool
not (Bool -> Bool) -> ((Bool, a) -> Bool) -> (Bool, a) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool, a) -> Bool
forall a b. (a, b) -> a
fst) Vector (Bool, a)
v
{-# INLINE svNull #-}

-- | Empty sparse vector.

empty :: (Unbox a) => SparseVector a
empty :: forall a. Unbox a => SparseVector a
empty = Vector (Bool, a) -> SparseVector a
forall a. Vector (Bool, a) -> SparseVector a
SparseVector Vector (Bool, a)
forall a. Unbox 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, undefined)@ to create empty cells.

--

-- >>> insert 0 'a' empty

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

--

-- >>> insert 2 'b' empty

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

insert :: (Unbox a) => Int -> a -> SparseVector a -> SparseVector a
insert :: forall a. Unbox 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. Unbox 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. Unbox 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. Unbox a => Vector a -> a -> Vector a
V.snoc (Vector (Bool, a)
vec Vector (Bool, a) -> Vector (Bool, a) -> Vector (Bool, a)
forall a. Unbox a => Vector a -> Vector a -> Vector a
V.++ Int -> (Bool, a) -> Vector (Bool, a)
forall a. Unbox 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 :: (Unbox a) => Int -> SparseVector a -> Maybe a
lookup :: forall a. Unbox 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. Unbox 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, undefined)@.

delete :: (Unbox a) => Int -> SparseVector a -> SparseVector a
delete :: forall a. Unbox 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. Unbox 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 :: (Unbox a, Unbox b) => (Int -> a -> b) -> SparseVector a -> SparseVector b
mapWithKey :: forall a b.
(Unbox a, Unbox b) =>
(Int -> a -> b) -> SparseVector a -> SparseVector b
mapWithKey Int -> a -> b
f (SparseVector Vector (Bool, a)
v) =
  let indexed :: [(Int, (Bool, a))]
indexed = [Int] -> [(Bool, a)] -> [(Int, (Bool, a))]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] (Vector (Bool, a) -> [(Bool, a)]
forall a. Unbox a => Vector a -> [a]
V.toList Vector (Bool, a)
v)
      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 (Vector (Bool, b) -> SparseVector b)
-> Vector (Bool, b) -> SparseVector b
forall a b. (a -> b) -> a -> b
$ [(Bool, b)] -> Vector (Bool, b)
forall a. Unbox a => [a] -> Vector a
V.fromList ([(Bool, b)] -> Vector (Bool, b))
-> [(Bool, b)] -> Vector (Bool, b)
forall a b. (a -> b) -> a -> b
$ ((Int, (Bool, a)) -> (Bool, b))
-> [(Int, (Bool, a))] -> [(Bool, b)]
forall a b. (a -> b) -> [a] -> [b]
map (Int, (Bool, a)) -> (Bool, b)
go [(Int, (Bool, a))]
indexed
{-# INLINE mapWithKey #-}

mapAccum :: (Unbox b, Unbox c) => (a -> b -> (a, c)) -> a -> SparseVector b -> (a, SparseVector c)
mapAccum :: forall b c a.
(Unbox b, Unbox 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)
      -- Convert to list, process, and convert back since storable vectors don't have mapM

      vecList :: [(Bool, b)]
vecList = Vector (Bool, b) -> [(Bool, b)]
forall a. Unbox a => Vector a -> [a]
V.toList Vector (Bool, b)
v
      ([(Bool, c)]
resultList, a
a') = State a [(Bool, c)] -> a -> ([(Bool, c)], a)
forall s a. State s a -> s -> (a, s)
runState (((Bool, b) -> StateT a Identity (Bool, c))
-> [(Bool, b)] -> State a [(Bool, c)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (Bool, b) -> StateT a Identity (Bool, c)
forall {m :: * -> *}. MonadState a m => (Bool, b) -> m (Bool, c)
f' [(Bool, b)]
vecList) a
a
   in (a
a', Vector (Bool, c) -> SparseVector c
forall a. Vector (Bool, a) -> SparseVector a
SparseVector ([(Bool, c)] -> Vector (Bool, c)
forall a. Unbox a => [a] -> Vector a
V.fromList [(Bool, c)]
resultList))

intersection :: (Unbox a, Unbox b) => SparseVector a -> SparseVector b -> SparseVector a
intersection :: forall a b.
(Unbox a, Unbox 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.
(Unbox a, Unbox b, Unbox 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 :: (Unbox a, Unbox b, Unbox c) => (a -> b -> c) -> SparseVector a -> SparseVector b -> SparseVector c
intersectionWith :: forall a b c.
(Unbox a, Unbox b, Unbox 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.
(Unbox a, Unbox b, Unbox 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 :: (Unbox a, Unbox b, Unbox c) => (Int -> a -> b -> c) -> SparseVector a -> SparseVector b -> SparseVector c
intersectionWithKey :: forall a b c.
(Unbox a, Unbox b, Unbox 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. Unbox 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. Unbox 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. Unbox a => Vector a -> Vector a -> Vector a
V.++ Int -> (Bool, b) -> Vector (Bool, b)
forall a. Unbox a => Int -> a -> Vector a
V.replicate (Vector (Bool, a) -> Int
forall a. Unbox 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. Unbox 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. Unbox a => Vector a -> Vector a -> Vector a
V.++ Int -> (Bool, a) -> Vector (Bool, a)
forall a. Unbox a => Int -> a -> Vector a
V.replicate (Vector (Bool, b) -> Int
forall a. Unbox 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. Unbox 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)
      pairs :: [(Int, ((Bool, a), (Bool, b)))]
pairs = [Int]
-> [((Bool, a), (Bool, b))] -> [(Int, ((Bool, a), (Bool, b)))]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] ([((Bool, a), (Bool, b))] -> [(Int, ((Bool, a), (Bool, b)))])
-> [((Bool, a), (Bool, b))] -> [(Int, ((Bool, a), (Bool, b)))]
forall a b. (a -> b) -> a -> b
$ [(Bool, a)] -> [(Bool, b)] -> [((Bool, a), (Bool, b))]
forall a b. [a] -> [b] -> [(a, b)]
zip (Vector (Bool, a) -> [(Bool, a)]
forall a. Unbox a => Vector a -> [a]
V.toList Vector (Bool, a)
as) (Vector (Bool, b) -> [(Bool, b)]
forall a. Unbox a => Vector a -> [a]
V.toList Vector (Bool, b)
bs)
   in Vector (Bool, c) -> SparseVector c
forall a. Vector (Bool, a) -> SparseVector a
SparseVector (Vector (Bool, c) -> SparseVector c)
-> Vector (Bool, c) -> SparseVector c
forall a b. (a -> b) -> a -> b
$ [(Bool, c)] -> Vector (Bool, c)
forall a. Unbox a => [a] -> Vector a
V.fromList ([(Bool, c)] -> Vector (Bool, c))
-> [(Bool, c)] -> Vector (Bool, c)
forall a b. (a -> b) -> a -> b
$ ((Int, ((Bool, a), (Bool, b))) -> (Bool, c))
-> [(Int, ((Bool, a), (Bool, b)))] -> [(Bool, c)]
forall a b. (a -> b) -> [a] -> [b]
map (Int, ((Bool, a), (Bool, b))) -> (Bool, c)
go [(Int, ((Bool, a), (Bool, b)))]
pairs

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

intersectionVecWith :: (Unbox a, Unbox b, Unbox c) => (a -> b -> c) -> SparseVector a -> SparseVector b -> Vector c
intersectionVecWith :: forall a b c.
(Unbox a, Unbox b, Unbox 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.
(Unbox a, Unbox b, Unbox 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 :: (Unbox a, Unbox b, Unbox c) => (Int -> a -> b -> c) -> SparseVector a -> SparseVector b -> Vector c
intersectionVecWithKey :: forall a b c.
(Unbox a, Unbox b, Unbox 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) = 
  let 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
      results :: [Maybe c]
results = (Int -> (Bool, a) -> (Bool, b) -> Maybe c)
-> [Int] -> [(Bool, a)] -> [(Bool, b)] -> [Maybe c]
forall a b c d. (a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d]
zipWith3 Int -> (Bool, a) -> (Bool, b) -> Maybe c
go [Int
0..] (Vector (Bool, a) -> [(Bool, a)]
forall a. Unbox a => Vector a -> [a]
V.toList Vector (Bool, a)
a) (Vector (Bool, b) -> [(Bool, b)]
forall a. Unbox a => Vector a -> [a]
V.toList Vector (Bool, b)
b)
   in [c] -> Vector c
forall a. Unbox a => [a] -> Vector a
V.fromList ([c] -> Vector c) -> [c] -> Vector c
forall a b. (a -> b) -> a -> b
$ [Maybe c] -> [c]
forall a. [Maybe a] -> [a]
catMaybes [Maybe c]
results
{-# INLINE intersectionVecWithKey #-}

fromList :: (Unbox a) => [(Int, a)] -> SparseVector a
fromList :: forall a. Unbox 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. Unbox a => Int -> a -> SparseVector a -> SparseVector a
insert Int
i a
a) SparseVector a
forall a. Unbox a => SparseVector a
empty [(Int, a)]
xs

toList :: (Unbox a) => SparseVector a -> [Maybe a]
toList :: forall a. Unbox a => SparseVector a -> [Maybe a]
toList (SparseVector Vector (Bool, a)
v) = ((Bool, a) -> Maybe a) -> [(Bool, a)] -> [Maybe a]
forall a b. (a -> b) -> [a] -> [b]
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) ([(Bool, a)] -> [Maybe a]) -> [(Bool, a)] -> [Maybe a]
forall a b. (a -> b) -> a -> b
$ Vector (Bool, a) -> [(Bool, a)]
forall a. Unbox a => Vector a -> [a]
V.toList Vector (Bool, a)
v
{-# INLINE toList #-}

fromVector :: (Unbox a) => Vector a -> SparseVector a
fromVector :: forall a. Unbox 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. (Unbox a, Unbox b) => (a -> b) -> Vector a -> Vector b
V.map (\a
x -> (Bool
True, a
x)) Vector a
v

toVector :: (Unbox a) => SparseVector a -> Vector a
toVector :: forall a. Unbox a => SparseVector a -> Vector a
toVector (SparseVector Vector (Bool, a)
v) = [a] -> Vector a
forall a. Unbox a => [a] -> Vector a
V.fromList ([a] -> Vector a) -> [a] -> Vector a
forall a b. (a -> b) -> a -> b
$ ((Bool, a) -> Maybe a) -> [(Bool, a)] -> [a]
forall a b. (a -> Maybe b) -> [a] -> [b]
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) ([(Bool, a)] -> [a]) -> [(Bool, a)] -> [a]
forall a b. (a -> b) -> a -> b
$ Vector (Bool, a) -> [(Bool, a)]
forall a. Unbox a => Vector a -> [a]
V.toList Vector (Bool, a)
v

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

freeze :: (PrimMonad m, Unbox a) => MSparseVector (PrimState m) a -> m (SparseVector a)
freeze :: forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
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 a (m :: * -> *).
(Unbox 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, Unbox a) => SparseVector a -> m (MSparseVector (PrimState m) a)
thaw :: forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
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 a (m :: * -> *).
(Unbox 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, Unbox a) => MSparseVector (PrimState m) a -> m (SparseVector a)
unsafeFreeze :: forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
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 a (m :: * -> *).
(Unbox 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, Unbox a) => SparseVector a -> m (MSparseVector (PrimState m) a)
unsafeThaw :: forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
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 a (m :: * -> *).
(Unbox 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 #-}