From e07c3dee7235496b71a89233106d93f6cc94ada1 Mon Sep 17 00:00:00 2001 From: Alberto Ruiz Date: Wed, 21 May 2014 09:57:03 +0200 Subject: Numeric.Container and Numeric.LinearAlgebra moved to base --- packages/base/src/Numeric/Container.hs | 239 +++++++++++++++++++++ packages/base/src/Numeric/LinearAlgebra.hs | 141 ++++++++++++ packages/base/src/Numeric/LinearAlgebra/Base.hs | 141 ------------ packages/base/src/Numeric/LinearAlgebra/Data.hs | 2 +- packages/base/src/Numeric/LinearAlgebra/Devel.hs | 2 +- packages/base/src/Numeric/LinearAlgebra/Random.hs | 2 +- packages/base/src/Numeric/LinearAlgebra/Util.hs | 2 +- .../src/Numeric/LinearAlgebra/Util/Convolution.hs | 2 +- 8 files changed, 385 insertions(+), 146 deletions(-) create mode 100644 packages/base/src/Numeric/Container.hs create mode 100644 packages/base/src/Numeric/LinearAlgebra.hs delete mode 100644 packages/base/src/Numeric/LinearAlgebra/Base.hs (limited to 'packages/base/src/Numeric') diff --git a/packages/base/src/Numeric/Container.hs b/packages/base/src/Numeric/Container.hs new file mode 100644 index 0000000..c715dac --- /dev/null +++ b/packages/base/src/Numeric/Container.hs @@ -0,0 +1,239 @@ +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE FunctionalDependencies #-} +{-# LANGUAGE UndecidableInstances #-} + +----------------------------------------------------------------------------- +-- | +-- Module : Numeric.Container +-- Copyright : (c) Alberto Ruiz 2010-14 +-- License : BSD3 +-- Maintainer : Alberto Ruiz +-- Stability : provisional +-- +-- Basic numeric operations on 'Vector' and 'Matrix', including conversion routines. +-- +-- The 'Container' class is used to define optimized generic functions which work +-- on 'Vector' and 'Matrix' with real or complex elements. +-- +-- Some of these functions are also available in the instances of the standard +-- numeric Haskell classes provided by "Numeric.LinearAlgebra". +-- +----------------------------------------------------------------------------- +{-# OPTIONS_HADDOCK hide #-} + +module Numeric.Container ( + -- * Basic functions + module Data.Packed, + konst, build, + linspace, + diag, ident, + ctrans, + -- * Generic operations + Container(..), + -- * Matrix product + Product(..), udot, dot, (◇), + Mul(..), + Contraction(..), + optimiseMult, + mXm,mXv,vXm,LSDiv(..), + outer, kronecker, + -- * Element conversion + Convert(..), + Complexable(), + RealElement(), + + RealOf, ComplexOf, SingleOf, DoubleOf, + + IndexOf, + module Data.Complex, + -- * IO + module Data.Packed.IO +) where + +import Data.Packed hiding (stepD, stepF, condD, condF, conjugateC, conjugateQ) +import Data.Packed.Internal.Numeric +import Data.Complex +import Numeric.LinearAlgebra.Algorithms(Field,linearSolveSVD) +import Data.Monoid(Monoid(mconcat)) +import Data.Packed.IO + +------------------------------------------------------------------ + +{- | Creates a real vector containing a range of values: + +>>> linspace 5 (-3,7::Double) +fromList [-3.0,-0.5,2.0,4.5,7.0]@ + +>>> linspace 5 (8,2+i) :: Vector (Complex Double) +fromList [8.0 :+ 0.0,6.5 :+ 0.25,5.0 :+ 0.5,3.5 :+ 0.75,2.0 :+ 1.0] + +Logarithmic spacing can be defined as follows: + +@logspace n (a,b) = 10 ** linspace n (a,b)@ +-} +linspace :: (Container Vector e) => Int -> (e, e) -> Vector e +linspace 0 (a,b) = fromList[(a+b)/2] +linspace n (a,b) = addConstant a $ scale s $ fromList $ map fromIntegral [0 .. n-1] + where s = (b-a)/fromIntegral (n-1) + +-------------------------------------------------------- + +class Contraction a b c | a b -> c + where + infixl 7 <.> + {- | Matrix product, matrix - vector product, and dot product + +Examples: + +>>> let a = (3><4) [1..] :: Matrix Double +>>> let v = fromList [1,0,2,-1] :: Vector Double +>>> let u = fromList [1,2,3] :: Vector Double + +>>> a +(3><4) + [ 1.0, 2.0, 3.0, 4.0 + , 5.0, 6.0, 7.0, 8.0 + , 9.0, 10.0, 11.0, 12.0 ] + +matrix × matrix: + +>>> disp 2 (a <.> trans a) +3x3 + 30 70 110 + 70 174 278 +110 278 446 + +matrix × vector: + +>>> a <.> v +fromList [3.0,11.0,19.0] + +dot product: + +>>> u <.> fromList[3,2,1::Double] +10 + +For complex vectors the first argument is conjugated: + +>>> fromList [1,i] <.> fromList[2*i+1,3] +1.0 :+ (-1.0) + +>>> fromList [1,i,1-i] <.> complex a +fromList [10.0 :+ 4.0,12.0 :+ 4.0,14.0 :+ 4.0,16.0 :+ 4.0] + +-} + (<.>) :: a -> b -> c + + +instance (Product t, Container Vector t) => Contraction (Vector t) (Vector t) t where + u <.> v = conj u `udot` v + +instance Product t => Contraction (Matrix t) (Vector t) (Vector t) where + (<.>) = mXv + +instance (Container Vector t, Product t) => Contraction (Vector t) (Matrix t) (Vector t) where + (<.>) v m = (conj v) `vXm` m + +instance Product t => Contraction (Matrix t) (Matrix t) (Matrix t) where + (<.>) = mXm + + +-------------------------------------------------------------------------------- + +class Mul a b c | a b -> c where + infixl 7 <> + -- | Matrix-matrix, matrix-vector, and vector-matrix products. + (<>) :: Product t => a t -> b t -> c t + +instance Mul Matrix Matrix Matrix where + (<>) = mXm + +instance Mul Matrix Vector Vector where + (<>) m v = flatten $ m <> asColumn v + +instance Mul Vector Matrix Vector where + (<>) v m = flatten $ asRow v <> m + +-------------------------------------------------------------------------------- + +class LSDiv c where + infixl 7 <\> + -- | least squares solution of a linear system, similar to the \\ operator of Matlab\/Octave (based on linearSolveSVD) + (<\>) :: Field t => Matrix t -> c t -> c t + +instance LSDiv Vector where + m <\> v = flatten (linearSolveSVD m (reshape 1 v)) + +instance LSDiv Matrix where + (<\>) = linearSolveSVD + +-------------------------------------------------------------------------------- + +class Konst e d c | d -> c, c -> d + where + -- | + -- >>> konst 7 3 :: Vector Float + -- fromList [7.0,7.0,7.0] + -- + -- >>> konst i (3::Int,4::Int) + -- (3><4) + -- [ 0.0 :+ 1.0, 0.0 :+ 1.0, 0.0 :+ 1.0, 0.0 :+ 1.0 + -- , 0.0 :+ 1.0, 0.0 :+ 1.0, 0.0 :+ 1.0, 0.0 :+ 1.0 + -- , 0.0 :+ 1.0, 0.0 :+ 1.0, 0.0 :+ 1.0, 0.0 :+ 1.0 ] + -- + konst :: e -> d -> c e + +instance Container Vector e => Konst e Int Vector + where + konst = konst' + +instance Container Vector e => Konst e (Int,Int) Matrix + where + konst = konst' + +-------------------------------------------------------------------------------- + +class Build d f c e | d -> c, c -> d, f -> e, f -> d, f -> c, c e -> f, d e -> f + where + -- | + -- >>> build 5 (**2) :: Vector Double + -- fromList [0.0,1.0,4.0,9.0,16.0] + -- + -- Hilbert matrix of order N: + -- + -- >>> let hilb n = build (n,n) (\i j -> 1/(i+j+1)) :: Matrix Double + -- >>> putStr . dispf 2 $ hilb 3 + -- 3x3 + -- 1.00 0.50 0.33 + -- 0.50 0.33 0.25 + -- 0.33 0.25 0.20 + -- + build :: d -> f -> c e + +instance Container Vector e => Build Int (e -> e) Vector e + where + build = build' + +instance Container Matrix e => Build (Int,Int) (e -> e -> e) Matrix e + where + build = build' + +-------------------------------------------------------------------------------- + +-- | alternative unicode symbol (25c7) for the contraction operator '(\<.\>)' +(◇) :: Contraction a b c => a -> b -> c +infixl 7 ◇ +(◇) = (<.>) + +-- | dot product: @cdot u v = 'udot' ('conj' u) v@ +dot :: (Container Vector t, Product t) => Vector t -> Vector t -> t +dot u v = udot (conj u) v + +-------------------------------------------------------------------------------- + +optimiseMult :: Monoid (Matrix t) => [Matrix t] -> Matrix t +optimiseMult = mconcat + diff --git a/packages/base/src/Numeric/LinearAlgebra.hs b/packages/base/src/Numeric/LinearAlgebra.hs new file mode 100644 index 0000000..96bf29f --- /dev/null +++ b/packages/base/src/Numeric/LinearAlgebra.hs @@ -0,0 +1,141 @@ +----------------------------------------------------------------------------- +{- | +Module : Numeric.LinearAlgebra +Copyright : (c) Alberto Ruiz 2006-14 +License : BSD3 +Maintainer : Alberto Ruiz +Stability : provisional + +-} +----------------------------------------------------------------------------- +module Numeric.LinearAlgebra ( + + -- * Basic types and data processing + module Numeric.LinearAlgebra.Data, + + -- | The standard numeric classes are defined elementwise: + -- + -- >>> fromList [1,2,3] * fromList [3,0,-2 :: Double] + -- fromList [3.0,0.0,-6.0] + -- + -- >>> (3><3) [1..9] * ident 3 :: Matrix Double + -- (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 product + (<.>), + + -- | This operator can also be written using the unicode symbol ◇ (25c7). + -- + + -- | The matrix x 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. + -- + -- >>> let m = (2><3)[1..] :: Matrix Double + -- >>> m <> 2 <> 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 products + outer, kronecker, cross, + scale, + sumElements, prodElements, absSum, + + -- * Linear Systems + (<\>), + linearSolve, + linearSolveLS, + linearSolveSVD, + luSolve, + cholSolve, + + -- * Inverse and pseudoinverse + inv, pinv, pinvTol, + + -- * Determinant and rank + rcond, rank, ranksv, + det, invlndet, + + -- * Singular value decomposition + svd, + fullSVD, + 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, + + -- * Nullspace + nullspacePrec, + nullVector, + nullspaceSVD, + null1, null1sym, + + orth, + + -- * Norms + norm1, norm2, normInf, pnorm, NormType(..), + + -- * Correlation and convolution + corr, conv, corrMin, corr2, conv2, + + -- * Random arrays + + RandDist(..), randomVector, rand, randn, gaussianSample, uniformSample, + + -- * Misc + meanCov, peps, relativeError, haussholder, optimiseMult, udot, Seed, (◇) +) where + +import Numeric.LinearAlgebra.Data + +import Numeric.Matrix() +import Numeric.Vector() +import Numeric.Container +import Numeric.LinearAlgebra.Algorithms +import Numeric.LinearAlgebra.Util +import Numeric.LinearAlgebra.Random + + + diff --git a/packages/base/src/Numeric/LinearAlgebra/Base.hs b/packages/base/src/Numeric/LinearAlgebra/Base.hs deleted file mode 100644 index 8d44d26..0000000 --- a/packages/base/src/Numeric/LinearAlgebra/Base.hs +++ /dev/null @@ -1,141 +0,0 @@ ------------------------------------------------------------------------------ -{- | -Module : Numeric.LinearAlgebra -Copyright : (c) Alberto Ruiz 2006-14 -License : BSD3 -Maintainer : Alberto Ruiz -Stability : provisional - --} ------------------------------------------------------------------------------ -module Numeric.LinearAlgebra.Base ( - - -- * Basic types and data processing - module Numeric.LinearAlgebra.Data, - - -- | The standard numeric classes are defined elementwise: - -- - -- >>> fromList [1,2,3] * fromList [3,0,-2 :: Double] - -- fromList [3.0,0.0,-6.0] - -- - -- >>> (3><3) [1..9] * ident 3 :: Matrix Double - -- (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 product - (<.>), - - -- | This operator can also be written using the unicode symbol ◇ (25c7). - -- - - -- | The matrix x 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. - -- - -- >>> let m = (2><3)[1..] :: Matrix Double - -- >>> m <> 2 <> 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 products - outer, kronecker, cross, - scale, - sumElements, prodElements, absSum, - - -- * Linear Systems - (<\>), - linearSolve, - linearSolveLS, - linearSolveSVD, - luSolve, - cholSolve, - - -- * Inverse and pseudoinverse - inv, pinv, pinvTol, - - -- * Determinant and rank - rcond, rank, ranksv, - det, invlndet, - - -- * Singular value decomposition - svd, - fullSVD, - 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, - - -- * Nullspace - nullspacePrec, - nullVector, - nullspaceSVD, - null1, null1sym, - - orth, - - -- * Norms - norm1, norm2, normInf, pnorm, NormType(..), - - -- * Correlation and convolution - corr, conv, corrMin, corr2, conv2, - - -- * Random arrays - - RandDist(..), randomVector, rand, randn, gaussianSample, uniformSample, - - -- * Misc - meanCov, peps, relativeError, haussholder, optimiseMult, udot, Seed, (◇) -) where - -import Numeric.LinearAlgebra.Data - -import Numeric.Matrix() -import Numeric.Vector() -import Data.Packed.Numeric -import Numeric.LinearAlgebra.Algorithms -import Numeric.LinearAlgebra.Util -import Numeric.LinearAlgebra.Random - - - diff --git a/packages/base/src/Numeric/LinearAlgebra/Data.hs b/packages/base/src/Numeric/LinearAlgebra/Data.hs index 45fc00c..7e8af03 100644 --- a/packages/base/src/Numeric/LinearAlgebra/Data.hs +++ b/packages/base/src/Numeric/LinearAlgebra/Data.hs @@ -62,7 +62,7 @@ module Numeric.LinearAlgebra.Data( import Data.Packed.Vector import Data.Packed.Matrix -import Data.Packed.Numeric +import Numeric.Container import Numeric.LinearAlgebra.Util import Data.Complex diff --git a/packages/base/src/Numeric/LinearAlgebra/Devel.hs b/packages/base/src/Numeric/LinearAlgebra/Devel.hs index b5ef60d..c41db2d 100644 --- a/packages/base/src/Numeric/LinearAlgebra/Devel.hs +++ b/packages/base/src/Numeric/LinearAlgebra/Devel.hs @@ -60,7 +60,7 @@ module Numeric.LinearAlgebra.Devel( import Data.Packed.Foreign import Data.Packed.Development import Data.Packed.ST -import Data.Packed.Numeric(Container,Contraction,LSDiv,Product, +import Numeric.Container(Container,Contraction,LSDiv,Product, Complexable(),RealElement(), RealOf, ComplexOf, SingleOf, DoubleOf, IndexOf) import Data.Packed diff --git a/packages/base/src/Numeric/LinearAlgebra/Random.hs b/packages/base/src/Numeric/LinearAlgebra/Random.hs index b36c7a3..7afd658 100644 --- a/packages/base/src/Numeric/LinearAlgebra/Random.hs +++ b/packages/base/src/Numeric/LinearAlgebra/Random.hs @@ -20,7 +20,7 @@ module Numeric.LinearAlgebra.Random ( ) where import Numeric.Vectorized -import Data.Packed.Numeric +import Numeric.Container import Numeric.LinearAlgebra.Algorithms import System.Random(randomIO) diff --git a/packages/base/src/Numeric/LinearAlgebra/Util.hs b/packages/base/src/Numeric/LinearAlgebra/Util.hs index 440f6d1..2f91e18 100644 --- a/packages/base/src/Numeric/LinearAlgebra/Util.hs +++ b/packages/base/src/Numeric/LinearAlgebra/Util.hs @@ -48,7 +48,7 @@ module Numeric.LinearAlgebra.Util( vtrans ) where -import Data.Packed.Numeric +import Numeric.Container import Numeric.LinearAlgebra.Algorithms hiding (i) import Numeric.Matrix() import Numeric.Vector() diff --git a/packages/base/src/Numeric/LinearAlgebra/Util/Convolution.hs b/packages/base/src/Numeric/LinearAlgebra/Util/Convolution.hs index 1d4e089..e4cba8f 100644 --- a/packages/base/src/Numeric/LinearAlgebra/Util/Convolution.hs +++ b/packages/base/src/Numeric/LinearAlgebra/Util/Convolution.hs @@ -16,7 +16,7 @@ module Numeric.LinearAlgebra.Util.Convolution( corr2, conv2, separable ) where -import Data.Packed.Numeric +import Numeric.Container vectSS :: Element t => Int -> Vector t -> Matrix t -- cgit v1.2.3