hmatrix-0.11.1.0: Linear algebra and numerical computation

Portabilityportable
Stabilityprovisional
MaintainerAlberto Ruiz <aruiz@um.es>

Numeric.Container

Contents

Description

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.

Synopsis

Basic functions

constant :: Element a => a -> Int -> Vector aSource

creates a vector with a given number of equal components:

> constant 2 7
7 |> [2.0,2.0,2.0,2.0,2.0,2.0,2.0]

linspace :: (Enum e, Container Vector e) => Int -> (e, e) -> Vector eSource

Creates a real vector containing a range of values:

> linspace 5 (-3,7)
5 |> [-3.0,-0.5,2.0,4.5,7.0]

Logarithmic spacing can be defined as follows:

logspace n (a,b) = 10 ** linspace n (a,b)

diag :: (Num a, Element a) => Vector a -> Matrix aSource

Creates a square matrix with a given diagonal.

ident :: (Num a, Element a) => Int -> Matrix aSource

creates the identity matrix of given dimension

ctrans :: (Container Vector e, Element e) => Matrix e -> Matrix eSource

conjugate transpose

Generic operations

class (Complexable c, Fractional e, Element e) => Container c e whereSource

Basic element-by-element functions for numeric containers

Methods

scalar :: e -> c eSource

create a structure with a single element

conj :: c e -> c eSource

complex conjugate

scale :: e -> c e -> c eSource

scaleRecip :: e -> c e -> c eSource

scale the element by element reciprocal of the object:

scaleRecip 2 (fromList [5,i]) == 2 |> [0.4 :+ 0.0,0.0 :+ (-2.0)]

addConstant :: e -> c e -> c eSource

add :: c e -> c e -> c eSource

sub :: c e -> c e -> c eSource

mul :: c e -> c e -> c eSource

element by element multiplication

divide :: c e -> c e -> c eSource

element by element division

equal :: c e -> c e -> BoolSource

arctan2 :: c e -> c e -> c eSource

cmap :: Element b => (e -> b) -> c e -> c bSource

cannot implement instance Functor because of Element class constraint

konst :: e -> IndexOf c -> c eSource

constant structure of given size

build :: IndexOf c -> ArgOf c e -> c eSource

create a structure using a function

Hilbert matrix of order N:

hilb n = build (n,n) (\i j -> 1/(i+j+1))

atIndex :: c e -> IndexOf c -> eSource

indexing function

minIndex :: c e -> IndexOf cSource

index of min element

maxIndex :: c e -> IndexOf cSource

index of max element

minElement :: c e -> eSource

value of min element

maxElement :: c e -> eSource

value of max element

sumElements :: c e -> eSource

the sum of elements (faster than using fold)

prodElements :: c e -> eSource

the product of elements (faster than using fold)

step :: RealElement e => c e -> c eSource

A more efficient implementation of cmap (\x -> if x>0 then 1 else 0)

> step $ linspace 5 (-1,1::Double)
 5 |> [0.0,0.0,0.0,1.0,1.0]

condSource

Arguments

:: RealElement e 
=> c e

a

-> c e

b

-> c e

l

-> c e

e

-> c e

g

-> c e

result

Element by element version of case compare a b of {LT -> l; EQ -> e; GT -> g}.

Arguments with any dimension = 1 are automatically expanded:

> cond ((1><4)[1..]) ((3><1)[1..]) 0 100 ((3><4)[1..]) :: Matrix Double
 (3><4)
 [ 100.0,   2.0,   3.0,  4.0
 ,   0.0, 100.0,   7.0,  8.0
 ,   0.0,   0.0, 100.0, 12.0 ]

find :: (e -> Bool) -> c e -> [IndexOf c]Source

Find index of elements which satisfy a predicate

> find (>0) (ident 3 :: Matrix Double)
 [(0,0),(1,1),(2,2)]

assocSource

Arguments

:: IndexOf c

size

-> e

default value

-> [(IndexOf c, e)]

association list

-> c e

result

Create a structure from an association list

> assoc 5 0 [(2,7),(1,3)] :: Vector Double
 5 |> [0.0,3.0,7.0,0.0,0.0]

accumSource

Arguments

:: c e

initial structure

-> (e -> e -> e)

update function

-> [(IndexOf c, e)]

association list

-> c e

result

Modify a structure using an update function

> accum (ident 5) (+) [((1,1),5),((0,3),3)] :: Matrix Double
 (5><5)
  [ 1.0, 0.0, 0.0, 3.0, 0.0
  , 0.0, 6.0, 0.0, 0.0, 0.0
  , 0.0, 0.0, 1.0, 0.0, 0.0
  , 0.0, 0.0, 0.0, 1.0, 0.0
  , 0.0, 0.0, 0.0, 0.0, 1.0 ]

