hmatrix 0.18.2.0 → 0.19.0.0

raw patch · 24 files changed

+230/−25 lines, 24 filesdep ~basenew-uploaderPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• CHANGELOG +3/−4
• hmatrix.cabal +1/−1
• src/Internal/Algorithms.hs +2/−0
• src/Internal/CG.hs +2/−0
• src/Internal/Chain.hs +2/−0
• src/Internal/Container.hs +2/−0
• src/Internal/Devel.hs +1/−0
• src/Internal/Element.hs +20/−3
• src/Internal/IO.hs +13/−3
• src/Internal/LAPACK.hs +2/−0
• src/Internal/Matrix.hs +86/−1
• src/Internal/Modular.hs +3/−0
• src/Internal/Numeric.hs +3/−7
• src/Internal/ST.hs +10/−2
• src/Internal/Sparse.hs +2/−0
• src/Internal/Static.hs +3/−0
• src/Internal/Util.hs +2/−0
• src/Internal/Vector.hs +7/−0
• src/Internal/Vectorized.hs +36/−0
• src/Numeric/LinearAlgebra.hs +2/−0
• src/Numeric/LinearAlgebra/HMatrix.hs +2/−0
• src/Numeric/LinearAlgebra/Static.hs +2/−0
• src/Numeric/Matrix.hs +12/−2
• src/Numeric/Vector.hs +12/−2

@@ -2,15 +2,15 @@ --------      * Many new functions and instances in the Static module-    +     * meanCov and gaussianSample use Herm type      * thinQR, thinRQ-    +     * compactSVDTol      * unitary changed to normalize, also admits Vector (Complex Double)-  + 0.17.0.0 -------- @@ -288,4 +288,3 @@     * added NFData instances for Matrix and Vector.      * liftVector, liftVector2 replaced by mapVector, zipVector.-

@@ -1,5 +1,5 @@ Name:               hmatrix-Version:            0.18.2.0+Version:            0.19.0.0 License:            BSD3 License-file:       LICENSE Author:             Alberto Ruiz

