diff --git a/Data/Matrix.hs b/Data/Matrix.hs index 05b1a41..6e87d70 100644 --- a/Data/Matrix.hs +++ b/Data/Matrix.hs @@ -63,6 +63,7 @@ module Data.Matrix ( -- ** Determinants , detLaplace , detLU + , flatten ) where -- Classes @@ -71,13 +72,14 @@ import Control.Monad (forM_) import Control.Loop (numLoop,numLoopFold) import Data.Foldable (Foldable, foldMap) import Data.Monoid -import Data.Traversable +import Data.Traversable() -- Data import Control.Monad.Primitive (PrimMonad, PrimState) import Data.List (maximumBy,foldl1') import Data.Ord (comparing) import qualified Data.Vector as V import qualified Data.Vector.Mutable as MV +import Data.Maybe ------------------------------------------------------- ------------------------------------------------------- @@ -152,6 +154,41 @@ instance Functor Matrix where ------------------------------------------------------- ------------------------------------------------------- +------------------------------------------------------- +------------------------------------------------------- +---- MONOID INSTANCE + +instance Monoid a => Monoid (Matrix a) where + mempty = fromList 1 1 [mempty] + mappend m m' = matrix (max (nrows m) (nrows m')) (max (ncols m) (ncols m')) $ uncurry zipTogether + where zipTogether row column = fromMaybe mempty $ safeGet row column m <> safeGet row column m' + + +------------------------------------------------------- +------------------------------------------------------- +------------------------------------------------------- +------------------------------------------------------- + +------------------------------------------------------- +------------------------------------------------------- +---- APPLICATIVE INSTANCE +---- Works like tensor product but applies a function + +instance Applicative Matrix where + pure x = fromList 1 1 [x] + m <*> m' = flatten $ ((\f -> f <$> m') <$> m) + + +------------------------------------------------------- +------------------------------------------------------- + + + +-- | Flatten a matrix of matrices. All sub matrices must have same dimensions +-- This criteria is not checked. +flatten:: (Matrix (Matrix a)) -> Matrix a +flatten m = foldl1 (<->) $ map (foldl1 (<|>) . (\i -> getRow i m)) [1..(nrows m)] + -- | /O(rows*cols)/. Map a function over a row. -- Example: -- @@ -1233,4 +1270,3 @@ detLU :: (Ord a, Fractional a) => Matrix a -> a detLU m = case luDecomp m of Just (u,_,_,d) -> d * diagProd u Nothing -> 0 - diff --git a/matrix.cabal b/matrix.cabal index 284b14d..ccc117b 100644 --- a/matrix.cabal +++ b/matrix.cabal @@ -50,11 +50,14 @@ Test-Suite matrix-test type: exitcode-stdio-1.0 hs-source-dirs: test main-is: Main.hs + ghc-options: -threaded -rtsopts -with-rtsopts=-N build-depends: base == 4.* , matrix , tasty , QuickCheck , tasty-quickcheck + , hspec + Test-Suite matrix-examples type: exitcode-stdio-1.0