Matrix product

class Element e => Product e whereSource

Matrix product and related functions

Methods

multiply :: Matrix e -> Matrix e -> Matrix eSource

matrix product

dot :: Vector e -> Vector e -> eSource

dot (inner) product

absSum :: Vector e -> RealOf eSource

sum of absolute value of elements (differs in complex case from norm1)

norm1 :: Vector e -> RealOf eSource

sum of absolute value of elements

norm2 :: Vector e -> RealOf eSource

euclidean norm

normInf :: Vector e -> RealOf eSource

element of maximum magnitude

optimiseMult :: Product t => [Matrix t] -> Matrix tSource

Provide optimal association order for a chain of matrix multiplications and apply the multiplications.

The algorithm is the well-known O(n^3) dynamic programming algorithm that builds a pyramid of optimal associations.

 m1, m2, m3, m4 :: Matrix Double
 m1 = (10><15) [1..]
 m2 = (15><20) [1..]
 m3 = (20><5) [1..]
 m4 = (5><10) [1..]
 >>> optimiseMult [m1,m2,m3,m4]

will perform ((m1 multiply (m2 multiply m3)) multiply m4)

The naive left-to-right multiplication would take 4500 scalar multiplications whereas the optimised version performs 2750 scalar multiplications. The complexity in this case is 32 (= 4^3/2) * (2 comparisons, 3 scalar multiplications, 3 scalar additions, 5 lookups, 2 updates) + a constant (= three table allocations)

mXm :: Product t => Matrix t -> Matrix t -> Matrix tSource

mXv :: Product t => Matrix t -> Vector t -> Vector tSource

vXm :: Product t => Vector t -> Matrix t -> Vector tSource

(<.>) :: Product t => Vector t -> Vector t -> tSource

Dot product: u <.> v = dot u v

class Mul a b c | a b -> c whereSource

Methods

(<>) :: Product t => a t -> b t -> c tSource

Matrix-matrix, matrix-vector, and vector-matrix products.

(<\>) :: Field a => Matrix a -> Vector a -> Vector aSource

least squares solution of a linear system, similar to the \ operator of Matlab/Octave (based on linearSolveSVD).

outer :: Product t => Vector t -> Vector t -> Matrix tSource

Outer product of two vectors.

> fromList [1,2,3] `outer` fromList [5,2,3]
(3><3)
 [  5.0, 2.0, 3.0
 , 10.0, 4.0, 6.0
 , 15.0, 6.0, 9.0 ]

kronecker :: Product t => Matrix t -> Matrix t -> Matrix tSource

Kronecker product of two matrices.

m1=(2><3)
 [ 1.0,  2.0, 0.0
 , 0.0, -1.0, 3.0 ]
m2=(4><3)
 [  1.0,  2.0,  3.0
 ,  4.0,  5.0,  6.0
 ,  7.0,  8.0,  9.0
 , 10.0, 11.0, 12.0 ]
> kronecker m1 m2
(8><9)
 [  1.0,  2.0,  3.0,   2.0,   4.0,   6.0,  0.0,  0.0,  0.0
 ,  4.0,  5.0,  6.0,   8.0,  10.0,  12.0,  0.0,  0.0,  0.0
 ,  7.0,  8.0,  9.0,  14.0,  16.0,  18.0,  0.0,  0.0,  0.0
 , 10.0, 11.0, 12.0,  20.0,  22.0,  24.0,  0.0,  0.0,  0.0
 ,  0.0,  0.0,  0.0,  -1.0,  -2.0,  -3.0,  3.0,  6.0,  9.0
 ,  0.0,  0.0,  0.0,  -4.0,  -5.0,  -6.0, 12.0, 15.0, 18.0
 ,  0.0,  0.0,  0.0,  -7.0,  -8.0,  -9.0, 21.0, 24.0, 27.0
 ,  0.0,  0.0,  0.0, -10.0, -11.0, -12.0, 30.0, 33.0, 36.0 ]

Random numbers

data RandDist Source

Constructors

Uniform

uniform distribution in [0,1)

Gaussian

normal distribution with mean zero and standard deviation one

Instances

randomVectorSource

Arguments

:: Int

seed

-> RandDist

distribution

-> Int

vector size

-> Vector Double 

Obtains a vector of pseudorandom elements from the the mt19937 generator in GSL, with a given seed. Use randomIO to get a random seed.

gaussianSampleSource

Arguments

:: Int

seed

-> Int

number of rows

-> Vector Double

mean vector

-> Matrix Double

covariance matrix

-> Matrix Double

result

