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/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 +---- 5 files changed, 10 insertions(+), 303 deletions(-) delete mode 100644 packages/base/src/Numeric/LinearAlgebra/HMatrix/Util.hs (limited to 'packages/base/src/Numeric/LinearAlgebra') 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) -- cgit v1.2.3