packages feed

typelevel-tensor (empty) → 0.1

raw patch · 5 files changed

+356/−0 lines, 5 filesdep +HUnitdep +QuickCheckdep +basesetup-changed

Dependencies added: HUnit, QuickCheck, base, control-monad-failure, numeric-prelude, test-framework, test-framework-hunit, test-framework-quickcheck2

Files

+ Data/Tensor/TypeLevel.hs view
@@ -0,0 +1,181 @@+{-# LANGUAGE DeriveDataTypeable, FlexibleContexts, FlexibleInstances,+ FunctionalDependencies, KindSignatures,+  MultiParamTypeClasses, NoImplicitPrelude,+  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.++module Data.Tensor.TypeLevel+    (+     (:~)(..), Vec(..), Axis(..), (!),+     Vector(..), VectorRing(..),+     contract,+     Vec0, Vec1, Vec2, Vec3, Vec4+    ) where++import qualified Algebra.Additive as Additive+import qualified Algebra.Ring as Ring+import           Control.Monad.Failure+import           System.IO.Unsafe+++import           Control.Applicative (Applicative(..), (<$>))+import           Control.Monad hiding +    (mapM_, sequence_, forM_, msum, mapM, sequence, forM)+import           Data.Foldable+import           Data.Traversable+import           NumericPrelude hiding +    (Monad, Functor, (*>),+     (>>=), (>>), 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+        +++infixl 9 !+-- | a component operator.+(!) :: Vector v => v a -> Axis v -> a+v ! i  = component i v   ++-- | data constructor for 0-dimensional tensor.+data Vec a +  = Vec +  deriving (Eq, Ord, Show, Read)++-- | data constructor for constructing n+1-dimensional tensor+-- from n-dimensional tensor.+data (n :: * -> * ) :~ a +  = (n a) :~ a +  deriving (Eq, Show, Read)+infixl 3 :~++-- | 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) ++instance Foldable Vec where+  foldMap = foldMapDefault+instance Functor Vec where+  fmap = fmapDefault+instance Traversable Vec where+  traverse _ Vec = pure Vec +instance Applicative Vec where+  pure _  = Vec+  _ <*> _ = Vec++instance (Traversable n) => Foldable ((:~) n) where+  foldMap = foldMapDefault+instance (Traversable n) => Functor ((:~) n) where+  fmap = fmapDefault+instance (Traversable n) => Traversable ((:~) n) where+  traverse f (x :~ y) = (:~) <$> traverse f x <*> f y+instance (Applicative n, Traversable n) => Applicative ((:~) n) where+  pure x = pure x :~ x+  (vf :~ f) <*> (vx :~ x) = (vf <*> vx) :~ (f x)++++-- | 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)++-- | 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) => +                Axis v -- ^the axis of the component you want+                -> 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,+  -- though, as long as the 'Axis' is generated from library functions+  -- such as 'compose', there will be no error.+  component :: Axis v -> v a -> a+  component axis vec = unsafePerformFailure $ componentF axis vec+  -- | The dimension of the vector.+  dimension :: v a -> Int+  -- | Create a 'Vector' from a function that maps +  -- axis to components.+  compose :: (Axis v -> a) -> v a++instance Vector Vec where+  componentF axis Vec +    = failureString $ "axis out of bound: " ++ show axis+  dimension _ = 0+  compose _ = Vec ++instance (Vector v) => Vector ((:~) v) where+  componentF (Axis i) vx@(v :~ x) +    | i==dimension vx - 1 = return x+    | True                = componentF (Axis i) v+  dimension (v :~ _) = 1 + dimension v+  compose f = let+    xs = compose (\(Axis i)->f (Axis i)) in xs :~ f (Axis (dimension xs))++-- | Vector whose components are additive is also additive.+instance (Additive.C a) => Additive.C (Vec a) where+  zero = compose $ const Additive.zero+  x+y  = compose (\i ->  x!i +  y!i)+  x-y  = compose (\i ->  x!i -  y!i)+  negate x = compose (\i -> negate $ x!i)++instance (Vector v, Additive.C a) => Additive.C ((:~) v a) where+  zero = compose $ const Additive.zero+  x+y  = compose (\i -> x!i + y!i)+  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 +-- 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', +-- 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.+  unitVectorF :: (Failure StringException f) => Axis v -> f (v a)+  -- | pure but unsafe version means of obtaining a 'unitVector'+  unitVector :: Axis v -> v a+  unitVector = unsafePerformFailure . unitVectorF++instance (Ring.C a) => VectorRing Vec a where+  unitVectorF axis+      = failureString $ "axis out of bound: " ++ show axis++instance (Ring.C a, VectorRing v a, Additive.C (v a)) +    => VectorRing ((:~) v) a where+  unitVectorF axis@(Axis i) = ret+    where+      z = Additive.zero+      d = dimension z+      ret+        | 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 +        -- this last guard never matches, but needed to infer the type of z.++-- | Type synonyms+type Vec0 = Vec+type Vec1 = (:~) Vec0+type Vec2 = (:~) Vec1+type Vec3 = (:~) Vec2+type Vec4 = (:~) Vec3++-- | convert Failure to runtime error+unsafePerformFailure :: IO a -> a+unsafePerformFailure = unsafePerformIO+
+ Data/Tensor/TypeLevel/Axis.hs view
@@ -0,0 +1,41 @@+{-# OPTIONS -Wall #-}+-- | Axis utility functions.+-- use this like +-- > import qualified Language.Paraiso.Axis as Axis++module Data.Tensor.TypeLevel.Axis+       (dimension, next, prev, all, allFrom, others)+    where++import           Data.Tensor.TypeLevel hiding (dimension)+import qualified Data.Tensor.TypeLevel as T (dimension)+import           Prelude hiding (all)+++-- | The dimension of the vector space the axis belongs to.+dimension :: (Vector v) => Axis v -> Int+dimension axis = T.dimension $ compose (\axis' -> [axis, axis'])++-- | The next axis under the Law of Cycles.+next :: (Vector v) => Axis v -> Axis v+next axis = Axis $ (axisIndex axis + 1) `mod` dimension axis++-- | The previous axis under the Law of Cycles.+prev :: (Vector v) => Axis v -> Axis v+prev axis = Axis $ (axisIndex axis - 1) `mod` dimension axis+++-- | All the axes belonging to the dimension.+all :: (Vector v) => Axis v -> [Axis v]+all axis = let dim = dimension axis in+              map head [[Axis i, axis] | i<-[0..dim-1]]+-- | All the axes belonging to the dimension,               +-- starting from the argument and followed by the Law of Cycles.+allFrom :: (Vector v) => Axis v -> [Axis v]+allFrom axis = let dim = dimension axis in+              map head [[Axis $ (axisIndex axis+i) `mod` dim, axis] | i<-[0..dim-1]]              +-- | All the axes belonging to the dimension but the argument itself,               +-- in the order of the Law of Cycles.              +others :: (Vector v) => Axis v -> [Axis v]+others axis = let dim = dimension axis in+              map head [[Axis $ (axisIndex axis+i) `mod` dim, axis] | i<-[1..dim-1]]
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c)2011, Takayuki Muranushi++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Takayuki Muranushi nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ typelevel-tensor.cabal view
@@ -0,0 +1,102 @@+-- typelevel-tensor.cabal auto-generated by cabal init. For additional+-- options, see+-- http://www.haskell.org/cabal/release/cabal-latest/doc/users-guide/authors.html#pkg-descr.++-- cabal cheatsheet+-- cabal init : initialize .cabal+-- cabal check : detect format error+-- cabal install : install this library+-- cabal haddock : create haddock documentation+-- cabal sdist : create tarball+-- cabal upload dist/Paraiso-....tar.gz : hackage debut!++-- The name of the package.+Name:                typelevel-tensor++-- 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++-- A short (one-line) description of the package.+Synopsis:            Tensors whose ranks and dimensions type-inferred and type-checked.++-- A longer description of the package.+Description:           A tensor class for Haskell that can type-infer and type-check over tensor ranks and dimensions.         ++-- URL for the project homepage or repository.+Homepage:            https://github.com/nushio3/typelevel-tensor++-- The license under which the package is released.+License:             BSD3++-- The file containing the license text.+License-file:        LICENSE++-- The package author(s).+Author:              Takayuki Muranushi++-- An email address to which users can send suggestions, bug reports,+-- and patches.+Maintainer:          muranushi@gmail.com++-- A copyright notice.+-- Copyright:           ++Category:            Data++Build-type:          Simple++-- Extra files to be distributed with the package, such as examples or+-- a README.+-- Extra-source-files:  ++-- Constraint on the version of Cabal needed to build this package.+Cabal-version:       >=1.10++flag test+  description: Build the executable to run unit tests+  default: True+++Library+  -- Modules exported by the library.+  Exposed-modules: Data.Tensor.TypeLevel+                   Data.Tensor.TypeLevel.Axis+  +  -- Packages needed in order to build this package.+  Build-depends: base            == 4.*,+                 control-monad-failure >= 0.7.0  && < 0.8,+                 numeric-prelude >= 0.2.1  && < 0.3++  -- Modules not exported by this package.+  -- Other-modules:       +  +  -- Extra tools (e.g. alex, hsc2hs, ...) needed to build the source.+  -- Build-tools:         ++  ghc-options:     -Wall -O3  -fspec-constr-count=25+  Default-Language: Haskell2010+++source-repository head+    type:     git+    location: https://github.com/nushio3/typelevel-tensor++++test-suite runtests+    type: exitcode-stdio-1.0+    Build-depends: base            == 4.*                   ,+                   control-monad-failure >= 0.7.0  && < 0.8 ,+                   numeric-prelude >= 0.2.1  && < 0.3       ,++                   test-framework                           ,+                   test-framework-quickcheck2               ,+                   test-framework-hunit                     ,+                   HUnit                                    ,+                   QuickCheck >= 2 && < 3+    main-is: runtests.hs+    +    ghc-options:     -Wall -O3  -fspec-constr-count=25+    Default-Language: Haskell2010