multilinear 0.3.1.0 → 0.3.2.0
raw patch · 8 files changed
+304/−185 lines, 8 filesPVP: major bump suggested
API removals or changes: PVP suggests a major version bump
API changes (from Hackage documentation)
+ Multilinear.Class: filter :: Multilinear t a => (String -> Int -> Bool) -> t a -> t a
+ Multilinear.Class: filterIndex :: Multilinear t a => String -> (Int -> Bool) -> t a -> t a
+ Multilinear.Class: zipWith :: (Multilinear t a, Unbox b, Unbox c) => (a -> b -> c) -> t a -> t b -> t c
- Multilinear.Generic: contractionErr :: TIndex -> TIndex -> Tensor a
+ Multilinear.Generic: contractionErr :: String -> TIndex -> TIndex -> Tensor a
Files
- ChangeLog.md +3/−0
- README.md +1/−6
- multilinear.cabal +7/−7
- src/Multilinear.hs +3/−2
- src/Multilinear/Class.hs +30/−0
- src/Multilinear/Generic.hs +121/−39
- test/Spec.hs +99/−68
- test/Test/QuickCheck/Multilinear.hs +40/−63
ChangeLog.md view
@@ -1,3 +1,6 @@+# 0.3.2.0, 2018-11-18 +- added filter and zipWith functions + # 0.3.1.0, 2018-11-17 - added more complex QuickCheck tests - and therefore, some error fixes
README.md view
@@ -1,9 +1,4 @@-# README - -## Build status -- Travis (Linux, macOS): [](https://travis-ci.org/ArturB/multilinear) -- AppVeyor (Windows): [](https://ci.appveyor.com/api/projects/status/github/ArturB/multilinear) +# Multilinear [](https://hackage.haskell.org/package/multilinear) [](https://travis-ci.org/ArturB/multilinear) ## Summary Multilinear is general - purpose linear algebra and multi-dimensional array library for Haskell. It provides generic and efficient implementation of linear algebra operations on vectors, linear functionals, matrices and its higher - rank analoges: tensors. It can also be used as simply a miltidimensional arrays for everyone.
multilinear.cabal view
@@ -2,10 +2,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: 024729415c87b786fd9fc6cc27a0236cc6844c4e6fe16fa3277095336c73be40+-- hash: d2d892ab946256d37232b1576c7d134de32865ac69b2c022d7d67f404bf52401 name: multilinear-version: 0.3.1.0+version: 0.3.2.0 synopsis: Comprehensive and efficient (multi)linear algebra implementation. description: Comprehensive and efficient (multi)linear algebra implementation, based on generic tensor formalism and concise Ricci-Curbastro index syntax. More information available on GitHub: <https://github.com/ArturB/multilinear#readme> category: Machine learning@@ -44,7 +44,7 @@ Paths_multilinear hs-source-dirs: src- default-extensions: DeriveGeneric FlexibleContexts FlexibleInstances GADTs MultiParamTypeClasses ScopedTypeVariables StandaloneDeriving+ default-extensions: DeriveGeneric FlexibleContexts FlexibleInstances GADTs LambdaCase MultiParamTypeClasses ScopedTypeVariables StandaloneDeriving ghc-options: -O2 -W build-depends: base >=4.7 && <5@@ -64,7 +64,7 @@ Paths_multilinear hs-source-dirs: test- default-extensions: DeriveGeneric FlexibleContexts FlexibleInstances GADTs MultiParamTypeClasses ScopedTypeVariables StandaloneDeriving+ default-extensions: DeriveGeneric FlexibleContexts FlexibleInstances GADTs LambdaCase MultiParamTypeClasses ScopedTypeVariables StandaloneDeriving ghc-options: -O2 -W -threaded -rtsopts -with-rtsopts=-N build-depends: QuickCheck@@ -83,7 +83,7 @@ Paths_multilinear hs-source-dirs: benchmark/memory- default-extensions: DeriveGeneric FlexibleContexts FlexibleInstances GADTs MultiParamTypeClasses ScopedTypeVariables StandaloneDeriving+ default-extensions: DeriveGeneric FlexibleContexts FlexibleInstances GADTs LambdaCase MultiParamTypeClasses ScopedTypeVariables StandaloneDeriving ghc-options: -O2 -W -threaded -rtsopts -with-rtsopts=-N build-depends: base >=4.7 && <5@@ -98,7 +98,7 @@ Paths_multilinear hs-source-dirs: benchmark/profile- default-extensions: DeriveGeneric FlexibleContexts FlexibleInstances GADTs MultiParamTypeClasses ScopedTypeVariables StandaloneDeriving+ default-extensions: DeriveGeneric FlexibleContexts FlexibleInstances GADTs LambdaCase MultiParamTypeClasses ScopedTypeVariables StandaloneDeriving ghc-options: -O2 -W -threaded -rtsopts -with-rtsopts=-N build-depends: base >=4.7 && <5@@ -113,7 +113,7 @@ Paths_multilinear hs-source-dirs: benchmark/time- default-extensions: DeriveGeneric FlexibleContexts FlexibleInstances GADTs MultiParamTypeClasses ScopedTypeVariables StandaloneDeriving+ default-extensions: DeriveGeneric FlexibleContexts FlexibleInstances GADTs LambdaCase MultiParamTypeClasses ScopedTypeVariables StandaloneDeriving ghc-options: -O2 -W -threaded -rtsopts -with-rtsopts=-N build-depends: base >=4.7 && <5
src/Multilinear.hs view
@@ -142,6 +142,7 @@ -} module Multilinear ( + module Multilinear.Class {-module Form, module Generic, module Index, @@ -155,8 +156,8 @@ ) where -- Re-export other library modules -{-import Multilinear.Class as Multilinear -import qualified Multilinear.Form as Form +import Multilinear.Class +{-import qualified Multilinear.Form as Form import Multilinear.Generic as Generic import qualified Multilinear.Index as Index import qualified Multilinear.Index.Finite as Index.Finite
src/Multilinear/Class.hs view
@@ -309,6 +309,36 @@ {-| @map f t@ returns tensor @t2@ in which @t2[i1,i2,...] = f t[i1,i2,...]@ -} map :: Unboxed.Unbox b => (a -> b) -> t a -> t b + {-| Filtering tensor. + Filtering multi-dimensional arrray may be dangerous, as we always assume, + that on each recursion level, all tensors have the same size (length). + To disable invalid filters, filtering is done over indices, not tensor elements. + Filter function takes and index name and index value and if it returns True, this index value remains in result tensor. + This allows to remove whole columns or rows of eg. a matrix: + filter (\i n -> i /= "a" || i > 10) filters all rows of "a" index (because if i /= "a", filter returns True) + and for "a" index filter elements with index value <= 10 + But this disallow to remove particular matrix element. + If for some index all elements are removed, the index itself is removed from tensor. -} + filter :: + (String -> Int -> Bool) -- ^ filter function + -> t a -- ^ tensor to filter + -> t a + + {-| Filtering one index of tensor. -} + filterIndex :: + String -- ^ Index name to filter + -> (Int -> Bool) -- ^ filter function + -> t a -- ^ tensor to filter + -> t a + filterIndex iname f = Multilinear.Class.filter (\i n -> i /= iname || f n) + + {-| Zip tensors with binary combinator -} + zipWith :: ( + Unboxed.Unbox b, Unboxed.Unbox c + ) => (a -> b -> c) + -> t a + -> t b + -> t c {-| If container on which tensor instance is built, allows for random access of its elements, then the tensor can be instanced as Accessible -} class Multilinear t a => Accessible t a where
src/Multilinear/Generic.hs view
@@ -40,6 +40,10 @@ indexNotFound :: String indexNotFound = "This tensor has not such index!" +{-| ERROR MESSAGE -} +tensorOfScalars :: String +tensorOfScalars = "Tensor construction error! Vector of scalars" + {-| Tensor defined recursively as scalar or list of other tensors -} {-| @c@ is type of a container, @i@ is type of index size and @a@ is type of tensor elements -} data Tensor a where @@ -159,6 +163,19 @@ _ -> FiniteTensor index1 $ _mergeScalars <$> ts1 _ -> x +-- | Generic map function, which does not require a,b types to be Num +_map :: ( + Unboxed.Unbox a, Unboxed.Unbox b + ) => (a -> b) + -> Tensor a + -> Tensor b +_map f x = case x of + -- Mapping scalar simply maps its value + Scalar v -> Scalar $ f v + -- Mapping complex tensor does mapping element by element + SimpleFinite index ts -> SimpleFinite index (f `Unboxed.map` ts) + FiniteTensor index ts -> FiniteTensor index $ _map f <$> ts + {-| Apply a tensor operator (here denoted by (+) ) elem by elem, trying to connect as many common indices as possible -} {-# INLINE _elemByElem' #-} _elemByElem' :: (Num a, Unboxed.Unbox a, NFData a) @@ -207,56 +224,57 @@ -> (Tensor a -> Tensor a -> Tensor a) -- ^ Tensor operator called if indices are the same -> Tensor a -- ^ Result tensor _elemByElem t1 t2 f op = - let commonIndices = filter (`Data.List.elem` indicesNames t2) $ indicesNames t1 + let commonIndices = Data.List.filter (`Data.List.elem` indicesNames t2) $ indicesNames t1 t1' = foldl' (|>>>) t1 commonIndices t2' = foldl' (|>>>) t2 commonIndices in _mergeScalars $ _elemByElem' t1' t2' f op -- | Zipping two tensors with a combinator, assuming they have the same indices. {-# INLINE zipT #-} -zipT :: (Num a, Unboxed.Unbox a) - => (Tensor a -> Tensor a -> Tensor a) -- ^ Two tensors combinator - -> (Tensor a -> a -> Tensor a) -- ^ Tensor and scalar combinator - -> (a -> Tensor a -> Tensor a) -- ^ Scalar and tensor combinator - -> (a -> a -> a) -- ^ Two scalars combinator +zipT :: ( + Num a, NFData a, Unboxed.Unbox a + ) => (a -> a -> a) -- ^ The zipping combinator -> Tensor a -- ^ First tensor to zip -> Tensor a -- ^ Second tensor to zip -> Tensor a -- ^ Result tensor -- Two simple tensors case -zipT _ _ _ f (SimpleFinite index1 v1) (SimpleFinite index2 v2) = +zipT f t1@(SimpleFinite index1 v1) t2@(SimpleFinite index2 v2) = if index1 == index2 then SimpleFinite index1 $ Unboxed.zipWith f v1 v2 - else zipErr (Index.toTIndex index1) (Index.toTIndex index2) + else dot t1 t2 --Two finite tensors case -zipT f _ _ _ (FiniteTensor index1 v1) (FiniteTensor index2 v2) = +zipT f t1@(FiniteTensor index1 v1) t2@(FiniteTensor index2 v2) = if index1 == index2 then - FiniteTensor index1 $ Boxed.zipWith f v1 v2 - else zipErr (Index.toTIndex index1) (Index.toTIndex index2) + FiniteTensor index1 $ Boxed.zipWith (zipT f) v1 v2 + else dot t1 t2 -- Finite and simple tensor case -zipT _ f _ _ (FiniteTensor index1 v1) (SimpleFinite index2 v2) = +zipT f t1@(FiniteTensor index1 v1) t2@(SimpleFinite index2 v2) = if index1 == index2 then - FiniteTensor index1 $ Boxed.generate (Finite.indexSize index1) (\i -> f (v1 Boxed.! i) (v2 Unboxed.! i)) - else zipErr (Index.toTIndex index1) (Index.toTIndex index2) + let f' t s = (`f` s) `_map` t + in FiniteTensor index1 $ Boxed.generate (Finite.indexSize index1) (\i -> f' (v1 Boxed.! i) (v2 Unboxed.! i)) + else dot t1 t2 -- Simple and finite tensor case -zipT _ _ f _ (SimpleFinite index1 v1) (FiniteTensor index2 v2) = +zipT f t1@(SimpleFinite index1 v1) t2@(FiniteTensor index2 v2) = if index1 == index2 then - FiniteTensor index1 $ Boxed.generate (Finite.indexSize index1) (\i -> f (v1 Unboxed.! i) (v2 Boxed.! i)) - else zipErr (Index.toTIndex index1) (Index.toTIndex index2) + let f' s t = (s `f`) `_map` t + in FiniteTensor index1 $ Boxed.generate (Finite.indexSize index1) (\i -> f' (v1 Unboxed.! i) (v2 Boxed.! i)) + else dot t1 t2 -- Zipping something with scalar is impossible -zipT _ _ _ _ _ _ = error $ "zipT: " ++ scalarIndices +zipT _ _ _ = error $ "zipT: " ++ scalarIndices -- | zipT error {-# INLINE zipErr #-} -zipErr :: Index.TIndex -- ^ Index of first dot product parameter +zipErr :: String -- ^ zipT function variant where the error occured + -> Index.TIndex -- ^ Index of first dot product parameter -> Index.TIndex -- ^ Index of second dot product parameter -> Tensor a -- ^ Erorr message -zipErr i1' i2' = error $ - "zipT: " ++ incompatibleTypes ++ +zipErr variant i1' i2' = error $ + "zipT: " ++ variant ++ " - " ++ incompatibleTypes ++ " - index1 is " ++ show i1' ++ " and index2 is " ++ show i2' @@ -272,51 +290,52 @@ dot (SimpleFinite i1@(Finite.Covariant count1 _) ts1') (SimpleFinite i2@(Finite.Contravariant count2 _) ts2') | count1 == count2 = Scalar $ Unboxed.sum $ Unboxed.zipWith (*) ts1' ts2' - | otherwise = contractionErr (Index.toTIndex i1) (Index.toTIndex i2) + | otherwise = contractionErr "simple-simple" (Index.toTIndex i1) (Index.toTIndex i2) dot (SimpleFinite i1@(Finite.Contravariant count1 _) ts1') (SimpleFinite i2@(Finite.Covariant count2 _) ts2') | count1 == count2 = Scalar $ Unboxed.sum $ Unboxed.zipWith (*) ts1' ts2' - | otherwise = contractionErr (Index.toTIndex i1) (Index.toTIndex i2) -dot t1@(SimpleFinite _ _) t2@(SimpleFinite _ _) = zipT (*) (.*) (*.) (*) t1 t2 + | otherwise = contractionErr "simple-simple" (Index.toTIndex i1) (Index.toTIndex i2) +dot t1@(SimpleFinite _ _) t2@(SimpleFinite _ _) = zipT (*) t1 t2 -- Two finite tensors product dot (FiniteTensor i1@(Finite.Covariant count1 _) ts1') (FiniteTensor i2@(Finite.Contravariant count2 _) ts2') | count1 == count2 = Boxed.sum $ Boxed.zipWith (*) ts1' ts2' - | otherwise = contractionErr (Index.toTIndex i1) (Index.toTIndex i2) + | otherwise = contractionErr "finite-finite" (Index.toTIndex i1) (Index.toTIndex i2) dot (FiniteTensor i1@(Finite.Contravariant count1 _) ts1') (FiniteTensor i2@(Finite.Covariant count2 _) ts2') | count1 == count2 = Boxed.sum $ Boxed.zipWith (*) ts1' ts2' - | otherwise = contractionErr (Index.toTIndex i1) (Index.toTIndex i2) -dot t1@(FiniteTensor _ _) t2@(FiniteTensor _ _) = zipT (*) (.*) (*.) (*) t1 t2 + | otherwise = contractionErr "finite-finite" (Index.toTIndex i1) (Index.toTIndex i2) +dot t1@(FiniteTensor _ _) t2@(FiniteTensor _ _) = zipT (*) t1 t2 -- Simple tensor and finite tensor product dot (SimpleFinite i1@(Finite.Covariant count1 _) ts1') (FiniteTensor i2@(Finite.Contravariant count2 _) ts2') | count1 == count2 = Boxed.sum $ Boxed.generate count1 (\i -> (ts1' Unboxed.! i) *. (ts2' Boxed.! i)) - | otherwise = contractionErr (Index.toTIndex i1) (Index.toTIndex i2) + | otherwise = contractionErr "simple-finite" (Index.toTIndex i1) (Index.toTIndex i2) dot (SimpleFinite i1@(Finite.Contravariant count1 _) ts1') (FiniteTensor i2@(Finite.Covariant count2 _) ts2') | count1 == count2 = Boxed.sum $ Boxed.generate count1 (\i -> (ts1' Unboxed.! i) *. (ts2' Boxed.! i)) - | otherwise = contractionErr (Index.toTIndex i1) (Index.toTIndex i2) -dot t1@(SimpleFinite _ _) t2@(FiniteTensor _ _) = zipT (*) (.*) (*.) (*) t1 t2 + | otherwise = contractionErr "simple-finite" (Index.toTIndex i1) (Index.toTIndex i2) +dot t1@(SimpleFinite _ _) t2@(FiniteTensor _ _) = zipT (*) t1 t2 -- Finite tensor and simple tensor product dot (FiniteTensor i1@(Finite.Covariant count1 _) ts1') (SimpleFinite i2@(Finite.Contravariant count2 _) ts2') | count1 == count2 = Boxed.sum $ Boxed.generate count1 (\i -> (ts1' Boxed.! i) .* (ts2' Unboxed.! i)) - | otherwise = contractionErr (Index.toTIndex i1) (Index.toTIndex i2) + | otherwise = contractionErr "finite-simple" (Index.toTIndex i1) (Index.toTIndex i2) dot (FiniteTensor i1@(Finite.Contravariant count1 _) ts1') (SimpleFinite i2@(Finite.Covariant count2 _) ts2') | count1 == count2 = Boxed.sum $ Boxed.generate count1 (\i -> (ts1' Boxed.! i) .* (ts2' Unboxed.! i)) - | otherwise = contractionErr (Index.toTIndex i1) (Index.toTIndex i2) -dot t1@(FiniteTensor _ _) t2@(SimpleFinite _ _) = zipT (*) (.*) (*.) (*) t1 t2 + | otherwise = contractionErr "finite-simple" (Index.toTIndex i1) (Index.toTIndex i2) +dot t1@(FiniteTensor _ _) t2@(SimpleFinite _ _) = zipT (*) t1 t2 -- Other cases cannot happen! -dot t1' t2' = contractionErr (tensorIndex t1') (tensorIndex t2') +dot t1' t2' = contractionErr "other" (tensorIndex t1') (tensorIndex t2') -- | contraction error {-# INLINE contractionErr #-} -contractionErr :: Index.TIndex -- ^ Index of first dot product parameter +contractionErr :: String -- ^ dot function variant where error occured + -> Index.TIndex -- ^ Index of first dot product parameter -> Index.TIndex -- ^ Index of second dot product parameter -> Tensor a -- ^ Erorr message -contractionErr i1' i2' = error $ - "Tensor product: " ++ incompatibleTypes ++ +contractionErr variant i1' i2' = error $ + "Tensor product: " ++ variant ++ " - " ++ incompatibleTypes ++ " - index1 is " ++ show i1' ++ " and index2 is " ++ show i2' @@ -333,11 +352,11 @@ -- Adding - element by element {-# INLINE (+) #-} - t1 + t2 = _elemByElem t1 t2 (+) $ zipT (+) (.+) (+.) (+) + t1 + t2 = _elemByElem t1 t2 (+) $ zipT (+) -- Subtracting - element by element {-# INLINE (-) #-} - t1 - t2 = _elemByElem t1 t2 (-) $ zipT (-) (.-) (-.) (-) + t1 - t2 = _elemByElem t1 t2 (-) $ zipT (-) -- Multiplicating is treated as tensor product -- Tensor product applies Einstein summation convention @@ -579,6 +598,69 @@ -- Mapping complex tensor does mapping element by element SimpleFinite index ts -> SimpleFinite index (f `Unboxed.map` ts) FiniteTensor index ts -> FiniteTensor index $ Multilinear.map f <$> ts + + {-| Filter functions -} + filter _ (Scalar x) = Scalar x + + filter f (SimpleFinite index ts) = + let iname = Finite.indexName' index + ts' = (\i _ -> f iname i) `Unboxed.ifilter` ts + in SimpleFinite index { Finite.indexSize = Unboxed.length ts' } ts' + + filter f (FiniteTensor index ts) = + let iname = Finite.indexName' index + ts' = Multilinear.filter f <$> ((\i _ -> f iname i) `Boxed.ifilter` ts) + ts'' = + (\case + (SimpleFinite _ ts) -> not $ Unboxed.null ts + (FiniteTensor _ ts) -> not $ Boxed.null ts + _ -> error $ "Filter: " ++ tensorOfScalars + ) `Boxed.filter` ts' + in FiniteTensor index { Finite.indexSize = Boxed.length ts'' } ts'' + + {-| Zip tensors with binary combinator -} + + -- Zippin two Scalars simply combines their values + zipWith f (Scalar x1) (Scalar x2) = Scalar $ f x1 x2 + + -- zipping complex tensor with scalar + zipWith f t (Scalar x) = (`f` x) `_map` t + + -- zipping scalar with complex tensor + zipWith f (Scalar x) t = (x `f`) `_map` t + + -- Two simple tensors case + zipWith f (SimpleFinite index1 v1) (SimpleFinite index2 v2) = + if index1 == index2 then + SimpleFinite index1 $ Unboxed.zipWith f v1 v2 + else zipErr "simple-simple" (Index.toTIndex index1) (Index.toTIndex index2) + + --Two finite tensors case + zipWith f (FiniteTensor index1 v1) (FiniteTensor index2 v2) = + if index1 == index2 then + FiniteTensor index1 $ Boxed.zipWith (Multilinear.zipWith f) v1 v2 + else zipErr "finite-finite" (Index.toTIndex index1) (Index.toTIndex index2) + + -- Finite and simple tensor case + zipWith f (FiniteTensor index1 v1) (SimpleFinite index2 v2) = + if index1 == index2 then + let f' t s = (`f` s) `_map` t + in FiniteTensor index1 $ Boxed.generate (Finite.indexSize index1) (\i -> f' (v1 Boxed.! i) (v2 Unboxed.! i)) + else zipErr "finite-simple" (Index.toTIndex index1) (Index.toTIndex index2) + + -- Simple and finite tensor case + zipWith f (SimpleFinite index1 v1) (FiniteTensor index2 v2) = + if index1 == index2 then + let f' s t = (s `f`) `_map` t + in FiniteTensor index1 $ Boxed.generate (Finite.indexSize index1) (\i -> f' (v1 Unboxed.! i) (v2 Boxed.! i)) + else zipErr "simple-finite" (Index.toTIndex index1) (Index.toTIndex index2) + + + + + + + {-| List allows for random access to tensor elements -} instance (Unboxed.Unbox a, Num a, NFData a) => Accessible Tensor a where
test/Spec.hs view
@@ -13,10 +13,12 @@ main ) where +import Data.Maybe import qualified Data.Set as Set -import Multilinear.Class +import Multilinear import Multilinear.Generic import qualified Multilinear.Index as Index +import System.Exit import System.IO import Test.QuickCheck import Test.QuickCheck.Multilinear() @@ -25,9 +27,15 @@ defTestN :: Int defTestN = 1000 + +------------------------------ +-- AUXILIARY TEST FUNCTIONS -- +------------------------------ + + -- quickCheck with parametrizable tests number -quickCheckN :: Testable prop => Int -> prop -> IO () -quickCheckN n = quickCheckWith (Args +quickCheckN :: Testable prop => Int -> prop -> IO Result +quickCheckN n = quickCheckWithResult (Args Nothing -- ^ Should we replay a previous test? No. n -- ^ Maximum number of successful tests before succeeding set to N. 1 -- ^ Maximum number of discarded tests per successful test before giving up - gave up after first failure. @@ -35,18 +43,28 @@ True -- ^ Whether to print anything? yes. 0) -- ^ Maximum number of shrinks to before giving up. Turn shrinking off. --- Print property test result -printPropertyTest :: ( +-- | Execute property test and check result: +-- | exit test suite with successs code if no errors occured +-- | exit test suite with failure code if any error occured +executePropertyTest :: ( Testable prop ) => String -- ^ Tested property name -> Int -- ^ Number of tests to do -> prop -- ^ Property to test -> IO () -printPropertyTest propName n f = do +executePropertyTest propName n f = do putStr $ " Checking " ++ propName ++ " " - quickCheckN n f - hFlush stdout + r <- quickCheckN n f + case r of + Success _ _ _ -> hFlush stdout + _ -> exitFailure + +------------------------------ +-- TESTED TENSOR PROPERTIES -- +------------------------------ + + -- | Unary operator applied on any tensor, -- | must preserve tensor indices in the result. preserveIndicesUnary :: @@ -70,8 +88,8 @@ i2 = Set.fromList $ indices t2 in i1 /= i2 || i1 == Set.fromList (indices $ f t1 t2) --- | Binary operator other than tensor product must merge common indices in result tensor --- | it means, that in operators other than (*), the result tensor indices are set union of arguments indices +-- | Binary operator other than tensor product cannot contract (or consume) any index +-- | it means, that in operators other than (*), the indices of result tensor are set union of arguments indices mergeCommonIndices :: (Tensor Double -> Tensor Double -> @@ -106,11 +124,11 @@ let inames1 = Set.fromList $ Index.indexName <$> indices t1 inames2 = Set.fromList $ Index.indexName <$> indices t2 - iContravariantNames1 = Set.fromList $ Index.indexName <$> (Index.isContravariant `filter` indices t1) - iCovariantNames1 = Set.fromList $ Index.indexName <$> (Index.isCovariant `filter` indices t1) + iContravariantNames1 = Set.fromList $ Index.indexName <$> (Index.isContravariant `Prelude.filter` indices t1) + iCovariantNames1 = Set.fromList $ Index.indexName <$> (Index.isCovariant `Prelude.filter` indices t1) - iContravariantNames2 = Set.fromList $ Index.indexName <$> (Index.isContravariant `filter` indices t2) - iCovariantNames2 = Set.fromList $ Index.indexName <$> (Index.isCovariant `filter` indices t2) + iContravariantNames2 = Set.fromList $ Index.indexName <$> (Index.isContravariant `Prelude.filter` indices t2) + iCovariantNames2 = Set.fromList $ Index.indexName <$> (Index.isCovariant `Prelude.filter` indices t2) contractedIndices = -- contracted are indices covariant in the first tensor and contravariant in the second @@ -124,19 +142,15 @@ in expectedIndices == resultIndices -- | Order of the tensor must be equal to number of its covariant and contravariant indices -orderIndices :: - Tensor Double - -> Bool +orderIndices :: Tensor Double -> Bool orderIndices t = let (conv, cov) = order t - iConv = Set.fromList $ Index.isContravariant `filter` indices t - iCov = Set.fromList $ Index.isCovariant `filter` indices t + iConv = Set.fromList $ Index.isContravariant `Prelude.filter` indices t + iCov = Set.fromList $ Index.isCovariant `Prelude.filter` indices t in conv == Set.size iConv && cov == Set.size iCov -- | Tensor must be equivalent in terms of its indices after any index shift -shiftEquiv :: - Tensor Double - -> Bool +shiftEquiv :: Tensor Double -> Bool shiftEquiv t = let inames = indicesNames t rShiftedTs = (\i -> t |>> i) <$> inames @@ -145,82 +159,99 @@ ltShiftedTs = (\i -> t <<<| i) <$> inames allShiftedTs = rShiftedTs ++ lShiftedTs ++ rtShiftedTs ++ ltShiftedTs ++ [t] allPairs = pure (,) <*> allShiftedTs <*> allShiftedTs - allEquivs = uncurry (|==|) <$> allPairs - in False `notElem` allEquivs + in all (uncurry (|==|)) allPairs --- | After rename, index must hold a new name --- | This property assumes, tensor have max 5 indices of each type -renameTest :: - Tensor Double - -> Bool +{-| After rename, index must hold a new name + This property assumes, tensor have max 5 indices of each type -} +renameTest :: Tensor Double -> Bool renameTest t = let (conv, cov) = order t convNs = take conv ['m' .. ] covNs = take cov ['s' .. ] renamedT = t $| (convNs, covNs) inamesAfter = concat $ indicesNames renamedT - inamesValid = (\i -> elem i convNs || elem i covNs) <$> inamesAfter - in False `notElem` inamesValid + in all (\i -> elem i convNs || elem i covNs) inamesAfter --- | After any raising or lowering index, it must be a valid type -raiseLowerTest :: - Tensor Double - -> Bool +-- | After any raising or lowering index, it must be a valid type. +raiseLowerTest :: Tensor Double -> Bool raiseLowerTest t = let inames = indicesNames t lowered = inames `zip` ((t \/) <$> inames) raised = inames `zip` ((t /\) <$> inames) - isLowered = (\(i,tl) -> i `elem` (Index.indexName <$> (Index.isCovariant `filter` indices tl))) <$> lowered - isRaised = (\(i,tr) -> i `elem` (Index.indexName <$> (Index.isContravariant `filter` indices tr))) <$> raised - in False `notElem` isLowered ++ isRaised + isLowered (i,tl) = i `elem` (Index.indexName <$> (Index.isCovariant `Prelude.filter` indices tl)) + isRaised (i,tr) = i `elem` (Index.indexName <$> (Index.isContravariant `Prelude.filter` indices tr)) + in all isLowered lowered && all isRaised raised + +-- | Filter second half of elements for each tensor index and check if they disappeared +filterIndexTest :: + Tensor Double -> Bool +filterIndexTest s@(Scalar _) = s == filterIndex "c" (const True) s +filterIndexTest t = + let indsT = indices t + -- filter second half of an index + filteredHalf i = filterIndex (Index.indexName i) (< (fromJust (Index.indexSize i) `div` 2)) t + fts = indsT `zip` (filteredHalf <$> indsT) -- tensors with filtered indices, paired with respective transformed indices + in all (\(i,ft) -> + size ft (Index.indexName i) == (fromJust (Index.indexSize i) `div` 2) + ) fts + -- | ENTRY POINT main :: IO () main = do + + -- PRINT PROBABILITY DISTRIBUTION OF TESTED TENSORS ORDER + executePropertyTest "probability distribution of order of tested tensors" 5000 $ + \(t :: Tensor Double) -> collect (order t) $ preserveIndicesUnary abs + + putStrLn "\nTesting multilinear library...\n" + --------------------------- -- CHECKING NUM INSTANCE -- --------------------------- - printPropertyTest "preserveIndicesBinary for (+)" defTestN $ preserveIndicesBinary (+) - printPropertyTest "preserveIndicesBinary for (-)" defTestN $ preserveIndicesBinary (-) - printPropertyTest "preserveIndicesBinary for (*)" defTestN $ preserveIndicesBinary (*) - printPropertyTest "preserveIndicesUnary for abs" defTestN $ preserveIndicesUnary abs - printPropertyTest "preserveIndicesUnary for signum" defTestN $ preserveIndicesUnary signum + executePropertyTest "preserveIndicesBinary for (+)" defTestN $ preserveIndicesBinary (+) + executePropertyTest "preserveIndicesBinary for (-)" defTestN $ preserveIndicesBinary (-) + executePropertyTest "preserveIndicesBinary for (*)" defTestN $ preserveIndicesBinary (*) + executePropertyTest "preserveIndicesUnary for abs" defTestN $ preserveIndicesUnary abs + executePropertyTest "preserveIndicesUnary for signum" defTestN $ preserveIndicesUnary signum - printPropertyTest "mergeCommonIndices for (+)" defTestN $ mergeCommonIndices (+) - printPropertyTest "mergeCommonIndices for (-)" defTestN $ mergeCommonIndices (-) - printPropertyTest "consumeContractedIndices" defTestN consumeContractedIndices + executePropertyTest "mergeCommonIndices for (+)" defTestN $ mergeCommonIndices (+) + executePropertyTest "mergeCommonIndices for (-)" defTestN $ mergeCommonIndices (-) + executePropertyTest "consumeContractedIndices" defTestN consumeContractedIndices -------------------------------- -- CHECKING FLOATING INSTANCE -- -------------------------------- - printPropertyTest "preserveIndicesUnary for exp" defTestN $ preserveIndicesUnary exp - printPropertyTest "preserveIndicesUnary for log" defTestN $ preserveIndicesUnary log - printPropertyTest "preserveIndicesUnary for sin" defTestN $ preserveIndicesUnary sin - printPropertyTest "preserveIndicesUnary for cos" defTestN $ preserveIndicesUnary cos - printPropertyTest "preserveIndicesUnary for asin" defTestN $ preserveIndicesUnary asin - printPropertyTest "preserveIndicesUnary for acos" defTestN $ preserveIndicesUnary acos - printPropertyTest "preserveIndicesUnary for atan" defTestN $ preserveIndicesUnary atan - printPropertyTest "preserveIndicesUnary for sinh" defTestN $ preserveIndicesUnary sinh - printPropertyTest "preserveIndicesUnary for cosh" defTestN $ preserveIndicesUnary cosh - printPropertyTest "preserveIndicesUnary for asinh" defTestN $ preserveIndicesUnary asinh - printPropertyTest "preserveIndicesUnary for acosh" defTestN $ preserveIndicesUnary acosh - printPropertyTest "preserveIndicesUnary for atanh" defTestN $ preserveIndicesUnary atanh + executePropertyTest "preserveIndicesUnary for exp" defTestN $ preserveIndicesUnary exp + executePropertyTest "preserveIndicesUnary for log" defTestN $ preserveIndicesUnary log + executePropertyTest "preserveIndicesUnary for sin" defTestN $ preserveIndicesUnary sin + executePropertyTest "preserveIndicesUnary for cos" defTestN $ preserveIndicesUnary cos + executePropertyTest "preserveIndicesUnary for asin" defTestN $ preserveIndicesUnary asin + executePropertyTest "preserveIndicesUnary for acos" defTestN $ preserveIndicesUnary acos + executePropertyTest "preserveIndicesUnary for atan" defTestN $ preserveIndicesUnary atan + executePropertyTest "preserveIndicesUnary for sinh" defTestN $ preserveIndicesUnary sinh + executePropertyTest "preserveIndicesUnary for cosh" defTestN $ preserveIndicesUnary cosh + executePropertyTest "preserveIndicesUnary for asinh" defTestN $ preserveIndicesUnary asinh + executePropertyTest "preserveIndicesUnary for acosh" defTestN $ preserveIndicesUnary acosh + executePropertyTest "preserveIndicesUnary for atanh" defTestN $ preserveIndicesUnary atanh ----------------------------------- -- CHECKING MULTILINEAR INSTANCE -- ----------------------------------- - printPropertyTest "preserveIndicesUnary for (+.)" defTestN $ preserveIndicesUnary (5 +.) - printPropertyTest "preserveIndicesUnary for (.+)" defTestN $ preserveIndicesUnary (.+ 5) - printPropertyTest "preserveIndicesUnary for (-.)" defTestN $ preserveIndicesUnary (5 -.) - printPropertyTest "preserveIndicesUnary for (.-)" defTestN $ preserveIndicesUnary (.- 5) - printPropertyTest "preserveIndicesUnary for (*.)" defTestN $ preserveIndicesUnary (5 *.) - printPropertyTest "preserveIndicesUnary for (.*)" defTestN $ preserveIndicesUnary (.* 5) + executePropertyTest "preserveIndicesUnary for (+.)" defTestN $ preserveIndicesUnary (5 +.) + executePropertyTest "preserveIndicesUnary for (.+)" defTestN $ preserveIndicesUnary (.+ 5) + executePropertyTest "preserveIndicesUnary for (-.)" defTestN $ preserveIndicesUnary (5 -.) + executePropertyTest "preserveIndicesUnary for (.-)" defTestN $ preserveIndicesUnary (.- 5) + executePropertyTest "preserveIndicesUnary for (*.)" defTestN $ preserveIndicesUnary (5 *.) + executePropertyTest "preserveIndicesUnary for (.*)" defTestN $ preserveIndicesUnary (.* 5) - printPropertyTest "orderIndices" defTestN orderIndices - printPropertyTest "shiftEquiv" defTestN shiftEquiv - printPropertyTest "renamedTest" defTestN renameTest - printPropertyTest "raiseLowerTest" defTestN raiseLowerTest + executePropertyTest "orderIndices" defTestN orderIndices + executePropertyTest "shiftEquiv" defTestN shiftEquiv + executePropertyTest "renamedTest" defTestN renameTest + executePropertyTest "raiseLowerTest" defTestN raiseLowerTest + executePropertyTest "filterIndexTest" defTestN filterIndexTest + executePropertyTest "zipWithIndicesTest" defTestN $ preserveIndicesUnary (\t -> Multilinear.zipWith (+) t t)
test/Test/QuickCheck/Multilinear.hs view
@@ -13,10 +13,8 @@ Arbitrary ) where -import Multilinear.Class import qualified Multilinear.Form as Form import Multilinear.Generic -import qualified Multilinear.Matrix as Matrix import qualified Multilinear.Vector as Vector import Test.QuickCheck @@ -32,73 +30,52 @@ kS :: Int kS = 10 --- | Set of sample tensors for testing. --- | All vectors, forms and matrices has indices from set [i,j,k] --- | and sizes compatible with each other, suitable for all (+,-,*) operator. --- | We have 33 tensors here, which allows to 33^2 circ. 1000 possible test cases for binary operators. -tensors :: [Tensor Double] -tensors = [ - -- Scalars +-- | Set of three Scalars, that can be used for building more complex tensors +scalars :: [Tensor Double] +scalars = [ + -- Scalars Scalar (-1.0) , Scalar 0.0 , Scalar 1.0 - -- Vectors with i,j,k indices - , Vector.fromIndices "i" iS fromIntegral - , Vector.fromIndices "j" jS (\x -> fromIntegral x - 5.0) - , Vector.fromIndices "k" kS fromIntegral - -- Functional with i,j,k indices - can be contracted with vectors above or matrices below - , Form.fromIndices "i" iS fromIntegral - , Form.fromIndices "j" jS (\x -> fromIntegral x - 5.0) - , Form.fromIndices "k" kS fromIntegral - -- Matrices with a,b indices - , Matrix.fromIndices "ab" aS bS (\i j -> fromIntegral i + fromIntegral j) - , Matrix.fromIndices "ab" aS bS (\i j -> 5 * fromIntegral i - fromIntegral j) - , Matrix.fromIndices "ab" aS bS (\_ _ -> 0.0) - -- The same matrices as above, but with changed indices order - , Matrix.fromIndices "ab" aS bS (\i j -> fromIntegral i + fromIntegral j) |>>> "a" - , Matrix.fromIndices "ab" aS bS (\i j -> 5 * fromIntegral i - fromIntegral j) |>>> "a" - , Matrix.fromIndices "ab" aS bS (\_ _ -> 0.0) |>>> "a" - -- Matrices with i,j,k indices and the same indices sizes as for vectors above - , Matrix.fromIndices "ij" iS jS (\i j -> fromIntegral i + fromIntegral j) - , Matrix.fromIndices "kj" kS jS (\i j -> fromIntegral i + fromIntegral j) - , Matrix.fromIndices "ik" iS kS (\i j -> fromIntegral i + fromIntegral j) - -- The same matrices as above, but with changed indices order - , Matrix.fromIndices "ij" iS jS (\i j -> fromIntegral i + fromIntegral j) |>>> "i" - , Matrix.fromIndices "kj" kS jS (\i j -> fromIntegral i + fromIntegral j) |>>> "k" - , Matrix.fromIndices "ik" iS kS (\i j -> fromIntegral i + fromIntegral j) |>>> "i" - -- Matrices with one i,j,k index and one a,b index - , Matrix.fromIndices "ja" jS aS (\i j -> fromIntegral i + fromIntegral j) - , Matrix.fromIndices "ak" aS kS (\i j -> fromIntegral i + fromIntegral j) - , Matrix.fromIndices "ai" aS iS (\i j -> fromIntegral i + fromIntegral j) - , Matrix.fromIndices "jb" jS bS (\i j -> fromIntegral i + fromIntegral j) - , Matrix.fromIndices "bk" bS kS (\i j -> fromIntegral i + fromIntegral j) - , Matrix.fromIndices "bi" bS iS (\i j -> fromIntegral i + fromIntegral j) - -- The same matrices as above, but with changed indices order - , Matrix.fromIndices "ja" jS aS (\i j -> fromIntegral i + fromIntegral j) |>>> "j" - , Matrix.fromIndices "ak" aS kS (\i j -> fromIntegral i + fromIntegral j) |>>> "a" - , Matrix.fromIndices "ai" aS iS (\i j -> fromIntegral i + fromIntegral j) |>>> "a" - , Matrix.fromIndices "jb" jS bS (\i j -> fromIntegral i + fromIntegral j) |>>> "j" - , Matrix.fromIndices "bk" bS kS (\i j -> fromIntegral i + fromIntegral j) |>>> "b" - , Matrix.fromIndices "bi" bS iS (\i j -> fromIntegral i + fromIntegral j) |>>> "b" + ] + +-- | Set of 5 simple Scalars and 1D tensors for testing with only upper indices +-- | We use set of a,b,i,j,k indices for further building more complex tensors sets +tensors1DUpper :: [Tensor Double] +tensors1DUpper = [ + -- Vectors with a,b,i,j,k indices + Vector.fromIndices "a" aS $ sin . fromIntegral + , Vector.fromIndices "b" bS $ cos . fromIntegral + , Vector.fromIndices "i" iS $ exp . fromIntegral + , Vector.fromIndices "j" jS $ cosh . fromIntegral + , Vector.fromIndices "k" kS $ tanh . fromIntegral ] -{- --- | Second set of tensors; its indices have sizes incompatible with indices of tensors above. --- | Multiplicating, adding and so on of tensors2 with tensors assumes an error. -tensors2 :: [Tensor Double] -tensors2 = [ - -- Matrices with i,j,k indices and different indices sizes as for vectors above - Matrix.fromIndices "ij" 11 16 (\i j -> fromIntegral i + fromIntegral j) - , Matrix.fromIndices "kj" 11 16 (\i j -> fromIntegral i + fromIntegral j) - , Matrix.fromIndices "ik" 11 11 (\i j -> fromIntegral i + fromIntegral j) - -- The same matrices as above but with changed indices order - , Matrix.fromIndices "ij" 11 16 (\i j -> fromIntegral i + fromIntegral j) |>>> "i" - , Matrix.fromIndices "kj" 11 16 (\i j -> fromIntegral i + fromIntegral j) |>>> "k" - , Matrix.fromIndices "ik" 11 11 (\i j -> fromIntegral i + fromIntegral j) |>>> "i" - ] --} +-- | Set of 5 simple Scalars and 1D tensors for testing with only lower indices +-- | We use set of a,b,i,j,k indices for further building more complex tensors sets +tensors1DLower :: [Tensor Double] +tensors1DLower = [ + -- Functional with a,b,i,j,k indices - can be contracted with vectors above or matrices below + Form.fromIndices "a" aS $ sin . fromIntegral + , Form.fromIndices "b" bS $ cos . fromIntegral + , Form.fromIndices "i" iS $ exp . fromIntegral + , Form.fromIndices "j" jS $ cosh . fromIntegral + , Form.fromIndices "k" kS $ tanh . fromIntegral + ] +-- | List sum of scalars and upper and lower indices simple tensors +-- | List contains 18 tensors in total +tensors1D :: [Tensor Double] +tensors1D = scalars ++ tensors1DUpper ++ tensors1DLower + +{-| More complex (up to 3D) tensors, built as sums and differences of tensor products of all pairs from tensors list above + List contains 18^3 = 5832 tensors in total -} + +tensors3D :: [Tensor Double] +tensors3D = pure (*) <*> ts <*> tensors1D + where ts = pure (*) <*> tensors1D <*> tensors1D + -- | Arbitrary random generating instance of Tensor Double -- | Simply choose a tensot from tensors list above instance Arbitrary (Tensor Double) where - arbitrary = elements tensors + arbitrary = elements tensors3D