Obtains a matrix whose rows are pseudorandom samples from a multivariate Gaussian distribution.

uniformSampleSource

Arguments

:: Int

seed

-> Int

number of rows

-> [(Double, Double)]

ranges for each column

-> Matrix Double

result

Obtains a matrix whose rows are pseudorandom samples from a multivariate uniform distribution.

meanCov :: Matrix Double -> (Vector Double, Matrix Double)Source

Compute mean vector and covariance matrix of the rows of a matrix.

Element conversion

class Convert t whereSource

Methods

real :: Container c t => c (RealOf t) -> c tSource

complex :: Container c t => c t -> c (ComplexOf t)Source

single :: Container c t => c t -> c (SingleOf t)Source

double :: Container c t => c t -> c (DoubleOf t)Source

toComplex :: (Container c t, RealElement t) => (c t, c t) -> c (Complex t)Source

fromComplex :: (Container c t, RealElement t) => c (Complex t) -> (c t, c t)Source

class Complexable c Source

Structures that may contain complex numbers

class (Element t, Element (Complex t), RealFloat t) => RealElement t Source

Supported real types

type family RealOf x Source

type family ComplexOf x Source

type family SingleOf x Source

type family DoubleOf x Source

type family IndexOf c Source

Input / Output

dispf :: Int -> Matrix Double -> StringSource

Show a matrix with a given number of decimal places.

disp = putStr . dispf 3

> disp (1/3 + ident 4)
4x4
1.333  0.333  0.333  0.333
0.333  1.333  0.333  0.333
0.333  0.333  1.333  0.333
0.333  0.333  0.333  1.333

disps :: Int -> Matrix Double -> StringSource

Show a matrix with "autoscaling" and a given number of decimal places.

disp = putStr . disps 2

> disp $ 120 * (3><4) [1..]
3x4  E3
 0.12  0.24  0.36  0.48
 0.60  0.72  0.84  0.96
 1.08  1.20  1.32  1.44

dispcf :: Int -> Matrix (Complex Double) -> StringSource

Pretty print a complex matrix with at most n decimal digits.

vecdisp :: Element t => (Matrix t -> String) -> Vector t -> StringSource

Show a vector using a function for showing matrices.

disp = putStr . vecdisp (dispf 2)

> disp (linspace 10 (0,1))
10 |> 0.00  0.11  0.22  0.33  0.44  0.56  0.67  0.78  0.89  1.00

latexFormatSource

Arguments

:: String

type of braces: "matrix", "bmatrix", "pmatrix", etc.

-> String

Formatted matrix, with elements separated by spaces and newlines

-> String 

Tool to display matrices with latex syntax.

format :: Element t => String -> (t -> String) -> Matrix t -> StringSource

Creates a string from a matrix given a separator and a function to show each entry. Using this function the user can easily define any desired display function:

import Text.Printf(printf)
disp = putStr . format "  " (printf "%.2f")

loadMatrix :: FilePath -> IO (Matrix Double)Source

Loads a matrix from an ASCII file formatted as a 2D table.

saveMatrixSource

Arguments

:: FilePath 
-> String

format (%f, %g, %e)

-> Matrix Double 
-> IO () 

Saves a matrix as 2D ASCII table.

fromFile :: FilePath -> (Int, Int) -> IO (Matrix Double)Source

Loads a matrix from an ASCII file (the number of rows and columns must be known in advance).

fileDimensions :: FilePath -> IO (Int, Int)Source

obtains the number of rows and columns in an ASCII data file (provisionally using unix's wc).

readMatrix :: String -> Matrix DoubleSource

reads a matrix from a string containing a table of numbers.

fscanfVector :: FilePath -> Int -> IO (Vector Double)Source

Loads a vector from an ASCII file (the number of elements must be known in advance).

fprintfVector :: FilePath -> String -> Vector Double -> IO ()Source

Saves the elements of a vector, with a given format (%f, %e, %g), to an ASCII file.

freadVector :: FilePath -> Int -> IO (Vector Double)Source

Loads a vector from a binary file (the number of elements must be known in advance).

fwriteVector :: FilePath -> Vector Double -> IO ()Source

Saves the elements of a vector to a binary file.

Experimental

build' :: Build f => BoundsOf f -> f -> ContainerOf fSource

konst' :: (Konst s, Element e) => e -> s -> ContainerOf' s eSource

Deprecated

(.*) :: Container c e => e -> c e -> c eSource

(*/) :: Container c e => c e -> e -> c eSource

(<|>) :: (Element t, Joinable a b) => a t -> b t -> Matrix tSource

(<->) :: (Element t, Joinable a b) => a t -> b t -> Matrix tSource