hTensor-0.9.1: Multidimensional arrays and simple tensor computations.

Copyright(c) Alberto Ruiz 2009
LicenseBSD3
MaintainerAlberto Ruiz
Stabilityprovisional
Safe HaskellNone
LanguageHaskell98

Numeric.LinearAlgebra.Array.Solve

Contents

Description

Solution of general multidimensional linear and multilinear systems.

Synopsis

Linear systems

solve Source #

Arguments

:: (Compat i, Coord t, Field t) 
=> NArray i t

coefficients (a)

-> NArray i t

target (b)

-> NArray i t

result (x)

Solution of the linear system a x = b, where a and b are general multidimensional arrays. The structure and dimension names of the result are inferred from the arguments.

solveHomog Source #

Arguments

:: (Compat i, Coord t, Field t) 
=> NArray i t

coefficients (a)

-> [Name]

desired dimensions for the result (a subset selected from the target).

-> Either Double Int

Left "numeric zero" (e.g. eps), Right "theoretical" rank

-> [NArray i t]

basis for the solutions (x)

Solution of the homogeneous linear system a x = 0, where a is a general multidimensional array.

If the system is overconstrained we may provide the theoretical rank to get a MSE solution.

solveHomog1 :: (Compat i, Coord t, Field t) => NArray i t -> [Name] -> NArray i t Source #

A simpler way to use solveHomog, which returns just one solution. If the system is overconstrained it returns the MSE solution.

solveH :: (Compat i, Coord t, Field t) => NArray i t -> [Char] -> NArray i t Source #

solveHomog1 for single letter index names.

solveP Source #

Arguments

:: Tensor Double

coefficients (a)

-> Tensor Double

desired result (b)

-> Name

the homogeneous dimension

-> Tensor Double

result (x)

Solution of the linear system a x = b, where a and b are general multidimensional arrays, with homogeneous equality along a given index.

Multilinear systems

General

data ALSParam i t Source #

optimization parameters for alternating least squares

Constructors

ALSParam 

Fields

  • nMax :: Int

    maximum number of iterations

  • delta :: Double

    minimum relative improvement in the optimization (percent, e.g. 0.1)

  • epsilon :: Double

    maximum relative error. For nonhomogeneous problems it is the reconstruction error in percent (e.g. 1E-3), and for homogeneous problems is the frobenius norm of the expected zero structure in the right hand side.

  • post :: [NArray i t] -> [NArray i t]

    post-processing function after each full iteration (e.g. id)

  • postk :: Int -> NArray i t -> NArray i t

    post-processing function for the k-th argument (e.g. const id)

  • presys :: Matrix t -> Matrix t

    preprocessing function for the linear systems (eg. id, or infoRank)

defaultParameters :: ALSParam i t Source #

nMax = 20, epsilon = 1E-3, delta = 1, post = id, postk = const id, presys = id

mlSolve Source #

Arguments

:: (Compat i, Coord t, Field t, Num (NArray i t), Show (NArray i t)) 
=> ALSParam i t

optimization parameters

-> [NArray i t]

coefficients (a), given as a list of factors.

-> [NArray i t]

initial solution [x,y,z...]

-> NArray i t

target (b)

-> ([NArray i t], [Double])

Solution and error history

Solution of a multilinear system a x y z ... = b based on alternating least squares.

mlSolveH Source #

Arguments

:: (Compat i, Coord t, Field t, Num (NArray i t), Show (NArray i t)) 
=> ALSParam i t

optimization parameters

-> [NArray i t]

coefficients (a), given as a list of factors.

-> [NArray i t]

initial solution [x,y,z...]

-> ([NArray i t], [Double])

Solution and error history

Solution of the homogeneous multilinear system a x y z ... = 0 based on alternating least squares.

mlSolveP Source #

Arguments

:: ALSParam Variant Double

optimization parameters

-> [Tensor Double]

coefficients (a), given as a list of factors.

-> [Tensor Double]

initial solution [x,y,z...]

-> Tensor Double

target (b)

-> Name

homogeneous index

-> ([Tensor Double], [Double])

Solution and error history

Solution of a multilinear system a x y z ... = b, with a homogeneous index, based on alternating least squares.

Factorized

solveFactors Source #

Arguments

:: (Coord t, Field t, Random t, Compat i, Num (NArray i t), Show (NArray i t)) 
=> Int

seed for random initialization

-> ALSParam i t

optimization parameters

-> [NArray i t]

source (also factorized)

-> String

index pairs for the factors separated by spaces

-> NArray i t

target

-> ([NArray i t], [Double])

solution and error history

Given two arrays a (source) and b (target), we try to compute linear transformations x,y,z,... for each dimension, such that product [a,x,y,z,...] == b. (We can use eqnorm for post processing, or id.)

solveFactorsH Source #

Arguments

:: (Coord t, Random t, Field t, Compat i, Num (NArray i t), Show (NArray i t)) 
=> Int

seed for random initialization

-> ALSParam i t

optimization parameters

-> [NArray i t]

coefficient array (a), (also factorized)

-> String

index pairs for the factors separated by spaces

-> ([NArray i t], [Double])

solution and error history

Homogeneous factorized system. Given an array a, given as a list of factors as, and a list of pairs of indices ["pi","qj", "rk", etc.], we try to compute linear transformations x!"pi", y!"pi", z!"rk", etc. such that product [a,x,y,z,...] == 0.

Utilities

eqnorm :: (Compat i, Show (NArray i Double)) => [NArray i Double] -> [NArray i Double] Source #

post processing function that modifies a list of tensors so that they have equal frobenius norm

infoRank :: Field t => Matrix t -> Matrix t Source #

debugging function (e.g. for presys), which shows rows, columns and rank of the coefficient matrix of a linear system.

solve' :: (Coord a, Coord t, Compat i, Field a) => (Matrix t -> Matrix a) -> NArray i t -> NArray i t -> NArray i a Source #

solveHomog' :: (Coord a, Coord t, Compat i, Field a) => (Matrix t -> Matrix a) -> NArray i t -> [Name] -> Either Double Int -> [NArray i a] Source #

solveHomog1' :: (Field a, Compat i, Coord t, Coord a) => (Matrix t -> Matrix a) -> NArray i t -> [Name] -> NArray i a Source #