| Copyright | (C) 2025 Alexey Tochin |
|---|---|
| License | BSD3 (see the file LICENSE) |
| Maintainer | Alexey Tochin <Alexey.Tochin@gmail.com> |
| Safe Haskell | None |
| Language | Haskell2010 |
Data.FiniteSupportStream
Description
This module provides functionality for working with infinite streams that have finite support (i.e., only finitely many non-zero elements). The streams are internally represented as arrays for efficient computation.
Any linear functional on an ordinary stream (Stream)
can be represented as a finite support stream.
Inversely, any finite support stream can be represented as
a linear functional on an ordinary stream.
Synopsis
- newtype FiniteSupportStream a = MkFiniteSupportStream {}
- supportLength :: FiniteSupportStream a -> Natural
- null :: FiniteSupportStream a -> Bool
- head :: Additive a => FiniteSupportStream a -> a
- tail :: FiniteSupportStream a -> FiniteSupportStream a
- cons :: a -> FiniteSupportStream a -> FiniteSupportStream a
- cons' :: (Additive a, Eq a) => a -> FiniteSupportStream a -> FiniteSupportStream a
- streamsConvolution :: Distributive a => Stream a -> FiniteSupportStream a -> a
- finiteSupportStreamSum :: Additive a => FiniteSupportStream a -> a
- unsafeMap :: (a -> b) -> FiniteSupportStream a -> FiniteSupportStream b
- optimize :: (Eq a, Additive a) => FiniteSupportStream a -> FiniteSupportStream a
- unsafeZip :: (Additive a, Additive b) => FiniteSupportStream a -> FiniteSupportStream b -> FiniteSupportStream (a, b)
- unsafeZipWith :: (a -> b -> c) -> (a -> c) -> (b -> c) -> FiniteSupportStream a -> FiniteSupportStream b -> FiniteSupportStream c
- mkFiniteSupportStream' :: (Eq a, Additive a) => Vector a -> FiniteSupportStream a
- empty :: FiniteSupportStream a
- singleton :: a -> FiniteSupportStream a
- singleton' :: (Additive a, Eq a) => a -> FiniteSupportStream a
- replicate :: Natural -> a -> FiniteSupportStream a
- replicate' :: (Additive a, Eq a) => Natural -> a -> FiniteSupportStream a
- unsafeFromList :: [a] -> FiniteSupportStream a
- fromTuple :: forall input (length :: Nat) a. IndexedListLiterals input length a => input -> FiniteSupportStream a
- finiteSupportStreamBasis :: a -> a -> Natural -> FiniteSupportStream a
- multiplicativeAction :: Multiplicative a => Stream a -> FiniteSupportStream a -> FiniteSupportStream a
- takeArray :: Additive a => Natural -> FiniteSupportStream a -> Vector a
- takeList :: Additive a => Natural -> FiniteSupportStream a -> [a]
- toList :: FiniteSupportStream a -> [a]
- toInfiniteList :: Additive a => FiniteSupportStream a -> [a]
- foldlWithStream :: Foldable t => (b -> a -> c -> b) -> b -> t a -> Stream c -> b
- foldlWithStream' :: Foldable t => (b -> a -> c -> b) -> b -> t a -> Stream c -> b
The type of finite support streams
newtype FiniteSupportStream a Source #
A stream with finite support, represented as a vector.
Elements beyond the vector's length are implicitly zero.
The vector may contain trailing zeros, which can be removed using optimize.
The type parameter a typically has an Additive instance with a zero element.
Examples
>>>import GHC.Base (Int, Float, Bool(False, True))>>>import Data.Vector (fromList)
>>>MkFiniteSupportStream $ fromList [0, 1, 2, 3] :: FiniteSupportStream Int[0,1,2,3,0,0,0,...
>>>MkFiniteSupportStream $ fromList [0, 1, 2, 3] :: FiniteSupportStream Float[0.0,1.0,2.0,3.0,0.0,0.0,0.0,...
>>>MkFiniteSupportStream $ fromList [False, True] :: FiniteSupportStream Bool[False,True,False,False,False,...
Constructors
| MkFiniteSupportStream | |
Instances
Basic functions
supportLength :: FiniteSupportStream a -> Natural Source #
Returns the length of the stream's support (the vector length after optimization). Trailing zeros are not counted in the support length.
Examples
>>>import GHC.Base (Int)
>>>supportLength $ unsafeFromList [0, 1, 2, 3]4
>>>supportLength $ unsafeFromList [0, 1, 2, 3, 0, 0]6
null :: FiniteSupportStream a -> Bool Source #
Checks if the finite support stream is empty.
Examples
>>>null $ unsafeFromList [0, 1, 2]False
>>>null $ unsafeFromList []True
>>>null $ unsafeFromList [0, 0, 0]False
head :: Additive a => FiniteSupportStream a -> a Source #
Returns the first element of the finite support stream.
If the stream is empty, it returns zero.
Examples
>>>import GHC.Base (Int, Bool)
>>>head $ unsafeFromList [1, 2, 3]1
>>>head $ empty :: Int0
>>>head $ empty :: BoolFalse
tail :: FiniteSupportStream a -> FiniteSupportStream a Source #
Removes the first element of the finite support stream. If the stream is empty, it returns an empty stream.
Examples
>>>import GHC.Base (Int)
>>>tail $ unsafeFromList [1, 2, 3][2,3,0,0,0,...
>>>tail $ empty :: FiniteSupportStream Int[0,0,0,...
cons :: a -> FiniteSupportStream a -> FiniteSupportStream a Source #
Adds an element to the front of the finite support stream. The inner array size is increased by exactly one. The head element of the array is not checked for zero elements.
Examples
>>>cons 42 (unsafeFromList [1, 2, 3])[42,1,2,3,0,0,0,...
>>>toVector $ cons 0 empty[0]
cons' :: (Additive a, Eq a) => a -> FiniteSupportStream a -> FiniteSupportStream a Source #
Adds an element to the front of the finite support stream. The inner array size is increased by exactly one if the head element is not zero. Otherwise, if the finite support stream is empty, the output is also the empty stream.
Examples
>>>cons' 42 (unsafeFromList [1, 2, 3])[42,1,2,3,0,0,0,...
>>>toVector $ cons' 0 empty[]
streamsConvolution :: Distributive a => Stream a -> FiniteSupportStream a -> a Source #
Convolves a stream with a finite support stream, producing a single value. The result is the sum of element-wise products.
This operation is equivalent to applying the stream as a linear functional to the finite support stream.
Examples
>>>import GHC.Base (Float, Int)>>>import GHC.Real ((/))>>>import Data.Stream (iterate, take, Stream)>>>import Data.HashMap.Internal.Array (fromList')
>>>s1 = iterate (+1) 0 :: Stream Int>>>Data.Stream.take 5 s1[0,1,2,3,4]>>>fss1 = unsafeFromList [0, 0, 1] :: FiniteSupportStream Int>>>streamsConvolution s1 fss12
>>>s2 = iterate (/2) (1 :: Float) :: Stream Float>>>Data.Stream.take 5 s2[1.0,0.5,0.25,0.125,6.25e-2]>>>fss2 = unsafeFromList $ Data.List.replicate 10 1 :: FiniteSupportStream Float>>>streamsConvolution s2 fss21.9980469
finiteSupportStreamSum :: Additive a => FiniteSupportStream a -> a Source #
Computes the sum of all elements the finite support stream.
Examples
>>>import GHC.Base (Int)
>>>finiteSupportStreamSum $ unsafeFromList [1, 2, 3, 0] :: Int6
>>>finiteSupportStreamSum empty :: Int0
unsafeMap :: (a -> b) -> FiniteSupportStream a -> FiniteSupportStream b Source #
Lifts a function to work with finite support streams. This function applies the provided function to each element of the stream support. The function is usafe because it is not checked that the argument function maps zero to zero, which is expected.
Examples
>>>unsafeMap (*2) (MkFiniteSupportStream $ DV.fromList [0, 1, 2, 3])[0,2,4,6,0,0,0,...
>>>unsafeMap (+1) (MkFiniteSupportStream $ DV.fromList [0, 1, 2, 3])[1,2,3,4,0,0,0,...
Transformations
optimize :: (Eq a, Additive a) => FiniteSupportStream a -> FiniteSupportStream a Source #
Removes trailing elements of the finite support stream's inner array if they are zeros. The resulting stream is represented in its minimal form.
Examples
>>>optimize $ unsafeFromList [0, 1, 0, 3, 0, 0][0,1,0,3,0,0,0,...
unsafeZip :: (Additive a, Additive b) => FiniteSupportStream a -> FiniteSupportStream b -> FiniteSupportStream (a, b) Source #
Zips two finite support streams.
Examples
>>>import GHC.Base (Int)
>>>unsafeZip (unsafeFromList [1, 2, 3]) (unsafeFromList [4, 5]) :: FiniteSupportStream (Int, Int)[(1,4),(2,5),(3,0),(0,0),(0,0),(0,0),...
Arguments
| :: (a -> b -> c) | Binary operation for overlapping elements |
| -> (a -> c) | Operation for excess elements in first stream |
| -> (b -> c) | Operation for excess elements in second stream |
| -> FiniteSupportStream a | |
| -> FiniteSupportStream b | |
| -> FiniteSupportStream c |
Applies an element-wise binary operation to two streams.
Parameters:
* f - Binary operation for overlapping elements
* g - Unary operation for excess elements in first stream
* h - Unary operation for excess elements in second stream
The resulting stream's length is the maximum of the input lengths,
with trailing elements transformed by g or h as appropriate.
Examples
>>>import GHC.Base (Int)
>>>let xs = unsafeFromList [10, 20, 30]>>>let ys = unsafeFromList [1,2]>>>unsafeZipWith (-) id negate xs ys[9,18,30,0,0,0,...
Construction
mkFiniteSupportStream' :: (Eq a, Additive a) => Vector a -> FiniteSupportStream a Source #
Creates a finite support stream from a array, removing trailing zeros in the tail. This is a constructor that ensures the minimal representation.
Examples
>>>import Data.Vector (fromList)
>>>toVector $ mkFiniteSupportStream' $ fromList [0, 1, 2, 3, 0][0,1,2,3]
empty :: FiniteSupportStream a Source #
Empty finite support stream. The stream contains only zeros.
Examples
>>>import GHC.Base (Int, Bool)
>>>empty :: FiniteSupportStream Int[0,0,0,...
>>>empty :: FiniteSupportStream Bool[False,False,False,...
singleton :: a -> FiniteSupportStream a Source #
Creates a finite support stream with exactly one element. The element is not checked for being zero.
Examples
>>>toVector $ singleton 42[42]
>>>toVector $ singleton 0[0]
>>>singleton 42[42,0,0,0,...
>>>singleton 0[0,0,0,...
>>>toVector $ singleton "a"["a"]
singleton' :: (Additive a, Eq a) => a -> FiniteSupportStream a Source #
Creates a finite support stream with exactly one non-zero element if the provided element is not zero. Returns the empty stream otherwise.
Examples
>>>toVector $ singleton' 42[42]
>>>toVector $ singleton' 0[]
>>>singleton' 42[42,0,0,0,...
>>>singleton' 0[0,0,0,...
replicate :: Natural -> a -> FiniteSupportStream a Source #
Creates a finite support stream with a constant value along the support. It does not check whether the provided value is zero. In this case, the inner array contains only zeros.
Examples
>>>replicate 3 42[42,42,42,0,0,0,...
>>>replicate 2 0[0,0,0,...
>>>toVector $ replicate 2 0[0,0]
replicate' :: (Additive a, Eq a) => Natural -> a -> FiniteSupportStream a Source #
Creates a finite support stream with a constant value along the support. It checks whether the provided value is zero. In this case, the inner array is empty.
Examples
>>>replicate' 3 42[42,42,42,0,0,0,...
>>>replicate' 2 0[0,0,0,...
>>>toVector $ replicate' 2 0[]
unsafeFromList :: [a] -> FiniteSupportStream a Source #
Converts a finite list to a FiniteSupportStream.
The list is assumed to be finite.
Trailing zero elements are not checked, and the inner array is not trimmed.
Examples
>>>import GHC.Base (Int, Float, Bool(False, True))
>>>unsafeFromList [0, 1, 2, 3] :: FiniteSupportStream Int[0,1,2,3,0,0,0,...
>>>unsafeFromList [0, 1, 2, 3] :: FiniteSupportStream Float[0.0,1.0,2.0,3.0,0.0,0.0,0.0,...
>>>unsafeFromList [False, True][False,True,False,False,False,...
fromTuple :: forall input (length :: Nat) a. IndexedListLiterals input length a => input -> FiniteSupportStream a Source #
Converts a tuple into a FiniteSupportStream.
Trailing zero elements are not checked, and the inner array is not trimmed.
Examples
>>>import GHC.Base (Int, Float, Bool(False, True))>>>import GHC.Integer (Integer)
>>>fromTuple (0, 1, 2, 3) :: FiniteSupportStream Integer[0,1,2,3,0,0,0,...
>>>fromTuple (0 :: Float, 1 :: Float, 2 :: Float, 3 :: Float) :: FiniteSupportStream Float[0.0,1.0,2.0,3.0,0.0,0.0,0.0,...
>>>fromTuple (False, True) :: FiniteSupportStream Bool[False,True,False,False,False,...
finiteSupportStreamBasis :: a -> a -> Natural -> FiniteSupportStream a Source #
Creates a finite support stream basis vector. The values of the zero and unit elements are provided as arguments.
Examples
>>>finiteSupportStreamBasis 0 1 3[0,0,0,1,0,0,0,...
Conversion
multiplicativeAction :: Multiplicative a => Stream a -> FiniteSupportStream a -> FiniteSupportStream a Source #
Applies the multiplicative action of the stream on the finite support stream. The resulting stream's support length is less than or equal to the stream's support length in the argument.
Examples
>>>import GHC.Base (Int)
>>>multiplicativeAction (DS.fromList [0 ..]) (unsafeFromList [1, 1, 0, 1])[0,1,0,3,0,0,0,...
takeArray :: Additive a => Natural -> FiniteSupportStream a -> Vector a Source #
Takes the first n elements of the finite support stream in the form of an array.
If n is greater than the length of the stream, the result is padded with zeros.
The resulting array is not trimmed.
Examples
>>>takeArray 5 $ unsafeFromList [1, 2, 3][1,2,3,0,0]
takeList :: Additive a => Natural -> FiniteSupportStream a -> [a] Source #
Takes the first n elements of the finite support stream in the form of a list.
If n is greater than the length of the stream, the result is padded with zeros.
Examples
>>>takeList 5 $ unsafeFromList [1, 2, 3][1,2,3,0,0]
toList :: FiniteSupportStream a -> [a] Source #
Converts a finite support stream to a finite list. The resulting list includes all elements of the stream, including any trailing zeros.
Examples
>>>toList $ unsafeFromList [1, 2, 3][1,2,3]
>>>toList $ unsafeFromList [1, 2, 3, 0][1,2,3,0]
toInfiniteList :: Additive a => FiniteSupportStream a -> [a] Source #
Converts a finite support stream to an infinite list. The resulting list contains all elements of the stream, followed by an infinite sequence of zeros.
Examples
>>>import Data.List (take)
>>>take 5 $ toInfiniteList $ unsafeFromList [1, 2, 3][1,2,3,0,0]