From fd94ecb3c3032beccdca4a4dee38bb306f57cd8b Mon Sep 17 00:00:00 2001 From: Alberto Ruiz Date: Fri, 16 May 2014 20:57:13 +0200 Subject: Numeric.Container compatible --- packages/base/src/Numeric/Chain.hs | 2 +- packages/base/src/Numeric/Container.hs | 240 --------------------- .../base/src/Numeric/LinearAlgebra/Algorithms.hs | 2 +- packages/base/src/Numeric/LinearAlgebra/Base.hs | 2 +- packages/base/src/Numeric/LinearAlgebra/Data.hs | 3 +- packages/base/src/Numeric/LinearAlgebra/Devel.hs | 2 +- packages/base/src/Numeric/LinearAlgebra/Util.hs | 14 +- .../src/Numeric/LinearAlgebra/Util/Convolution.hs | 2 +- packages/base/src/Numeric/Matrix.hs | 2 +- packages/base/src/Numeric/Vector.hs | 2 +- 10 files changed, 10 insertions(+), 261 deletions(-) delete mode 100644 packages/base/src/Numeric/Container.hs (limited to 'packages/base/src/Numeric') diff --git a/packages/base/src/Numeric/Chain.hs b/packages/base/src/Numeric/Chain.hs index fbdb01b..c6160e9 100644 --- a/packages/base/src/Numeric/Chain.hs +++ b/packages/base/src/Numeric/Chain.hs @@ -19,7 +19,7 @@ module Numeric.Chain ( import Data.Maybe import Data.Packed.Matrix -import Data.Packed.Numeric +import Data.Packed.Internal.Numeric import qualified Data.Array.IArray as A diff --git a/packages/base/src/Numeric/Container.hs b/packages/base/src/Numeric/Container.hs deleted file mode 100644 index 240e5f5..0000000 --- a/packages/base/src/Numeric/Container.hs +++ /dev/null @@ -1,240 +0,0 @@ -{-# 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 -) where - -import Data.Packed hiding (stepD, stepF, condD, condF, conjugateC, conjugateQ) -import Data.Packed.Numeric -import Data.Complex -import Numeric.LinearAlgebra.Algorithms(Field,linearSolveSVD) -import Data.Monoid(Monoid(mconcat)) - ------------------------------------------------------------------- - -{- | 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 operator for '(\<.\>)' - -x25c7, white diamond - --} -(◇) :: 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/Algorithms.hs b/packages/base/src/Numeric/LinearAlgebra/Algorithms.hs index 92761be..063bfc9 100644 --- a/packages/base/src/Numeric/LinearAlgebra/Algorithms.hs +++ b/packages/base/src/Numeric/LinearAlgebra/Algorithms.hs @@ -81,7 +81,7 @@ import Data.Packed import Numeric.LinearAlgebra.LAPACK as LAPACK import Data.List(foldl1') import Data.Array -import Data.Packed.Numeric +import Data.Packed.Internal.Numeric {- | Generic linear algebra functions for double precision real and complex matrices. diff --git a/packages/base/src/Numeric/LinearAlgebra/Base.hs b/packages/base/src/Numeric/LinearAlgebra/Base.hs index 1af4711..395c84a 100644 --- a/packages/base/src/Numeric/LinearAlgebra/Base.hs +++ b/packages/base/src/Numeric/LinearAlgebra/Base.hs @@ -129,7 +129,7 @@ import Numeric.LinearAlgebra.Data import Numeric.Matrix() import Numeric.Vector() -import Numeric.Container +import Data.Packed.Numeric import Numeric.LinearAlgebra.Algorithms import Numeric.LinearAlgebra.Util diff --git a/packages/base/src/Numeric/LinearAlgebra/Data.hs b/packages/base/src/Numeric/LinearAlgebra/Data.hs index 3bc88f9..2754576 100644 --- a/packages/base/src/Numeric/LinearAlgebra/Data.hs +++ b/packages/base/src/Numeric/LinearAlgebra/Data.hs @@ -61,8 +61,7 @@ module Numeric.LinearAlgebra.Data( import Data.Packed.Vector import Data.Packed.Matrix -import Numeric.Container -import Data.Packed.IO +import Data.Packed.Numeric 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 c41db2d..b5ef60d 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 Numeric.Container(Container,Contraction,LSDiv,Product, +import Data.Packed.Numeric(Container,Contraction,LSDiv,Product, Complexable(),RealElement(), RealOf, ComplexOf, SingleOf, DoubleOf, IndexOf) import Data.Packed diff --git a/packages/base/src/Numeric/LinearAlgebra/Util.hs b/packages/base/src/Numeric/LinearAlgebra/Util.hs index f0470ab..440f6d1 100644 --- a/packages/base/src/Numeric/LinearAlgebra/Util.hs +++ b/packages/base/src/Numeric/LinearAlgebra/Util.hs @@ -45,25 +45,15 @@ module Numeric.LinearAlgebra.Util( vec, vech, dup, - vtrans, -{- -- * Plot - mplot, - plot, parametricPlot, - splot, mesh, meshdom, - matrixToPGM, imshow, - gnuplotX, gnuplotpdf, gnuplotWin --} + vtrans ) where -import Numeric.Container -import Data.Packed.IO +import Data.Packed.Numeric import Numeric.LinearAlgebra.Algorithms hiding (i) import Numeric.Matrix() import Numeric.Vector() import Numeric.LinearAlgebra.Util.Convolution ---import Graphics.Plot - {- | print a real matrix with given number of digits after the decimal point diff --git a/packages/base/src/Numeric/LinearAlgebra/Util/Convolution.hs b/packages/base/src/Numeric/LinearAlgebra/Util/Convolution.hs index 1775f14..3cad8d7 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 Numeric.Container +import Data.Packed.Numeric vectSS :: Element t => Int -> Vector t -> Matrix t diff --git a/packages/base/src/Numeric/Matrix.hs b/packages/base/src/Numeric/Matrix.hs index 962ee84..719b591 100644 --- a/packages/base/src/Numeric/Matrix.hs +++ b/packages/base/src/Numeric/Matrix.hs @@ -27,7 +27,7 @@ module Numeric.Matrix ( ------------------------------------------------------------------- import Data.Packed -import Data.Packed.Numeric +import Data.Packed.Internal.Numeric import qualified Data.Monoid as M import Data.List(partition) import Numeric.Chain diff --git a/packages/base/src/Numeric/Vector.hs b/packages/base/src/Numeric/Vector.hs index 3a425f5..28b453f 100644 --- a/packages/base/src/Numeric/Vector.hs +++ b/packages/base/src/Numeric/Vector.hs @@ -21,7 +21,7 @@ module Numeric.Vector () where import Numeric.Vectorized import Data.Packed.Vector -import Data.Packed.Numeric +import Data.Packed.Internal.Numeric ------------------------------------------------------------------- -- cgit v1.2.3