From 27c1c4c1b4acd6ccfb53cfef5687bfda1b99d81c Mon Sep 17 00:00:00 2001 From: Alberto Ruiz Date: Wed, 15 Apr 2015 19:53:15 +0200 Subject: remove Util --- packages/base/hmatrix.cabal | 15 +- packages/base/src/Numeric/LinearAlgebra.hs | 231 ++++++++++++++++++++- packages/base/src/Numeric/LinearAlgebra/HMatrix.hs | 228 +------------------- .../base/src/Numeric/LinearAlgebra/HMatrix/Util.hs | 29 --- packages/base/src/Numeric/LinearAlgebra/Static.hs | 4 +- .../src/Numeric/LinearAlgebra/Static/Internal.hs | 4 +- packages/base/src/Numeric/LinearAlgebra/Util.hs | 48 +---- packages/tests/src/Numeric/LinearAlgebra/Tests.hs | 21 +- .../src/Numeric/LinearAlgebra/Tests/Properties.hs | 2 +- 9 files changed, 236 insertions(+), 346 deletions(-) delete mode 100644 packages/base/src/Numeric/LinearAlgebra/HMatrix/Util.hs (limited to 'packages') diff --git a/packages/base/hmatrix.cabal b/packages/base/hmatrix.cabal index 01699f2..7bfc762 100644 --- a/packages/base/hmatrix.cabal +++ b/packages/base/hmatrix.cabal @@ -8,16 +8,6 @@ Stability: provisional Homepage: https://github.com/albertoruiz/hmatrix Synopsis: Numeric Linear Algebra Description: Linear algebra based on BLAS and LAPACK. - . - The package is organized as follows: - . - ["Numeric.LinearAlgebra.HMatrix"] Starting point and recommended import module for most applications. - . - ["Numeric.LinearAlgebra.Static"] Experimental alternative interface. - . - ["Numeric.LinearAlgebra.Devel"] Tools for extending the library. - . - (Other modules are exposed with hidden documentation for backwards compatibility.) . Code examples: @@ -51,11 +41,11 @@ library hs-source-dirs: src - exposed-modules: Numeric.LinearAlgebra.Devel + exposed-modules: Numeric.LinearAlgebra + Numeric.LinearAlgebra.Devel Numeric.LinearAlgebra.Data Numeric.LinearAlgebra.HMatrix Numeric.LinearAlgebra.Static - Numeric.LinearAlgebra.HMatrix.Util other-modules: Data.Packed, Data.Packed.Vector @@ -75,7 +65,6 @@ library Numeric.Matrix Data.Packed.Internal.Numeric Data.Packed.Numeric - Numeric.LinearAlgebra Numeric.LinearAlgebra.LAPACK Numeric.LinearAlgebra.Algorithms Numeric.Container diff --git a/packages/base/src/Numeric/LinearAlgebra.hs b/packages/base/src/Numeric/LinearAlgebra.hs index ad315e4..4ba0c98 100644 --- a/packages/base/src/Numeric/LinearAlgebra.hs +++ b/packages/base/src/Numeric/LinearAlgebra.hs @@ -1,22 +1,235 @@ --------------------------------------------------------------------------------- +----------------------------------------------------------------------------- {- | Module : Numeric.LinearAlgebra -Copyright : (c) Alberto Ruiz 2006-14 +Copyright : (c) Alberto Ruiz 2006-15 License : BSD3 Maintainer : Alberto Ruiz Stability : provisional -} --------------------------------------------------------------------------------- -{-# OPTIONS_HADDOCK hide #-} - +----------------------------------------------------------------------------- module Numeric.LinearAlgebra ( - module Numeric.Container, - module Numeric.LinearAlgebra.Algorithms + + -- * Basic types and data processing + module Numeric.LinearAlgebra.Data, + + -- * Arithmetic and numeric classes + -- | + -- The standard numeric classes are defined elementwise: + -- + -- >>> vector [1,2,3] * vector [3,0,-2] + -- fromList [3.0,0.0,-6.0] + -- + -- >>> matrix 3 [1..9] * ident 3 + -- (3><3) + -- [ 1.0, 0.0, 0.0 + -- , 0.0, 5.0, 0.0 + -- , 0.0, 0.0, 9.0 ] + -- + -- In arithmetic operations single-element vectors and matrices + -- (created from numeric literals or using 'scalar') automatically + -- expand to match the dimensions of the other operand: + -- + -- >>> 5 + 2*ident 3 :: Matrix Double + -- (3><3) + -- [ 7.0, 5.0, 5.0 + -- , 5.0, 7.0, 5.0 + -- , 5.0, 5.0, 7.0 ] + -- + -- >>> matrix 3 [1..9] + matrix 1 [10,20,30] + -- (3><3) + -- [ 11.0, 12.0, 13.0 + -- , 24.0, 25.0, 26.0 + -- , 37.0, 38.0, 39.0 ] + -- + + -- * Products + -- ** dot + dot, (<·>), + -- ** matrix-vector + app, (#>), (<#), (!#>), + -- ** matrix-matrix + mul, (<>), + -- | The matrix product is also implemented in the "Data.Monoid" instance, where + -- single-element matrices (created from numeric literals or using 'scalar') + -- are used for scaling. + -- + -- >>> import Data.Monoid as M + -- >>> let m = matrix 3 [1..6] + -- >>> m M.<> 2 M.<> diagl[0.5,1,0] + -- (2><3) + -- [ 1.0, 4.0, 0.0 + -- , 4.0, 10.0, 0.0 ] + -- + -- 'mconcat' uses 'optimiseMult' to get the optimal association order. + + + -- ** other + outer, kronecker, cross, + scale, + sumElements, prodElements, + + -- * Linear Systems + (<\>), + linearSolve, + linearSolveLS, + linearSolveSVD, + luSolve, + cholSolve, + cgSolve, + cgSolve', + + -- * Inverse and pseudoinverse + inv, pinv, pinvTol, + + -- * Determinant and rank + rcond, rank, + det, invlndet, + + -- * Norms + Normed(..), + norm_Frob, norm_nuclear, + + -- * Nullspace and range + orth, + nullspace, null1, null1sym, + + -- * SVD + svd, + thinSVD, + compactSVD, + singularValues, + leftSV, rightSV, + + -- * Eigensystems + eig, eigSH, eigSH', + eigenvalues, eigenvaluesSH, eigenvaluesSH', + geigSH', + + -- * QR + qr, rq, qrRaw, qrgr, + + -- * Cholesky + chol, cholSH, mbCholSH, + + -- * Hessenberg + hess, + + -- * Schur + schur, + + -- * LU + lu, luPacked, + + -- * Matrix functions + expm, + sqrtm, + matFunc, + + -- * Correlation and convolution + corr, conv, corrMin, corr2, conv2, + + -- * Random arrays + + Seed, RandDist(..), randomVector, rand, randn, gaussianSample, uniformSample, + + -- * Misc + meanCov, rowOuters, pairwiseD2, unitary, peps, relativeError, haussholder, optimiseMult, udot, nullspaceSVD, orthSVD, ranksv, + ℝ,ℂ,iC, + -- * Auxiliary classes + Element, Container, Product, Numeric, LSDiv, + Complexable, RealElement, + RealOf, ComplexOf, SingleOf, DoubleOf, + IndexOf, + Field, +-- Normed, + Transposable, + CGState(..), + Testable(..) ) where -import Numeric.Container -import Numeric.LinearAlgebra.Algorithms +import Numeric.LinearAlgebra.Data + import Numeric.Matrix() import Numeric.Vector() +import Data.Packed.Numeric hiding ((<>), mul) +import Numeric.LinearAlgebra.Algorithms hiding (linearSolve,Normed,orth) +import qualified Numeric.LinearAlgebra.Algorithms as A +import Numeric.LinearAlgebra.Util +import Numeric.LinearAlgebra.Random +import Numeric.Sparse((!#>)) +import Numeric.LinearAlgebra.Util.CG + +{- | infix synonym of 'mul' + +>>> let a = (3><5) [1..] +>>> a +(3><5) + [ 1.0, 2.0, 3.0, 4.0, 5.0 + , 6.0, 7.0, 8.0, 9.0, 10.0 + , 11.0, 12.0, 13.0, 14.0, 15.0 ] + +>>> let b = (5><2) [1,3, 0,2, -1,5, 7,7, 6,0] +>>> b +(5><2) + [ 1.0, 3.0 + , 0.0, 2.0 + , -1.0, 5.0 + , 7.0, 7.0 + , 6.0, 0.0 ] + +>>> a <> b +(3><2) + [ 56.0, 50.0 + , 121.0, 135.0 + , 186.0, 220.0 ] + +-} +(<>) :: Numeric t => Matrix t -> Matrix t -> Matrix t +(<>) = mXm +infixr 8 <> + +-- | dense matrix product +mul :: Numeric t => Matrix t -> Matrix t -> Matrix t +mul = mXm + + +{- | Solve a linear system (for square coefficient matrix and several right-hand sides) using the LU decomposition, returning Nothing for a singular system. For underconstrained or overconstrained systems use 'linearSolveLS' or 'linearSolveSVD'. + +@ +a = (2><2) + [ 1.0, 2.0 + , 3.0, 5.0 ] +@ + +@ +b = (2><3) + [ 6.0, 1.0, 10.0 + , 15.0, 3.0, 26.0 ] +@ + +>>> linearSolve a b +Just (2><3) + [ -1.4802973661668753e-15, 0.9999999999999997, 1.999999999999997 + , 3.000000000000001, 1.6653345369377348e-16, 4.000000000000002 ] + +>>> let Just x = it +>>> disp 5 x +2x3 +-0.00000 1.00000 2.00000 + 3.00000 0.00000 4.00000 + +>>> a <> x +(2><3) + [ 6.0, 1.0, 10.0 + , 15.0, 3.0, 26.0 ] + +-} +linearSolve m b = A.mbLinearSolve m b + +-- | return an orthonormal basis of the null space of a matrix. See also 'nullspaceSVD'. +nullspace m = nullspaceSVD (Left (1*eps)) m (rightSV m) + +-- | return an orthonormal basis of the range space of a matrix. See also 'orthSVD'. +orth m = orthSVD (Left (1*eps)) m (leftSV m) diff --git a/packages/base/src/Numeric/LinearAlgebra/HMatrix.hs b/packages/base/src/Numeric/LinearAlgebra/HMatrix.hs index a640351..8e67eb4 100644 --- a/packages/base/src/Numeric/LinearAlgebra/HMatrix.hs +++ b/packages/base/src/Numeric/LinearAlgebra/HMatrix.hs @@ -1,4 +1,4 @@ ------------------------------------------------------------------------------ +-------------------------------------------------------------------------------- {- | Module : Numeric.LinearAlgebra.HMatrix Copyright : (c) Alberto Ruiz 2006-14 @@ -7,229 +7,11 @@ Maintainer : Alberto Ruiz Stability : provisional -} ------------------------------------------------------------------------------ -module Numeric.LinearAlgebra.HMatrix ( - - -- * Basic types and data processing - module Numeric.LinearAlgebra.Data, - - -- * Arithmetic and numeric classes - -- | - -- The standard numeric classes are defined elementwise: - -- - -- >>> vector [1,2,3] * vector [3,0,-2] - -- fromList [3.0,0.0,-6.0] - -- - -- >>> matrix 3 [1..9] * ident 3 - -- (3><3) - -- [ 1.0, 0.0, 0.0 - -- , 0.0, 5.0, 0.0 - -- , 0.0, 0.0, 9.0 ] - -- - -- In arithmetic operations single-element vectors and matrices - -- (created from numeric literals or using 'scalar') automatically - -- expand to match the dimensions of the other operand: - -- - -- >>> 5 + 2*ident 3 :: Matrix Double - -- (3><3) - -- [ 7.0, 5.0, 5.0 - -- , 5.0, 7.0, 5.0 - -- , 5.0, 5.0, 7.0 ] - -- - -- >>> matrix 3 [1..9] + matrix 1 [10,20,30] - -- (3><3) - -- [ 11.0, 12.0, 13.0 - -- , 24.0, 25.0, 26.0 - -- , 37.0, 38.0, 39.0 ] - -- - - -- * Products - -- ** dot - dot, (<·>), - -- ** matrix-vector - app, (#>), (<#), (!#>), - -- ** matrix-matrix - mul, (<>), - -- | The matrix product is also implemented in the "Data.Monoid" instance, where - -- single-element matrices (created from numeric literals or using 'scalar') - -- are used for scaling. - -- - -- >>> import Data.Monoid as M - -- >>> let m = matrix 3 [1..6] - -- >>> m M.<> 2 M.<> diagl[0.5,1,0] - -- (2><3) - -- [ 1.0, 4.0, 0.0 - -- , 4.0, 10.0, 0.0 ] - -- - -- 'mconcat' uses 'optimiseMult' to get the optimal association order. - - - -- ** other - outer, kronecker, cross, - scale, - sumElements, prodElements, - - -- * Linear Systems - (<\>), - linearSolve, - linearSolveLS, - linearSolveSVD, - luSolve, - cholSolve, - cgSolve, - cgSolve', - - -- * Inverse and pseudoinverse - inv, pinv, pinvTol, - - -- * Determinant and rank - rcond, rank, - det, invlndet, - - -- * Norms - Normed(..), - norm_Frob, norm_nuclear, - - -- * Nullspace and range - orth, - nullspace, null1, null1sym, - - -- * SVD - svd, - thinSVD, - compactSVD, - singularValues, - leftSV, rightSV, - - -- * Eigensystems - eig, eigSH, eigSH', - eigenvalues, eigenvaluesSH, eigenvaluesSH', - geigSH', - - -- * QR - qr, rq, qrRaw, qrgr, - - -- * Cholesky - chol, cholSH, mbCholSH, - - -- * Hessenberg - hess, - - -- * Schur - schur, - - -- * LU - lu, luPacked, - - -- * Matrix functions - expm, - sqrtm, - matFunc, - - -- * Correlation and convolution - corr, conv, corrMin, corr2, conv2, - - -- * Random arrays +-------------------------------------------------------------------------------- - Seed, RandDist(..), randomVector, rand, randn, gaussianSample, uniformSample, - - -- * Misc - meanCov, rowOuters, peps, relativeError, haussholder, optimiseMult, udot, nullspaceSVD, orthSVD, ranksv, - ℝ,ℂ,iC, - -- * Auxiliary classes - Element, Container, Product, Numeric, LSDiv, - Complexable, RealElement, - RealOf, ComplexOf, SingleOf, DoubleOf, - IndexOf, - Field, --- Normed, - Transposable, - CGState(..), - Testable(..) +module Numeric.LinearAlgebra.HMatrix ( + module Numeric.LinearAlgebra ) where -import Numeric.LinearAlgebra.Data - -import Numeric.Matrix() -import Numeric.Vector() -import Data.Packed.Numeric hiding ((<>), mul) -import Numeric.LinearAlgebra.Algorithms hiding (linearSolve,Normed,orth) -import qualified Numeric.LinearAlgebra.Algorithms as A -import Numeric.LinearAlgebra.Util -import Numeric.LinearAlgebra.Random -import Numeric.Sparse((!#>)) -import Numeric.LinearAlgebra.Util.CG - -{- | infix synonym of 'mul' - ->>> let a = (3><5) [1..] ->>> a -(3><5) - [ 1.0, 2.0, 3.0, 4.0, 5.0 - , 6.0, 7.0, 8.0, 9.0, 10.0 - , 11.0, 12.0, 13.0, 14.0, 15.0 ] - ->>> let b = (5><2) [1,3, 0,2, -1,5, 7,7, 6,0] ->>> b -(5><2) - [ 1.0, 3.0 - , 0.0, 2.0 - , -1.0, 5.0 - , 7.0, 7.0 - , 6.0, 0.0 ] - ->>> a <> b -(3><2) - [ 56.0, 50.0 - , 121.0, 135.0 - , 186.0, 220.0 ] - --} -(<>) :: Numeric t => Matrix t -> Matrix t -> Matrix t -(<>) = mXm -infixr 8 <> - --- | dense matrix product -mul :: Numeric t => Matrix t -> Matrix t -> Matrix t -mul = mXm - - -{- | Solve a linear system (for square coefficient matrix and several right-hand sides) using the LU decomposition, returning Nothing for a singular system. For underconstrained or overconstrained systems use 'linearSolveLS' or 'linearSolveSVD'. - -@ -a = (2><2) - [ 1.0, 2.0 - , 3.0, 5.0 ] -@ - -@ -b = (2><3) - [ 6.0, 1.0, 10.0 - , 15.0, 3.0, 26.0 ] -@ - ->>> linearSolve a b -Just (2><3) - [ -1.4802973661668753e-15, 0.9999999999999997, 1.999999999999997 - , 3.000000000000001, 1.6653345369377348e-16, 4.000000000000002 ] - ->>> let Just x = it ->>> disp 5 x -2x3 --0.00000 1.00000 2.00000 - 3.00000 0.00000 4.00000 - ->>> a <> x -(2><3) - [ 6.0, 1.0, 10.0 - , 15.0, 3.0, 26.0 ] - --} -linearSolve m b = A.mbLinearSolve m b - --- | return an orthonormal basis of the null space of a matrix. See also 'nullspaceSVD'. -nullspace m = nullspaceSVD (Left (1*eps)) m (rightSV m) - --- | return an orthonormal basis of the range space of a matrix. See also 'orthSVD'. -orth m = orthSVD (Left (1*eps)) m (leftSV m) +import Numeric.LinearAlgebra diff --git a/packages/base/src/Numeric/LinearAlgebra/HMatrix/Util.hs b/packages/base/src/Numeric/LinearAlgebra/HMatrix/Util.hs deleted file mode 100644 index 818b226..0000000 --- a/packages/base/src/Numeric/LinearAlgebra/HMatrix/Util.hs +++ /dev/null @@ -1,29 +0,0 @@ ------------------------------------------------------------------------------ -{- | -Module : Numeric.LinearAlgebra.HMatrix.Util -Copyright : (c) Alberto Ruiz 2015 -License : BSD3 -Maintainer : Alberto Ruiz -Stability : provisional - --} ------------------------------------------------------------------------------ - -module Numeric.LinearAlgebra.HMatrix.Util( - unitary, - pairwiseD2, - -- * Tools for the Kronecker product - -- - -- | (see A. Fusiello, A matter of notation: Several uses of the Kronecker product in - -- 3d computer vision, Pattern Recognition Letters 28 (15) (2007) 2127-2132) - - -- - -- | @`vec` (a \<> x \<> b) == ('trans' b ` 'kronecker' ` a) \<> 'vec' x@ - vec, - vech, - dup, - vtrans -) where - -import Numeric.LinearAlgebra.Util - diff --git a/packages/base/src/Numeric/LinearAlgebra/Static.hs b/packages/base/src/Numeric/LinearAlgebra/Static.hs index 4c3186f..25b10b4 100644 --- a/packages/base/src/Numeric/LinearAlgebra/Static.hs +++ b/packages/base/src/Numeric/LinearAlgebra/Static.hs @@ -60,13 +60,13 @@ module Numeric.LinearAlgebra.Static( import GHC.TypeLits -import Numeric.LinearAlgebra.HMatrix hiding ( +import Numeric.LinearAlgebra hiding ( (<>),(#>),(<·>),Konst(..),diag, disp,(¦),(——), row,col,vector,matrix,linspace,toRows,toColumns, (<\>),fromList,takeDiag,svd,eig,eigSH,eigSH', eigenvalues,eigenvaluesSH,eigenvaluesSH',build, qr,size,app,mul,dot,chol) -import qualified Numeric.LinearAlgebra.HMatrix as LA +import qualified Numeric.LinearAlgebra as LA import Data.Proxy(Proxy) import Numeric.LinearAlgebra.Static.Internal import Control.Arrow((***)) diff --git a/packages/base/src/Numeric/LinearAlgebra/Static/Internal.hs b/packages/base/src/Numeric/LinearAlgebra/Static/Internal.hs index ec02cf6..a5fc29b 100644 --- a/packages/base/src/Numeric/LinearAlgebra/Static/Internal.hs +++ b/packages/base/src/Numeric/LinearAlgebra/Static/Internal.hs @@ -24,8 +24,8 @@ module Numeric.LinearAlgebra.Static.Internal where import GHC.TypeLits -import qualified Numeric.LinearAlgebra.HMatrix as LA -import Numeric.LinearAlgebra.HMatrix hiding (konst,size) +import qualified Numeric.LinearAlgebra as LA +import Numeric.LinearAlgebra hiding (konst,size) import Data.Packed as D import Data.Packed.ST import Data.Proxy(Proxy) diff --git a/packages/base/src/Numeric/LinearAlgebra/Util.hs b/packages/base/src/Numeric/LinearAlgebra/Util.hs index 89202d3..370ca27 100644 --- a/packages/base/src/Numeric/LinearAlgebra/Util.hs +++ b/packages/base/src/Numeric/LinearAlgebra/Util.hs @@ -16,7 +16,6 @@ Stability : provisional -} ----------------------------------------------------------------------------- -{-# OPTIONS_HADDOCK hide #-} module Numeric.LinearAlgebra.Util( @@ -53,18 +52,7 @@ module Numeric.LinearAlgebra.Util( -- ** 1D corr, conv, corrMin, -- ** 2D - corr2, conv2, separable, - -- * Tools for the Kronecker product - -- - -- | (see A. Fusiello, A matter of notation: Several uses of the Kronecker product in - -- 3d computer vision, Pattern Recognition Letters 28 (15) (2007) 2127-2132) - - -- - -- | @`vec` (a \<> x \<> b) == ('trans' b ` 'kronecker' ` a) \<> 'vec' x@ - vec, - vech, - dup, - vtrans + corr2, conv2, separable ) where import Data.Packed.Numeric @@ -407,40 +395,6 @@ null1sym = last . toColumns . snd . eigSH' -------------------------------------------------------------------------------- -vec :: Element t => Matrix t -> Vector t --- ^ stacking of columns -vec = flatten . trans - - -vech :: Element t => Matrix t -> Vector t --- ^ half-vectorization (of the lower triangular part) -vech m = vjoin . zipWith f [0..] . toColumns $ m - where - f k v = subVector k (dim v - k) v - - -dup :: (Num t, Num (Vector t), Element t) => Int -> Matrix t --- ^ duplication matrix (@'dup' k \<> 'vech' m == 'vec' m@, for symmetric m of 'dim' k) -dup k = trans $ fromRows $ map f es - where - rs = zip [0..] (toRows (ident (k^(2::Int)))) - es = [(i,j) | j <- [0..k-1], i <- [0..k-1], i>=j ] - f (i,j) | i == j = g (k*j + i) - | otherwise = g (k*j + i) + g (k*i + j) - g j = v - where - Just v = lookup j rs - - -vtrans :: Element t => Int -> Matrix t -> Matrix t --- ^ generalized \"vector\" transposition: @'vtrans' 1 == 'trans'@, and @'vtrans' ('rows' m) m == 'asColumn' ('vec' m)@ -vtrans p m | r == 0 = fromBlocks . map (map asColumn . takesV (replicate q p)) . toColumns $ m - | otherwise = error $ "vtrans " ++ show p ++ " of matrix with " ++ show (rows m) ++ " rows" - where - (q,r) = divMod (rows m) p - --------------------------------------------------------------------------------- - infixl 0 ~!~ c ~!~ msg = when c (error msg) diff --git a/packages/tests/src/Numeric/LinearAlgebra/Tests.hs b/packages/tests/src/Numeric/LinearAlgebra/Tests.hs index cf0f581..71c7c16 100644 --- a/packages/tests/src/Numeric/LinearAlgebra/Tests.hs +++ b/packages/tests/src/Numeric/LinearAlgebra/Tests.hs @@ -28,9 +28,8 @@ module Numeric.LinearAlgebra.Tests( --, runBigTests ) where -import Numeric.LinearAlgebra.HMatrix +import Numeric.LinearAlgebra hiding (unitary) import Numeric.LinearAlgebra.Devel hiding (vec) -import Numeric.LinearAlgebra.HMatrix.Util import Numeric.LinearAlgebra.Static(L) import Numeric.LinearAlgebra.Tests.Instances import Numeric.LinearAlgebra.Tests.Properties @@ -372,23 +371,6 @@ convolutionTest = utest "convolution" ok -------------------------------------------------------------------------------- -kroneckerTest = utest "kronecker" ok - where - a,x,b :: Matrix Double - a = (3><4) [1..] - x = (4><2) [3,5..] - b = (2><5) [0,5..] - v1 = vec (a <> x <> b) - v2 = (tr b `kronecker` a) #> vec x - s = tr b <> b - v3 = vec s - v4 = (dup 5 :: Matrix Double) #> vech s - ok = v1 == v2 && v3 == v4 - && vtrans 1 a == tr a - && vtrans (rows a) a == asColumn (vec a) - --------------------------------------------------------------------------------- - sparseTest = utest "sparse" (fst $ checkT (undefined :: GMatrix)) -------------------------------------------------------------------------------- @@ -583,7 +565,6 @@ runTests n = do , conformTest , accumTest , convolutionTest - , kroneckerTest , sparseTest , staticTest ] diff --git a/packages/tests/src/Numeric/LinearAlgebra/Tests/Properties.hs b/packages/tests/src/Numeric/LinearAlgebra/Tests/Properties.hs index e2492dd..207a303 100644 --- a/packages/tests/src/Numeric/LinearAlgebra/Tests/Properties.hs +++ b/packages/tests/src/Numeric/LinearAlgebra/Tests/Properties.hs @@ -42,7 +42,7 @@ module Numeric.LinearAlgebra.Tests.Properties ( linearSolveProp, linearSolveProp2 ) where -import Numeric.LinearAlgebra.HMatrix hiding (Testable)--hiding (real,complex) +import Numeric.LinearAlgebra.HMatrix hiding (Testable,unitary) import Test.QuickCheck trivial :: Testable a => Bool -> a -> Property -- cgit v1.2.3