packages feed

testing-tensor 0.1.0 → 0.1.1

raw patch · 7 files changed

+118/−64 lines, 7 filesdep ~QuickCheck

Dependency ranges changed: QuickCheck

Files

CHANGELOG.md view
@@ -1,5 +1,10 @@ # Revision history for tmp -## 0.1.0.0 -- YYYY-mm-dd+## 0.1.1 -- 2025-08-27 -* First version. Released on an unsuspecting world.+* Add missing instances for `TestValue`+* Document `Tensor` invariants (#11)++## 0.1.0 -- 2025-02-15++* First release
src/Test/Tensor.hs view
@@ -37,7 +37,6 @@   , foreachWith     -- * Subtensors   , subs-  , subsWithStride   , convolve   , convolveWithStride   , padWith@@ -76,7 +75,6 @@  import Control.Monad.Trans.State (StateT(..), evalStateT) import Data.Bifunctor-import Data.Foldable (foldl') import Data.Foldable qualified as Foldable import Data.List qualified as L import Data.Maybe (catMaybes)@@ -98,6 +96,15 @@   Definition -------------------------------------------------------------------------------} +-- | N-dimensional tensor+--+-- Invariants:+--+-- * The dimension must be strictly positive (zero is not allowed)+-- * Tensors must be rectangular+--+-- (These invariants could in principle be enforced by using more precise types,+-- but at the cost of much more complex code.) data Tensor n a where   Scalar :: a -> Tensor Z a   Tensor :: [Tensor n a] -> Tensor (S n) a@@ -150,17 +157,13 @@ rotate (Scalar x)  = Scalar x rotate (Tensor xs) = Tensor $ map rotate (L.reverse xs) --- | Distribute '[]' over 'Tensor'+-- | Analogue of @distribute@ (@distributive@ package) ----- Collects values in corresponding in all tensors.-distrib :: [Tensor n a] -> Tensor n [a]-distrib = \case-    []   -> error "distrib: empty list"-    t:ts -> go ((:[]) <$> t) ts-  where-    go :: Tensor n [a] -> [Tensor n a] -> Tensor n [a]-    go acc []     = reverse <$> acc-    go acc (t:ts) = go (zipWith (:) t acc) ts+-- Since we don't track the complete size of the tensor at the type level, we+-- must be told how large the resulting tensor is going to be.+distrib :: Functor f => Size n -> f (Tensor n a) -> Tensor n (f a)+distrib VNil       = Scalar . fmap getScalar+distrib (n ::: ns) = Tensor . fmap (distrib ns) . distribList n . fmap getTensor  -- | Transpose --@@ -184,17 +187,37 @@   Subtensors -------------------------------------------------------------------------------} +-- | Compute number of subtensors+--+-- Internal auxiliary.+numSubs ::+     Size n  -- ^ Kernel size+  -> Size n  -- ^ Input size+  -> Size n  -- ^ Output size+numSubs VNil       VNil       = VNil+numSubs (k ::: ks) (i ::: is) = (i - k + 1) ::: numSubs ks is+ -- | Subtensors of the specified size-subs :: SNatI n => Size n -> Tensor n a -> Tensor n (Tensor n a)-subs = subsWithStride (pure 1)+subs :: Size n -> Tensor n a -> Tensor n (Tensor n a)+subs = \kernelSize input ->+    go (numSubs kernelSize (size input)) kernelSize input+  where+    go :: Size n -> Size n -> Tensor n a -> Tensor n (Tensor n a)+    go VNil       VNil       (Scalar x)  = Scalar (Scalar x)+    go (r ::: rs) (n ::: ns) (Tensor xs) = Tensor [+          Tensor <$> distrib rs selected+        | selected <- consecutive r n (map (go rs ns) xs)+        ] --- | Generalization of 'subs' with non-default stride-subsWithStride :: Vec n Int -> Size n -> Tensor n a -> Tensor n (Tensor n a)-subsWithStride VNil       VNil       (Scalar x)  = Scalar (Scalar x)-subsWithStride (s ::: ss) (n ::: ns) (Tensor xs) = Tensor [-      Tensor <$> distrib selected-    | selected <- everyNth s $ consecutive n (map (subsWithStride ss ns) xs)-    ]+-- | Apply stride.+--+-- This is the N-dimensional equivalent of 'everyNth'.+--+-- Internal auxiliary.+applyStride :: Vec n Int -> Tensor n a -> Tensor n a+applyStride VNil       (Scalar x)  = Scalar x+applyStride (s ::: ss) (Tensor xs) = Tensor $+    everyNth s (map (applyStride ss) xs)  -- | Convolution --@@ -214,10 +237,10 @@   -> Tensor n a  -- ^ Input   -> Tensor n a convolveWithStride stride kernel input =-    aux <$> subsWithStride stride (size kernel) input+    aux <$> applyStride stride (subs (size kernel) input)   where     aux :: Tensor n a -> a-    aux = foldl' (+) 0 . zipWith (*) kernel+    aux = Foldable.foldl' (+) 0 . zipWith (*) kernel  {-------------------------------------------------------------------------------   Padding@@ -524,7 +547,7 @@ -- | Inverse to 'Foldable.toList' -- -- Throws a pure exception if the list does not contain enough elements.-fromList :: forall n a. Size n -> [a] -> Tensor n a+fromList :: forall n a. HasCallStack => Size n -> [a] -> Tensor n a fromList sz xs =     checkEnoughElems . flip evalStateT xs $ sequenceA (replicate sz genElem)   where@@ -575,12 +598,12 @@   Internal auxiliary: lists -------------------------------------------------------------------------------} --- | Consecutive elements+-- | The first @r@ sublists of length @n@ ----- >    consecutive 3 [1..5]--- > == [[1,2,3],[2,3,4],[3,4,5]]-consecutive :: Int -> [a] -> [[a]]-consecutive n = L.takeWhile ((== n) . length) . fmap (L.take n) . L.tails+-- >    consecutive 4 3 [1..6]+-- > == [[1,2,3],[2,3,4],[3,4,5],[4,5,6]]+consecutive :: Int -> Int -> [a] -> [[a]]+consecutive r n = L.take r . L.map (L.take n) . L.tails  -- | Every nth element of the list --@@ -615,3 +638,8 @@     go :: [a] -> a -> [a] -> [([a], a, [a])]     go acc x []     = [(reverse acc, x, [])]     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 0 _   = []+distribList n fxs = (head <$> fxs) : distribList (n - 1) (tail <$> fxs)
src/Test/Tensor/TestValue.hs view
@@ -19,7 +19,17 @@ -- Test values are suitable for use in QuickCheck tests involving floating -- point numbers, if you want to ignore rounding errors. newtype TestValue = TestValue Float-  deriving newtype (Num, Fractional, Real, Random)+  deriving newtype (+      Enum+    , Floating+    , Fractional+    , Num+    , Random+    , Read+    , Real+    , RealFloat+    , RealFrac+    )  -- | Test values are equipped with a crude equality --
test/TestSuite/Test/Convolution.hs view
@@ -35,9 +35,8 @@         , testCase "weightedDice"          example_3b1b_weightedDice         ]     , testGroup "Properties" [-          testProperty "distrib_dim0"            prop_distrib_dim0-        , testProperty "distrib_dim1"            prop_distrib_dim1-        , testProperty "distrib_dim1_nonUniform" prop_distrib_dim1_nonUniform+          testProperty "distrib_dim0" prop_distrib_dim0+        , testProperty "distrib_dim1" prop_distrib_dim1         ]     ] @@ -56,7 +55,7 @@ example_distrib_dim2 :: Assertion example_distrib_dim2 =     assertEqual "" expected $-      Tensor.distrib input+      Tensor.distrib (Tensor.size expected) input   where     input :: [Tensor Nat2 Int]     input = [@@ -210,22 +209,23 @@ -- | Distribute over a list of 0-D tensor is the identity prop_distrib_dim0 :: NonEmptyList Int -> Property prop_distrib_dim0 (getNonEmpty -> xs) =-        Tensor.toLists (Tensor.distrib (map Tensor.scalar xs))+        Tensor.toLists (Tensor.distrib size (map Tensor.scalar xs))     === xs+  where+    size :: Tensor.Size Nat0+    size = VNil  -- | Distribute over a list of 1-D tensor is 'transpose'+--+-- This is true only for rectangular input. prop_distrib_dim1 :: NonEmptyList (NonEmptyList Int) -> Property prop_distrib_dim1 (getSameLength -> xss) =     counterexample ("input: " ++ show xss) $-          Tensor.toLists (Tensor.distrib (map Tensor.dim1 xss))-      === L.transpose xss---- | Counterpart to 'prop_distrib_dim1': this is only true for same-size lists-prop_distrib_dim1_nonUniform :: NonEmptyList (NonEmptyList Int) -> Property-prop_distrib_dim1_nonUniform (getNonEmpty2 -> xss) =-    expectFailure $-          Tensor.toLists (Tensor.distrib (map Tensor.dim1 xss))+          Tensor.toLists (Tensor.distrib size (map Tensor.dim1 xss))       === L.transpose xss+  where+    size :: Tensor.Size Nat1+    size = length (L.head xss) ::: VNil  {-------------------------------------------------------------------------------   Auxiliary
test/TestSuite/Test/Convolution/CUDNN.hs view
@@ -1,6 +1,5 @@ module TestSuite.Test.Convolution.CUDNN (tests) where -import Data.List qualified as L import Data.Type.Nat import Data.Vec.Lazy (Vec(..)) import Foreign@@ -123,20 +122,21 @@ -------------------------------------------------------------------------------}  -- | cuDNN-style convolutions, but using our implementation-convolve_cuDNN_style :: forall a.-     (Fractional a, Real a)-  => ConvolutionParams a -> Tensor Nat4 a+convolve_cuDNN_style :: Real a => ConvolutionParams a -> Tensor Nat4 a convolve_cuDNN_style params =-    Tensor.foreach input $ \(Tensor channels) -> Tensor [-        fmap (L.foldl' (+) 0) . Tensor.distrib $-          zipWith (Tensor.convolveWithStride stride') inputFeatures channels-      | Tensor inputFeatures <- Tensor.getTensor kernels+    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+          Tensor [result] -> result+          _otherwise -> error "unexpected result"+      | inputFeatures <- Tensor.getTensor kernels       ]   where     ConvolutionParams{stride = (sv, sh), input, kernels} = params -    stride' :: Vec Nat2 Int-    stride' = sv ::: sh ::: VNil+    stride' :: Vec Nat3 Int+    stride' = 1 ::: sv ::: sh ::: VNil  -- | Convolution parameters --
test/TestSuite/Test/StdOps.hs view
@@ -2,6 +2,7 @@  import Data.Foldable qualified as Foldable import Data.Type.Nat+import Data.Vec.Lazy (Vec(..)) import Test.Tasty import Test.Tasty.QuickCheck @@ -31,15 +32,19 @@   Properties -------------------------------------------------------------------------------} -prop_fromList_toList :: SNatI n => Tensor n Int -> Property+prop_fromList_toList :: Tensor n Int -> Property prop_fromList_toList tensor =         Tensor.fromList (Tensor.size tensor) (Foldable.toList tensor)     === tensor  prop_distrib_transpose :: Tensor Nat2 Int -> Property prop_distrib_transpose tensor =-        (restructure . Tensor.distrib . Tensor.getTensor $ tensor)-    === (Tensor.transpose $ tensor)+        (restructure . Tensor.distrib size . Tensor.getTensor $ tensor)+    === (Tensor.transpose                                     $ tensor)   where     restructure :: Tensor Nat1 [Int] -> Tensor Nat2 Int     restructure = Tensor.fromLists . Tensor.toLists++    size :: Tensor.Size Nat1+    size = case Tensor.size tensor of+             _n1 ::: n2 ::: VNil -> n2 ::: VNil
testing-tensor.cabal view
@@ -1,6 +1,6 @@ cabal-version:   3.0 name:            testing-tensor-version:         0.1.0+version:         0.1.1 license:         BSD-3-Clause license-file:    LICENSE author:          Edsko de Vries@@ -9,14 +9,15 @@ build-type:      Simple synopsis:        Pure implementation of tensors, for use in tests. description:     This is a pure Haskell implementation of tensors, emphasizing-                 simplify over all else. It is intended to be used as a model+                 simplicity over all else. It is intended to be used as a model                  in tests. extra-doc-files: CHANGELOG.md tested-with:     GHC ==9.2.8                  GHC ==9.4.8-                 GHC ==9.6.6+                 GHC ==9.6.7                  GHC ==9.8.4-                 GHC ==9.10.1+                 GHC ==9.10.2+                 GHC ==9.12.2  source-repository head   type:     git@@ -28,9 +29,10 @@    ghc-options:       -Wall+      -Widentities       -Wprepositive-qualified-module+      -Wredundant-constraints       -Wunused-packages-      -Widentities       -Wno-unticked-promoted-constructors    default-extensions:@@ -41,6 +43,10 @@       TypeFamilies       ViewPatterns +  if impl(ghc >= 9.8)+    ghc-options:+      -Wno-x-partial+ library   import:          lang   hs-source-dirs:  src@@ -51,7 +57,7 @@    build-depends:     , fin          >= 0.3  && < 0.4-    , QuickCheck   >= 2.15 && < 2.16+    , QuickCheck   >= 2.15 && < 2.17     , random       >= 1.2  && < 1.4     , transformers >= 0.5  && < 0.7     , vec          >= 0.5  && < 0.6