module Data.VectorSpace.Free.FiniteSupportedSequence (
FinSuppSeq (..)
) where
import Data.AffineSpace
import Data.VectorSpace
import Data.Basis
import qualified Data.Foldable as Foldable
import qualified Data.Vector.Unboxed as UArr
import qualified Data.Vector.Generic.Mutable as MArr
import GHC.Exts (IsList(..))
newtype FinSuppSeq n = FinSuppSeq { getFiniteSeq :: UArr.Vector n }
liftU2FSS :: UArr.Unbox n => (n -> n -> n) -> FinSuppSeq n -> FinSuppSeq n -> FinSuppSeq n
liftU2FSS f (FinSuppSeq u) (FinSuppSeq v) = FinSuppSeq $ case compare lu lv of
LT | lu == 0 -> v
| otherwise -> UArr.modify
(\ w -> Foldable.forM_ [0..lu1] $
\i -> MArr.unsafeWrite w i $ f (UArr.unsafeIndex u i)
(UArr.unsafeIndex v i)) v
EQ -> UArr.zipWith f u v
GT | lv == 0 -> u
| otherwise -> UArr.modify
(\ w -> Foldable.forM_ [0..lv1] $
\i -> MArr.unsafeWrite w i $ f (UArr.unsafeIndex u i)
(UArr.unsafeIndex v i)) u
where lu = UArr.length u
lv = UArr.length v
instance (Num n, UArr.Unbox n) => AffineSpace (FinSuppSeq n) where
type Diff (FinSuppSeq n) = FinSuppSeq n
(.-.) = (^-^)
(.+^) = (^+^)
instance (Num n, UArr.Unbox n) => AdditiveGroup (FinSuppSeq n) where
zeroV = FinSuppSeq $ UArr.empty
(^+^) = liftU2FSS (+)
negateV (FinSuppSeq v) = FinSuppSeq $ UArr.map negate v
instance (Num n, UArr.Unbox n) => VectorSpace (FinSuppSeq n) where
type Scalar (FinSuppSeq n) = n
μ*^FinSuppSeq v = FinSuppSeq $ UArr.map (μ*) v
instance (Num n, AdditiveGroup n, UArr.Unbox n) => InnerSpace (FinSuppSeq n) where
FinSuppSeq v<.>FinSuppSeq w = UArr.sum (UArr.zipWith (*) v w)
instance (Num n, UArr.Unbox n) => HasBasis (FinSuppSeq n) where
type Basis (FinSuppSeq n) = Int
basisValue i = FinSuppSeq $ UArr.replicate i 0 `UArr.snoc` 1
decompose = zip [0..] . toList
decompose' (FinSuppSeq v) i = maybe 0 id $ v UArr.!? i
instance UArr.Unbox n => IsList (FinSuppSeq n) where
type Item (FinSuppSeq n) = n
fromListN l = FinSuppSeq . fromListN l
fromList = FinSuppSeq . fromList
toList = toList . getFiniteSeq
instance (UArr.Unbox n, Show n) => Show (FinSuppSeq n) where
show = ("fromList "++) . show . toList