@@ -4,6 +4,8 @@ {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE TypeFamilies #-} +{-# OPTIONS_GHC -fno-warn-missing-signatures #-}+ ----------------------------------------------------------------------------- {- | Module      :  Internal.Algorithms

@@ -1,6 +1,8 @@ {-# LANGUAGE FlexibleContexts, FlexibleInstances #-} {-# LANGUAGE RecordWildCards #-} +{-# OPTIONS_GHC -fno-warn-orphans #-}+ module Internal.CG(     cgSolve, cgSolve',     CGState(..), R, V

@@ -1,5 +1,7 @@ {-# LANGUAGE FlexibleContexts #-} +{-# OPTIONS_GHC -fno-warn-missing-signatures #-}+ ----------------------------------------------------------------------------- -- | -- Module      :  Internal.Chain

@@ -5,6 +5,8 @@ {-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE UndecidableInstances #-} +{-# OPTIONS_GHC -fno-warn-simplifiable-class-constraints #-}+ ----------------------------------------------------------------------------- -- | -- Module      :  Internal.Container

@@ -54,6 +54,7 @@  -- | postfix error code check infixl 0 #|+(#|) :: IO CInt -> String -> IO () (#|) = flip check  -- | Error capture and conversion to Maybe

@@ -4,6 +4,8 @@ {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} +{-# OPTIONS_GHC -fno-warn-orphans #-}+ ----------------------------------------------------------------------------- -- | -- Module      :  Data.Packed.Matrix@@ -31,6 +33,7 @@ import Foreign.Storable(Storable) import System.IO.Unsafe(unsafePerformIO) import Control.Monad(liftM)+import Foreign.C.Types(CInt)  ------------------------------------------------------------------- @@ -53,8 +56,10 @@     show m | rows m == 0 || cols m == 0 = sizes m ++" []"     show m = (sizes m++) . dsp . map (map show) . toLists $ m +sizes :: Matrix t -> [Char] sizes m = "("++show (rows m)++"><"++show (cols m)++")\n" +dsp :: [[[Char]]] -> [Char] dsp as = (++" ]") . (" ["++) . init . drop 2 . unlines . map (" , "++) . map unwords' $ transpose mtp     where         mt = transpose as@@ -73,6 +78,7 @@               rs = read . snd . breakAt '(' .init . fst . breakAt '>' $ dims  +breakAt :: Eq a => a -> [a] -> ([a], [a]) breakAt c l = (a++[c],tail b) where     (a,b) = break (==c) l @@ -88,7 +94,8 @@     | Drop Int     | DropLast Int   deriving Show-  ++ppext :: Extractor -> [Char] ppext All = ":" ppext (Range a 1 c) = printf "%d:%d" a c ppext (Range a b c) = printf "%d:%d:%d" a b c@@ -128,10 +135,14 @@ infixl 9 ?? (??)  :: Element t => Matrix t -> (Extractor,Extractor) -> Matrix t +minEl :: Vector CInt -> CInt minEl = toScalarI Min+maxEl :: Vector CInt -> CInt maxEl = toScalarI Max+cmodi :: Foreign.C.Types.CInt -> Vector Foreign.C.Types.CInt -> Vector Foreign.C.Types.CInt cmodi = vectorMapValI ModVS +extractError :: Matrix t1 -> (Extractor, Extractor) -> t extractError m (e1,e2)= error $ printf "can't extract (%s,%s) from matrix %dx%d" (ppext e1::String) (ppext e2::String) (rows m) (cols m)  m ?? (Range a s b,e) | s /= 1 = m ?? (Pos (idxs [a,a+s .. b]), e)@@ -232,8 +243,10 @@ fromBlocks :: Element t => [[Matrix t]] -> Matrix t fromBlocks = fromBlocksRaw . adaptBlocks +fromBlocksRaw :: Element t => [[Matrix t]] -> Matrix t fromBlocksRaw mms = joinVert . map joinHoriz $ mms +adaptBlocks :: Element t => [[Matrix t]] -> [[Matrix t]] adaptBlocks ms = ms' where     bc = case common length ms of           Just c -> c@@ -486,6 +499,9 @@     m2' = conformMTo (r,c) m2  -- FIXME do not flatten if equal order+lM :: (Storable t, Element t1, Element t2)+   => (Vector t1 -> Vector t2 -> Vector t)+   -> Matrix t1 -> Matrix t2 -> Matrix t lM f m1 m2 = matrixFromVector                 RowMajor                 (max' (rows m1) (rows m2))@@ -504,6 +520,7 @@  ------------------------------------------------------------ +toBlockRows :: Element t => [Int] -> Matrix t -> [Matrix t] toBlockRows [r] m     | r == rows m = [m] toBlockRows rs m@@ -513,6 +530,7 @@     szs = map (* cols m) rs     g k = (k><0)[] +toBlockCols :: Element t => [Int] -> Matrix t -> [Matrix t] toBlockCols [c] m | c == cols m = [m] toBlockCols cs m = map trans . toBlockRows cs . trans $ m @@ -576,7 +594,7 @@ mapMatrixWithIndexM   :: (Element a, Storable b, Monad m) =>       ((Int, Int) -> a -> m b) -> Matrix a -> m (Matrix b)-mapMatrixWithIndexM g m = liftM (reshape c) . mapVectorWithIndexM (mk c g) . flatten $ m +mapMatrixWithIndexM g m = liftM (reshape c) . mapVectorWithIndexM (mk c g) . flatten $ m     where       c = cols m @@ -598,4 +616,3 @@  mapMatrix :: (Element a, Element b) => (a -> b) -> Matrix a -> Matrix b mapMatrix f = liftMatrix (mapVector f)-

@@ -20,7 +20,7 @@ import Internal.Vector import Internal.Matrix import Internal.Vectorized-import Text.Printf(printf)+import Text.Printf(printf, PrintfArg, PrintfType) import Data.List(intersperse,transpose) import Data.Complex @@ -78,12 +78,18 @@ dispf :: Int -> Matrix Double -> String dispf d x = sdims x ++ "\n" ++ formatFixed (if isInt x then 0 else d) x +sdims :: Matrix t -> [Char] sdims x = show (rows x) ++ "x" ++ show (cols x) +formatFixed :: (Show a, Text.Printf.PrintfArg t, Element t)+            => a -> Matrix t -> String formatFixed d x = format "  " (printf ("%."++show d++"f")) $ x +isInt :: Matrix Double -> Bool isInt = all lookslikeInt . toList . flatten +formatScaled :: (Text.Printf.PrintfArg b, RealFrac b, Floating b, Num t, Element b, Show t)+             => t -> Matrix b -> [Char] formatScaled dec t = "E"++show o++"\n" ++ ss     where ss = format " " (printf fmt. g) t           g x | o >= 0    = x/10^(o::Int)@@ -133,14 +139,18 @@     s2 = if b<0 then "-" else ""     s3 = if b<0 then "-" else "+" +shcr :: (Show a, Show t1, Text.Printf.PrintfType t, Text.Printf.PrintfArg t1, RealFrac t1)+     => a -> t1 -> t shcr d a | lookslikeInt a = printf "%.0f" a          | otherwise      = printf ("%."++show d++"f") a -+lookslikeInt :: (Show a, RealFrac a) => a -> Bool lookslikeInt x = show (round x :: Int) ++".0" == shx || "-0.0" == shx    where shx = show x +isZero :: Show a => a -> Bool isZero x = show x `elem` ["0.0","-0.0"]+isOne :: Show a => a -> Bool isOne  x = show x `elem` ["1.0","-1.0"]  -- | Pretty print a complex matrix with at most n decimal digits.@@ -168,6 +178,6 @@       else         return (reshape c v) -+loadMatrix' :: FilePath -> IO (Maybe (Matrix Double)) loadMatrix' name = mbCatch (loadMatrix name) 

@@ -1,6 +1,8 @@ {-# LANGUAGE TypeOperators #-} {-# LANGUAGE ViewPatterns #-} +{-# OPTIONS_GHC -fno-warn-missing-signatures #-}+ ----------------------------------------------------------------------------- -- | -- Module      :  Numeric.LinearAlgebra.LAPACK

@@ -57,19 +57,24 @@ cols = icols {-# INLINE cols #-} +size :: Matrix t -> (Int, Int) size m = (irows m, icols m) {-# INLINE size #-} +rowOrder :: Matrix t -> Bool rowOrder m = xCol m == 1 || cols m == 1 {-# INLINE rowOrder #-} +colOrder :: Matrix t -> Bool colOrder m = xRow m == 1 || rows m == 1 {-# INLINE colOrder #-} +is1d :: Matrix t -> Bool is1d (size->(r,c)) = r==1 || c==1 {-# INLINE is1d #-}  -- data is not contiguous+isSlice :: Storable t => Matrix t -> Bool isSlice m@(size->(r,c)) = r*c < dim (xdat m) {-# INLINE isSlice #-} @@ -136,16 +141,20 @@     {-# INLINE applyRaw #-}  infixr 1 #+(#) :: TransArray c => c -> (b -> IO r) -> Trans c b -> IO r a # b = apply a b {-# INLINE (#) #-} +(#!) :: (TransArray c, TransArray c1) => c1 -> c -> Trans c1 (Trans c (IO r)) -> IO r a #! b = a # b # id {-# INLINE (#!) #-}  -------------------------------------------------------------------------------- +copy :: Element t => MatrixOrder -> Matrix t -> IO (Matrix t) copy ord m = extractR ord m 0 (idxs[0,rows m-1]) 0 (idxs[0,cols m-1]) +extractAll :: Element t => MatrixOrder -> Matrix t -> Matrix t extractAll ord m = unsafePerformIO (copy ord m)  {- | Creates a vector by concatenation of rows. If the matrix is ColumnMajor, this operation requires a transpose.@@ -223,11 +232,13 @@ {-# INLINE (@@>) #-}  --  Unsafe matrix access without range checking+atM' :: Storable t => Matrix t -> Int -> Int -> t atM' m i j = xdat m `at'` (i * (xRow m) + j * (xCol m)) {-# INLINE atM' #-}  ------------------------------------------------------------------ +matrixFromVector :: Storable t => MatrixOrder -> Int -> Int -> Vector t -> Matrix t matrixFromVector _ 1 _ v@(dim->d) = Matrix { irows = 1, icols = d, xdat = v, xRow = d, xCol = 1 } matrixFromVector _ _ 1 v@(dim->d) = Matrix { irows = d, icols = 1, xdat = v, xRow = 1, xCol = d } matrixFromVector o r c v@@ -387,18 +398,21 @@  -------------------------------------------------------------------------- +maxZ :: (Num t1, Ord t1, Foldable t) => t t1 -> t1 maxZ xs = if minimum xs == 0 then 0 else maximum xs +conformMs :: Element t => [Matrix t] -> [Matrix t] conformMs ms = map (conformMTo (r,c)) ms   where     r = maxZ (map rows ms)     c = maxZ (map cols ms) -+conformVs :: Element t => [Vector t] -> [Vector t] conformVs vs = map (conformVTo n) vs   where     n = maxZ (map dim vs) +conformMTo :: Element t => (Int, Int) -> Matrix t -> Matrix t conformMTo (r,c) m     | size m == (r,c) = m     | size m == (1,1) = matrixFromVector RowMajor r c (constantD (m@@>(0,0)) (r*c))@@ -406,18 +420,24 @@     | size m == (1,c) = repRows r m     | otherwise = error $ "matrix " ++ shSize m ++ " cannot be expanded to " ++ shDim (r,c) +conformVTo :: Element t => Int -> Vector t -> Vector t conformVTo n v     | dim v == n = v     | dim v == 1 = constantD (v@>0) n     | otherwise = error $ "vector of dim=" ++ show (dim v) ++ " cannot be expanded to dim=" ++ show n +repRows :: Element t => Int -> Matrix t -> Matrix t repRows n x = fromRows (replicate n (flatten x))+repCols :: Element t => Int -> Matrix t -> Matrix t repCols n x = fromColumns (replicate n (flatten x)) +shSize :: Matrix t -> [Char] shSize = shDim . size +shDim :: (Show a, Show a1) => (a1, a) -> [Char] shDim (r,c) = "(" ++ show r ++"x"++ show c ++")" +emptyM :: Storable t => Int -> Int -> Matrix t emptyM r c = matrixFromVector RowMajor r c (fromList[])  ----------------------------------------------------------------------@@ -432,6 +452,11 @@  --------------------------------------------------------------- +extractAux :: (Eq t3, Eq t2, TransArray c, Storable a, Storable t1,+                Storable t, Num t3, Num t2, Integral t1, Integral t)+           => (t3 -> t2 -> CInt -> Ptr t1 -> CInt -> Ptr t+                  -> Trans c (CInt -> CInt -> CInt -> CInt -> Ptr a -> IO CInt))+           -> MatrixOrder -> c -> t3 -> Vector t1 -> t2 -> Vector t -> IO (Matrix a) extractAux f ord m moder vr modec vc = do     let nr = if moder == 0 then fromIntegral $ vr@>1 - vr@>0 + 1 else dim vr         nc = if modec == 0 then fromIntegral $ vc@>1 - vc@>0 + 1 else dim vc@@ -451,6 +476,9 @@  --------------------------------------------------------------- +setRectAux :: (TransArray c1, TransArray c)+           => (CInt -> CInt -> Trans c1 (Trans c (IO CInt)))+           -> Int -> Int -> c1 -> c -> IO () setRectAux f i j m r = (m #! r) (f (fi i) (fi j)) #|"setRect"  type SetRect x = I -> I -> x ::> x::> Ok@@ -464,19 +492,29 @@  -------------------------------------------------------------------------------- +sortG :: (Storable t, Storable a)+      => (CInt -> Ptr t -> CInt -> Ptr a -> IO CInt) -> Vector t -> Vector a sortG f v = unsafePerformIO $ do     r <- createVector (dim v)     (v #! r) f #|"sortG"     return r +sortIdxD :: Vector Double -> Vector CInt sortIdxD = sortG c_sort_indexD+sortIdxF :: Vector Float -> Vector CInt sortIdxF = sortG c_sort_indexF+sortIdxI :: Vector CInt -> Vector CInt sortIdxI = sortG c_sort_indexI+sortIdxL :: Vector Z -> Vector I sortIdxL = sortG c_sort_indexL +sortValD :: Vector Double -> Vector Double sortValD = sortG c_sort_valD+sortValF :: Vector Float -> Vector Float sortValF = sortG c_sort_valF+sortValI :: Vector CInt -> Vector CInt sortValI = sortG c_sort_valI+sortValL :: Vector Z -> Vector Z sortValL = sortG c_sort_valL  foreign import ccall unsafe "sort_indexD" c_sort_indexD :: CV Double (CV CInt (IO CInt))@@ -491,14 +529,21 @@  -------------------------------------------------------------------------------- +compareG :: (TransArray c, Storable t, Storable a)+         => Trans c (CInt -> Ptr t -> CInt -> Ptr a -> IO CInt)+         -> c -> Vector t -> Vector a compareG f u v = unsafePerformIO $ do     r <- createVector (dim v)     (u # v #! r) f #|"compareG"     return r +compareD :: Vector Double -> Vector Double -> Vector CInt compareD = compareG c_compareD+compareF :: Vector Float -> Vector Float -> Vector CInt compareF = compareG c_compareF+compareI :: Vector CInt -> Vector CInt -> Vector CInt compareI = compareG c_compareI+compareL :: Vector Z -> Vector Z -> Vector CInt compareL = compareG c_compareL  foreign import ccall unsafe "compareD" c_compareD :: CV Double (CV Double (CV CInt (IO CInt)))@@ -508,16 +553,33 @@  -------------------------------------------------------------------------------- +selectG :: (TransArray c, TransArray c1, TransArray c2, Storable t, Storable a)+        => Trans c2 (Trans c1 (CInt -> Ptr t -> Trans c (CInt -> Ptr a -> IO CInt)))+        -> c2 -> c1 -> Vector t -> c -> Vector a selectG f c u v w = unsafePerformIO $ do     r <- createVector (dim v)     (c # u # v # w #! r) f #|"selectG"     return r +selectD :: Vector CInt -> Vector Double -> Vector Double -> Vector Double -> Vector Double selectD = selectG c_selectD+selectF :: Vector CInt -> Vector Float -> Vector Float -> Vector Float -> Vector Float selectF = selectG c_selectF+selectI :: Vector CInt -> Vector CInt -> Vector CInt -> Vector CInt -> Vector CInt selectI = selectG c_selectI+selectL :: Vector CInt -> Vector Z -> Vector Z -> Vector Z -> Vector Z selectL = selectG c_selectL+selectC :: Vector CInt+        -> Vector (Complex Double)+        -> Vector (Complex Double)+        -> Vector (Complex Double)+        -> Vector (Complex Double) selectC = selectG c_selectC+selectQ :: Vector CInt+        -> Vector (Complex Float)+        -> Vector (Complex Float)+        -> Vector (Complex Float)+        -> Vector (Complex Float) selectQ = selectG c_selectQ  type Sel x = CV CInt (CV x (CV x (CV x (CV x (IO CInt)))))@@ -531,16 +593,29 @@  --------------------------------------------------------------------------- +remapG :: (TransArray c, TransArray c1, Storable t, Storable a)+       => (CInt -> CInt -> CInt -> CInt -> Ptr t+                -> Trans c1 (Trans c (CInt -> CInt -> CInt -> CInt -> Ptr a -> IO CInt)))+       -> Matrix t -> c1 -> c -> Matrix a remapG f i j m = unsafePerformIO $ do     r <- createMatrix RowMajor (rows i) (cols i)     (i # j # m #! r) f #|"remapG"     return r +remapD :: Matrix CInt -> Matrix CInt -> Matrix Double -> Matrix Double remapD = remapG c_remapD+remapF :: Matrix CInt -> Matrix CInt -> Matrix Float -> Matrix Float remapF = remapG c_remapF+remapI :: Matrix CInt -> Matrix CInt -> Matrix CInt -> Matrix CInt remapI = remapG c_remapI+remapL :: Matrix CInt -> Matrix CInt -> Matrix Z -> Matrix Z remapL = remapG c_remapL+remapC :: Matrix CInt+       -> Matrix CInt+       -> Matrix (Complex Double)+       -> Matrix (Complex Double) remapC = remapG c_remapC+remapQ :: Matrix CInt -> Matrix CInt -> Matrix (Complex Float) -> Matrix (Complex Float) remapQ = remapG c_remapQ  type Rem x = OM CInt (OM CInt (OM x (OM x (IO CInt))))@@ -554,6 +629,9 @@  -------------------------------------------------------------------------------- +rowOpAux :: (TransArray c, Storable a) =>+            (CInt -> Ptr a -> CInt -> CInt -> CInt -> CInt -> Trans c (IO CInt))+         -> Int -> a -> Int -> Int -> Int -> Int -> c -> IO () rowOpAux f c x i1 i2 j1 j2 m = do     px <- newArray [x]     (m # id) (f (fi c) px (fi i1) (fi i2) (fi j1) (fi j2)) #|"rowOp"@@ -572,6 +650,9 @@  -------------------------------------------------------------------------------- +gemmg :: (TransArray c1, TransArray c, TransArray c2, TransArray c3)+      => Trans c3 (Trans c2 (Trans c1 (Trans c (IO CInt))))+      -> c3 -> c2 -> c1 -> c -> IO () gemmg f v m1 m2 m3 = (v # m1 # m2 #! m3) f #|"gemmg"  type Tgemm x = x :> x ::> x ::> x ::> Ok@@ -587,6 +668,10 @@  -------------------------------------------------------------------------------- +reorderAux :: (TransArray c, Storable t, Storable a1, Storable t1, Storable a) =>+              (CInt -> Ptr a -> CInt -> Ptr t1+                    -> Trans c (CInt -> Ptr t -> CInt -> Ptr a1 -> IO CInt))+           -> Vector t1 -> c -> Vector t -> Vector a1 reorderAux f s d v = unsafePerformIO $ do     k <- createVector (dim s)     r <- createVector (dim v)

@@ -13,6 +13,9 @@ {-# LANGUAGE TypeFamilies  #-} {-# LANGUAGE TypeOperators #-} +{-# OPTIONS_GHC -fno-warn-missing-signatures #-}+{-# OPTIONS_GHC -fno-warn-missing-methods #-}+ {- | Module      :  Internal.Modular Copyright   :  (c) Alberto Ruiz 2015

@@ -5,6 +5,8 @@ {-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE UndecidableInstances #-} +{-# OPTIONS_GHC -fno-warn-missing-signatures #-}+ ----------------------------------------------------------------------------- -- | -- Module      :  Data.Packed.Internal.Numeric@@ -788,13 +790,7 @@ type instance RealOf I = I type instance RealOf Z = Z -type family ComplexOf x--type instance ComplexOf Double = Complex Double-type instance ComplexOf (Complex Double) = Complex Double--type instance ComplexOf Float = Complex Float-type instance ComplexOf (Complex Float) = Complex Float+type ComplexOf x = Complex (RealOf x)  type family SingleOf x 

@@ -81,6 +81,8 @@ unsafeFreezeVector (STVector x) = unsafeIOToST . return $ x  {-# INLINE safeIndexV #-}+safeIndexV :: Storable t2+           => (STVector s t2 -> Int -> t) -> STVector t1 t2 -> Int -> t safeIndexV f (STVector v) k     | k < 0 || k>= dim v = error $ "out of range error in vector (dim="                                    ++show (dim v)++", pos="++show k++")"@@ -150,9 +152,12 @@ freezeMatrix :: (Element t) => STMatrix s t -> ST s (Matrix t) freezeMatrix m = liftSTMatrix id m +cloneMatrix :: Element t => Matrix t -> IO (Matrix t) cloneMatrix m = copy (orderOf m) m  {-# INLINE safeIndexM #-}+safeIndexM :: (STMatrix s t2 -> Int -> Int -> t)+           -> STMatrix t1 t2 -> Int -> Int -> t safeIndexM f (STMatrix m) r c     | r<0 || r>=rows m ||       c<0 || c>=cols m = error $ "out of range error in matrix (size="@@ -184,6 +189,7 @@               | Col Int               | FromCol Int +getColRange :: Int -> ColRange -> (Int, Int) getColRange c AllCols = (0,c-1) getColRange c (ColRange a b) = (a `mod` c, b `mod` c) getColRange c (Col a) = (a `mod` c, a `mod` c)@@ -194,6 +200,7 @@               | Row Int               | FromRow Int +getRowRange :: Int -> RowRange -> (Int, Int) getRowRange r AllRows = (0,r-1) getRowRange r (RowRange a b) = (a `mod` r, b `mod` r) getRowRange r (Row a) = (a `mod` r, a `mod` r)@@ -223,6 +230,7 @@     i2' = i2 `mod` (rows m)  +extractMatrix :: Element a => STMatrix t a -> RowRange -> ColRange -> ST s (Matrix a) extractMatrix (STMatrix m) rr rc = unsafeIOToST (extractR (orderOf m) m 0 (idxs[i1,i2]) 0 (idxs[j1,j2]))   where     (i1,i2) = getRowRange (rows m) rr@@ -231,6 +239,7 @@ -- | r0 c0 height width data Slice s t = Slice (STMatrix s t) Int Int Int Int +slice :: Element a => Slice t a -> Matrix a slice (Slice (STMatrix m) r0 c0 nr nc) = subMatrix (r0,c0) (nr,nc) m  gemmm :: Element t => t -> Slice s t -> t -> Slice s t -> Slice s t -> ST s ()@@ -238,12 +247,11 @@   where     res = unsafeIOToST (gemm v a b r)     v = fromList [alpha,beta]-     + mutable :: Element t => (forall s . (Int, Int) -> STMatrix s t -> ST s u) -> Matrix t -> (Matrix t,u) mutable f a = runST $ do    x <- thawMatrix a    info <- f (rows a, cols a) x    r <- unsafeFreezeMatrix x    return (r,info)-

@@ -2,6 +2,8 @@ {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FlexibleInstances #-} +{-# OPTIONS_GHC -fno-warn-missing-signatures #-}+ module Internal.Sparse(     GMatrix(..), CSR(..), mkCSR, fromCSR,     mkSparse, mkDiagR, mkDense,

@@ -15,6 +15,9 @@ {-# LANGUAGE BangPatterns #-} {-# LANGUAGE DeriveGeneric #-} +{-# OPTIONS_GHC -fno-warn-missing-signatures #-}+{-# OPTIONS_GHC -fno-warn-simplifiable-class-constraints #-}+ {- | Module      :  Internal.Static Copyright   :  (c) Alberto Ruiz 2006-14

@@ -6,6 +6,8 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE ViewPatterns #-} +{-# OPTIONS_GHC -fno-warn-missing-signatures #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}  ----------------------------------------------------------------------------- {- |

@@ -1,6 +1,7 @@ {-# LANGUAGE MagicHash, UnboxedTuples, BangPatterns, FlexibleContexts #-} {-# LANGUAGE TypeSynonymInstances #-} +{-# OPTIONS_GHC -fno-warn-orphans #-}  -- | -- Module      :  Internal.Vector@@ -40,6 +41,7 @@ import Data.Vector.Storable(Vector, fromList, unsafeToForeignPtr, unsafeFromForeignPtr, unsafeWith)  import Data.Binary+import Data.Binary.Put import Control.Monad(replicateM) import qualified Data.ByteString.Internal as BS import Data.Vector.Storable.Internal(updPtr)@@ -92,6 +94,7 @@  -} +safeRead :: Storable a => Vector a -> (Ptr a -> IO c) -> c safeRead v = inlinePerformIO . unsafeWith v {-# INLINE safeRead #-} @@ -283,11 +286,13 @@         go (dim v -1) x {-# INLINE foldVectorWithIndex #-} +foldLoop :: (Int -> t -> t) -> t -> Int -> t foldLoop f s0 d = go (d - 1) s0      where        go 0 s = f (0::Int) s        go !j !s = go (j - 1) (f j s) +foldVectorG :: Storable t1 => (Int -> (Int -> t1) -> t -> t) -> t -> Vector t1 -> t foldVectorG f s0 v = foldLoop g s0 (dim v)     where g !k !s = f k (safeRead v . flip peekElemOff) s           {-# INLINE g #-} -- Thanks to Ryan Ingram (http://permalink.gmane.org/gmane.comp.lang.haskell.cafe/46479)@@ -390,8 +395,10 @@                m = d `mod` chunk            in if m /= 0 then reverse (m:(replicate c chunk)) else (replicate c chunk) +putVector :: (Storable t, Binary t) => Vector t -> Data.Binary.Put.PutM () putVector v = mapM_ put $! toList v +getVector :: (Storable a, Binary a) => Int -> Get (Vector a) getVector d = do               xs <- replicateM d get               return $! fromList xs

@@ -28,12 +28,15 @@ import Control.Monad(when)  infixr 1 #+(#) :: TransArray c => c -> (b -> IO r) -> TransRaw c b -> IO r a # b = applyRaw a b {-# INLINE (#) #-} +(#!) :: (TransArray c, TransArray c1) => c1 -> c -> TransRaw c1 (TransRaw c (IO r)) -> IO r a #! b = a # b # id {-# INLINE (#!) #-} +fromei :: Enum a => a -> CInt fromei x = fromIntegral (fromEnum x) :: CInt  data FunCodeV = Sin@@ -100,10 +103,20 @@ sumC :: Vector (Complex Double) -> Complex Double sumC = sumg c_sumC +sumI :: ( TransRaw c (CInt -> Ptr a -> IO CInt) ~ (CInt -> Ptr I -> I :> Ok)+        , TransArray c+        , Storable a+        )+     => I -> c -> a sumI m = sumg (c_sumI m) +sumL :: ( TransRaw c (CInt -> Ptr a -> IO CInt) ~ (CInt -> Ptr Z -> Z :> Ok)+        , TransArray c+        , Storable a+        ) => Z -> c -> a sumL m = sumg (c_sumL m) +sumg :: (TransArray c, Storable a) => TransRaw c (CInt -> Ptr a -> IO CInt) -> c -> a sumg f x = unsafePerformIO $ do     r <- createVector 1     (x #! r) f #| "sum"@@ -140,6 +153,8 @@ prodL :: Z-> Vector Z -> Z prodL = prodg . c_prodL +prodg :: (TransArray c, Storable a)+      => TransRaw c (CInt -> Ptr a -> IO CInt) -> c -> a prodg f x = unsafePerformIO $ do     r <- createVector 1     (x #! r) f #| "prod"@@ -155,16 +170,25 @@  ------------------------------------------------------------------ +toScalarAux :: (Enum a, TransArray c, Storable a1)+            => (CInt -> TransRaw c (CInt -> Ptr a1 -> IO CInt)) -> a -> c -> a1 toScalarAux fun code v = unsafePerformIO $ do     r <- createVector 1     (v #! r) (fun (fromei code)) #|"toScalarAux"     return (r @> 0) ++vectorMapAux :: (Enum a, Storable t, Storable a1)+             => (CInt -> CInt -> Ptr t -> CInt -> Ptr a1 -> IO CInt)+             -> a -> Vector t -> Vector a1 vectorMapAux fun code v = unsafePerformIO $ do     r <- createVector (dim v)     (v #! r) (fun (fromei code)) #|"vectorMapAux"     return r +vectorMapValAux :: (Enum a, Storable a2, Storable t, Storable a1)+                => (CInt -> Ptr a2 -> CInt -> Ptr t -> CInt -> Ptr a1 -> IO CInt)+                -> a -> a2 -> Vector t -> Vector a1 vectorMapValAux fun code val v = unsafePerformIO $ do     r <- createVector (dim v)     pval <- newArray [val]@@ -172,6 +196,9 @@     free pval     return r +vectorZipAux :: (Enum a, TransArray c, Storable t, Storable a1)+             => (CInt -> CInt -> Ptr t -> TransRaw c (CInt -> Ptr a1 -> IO CInt))+             -> a -> Vector t -> c -> Vector a1 vectorZipAux fun code u v = unsafePerformIO $ do     r <- createVector (dim u)     (u # v #! r) (fun (fromei code)) #|"vectorZipAux"@@ -378,6 +405,7 @@  -------------------------------------------------------------------------------- +roundVector :: Vector Double -> Vector Double roundVector v = unsafePerformIO $ do     r <- createVector (dim v)     (v #! r) c_round_vector #|"roundVector"@@ -432,6 +460,8 @@ long2intV = tog c_long2int  +tog :: (Storable t, Storable a)+    => (CInt -> Ptr t -> CInt -> Ptr a -> IO CInt) -> Vector t -> Vector a tog f v = unsafePerformIO $ do     r <- createVector (dim v)     (v #! r) f #|"tog"@@ -451,6 +481,8 @@  --------------------------------------------------------------- +stepg :: (Storable t, Storable a)+      => (CInt -> Ptr t -> CInt -> Ptr a -> IO CInt) -> Vector t -> Vector a stepg f v = unsafePerformIO $ do     r <- createVector (dim v)     (v #! r) f #|"step"@@ -476,6 +508,8 @@  -------------------------------------------------------------------------------- +conjugateAux :: (Storable t, Storable a)+             => (CInt -> Ptr t -> CInt -> Ptr a -> IO CInt) -> Vector t -> Vector a conjugateAux fun x = unsafePerformIO $ do     v <- createVector (dim x)     (x #! v) fun #|"conjugateAux"@@ -501,6 +535,8 @@  -------------------------------------------------------------------------------- +constantAux :: (Storable a1, Storable a)+            => (Ptr a1 -> CInt -> Ptr a -> IO CInt) -> a1 -> Int -> Vector a constantAux fun x n = unsafePerformIO $ do     v <- createVector n     px <- newArray [x]

@@ -1,6 +1,8 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} +{-# OPTIONS_GHC -fno-warn-missing-signatures #-}+ ----------------------------------------------------------------------------- {- | Module      :  Numeric.LinearAlgebra

@@ -28,7 +28,9 @@ (<·>) :: Numeric t => Vector t -> Vector t -> t (<·>) = dot +app :: Numeric t => Matrix t -> Vector t -> Vector t app m v = m #> v +mul :: Numeric t => Matrix t -> Matrix t -> Matrix t mul a b = a <> b 

@@ -14,6 +14,8 @@ {-# LANGUAGE GADTs #-} {-# LANGUAGE TypeFamilies #-} +{-# OPTIONS_GHC -fno-warn-missing-signatures #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}  {- | Module      :  Numeric.LinearAlgebra.Static

@@ -4,6 +4,8 @@ {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} +{-# OPTIONS_GHC -fno-warn-orphans #-}+ ----------------------------------------------------------------------------- -- | -- Module      :  Numeric.Matrix@@ -35,6 +37,7 @@ import qualified Data.Foldable as F import qualified Data.Semigroup as S import Internal.Chain+import Foreign.Storable(Storable)   -------------------------------------------------------------------@@ -80,8 +83,16 @@  -------------------------------------------------------------------------------- +isScalar :: Matrix t -> Bool isScalar m = rows m == 1 && cols m == 1 +adaptScalarM :: (Foreign.Storable.Storable t1, Foreign.Storable.Storable t2)+             => (t1 -> Matrix t2 -> t)+             -> (Matrix t1 -> Matrix t2 -> t)+             -> (Matrix t1 -> t2 -> t)+             -> Matrix t1+             -> Matrix t2+             -> t adaptScalarM f1 f2 f3 x y     | isScalar x = f1   (x @@>(0,0) ) y     | isScalar y = f3 x (y @@>(0,0) )@@ -96,7 +107,7 @@   where     mempty = 1     mappend = adaptScalarM scale mXm (flip scale)-    +     mconcat xs = work (partition isScalar xs)       where         work (ss,[]) = product ss@@ -106,4 +117,3 @@             | otherwise              = scale x00 m           where             x00 = x @@> (0,0)-

@@ -3,6 +3,9 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE MultiParamTypeClasses #-}++{-# OPTIONS_GHC -fno-warn-orphans #-}+ ----------------------------------------------------------------------------- -- | -- Module      :  Numeric.Vector@@ -14,7 +17,7 @@ -- -- Provides instances of standard classes 'Show', 'Read', 'Eq', -- 'Num', 'Fractional',  and 'Floating' for 'Vector'.--- +-- -----------------------------------------------------------------------------  module Numeric.Vector () where@@ -23,9 +26,17 @@ import Internal.Vector import Internal.Numeric import Internal.Conversion+import Foreign.Storable(Storable)  ------------------------------------------------------------------- +adaptScalar :: (Foreign.Storable.Storable t1, Foreign.Storable.Storable t2)+            => (t1 -> Vector t2 -> t)+            -> (Vector t1 -> Vector t2 -> t)+            -> (Vector t1 -> t2 -> t)+            -> Vector t1+            -> Vector t2+            -> t adaptScalar f1 f2 f3 x y     | dim x == 1 = f1   (x@>0) y     | dim y == 1 = f3 x (y@>0)@@ -172,4 +183,3 @@     sqrt  = vectorMapQ Sqrt     (**)  = adaptScalar (vectorMapValQ PowSV) (vectorZipQ Pow) (flip (vectorMapValQ PowVS))     pi    = fromList [pi]-