testing-tensor 0.1.2 → 0.2.0
raw patch · 4 files changed
+61/−25 lines, 4 files
Files
- CHANGELOG.md +9/−0
- src/Test/Tensor.hs +48/−21
- test/TestSuite/Test/Convolution/CUDNN.hs +3/−3
- testing-tensor.cabal +1/−1
CHANGELOG.md view
@@ -1,5 +1,14 @@ # Revision history for tmp +## 0.2.0 -- 2025-08-27++* Improve docs+* Make tensors with empty dimensions `Show`able (such tensors are invalid, but+ if they are not showable, it's harder to debug code that generates them)+* Add some `HasCallStack` constraints+* Add `zipEach`+* Rename `foreach`/`foreachWith` to `forEach`/`forEachWith` for consistency+ ## 0.1.2 -- 2025-08-27 * Add `subsWithStride`
src/Test/Tensor.hs view
@@ -29,12 +29,13 @@ , sizeAtLeast -- * Standard operations , zipWith+ , zipEach , replicate , rotate , distrib , transpose- , foreach- , foreachWith+ , forEach+ , forEachWith -- * Subtensors , subs , subsWithStride@@ -101,7 +102,7 @@ -- -- Invariants: ----- * The dimension must be strictly positive (zero is not allowed)+-- * None of the dimensions may be empty -- * Tensors must be rectangular -- -- (These invariants could in principle be enforced by using more precise types,@@ -129,7 +130,7 @@ type Size n = Vec n Int -- | Analogue of 'List.length'-size :: Tensor n a -> Size n+size :: HasCallStack => Tensor n a -> Size n size (Scalar _) = VNil size (Tensor xs) = L.length xs ::: size (L.head xs) @@ -146,6 +147,15 @@ zipWith f (Scalar a) (Scalar b) = Scalar (f a b) zipWith f (Tensor as) (Tensor bs) = Tensor $ L.zipWith (zipWith f) as bs +-- | Zip each top-level dimension+--+-- Unlike 'zipWith', this allows for two tensors of different dimensions,+-- somewhat similar to 'forEach'.+zipEach ::+ (Tensor n a -> Tensor m b -> Tensor l c)+ -> Tensor (S n) a -> Tensor (S m) b -> Tensor (S l) c+zipEach f (Tensor as) (Tensor bs) = Tensor $ L.zipWith f as bs+ -- | Analogue of 'List.replicate' replicate :: Size n -> a -> Tensor n a replicate VNil x = Scalar x@@ -173,16 +183,16 @@ transpose = fromLists . L.transpose . toLists -- | Map element over the first dimension of the tensor-foreach :: Tensor (S n) a -> (Tensor n a -> Tensor m b) -> Tensor (S m) b-foreach (Tensor as) f = Tensor (Prelude.map f as)+forEach :: Tensor (S n) a -> (Tensor n a -> Tensor m b) -> Tensor (S m) b+forEach (Tensor as) f = Tensor (Prelude.map f as) --- | Variation of 'foreach' with an auxiliary list-foreachWith ::+-- | Variation of 'forEach' with an auxiliary list+forEachWith :: Tensor (S n) a -> [x] -> (Tensor n a -> x -> Tensor m b) -> Tensor (S m) b-foreachWith (Tensor as) xs f = Tensor (L.zipWith f as xs)+forEachWith (Tensor as) xs f = Tensor (L.zipWith f as xs) {------------------------------------------------------------------------------- Subtensors@@ -584,22 +594,39 @@ n' = snatToNatural sn instance Show a => Show (Tensor n a) where- showsPrec p tensor = showLists (Proxy @a) (tensorSNat tensor) $- showParen (p >= appPrec1) $- showConstructor appPrec1 (tensorSNat tensor)- . showSpace- . showsPrec appPrec1 (toLists tensor)+ showsPrec p tensor = showParen (p >= appPrec1) $+ case tensorSNat tensor of+ Just sz ->+ showLists (Proxy @a) sz $+ showConstructor appPrec1 sz+ . showSpace+ . showsPrec appPrec1 (toLists tensor)+ Nothing ->+ showString "fromLists "+ . showInvalid tensor+ where+ -- Tensors with empty dimensions are invalid, but if we fail to 'show'+ -- them, that would make debugging code that accidentally creates them+ -- unnecessarily difficult. We therefore special case this.+ showInvalid :: forall m. Tensor m a -> ShowS+ showInvalid (Scalar x) = showsPrec 0 x+ showInvalid (Tensor xs) =+ showString "["+ . L.foldr (.) id (L.intersperse (showString ",") (map showInvalid xs))+ . showString "]" {------------------------------------------------------------------------------- Internal auxiliary: SNat -------------------------------------------------------------------------------} -tensorSNatI :: Tensor n a -> (SNatI n => r) -> r-tensorSNatI (Scalar _) k = k-tensorSNatI (Tensor xs) k = tensorSNatI (L.head xs) k+-- | Size of the tensor, unless it contains empty dimensions+tensorSNatI :: Tensor n a -> r -> (SNatI n => r) -> r+tensorSNatI (Scalar _ ) _ kOk = kOk+tensorSNatI (Tensor (x:_)) kErr kOk = tensorSNatI x kErr kOk+tensorSNatI (Tensor [] ) kErr _ = kErr -tensorSNat :: Tensor n a -> SNat n-tensorSNat tensor = tensorSNatI tensor snat+tensorSNat :: Tensor n a -> Maybe (SNat n)+tensorSNat tensor = tensorSNatI tensor Nothing (Just snat) {------------------------------------------------------------------------------- Internal auxiliary: lists@@ -647,6 +674,6 @@ go acc x (y:ys) = (reverse acc, x, (y:ys)) : go (x:acc) y ys -- | Distribute @f@ over @[]@-distribList :: Functor f => Int -> f [a] -> [f a]+distribList :: (HasCallStack, Functor f) => Int -> f [a] -> [f a] distribList 0 _ = []-distribList n fxs = (head <$> fxs) : distribList (n - 1) (tail <$> fxs)+distribList n fxs = (L.head <$> fxs) : distribList (n - 1) (tail <$> fxs)
test/TestSuite/Test/Convolution/CUDNN.hs view
@@ -109,8 +109,8 @@ === convolveCUDNN c_mode_convolution stride- ( Tensor.foreach kernels $ \outputFeature ->- Tensor.foreach outputFeature $ \inputFeature ->+ ( Tensor.forEach kernels $ \outputFeature ->+ Tensor.forEach outputFeature $ \inputFeature -> Tensor.rotate inputFeature ) input@@ -124,7 +124,7 @@ -- | cuDNN-style convolutions, but using our implementation convolve_cuDNN_style :: Real a => ConvolutionParams a -> Tensor Nat4 a convolve_cuDNN_style params =- Tensor.foreach input $ \channels -> Tensor [+ Tensor.forEach input $ \channels -> Tensor [ -- Both the input and the kernel have 3 channels, so the result must -- be a singleton "channel". case Tensor.convolveWithStride stride' inputFeatures channels of
testing-tensor.cabal view
@@ -1,6 +1,6 @@ cabal-version: 3.0 name: testing-tensor-version: 0.1.2+version: 0.2.0 license: BSD-3-Clause license-file: LICENSE author: Edsko de Vries