typelevel-tensor 0.1.0.4 → 0.1.1
raw patch · 3 files changed
+111/−37 lines, 3 filesdep ~QuickCheckdep ~control-monad-failure
Dependency ranges changed: QuickCheck, control-monad-failure
Files
- Data/Tensor/TypeLevel.hs +98/−33
- runtests.hs +9/−0
- typelevel-tensor.cabal +4/−4
Data/Tensor/TypeLevel.hs view
@@ -1,13 +1,13 @@ {-# LANGUAGE DeriveDataTypeable, FlexibleContexts, FlexibleInstances, FunctionalDependencies, KindSignatures, MultiParamTypeClasses, NoImplicitPrelude,- TypeOperators, UndecidableInstances #-} + TypeOperators, UndecidableInstances #-} {-# OPTIONS -Wall #-} -- | A tensor algebra library. Main ingredients are :--- +-- -- 'Vec' and ':~' are data constructors for rank-1 tensor. -- This is essentially a touple of objects of the same type.--- +-- -- 'Vector' is a class for rank-1 tensor. -- -- 'Axis' is an object for accessing the tensor components.@@ -17,56 +17,82 @@ (:~)(..), Vec(..), Axis(..), (!), Vector(..), VectorRing(..), contract,- Vec0, Vec1, Vec2, Vec3, Vec4+ Vec0, Vec1, Vec2, Vec3, Vec4,+ Vec5, Vec6, Vec7, Vec8, Vec9, Vec10,+ vec0, vec1, vec2, vec3, vec4,+ vec5, vec6, vec7, vec8, vec9, vec10 ) where import qualified Algebra.Additive as Additive import qualified Algebra.Ring as Ring import Control.Monad.Failure import System.IO.Unsafe-+import Text.Read+import qualified Text.ParserCombinators.ReadP as P import Control.Applicative (Applicative(..), (<$>))-import Control.Monad hiding +import Control.Monad hiding (mapM_, sequence_, forM_, msum, mapM, sequence, forM) import Data.Foldable+import Data.List (intercalate) import Data.Traversable-import NumericPrelude hiding +import NumericPrelude hiding (Monad, Functor, (*>),- (>>=), (>>), return, fail, fmap, mapM, mapM_, sequence, sequence_, - (=<<), foldl, foldl1, foldr, foldr1, and, or, any, all, sum, product, + (>>=), (>>), return, fail, fmap, mapM, mapM_, sequence, sequence_,+ (=<<), foldl, foldl1, foldr, foldr1, and, or, any, all, sum, product, concat, concatMap, maximum, minimum, elem, notElem)-import qualified NumericPrelude as Prelude- +import qualified Prelude as P98 infixl 9 ! -- | a component operator. (!) :: Vector v => v a -> Axis v -> a-v ! i = component i v +v ! i = component i v -- | data constructor for 0-dimensional tensor.-data Vec a - = Vec - deriving (Eq, Ord, Show, Read)+data Vec a+ = Vec+ deriving (Eq, Ord) -- | data constructor for constructing n+1-dimensional tensor -- from n-dimensional tensor.-data (n :: * -> * ) :~ a - = (n a) :~ a - deriving (Eq, Show, Read)+data (n :: * -> * ) :~ a+ = (n a) :~ a+ deriving (Eq) infixl 3 :~ +instance Show (Vec a) where+ show = const "()"++instance (Show a, Traversable ((:~) n)) => Show (n :~ a) where+ show = ("("++) . (++")") .+ intercalate "," . map show . toList++instance Read (Vec a) where+ readsPrec _ = P.readP_to_S $ do+ _ <- P.string "()"+ return Vec++instance (Read a, Vector ((:~) n)) => Read (n :~ a) where+ readsPrec _ = P.readP_to_S $ do+ _ <- P.char '('+ ret <- sequence $ compose (\(Axis i) -> do+ when (i>0) $ (P.char ',' >> return ())+ P.readS_to_P (readsPrec 0)+ )+ _ <- P.char ')'+ return ret+ -- | the last component contributes the most to the ordering instance (Ord (n a), Ord a) => Ord (n :~ a) where- compare (xs :~ x) (ys :~ y) = compare (x, xs) (y, ys) + compare (xs :~ x) (ys :~ y) = compare (x, xs) (y, ys) instance Foldable Vec where foldMap = foldMapDefault instance Functor Vec where fmap = fmapDefault instance Traversable Vec where- traverse _ Vec = pure Vec + traverse _ Vec = pure Vec instance Applicative Vec where pure _ = Vec _ <*> _ = Vec@@ -83,18 +109,18 @@ --- | An coordinate 'Axis' , labeled by an integer. +-- | An coordinate 'Axis' , labeled by an integer. -- Axis also carries v, the container type for its corresponding -- vector. Therefore, An axis of one type can access only vectors -- of a fixed dimension, but of arbitrary type.-newtype (Vector v) => Axis v = Axis {axisIndex::Int} deriving (Eq,Ord,Show,Read)+newtype Axis (v :: * -> *) = Axis {axisIndex::Int} deriving (Eq,Ord,Show,Read) -- | An object that allows component-wise access. class (Traversable v) => Vector v where -- | Get a component within f, a context which allows 'Failure'.- componentF :: (Failure StringException f) => + componentF :: (Failure StringException f) => Axis v -- ^the axis of the component you want- -> v a -- ^the target vector + -> v a -- ^the target vector -> f a -- ^the component, obtained within a 'Failure' monad -- | Get a component. This computation may result in a runtime error,@@ -104,18 +130,18 @@ component axis vec = unsafePerformFailure $ componentF axis vec -- | The dimension of the vector. dimension :: v a -> Int- -- | Create a 'Vector' from a function that maps + -- | Create a 'Vector' from a function that maps -- axis to components. compose :: (Axis v -> a) -> v a instance Vector Vec where- componentF axis Vec + componentF axis Vec = failureString $ "axis out of bound: " ++ show axis dimension _ = 0- compose _ = Vec + compose _ = Vec instance (Vector v) => Vector ((:~) v) where- componentF (Axis i) vx@(v :~ x) + componentF (Axis i) vx@(v :~ x) | i==dimension vx - 1 = return x | True = componentF (Axis i) v dimension (v :~ _) = 1 + dimension v@@ -135,14 +161,14 @@ x-y = compose (\i -> x!i - y!i) negate x = compose (\i -> negate $ x!i) --- | Tensor contraction. Create a 'Vector' from a function that maps +-- | Tensor contraction. Create a 'Vector' from a function that maps -- axis to component, then sums over the axis and returns @a@. contract :: (Vector v, Additive.C a) => (Axis v -> a) -> a contract f = foldl (+) Additive.zero (compose f) --- | 'VectorRing' is a 'Vector' whose components belongs to 'Ring.C', +-- | 'VectorRing' is a 'Vector' whose components belongs to 'Ring.C', -- thus providing unit vectors. class (Vector v, Ring.C a) => VectorRing v a where -- | A vector where 'Axis'th component is unity but others are zero.@@ -155,7 +181,7 @@ unitVectorF axis = failureString $ "axis out of bound: " ++ show axis -instance (Ring.C a, VectorRing v a, Additive.C (v a)) +instance (Ring.C a, VectorRing v a, Additive.C (v a)) => VectorRing ((:~) v) a where unitVectorF axis@(Axis i) = ret where@@ -165,17 +191,56 @@ | i < 0 || i >= d = failureString $ "axis out of bound: " ++ show axis | i == d-1 = return $ Additive.zero :~ Ring.one | 0 <= i && i < d-1 = liftM (:~ Additive.zero) $ unitVectorF (Axis i)- | True = return z + | True = return z -- this last guard never matches, but needed to infer the type of z. +instance (Vector v, P98.Num a) => P98.Num ((:~) v a) where+ x+y = compose (\i -> x!i P98.+ y!i)+ x-y = compose (\i -> x!i P98.- y!i)+ negate x = compose (\i -> P98.negate $ x!i)+ (*) = error "P98 legacy instance"+ fromInteger x = compose $ const (P98.fromInteger x)+ abs = error "P98 legacy instance"+ signum = error "P98 legacy instance"+ -- | Type synonyms type Vec0 = Vec type Vec1 = (:~) Vec0 type Vec2 = (:~) Vec1 type Vec3 = (:~) Vec2 type Vec4 = (:~) Vec3+type Vec5 = (:~) Vec4+type Vec6 = (:~) Vec5+type Vec7 = (:~) Vec6+type Vec8 = (:~) Vec7+type Vec9 = (:~) Vec8+type Vec10 = (:~) Vec9 +-- | Utility functions+vec0 :: Vec0 a+vec0 = Vec+vec1 :: a -> Vec1 a+vec1 x0 = Vec :~ x0+vec2 :: a -> a -> Vec2 a+vec2 x0 x1 = Vec :~ x0 :~ x1+vec3 :: a -> a -> a -> Vec3 a+vec3 x0 x1 x2 = Vec :~ x0 :~ x1 :~ x2+vec4 :: a -> a -> a -> a -> Vec4 a+vec4 x0 x1 x2 x3 = Vec :~ x0 :~ x1 :~ x2 :~ x3+vec5 :: a -> a -> a -> a -> a -> Vec5 a+vec5 x0 x1 x2 x3 x4 = Vec :~ x0 :~ x1 :~ x2 :~ x3 :~ x4+vec6 :: a -> a -> a -> a -> a -> a -> Vec6 a+vec6 x0 x1 x2 x3 x4 x5 = Vec :~ x0 :~ x1 :~ x2 :~ x3 :~ x4 :~ x5+vec7 :: a -> a -> a -> a -> a -> a -> a -> Vec7 a+vec7 x0 x1 x2 x3 x4 x5 x6 = Vec :~ x0 :~ x1 :~ x2 :~ x3 :~ x4 :~ x5 :~ x6+vec8 :: a -> a -> a -> a -> a -> a -> a -> a -> Vec8 a+vec8 x0 x1 x2 x3 x4 x5 x6 x7 = Vec :~ x0 :~ x1 :~ x2 :~ x3 :~ x4 :~ x5 :~ x6 :~ x7+vec9 :: a -> a -> a -> a -> a -> a -> a -> a -> a -> Vec9 a+vec9 x0 x1 x2 x3 x4 x5 x6 x7 x8 = Vec :~ x0 :~ x1 :~ x2 :~ x3 :~ x4 :~ x5 :~ x6 :~ x7 :~ x8+vec10 :: a -> a -> a -> a -> a -> a -> a -> a -> a -> a -> Vec10 a+vec10 x0 x1 x2 x3 x4 x5 x6 x7 x8 x9 = Vec :~ x0 :~ x1 :~ x2 :~ x3 :~ x4 :~ x5 :~ x6 :~ x7 :~ x8 :~ x9++ -- | convert Failure to runtime error unsafePerformFailure :: IO a -> a unsafePerformFailure = unsafePerformIO-
+ runtests.hs view
@@ -0,0 +1,9 @@+import Control.Exception (finally)+import Control.Monad+import Test.Framework (defaultMain)+-- Actual tests+import Test.Tensor++main :: IO ()+main = defaultMain [testTensor]+
typelevel-tensor.cabal view
@@ -16,7 +16,7 @@ -- The package version. See the Haskell package versioning policy -- (http://www.haskell.org/haskellwiki/Package_versioning_policy) for -- standards guiding when and how versions should be incremented.-Version: 0.1.0.4+Version: 0.1.1 -- A short (one-line) description of the package. Synopsis: Tensors whose ranks and dimensions type-inferred and type-checked.@@ -68,7 +68,7 @@ -- Packages needed in order to build this package. Build-depends: base == 4.*,- control-monad-failure >= 0.7.0 && < 0.8,+ control-monad-failure >= 0.7.0, numeric-prelude >= 0.3 -- Modules not exported by this package.@@ -91,13 +91,13 @@ type: exitcode-stdio-1.0 Build-depends: array >= 0.4, base == 4.* ,- control-monad-failure >= 0.7.0 && < 0.8 ,+ control-monad-failure >= 0.7.0 , numeric-prelude >= 0.3 , test-framework , test-framework-quickcheck2 , test-framework-hunit , HUnit ,- QuickCheck >= 2 && < 3+ QuickCheck >= 2 main-is: runtests.hs ghc-options: -Wall -O3 -fspec-constr-count=25