public static Array <float> PseudoInv(Array <float> a)
{
// https://en.wikipedia.org/wiki/Moore–Penrose_pseudoinverse
// http://vene.ro/blog/inverses-pseudoinverses-numerical-issues-speed-symmetry.html
// https://software.intel.com/en-us/forums/intel-math-kernel-library/topic/296030
// dgelss can do the job with one input your matrix, the other the unit matrix
// http://icl.cs.utk.edu/lapack-forum/viewtopic.php?f=2&t=160
var m = a.Shape[0];
var n = a.Shape[1];
/* Compute SVD */
var k = Math.Min(m, n);
var s = new float[k];
var u = NN.Zeros <float>(m, m);
var vt = NN.Zeros <float>(n, n);
var copy = (float[])a.Values.Clone(); // if (jobu != 'O' && jobv != 'O') a is destroyed by dgesdv (https://software.intel.com/en-us/node/521150)
var superb = new float[k - 1];
Lapack.gesvd('A', 'A', m, n, copy, n, s, u.Values, m, vt.Values, n, superb);
var invSigma = NN.Zeros <float>(n, m);
invSigma[Range(0, k), Range(0, k)] = NN.Diag(1 / NN.Array(s));
var pseudoInv = vt.T.Dot(invSigma).Dot(u.T);
return(pseudoInv);
}
public void TestInverse2x2b()
{
const int n = 2;
float[,] a = new float[n, n] {
{ 1, 2 },
{ 3, 4 }
};
float[,] aInv = (float[, ])a.Clone();
Lapack.Inverse(aInv, n);
float[,] eye = new float[n, n];
for (int i = 0; i < n; i++)
{
for (int j = 0; j < n; j++)
{
for (int k = 0; k < n; k++)
{
eye[i, j] += a[i, k] * aInv[k, j];
}
}
}
AssertArray.AreAlmostEqual(1f, eye[0, 0]);
AssertArray.AreAlmostEqual(0f, eye[0, 1]);
AssertArray.AreAlmostEqual(0f, eye[1, 0]);
AssertArray.AreAlmostEqual(1f, eye[1, 1]);
}
} // private constructor for singleton pattern
/// <summary>
/// See https://software.intel.com/content/www/us/en/develop/documentation/mkl-developer-reference-fortran/top/lapack-routines/lapack-least-squares-and-eigenvalue-problem-routines/lapack-least-squares-and-eigenvalue-problem-driver-routines/nonsymmetric-eigenvalue-problems-lapack-driver-routines/geev.html
/// </summary>
public void Dgeev(string jobVl, string jobVr, int n, ref double[] a, int offsetA, int ldA, ref double[] wr, int offsetWr,
ref double[] wi, int offsetWi, ref double[] vl, int offsetVl, int ldVl, ref double[] vr, int offsetVr, int ldVr,
ref double[] work, int offsetWork, int lWork, ref int info)
{
Lapack.Dgeev(jobVl, jobVr, ref n, ref a[offsetA], ref ldA, ref wr[offsetWr], ref wi[offsetWi], ref vl[offsetVl],
ref ldVl, ref vr[offsetVr], ref ldVr, ref work[offsetWork], ref lWork, ref info);
}
public PositiveDefiniteMatrix SetToInverse(PositiveDefiniteMatrix A)
{
#if LAPACK
this.SetTo(A);
Lapack.SymmetricInverseInPlace(this);
return(this);
#else
return(SetToInverse(A, new LowerTriangularMatrix(rows, cols)));
#endif
}
public void TestSolve()
{
/* Solve the equations A*X = B */
// https://software.intel.com/sites/products/documentation/doclib/mkl_sa/11/mkl_lapack_examples/dgesv_ex.c.htm
const int N = 5;
const int NRHS = 3;
const int LDA = N;
const int LDB = NRHS;
int n = N, nrhs = NRHS, lda = LDA, ldb = LDB;
/* Local arrays */
int[] ipiv = new int[N];
double[] a = new double[N * N] {
6.80, -6.05, -0.45, 8.32, -9.67,
-2.11, -3.30, 2.58, 2.71, -5.14,
5.66, 5.36, -2.70, 4.35, -7.26,
5.97, -4.44, 0.27, -7.17, 6.08,
8.23, 1.08, 9.04, 2.14, -6.87
};
double[] b = new double[N * NRHS] {
4.02, -1.56, 9.81,
6.19, 4.00, -4.09,
-8.22, -8.67, -4.57,
-7.57, 1.75, -8.61,
-3.03, 2.86, 8.99
};
/* Solve the equations A*X = B */
Lapack.gesv(n, nrhs, a, lda, ipiv, b, ldb);
// Solution
var solution = NN.Array(new[] {
-0.80, -0.39, 0.96,
-0.70, -0.55, 0.22,
0.59, 0.84, 1.90,
1.32, -0.10, 5.36,
0.57, 0.11, 4.04,
}).Reshape(n, nrhs);
AssertArray.AreAlmostEqual(solution, NN.Array(b).Reshape(N, NRHS), 1e-2, 1e-2);
// Details of LU factorization
var luFactorization = NN.Array(new[]
{
8.23, 1.08, 9.04, 2.14, -6.87,
0.83, -6.94, -7.92, 6.55, -3.99,
0.69, -0.67, -14.18, 7.24, -5.19,
0.73, 0.75, 0.02, -13.82, 14.19,
-0.26, 0.44, -0.59, -0.34, -3.43,
}).Reshape(n, n);
AssertArray.AreAlmostEqual(luFactorization, NN.Array(a).Reshape(n, n), 1e-2, 1e-2);
// Pivot indices
AssertArray.AreEqual(new[] { 5, 5, 3, 4, 5 }, ipiv);
}
public void TestDeterminant2x2c()
{
const int n = 2;
var A = new float[n * n] {
1, 2,
3, 4
};
var result = Lapack.Determinant(A, n);
AssertArray.AreAlmostEqual(result, -2f);
}
/// <summary>
/// Gets the Cholesky decomposition of the matrix (L*L' = A), replacing its contents.
/// </summary>
/// <param name="isPosDef">True if <c>this</c> is positive definite, otherwise false.</param>
/// <returns>The Cholesky decomposition L. If <c>this</c> is positive semidefinite,
/// then L will satisfy L*L' = A.
/// Otherwise, L will only approximately satisfy L*L' = A.</returns>
/// <remarks>
/// <c>this</c> must be symmetric, but need not be positive definite.
/// </remarks>
public LowerTriangularMatrix CholeskyInPlace(out bool isPosDef)
{
LowerTriangularMatrix L = new LowerTriangularMatrix(rows, cols, data);
#if LAPACK
isPosDef = Lapack.CholeskyInPlace(this);
#else
isPosDef = L.SetToCholesky(this);
#endif
return(L);
}
public void TestDeterminantUpper()
{
const int n = 4;
float[] A = new float[n * n] {
1, 2, 4, 7,
0, 3, 5, 8,
0, 0, 6, 9,
0, 0, 0, 10
};
var result = Lapack.Determinant(A, n);
Assert.AreEqual(result, 180f);
}
/// <summary>
/// cholesky factorization
/// </summary>
/// <param name="A">hermitian matrix A. A must be a symmetric matrix.
/// Therefore the upper triangular part of A must be
/// <param name="throwException">throw an ILArgumentException if A
/// is found not to be positive definite.</param>
/// the (complex conjugate) of the lower triangular part. No check
/// is made for that! <br/>
/// The elements of A will not be altered.</param>
/// <returns>cholesky factorization</returns>
/// <remarks><para>if <paramref name="throwException"/> is true and
/// A is found not to be positive definite, an ILArgumentException
/// will be thrown and the operation will be canceled.</para>
/// <para> If <paramref name="throwException"/> is false, check the
/// return value's dimension to determine the success of the
/// operation (unless you are sure, A was positive definite).
/// If A was found not pos.def. the matrix returned
/// will be of dimension [k x k] and the result of the cholesky
/// factorization of A[0:k-1;0:k-1]. Here k is the first leading
/// minor of A which was found to be not positive definite. </para>
/// The factorization is carried out by use of the LAPACK functions
/// DPOTRF, ZPOTRF, SPOTRF or CPOTRF respectively. </remarks>
public static ILArray <complex> chol(
ILArray <complex> A, bool throwException)
{
if (!A.IsMatrix)
{
throw new ILArgumentSizeException("chol is defined for matrices only!");
}
int n = A.Dimensions[0], info = 0;
if (A.Dimensions[1] != n)
{
throw new ILArgumentException("chol: input matrix must be square!");
}
ILArray <complex> ret = A.copyUpperTriangle(n);
Lapack.zpotrf('U', n, ret.m_data, n, ref info);
if (info < 0)
{
throw new ILArgumentException("chol: illegal parameter error.");
}
else if (info > 0)
{
// not pos.definite
if (!throwException)
{
if (info > 1)
{
int newDim = info - 1;
ret = A.copyUpperTriangle(newDim);
Lapack.zpotrf('U', newDim, ret.m_data, newDim, ref info);
if (info != 0)
{
throw new ILArgumentException("chol: the original matrix given was not pos. definit. An attempt to decompose the submatrix of order " + (newDim + 1).ToString() + " failed.");
}
return(ret);
}
else
{
return(ILArray <complex> .empty(0, 0));
}
}
else
{
throw new ILArgumentException("chol: the matrix given is not positive definite!");
}
}
return(ret);
}
/// <summary>
/// Decompose matrix A into uper and lower triangular part. Returns permutation matrix also.
/// </summary>
/// <param name="A">general input matrix. Size [m x n]</param>
/// <param name="U">[output] reference to upper triangular matrix. Size [min(m,n) x n]. Must not be null.</param>
/// <param name="P">[output] reference to permutation matrix. Size [min(m,n) x min(m,n)]. Must not be null.</param>
/// <returns>lower triangular matrix L of size [m x min(m,n)]</returns>
/// <remarks>A is decomposed into L and U, so that the equation
/// <code>ILMath.multiply(L,U) == ILMath.multiply(P,A)</code>
/// will hold except for round off error.
/// <para>L and U will be true lower triangular matrices.</para>
/// <example> <code>
/// //Let's construct a matrix X:
/// ILArray<double> X = new ILArray<double>(new double[]{1, 2, 3, 4, 4, 4, 5, 6, 7},3,3).T;
/// // now X.ToString() will give something like:
/// // {<Double> 63238509 [3x3] Ref(2)
/// //(:,:)
/// // 1,00000 2,00000 3,00000
/// // 4,00000 4,00000 4,00000
/// // 5,00000 6,00000 7,00000
/// //}
/// // construct references on U and P and call the decomposition
/// ILArray<double> U = new ILArray<double>.empty();
/// ILArray<double> P = new ILArray<double>.empty();
/// ILArray<double> L = ILMath.lu(X, ref U, ref P);
///
/// // L.ToString() is now:
/// // {<Double> 19634871 [3x3] Phys.
/// //(:,:)
/// // 1,00000 0,00000 0,00000
/// // 0,80000 1,00000 0,00000
/// // 0,20000 -1,00000 1,00000
/// //}
/// // U is now:
/// //{<Double> 22584602 [3x3] Phys.
/// //(:,:)
/// // 5,00000 6,00000 7,00000
/// // 0,00000 -0,80000 -1,60000
/// // 0,00000 0,00000 0,00000
/// //}
/// // and P is:
/// //{<Double> 2192437 [3x3] Phys.
/// //(:,:)
/// // 0,00000 0,00000 1,00000
/// // 0,00000 1,00000 0,00000
/// // 1,00000 0,00000 0,00000
/// //}
/// </code>
/// In order to reflect the pivoting done during the decomposition inside ?getrf, the matrix P may be used on A:
/// <code>
/// (ILMath.multiply(P,A) - ILMath.multiply(L,U)).ToString();
/// // will give:
/// //{<Double> 59192235 [3x3] Phys.
/// //(:,:)
/// // 0,00000 0,00000 0,00000
/// // 0,00000 0,00000 0,00000
/// // 0,00000 0,00000 0,00000
/// //}
/// </code>
/// </example>
/// <para>lu uses the Lapack function ?getrf.</para>
/// <para>All of the matrices U,L,P returned will be solid ILArrays.</para>
/// </remarks>
/// <seealso cref="ILNumerics.BuiltInFunctions.ILMath.lu(ILArray<double>)"/>
/// <seealso cref="ILNumerics.BuiltInFunctions.ILMath.lu(ILArray<double>, ref ILArray<double>)"/>
/// <exception cref="ILNumerics.Exceptions.ILArgumentException"> if input A is not a matrix.</exception>
public static ILArray <complex> lu(ILArray <complex> A, ref ILArray <complex> U, ref ILArray <complex> P)
{
if (!A.IsMatrix)
{
throw new ILArgumentSizeException("lu is defined for matrices only!");
}
int m = A.Dimensions[0], n = A.Dimensions[1], info = 0, minMN = (m < n)? m : n;
ILArray <complex> L = (ILArray <complex>)A.Clone();
int [] pivInd = ILMemoryPool.Pool.New <int>(minMN);
Lapack.zgetrf(m, n, L.m_data, m, pivInd, ref info);
if (info < 0)
{
ILMemoryPool.Pool.RegisterObject(pivInd);
throw new ILArgumentException("lu: illegal parameter error.");
//} else if (info > 0) {
// // singular diagonal entry found
}
else
{
// completed successfuly
if (!Object.Equals(U, null))
{
if (!Object.Equals(P, null))
{
pivInd = perm2indicesForward(pivInd);
U = copyUpperTriangle(L, minMN, n);
L = copyLowerTriangle(L, m, minMN, new complex(1.0, 0.0));
P = ILArray <complex> .zeros(minMN, minMN);
// construct permutation matrix P
for (int r = 0; r < m; r++)
{
P[r, pivInd[r]] = new complex(1.0, 0.0);
}
}
else
{
pivInd = perm2indicesBackward(pivInd);
U = copyUpperTriangle(L, minMN, n);
L = copyLowerTrianglePerm(L, m, minMN, new complex(1.0, 0.0), pivInd);
}
}
}
ILMemoryPool.Pool.RegisterObject(pivInd);
return(L);
}
public static (matrix, vector) Eigens(MatrixExpression a)
{
var v = a.Evaluate();
if (v.Rows != v.Cols)
{
ThrowHelper.ThrowIncorrectDimensionsForOperation();
}
if (a is MatrixInput)
{
v = Copy(v);
}
var w = new vector(v.Rows);
ThrowHelper.Check(Lapack.syev(Layout.ColMajor, 'V', UpLoChar.Lower, v.Rows, v.Array, v.Rows, w.Array));
return(v, w);
}
public static Array <float> PowerMethod(Array <float> a)
{
// https://en.wikipedia.org/wiki/Moore%E2%80%93Penrose_pseudoinverse
// init A(0) = (A*A + dI)-1.A*
var d = 1e-6f;
var result = a.T.Dot(a) + d * NN.Eye(a.Shape[1]);
Lapack.Inverse(result.Values, result.Shape[0]);
result = result.Dot(a.T);
// iterate: A(i+1) = 2A(i) - A(i).A.A(i)
for (int i = 0; i < 2; i++)
{
result = 2 * result - result.Dot(a).Dot(result);
}
return(result);
}
// DO NOT EDIT INSIDE THIS REGION !! CHANGES WILL BE LOST !!
/// <summary>
/// QR decomposition - raw Lapack output
/// </summary>
/// <param name="A">general input matrix A</param>
/// <returns>orthonormal / unitary matrix Q and upper triangular
/// matrix R packed into single matrix. This is the output of the
/// lapack function ?geqrf.</returns>
/// <remarks><para>Input matrix A will not be altered. </para>
/// <para>The matrix returned is the direct output of the lapack
/// function [d,s,c,z]geqrf respectively. This mean that it contains
/// the decomposition factors Q and R, but they are cmbined into a
/// single matrix for performance reasons. If you need one of the factors,
/// you would use the overloaded function
/// <see cref="ILNumerics.BuiltInFunctions.ILMath.qr(ILArray<double>,ref ILArray<double>)"/>
/// instead, which returns those factors seperately.</para></remarks>
public static ILArray <complex> qr(ILArray <complex> A)
{
if (!A.IsMatrix)
{
throw new ILArgumentException("qr decomposition: A must be a matrix");
}
int m = A.Dimensions[0], n = A.Dimensions[1];
ILArray <complex> ret = (ILArray <complex>)A.Clone();
complex [] tau = new complex [(m < n)?m:n];
int info = 0;
Lapack.zgeqrf(m, n, ret.m_data, m, tau, ref info);
if (info < 0)
{
throw new ILArgumentException("qr: an error occoured during decomposition");
}
return(ret);
}
/// <summary>
/// QR decomposition - raw Lapack output
/// </summary>
/// <param name="A">general input matrix A</param>
/// <returns>orthonormal / unitary matrix Q and upper triangular
/// matrix R packed into single matrix. This is the output of the
/// lapack function ?geqrf.</returns>
/// <remarks><para>Input matrix A will not be altered. </para>
/// <para>The matrix returned is the direct output of the lapack
/// function [d,s,c,z]geqrf respectively. This mean that it contains
/// the decomposition factors Q and R, but they are cmbined into a
/// single matrix for performance reasons. If you need one of the factors,
/// you would use the overloaded function
/// <see cref="ILNumerics.BuiltInFunctions.ILMath.qr(ILArray<double>,ref ILArray<double>)"/>
/// instead, which returns those factors seperately.</para></remarks>
public static /*!HC:inCls1*/ ILArray <double> qr(/*!HC:inCls1*/ ILArray <double> A)
{
if (!A.IsMatrix)
{
throw new ILArgumentException("qr decomposition: A must be a matrix");
}
int m = A.Dimensions[0], n = A.Dimensions[1];
/*!HC:inCls1*/ ILArray <double> ret = (/*!HC:inCls1*/ ILArray <double>)A.Clone();
/*!HC:inArr1*/ double [] tau = new /*!HC:inArr1*/ double [(m < n)?m:n];
int info = 0;
/*!HC:lapack_*geqrf*/ Lapack.dgeqrf(m, n, ret.m_data, m, tau, ref info);
if (info < 0)
{
throw new ILArgumentException("qr: an error occoured during decomposition");
}
return(ret);
}
static void Main(string[] args)
{
var x = new float[] { 1.0f, 1.0f, 1.0f };
WriteLine("Level1 BLAS sasum call test.");
WriteLine(Blas1.sasum(x.Length, x, 1));
WriteLine("Level1 BLAS scopy call test.");
Blas1.scopy(x.Length, x, 1, out var y, 1);
for (var i = 0; i < y.Length; i++)
{
Write(y[i] + " ");
}
WriteLine("\n");
WriteLine("Level2 BLAS dgemv call test.");
var ad = new double[] { 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0 };
var xd = new double[] { 1.0, 1.0, 1.0 };
var yd = new double[] { 0.0, 0.0, 0.0 };
Blas2.dgemv(CBlasLayout.RowMajor, CBlasTranspose.NoTrans, 3, 3, 1.0, ad, 3, xd, 1, 1.0, yd, 1);
for (var i = 0; i < yd.Length; i++)
{
Write(yd[i] + " ");
}
WriteLine("\n");
WriteLine("LAPACK General Matrix call test.");
var ag = new double[] { 2.0, 1.0, 1.0, 1.0, 1.0, 2.0, 1.0, 1.0, 1.0, 1.0, 2.0, 1.0, 1.0, 1.0, 1.0, 2.0 };
var bg = new double[] { 6.0, 7.0, 12.0, 15.0 };
Lapack.dgetrf(LapackLayout.RowMajor, 4, 4, ag, 4, out var ipiv);
Lapack.dgetrs(LapackLayout.RowMajor, LapackTranspose.N, 4, 1, ag, 4, ipiv, bg, 1);
for (var i = 0; i < bg.Length; i++)
{
Write(bg[i] + " ");
}
WriteLine();
WriteLine("Please press Enter key...");
ReadLine();
}
/// <summary>
/// Determinant of square matrix
/// </summary>
/// <param name="A">square input matrix</param>
/// <returns>determinant of A</returns>
/// <remarks><para>The determinant is computed by decomposing A into upper and lower triangular part. Therefore LAPACK function ?getrf is used. <br />
/// Due to the properties of determinants, det(a) is the same as det(L) * det(U),where det(L) can easily be extracted from the permutation indices returned from LU decomposition. det(U) - with U beeing an upper triangular matrix - equals the product of the diagonal elements.</para>
/// <para>For scalar A, a plain copy of A is returned.</para></remarks>
/// <example>Creating a nonsingular 4x4 (double) matrix and it's determinant
/// <code>ILArray<double> A = ILMath.counter(1.0,1.0,4,4);
///A[1] = 0.0; // make A nonsingular
///A[14] = 0.0; //(same as: A[2,3] = 0.0;)
/// // A is now:
/// //<Double> [4,4]
/// //(:,:) 1e+001 *
/// // 0,10000 0,50000 0,90000 1,30000
/// // 0,00000 0,60000 1,00000 1,40000
/// // 0,30000 0,70000 1,10000 0,00000
/// // 0,40000 0,80000 1,20000 1,60000
///
///ILMath.det(A) gives:
/// //<Double> -360
///</code></example>
///<exception cref="ILNumerics.Exceptions.ILArgumentException">if A is empty or not a square matrix</exception>
public static /*!HC:inCls1*/ ILArray <double> det(/*!HC:inCls1*/ ILArray <double> A)
{
if (A.IsScalar)
{
return(A.C);
}
if (A.IsEmpty)
{
throw new ILArgumentException("det: A must be a matrix");
}
int m = A.Dimensions[0];
if (m != A.Dimensions[1])
{
throw new ILArgumentException("det: matrix A must be square");
}
/*!HC:inCls1*/ ILArray <double> L = A.C;
int [] pivInd = new int[m];
int info = 0;
/*!HC:lapack_*getrf*/ Lapack.dgetrf(m, m, L.m_data, m, pivInd, ref info);
if (info < 0)
{
throw new ILArgumentException("det: illegal parameter error.");
}
// determine pivoting: number of exchanges
/*!HC:inArr1*/ double retA = /*!HC:unityVal*/ 1.0;
for (int i = 0; i < m;)
{
retA *= L.m_data[i * m + i];
if (pivInd[i] != ++i)
{
retA *= /*!HC:negUnityValNoCmplx*/ -1.0;
}
}
L.Dispose();
return(new /*!HC:inCls1*/ ILArray <double> (retA));
}
/// <summary>
/// Determinant of square matrix
/// </summary>
/// <param name="A">square input matrix</param>
/// <returns>determinant of A</returns>
/// <remarks><para>The determinant is computed by decomposing A into upper and lower triangular part. Therefore LAPACK function ?getrf is used. <br />
/// Due to the properties of determinants, det(a) is the same as det(L) * det(U),where det(L) can easily be extracted from the permutation indices returned from LU decomposition. det(U) - with U beeing an upper triangular matrix - equals the product of the diagonal elements.</para>
/// <para>For scalar A, a plain copy of A is returned.</para></remarks>
/// <example>Creating a nonsingular 4x4 (double) matrix and it's determinant
/// <code>ILArray<double> A = ILMath.counter(1.0,1.0,4,4);
///A[1] = 0.0; // make A nonsingular
///A[14] = 0.0; //(same as: A[2,3] = 0.0;)
/// // A is now:
/// //<Double> [4,4]
/// //(:,:) 1e+001 *
/// // 0,10000 0,50000 0,90000 1,30000
/// // 0,00000 0,60000 1,00000 1,40000
/// // 0,30000 0,70000 1,10000 0,00000
/// // 0,40000 0,80000 1,20000 1,60000
///
///ILMath.det(A) gives:
/// //<Double> -360
///</code></example>
///<exception cref="ILNumerics.Exceptions.ILArgumentException">if A is empty or not a square matrix</exception>
public static ILArray <complex> det(ILArray <complex> A)
{
if (A.IsScalar)
{
return(A.C);
}
if (A.IsEmpty)
{
throw new ILArgumentException("det: A must be a matrix");
}
int m = A.Dimensions[0];
if (m != A.Dimensions[1])
{
throw new ILArgumentException("det: matrix A must be square");
}
ILArray <complex> L = A.C;
int [] pivInd = new int[m];
int info = 0;
Lapack.zgetrf(m, m, L.m_data, m, pivInd, ref info);
if (info < 0)
{
throw new ILArgumentException("det: illegal parameter error.");
}
// determine pivoting: number of exchanges
complex retA = new complex(1.0, 0.0);
for (int i = 0; i < m;)
{
retA *= L.m_data[i * m + i];
if (pivInd[i] != ++i)
{
retA *= -1.0;
}
}
L.Dispose();
return(new ILArray <complex> (retA));
}
public static double Det(MatrixExpression a)
{
var m = a.Evaluate();
if (a is MatrixInput)
{
m = Copy(m);
}
var ipiv = Pool.Int.Rent(m.Rows);
ThrowHelper.Check(Lapack.getrf(Layout.ColMajor, m.Rows, m.Rows, m.Array, m.Rows, ipiv));
Pool.Int.Return(ipiv);
double r = m[0, 0];
for (int i = 1; i < m.Rows; i++)
{
r *= m[i, i];
}
m.Dispose();
return(-r);
}
public static double[] LsFit(double[] x, double[] y, int order)
{
//Least squares fit to x, y data
int m = Math.Min(x.Length, y.Length);
int n = order + 1;
int i, j, r;
if (m < 1)
{
throw new Exception("Invalid number of elements for Ls");
}
double[] a = new double[m * n];
double[] b = new double[Math.Max(m, n)];
for (i = 0; i < m; ++i)
{
r = n * i;
a[r] = 1.0;
b[i] = y[i];
for (j = 1; j < n; ++j)
{
a[r + j] = x[i] * a[r + j - 1];
}
}
int info = Lapack.LAPACKE_dgels(Lapack.LAPACK_ROW_MAJOR, 'N', m, n, 1, a, n, b, 1);
if (info != 0)
{
throw new Exception(string.Format("LAPACKE_dgels returned {0}", info));
}
double[] c = new double[n];
for (i = 0; i < n; ++i)
{
c[i] = b[i];
}
return(c);
}
public static double[] LsSolve(double[] a, int rows, int cols, double[] b)
{
//Least squares solution of X * A = B, X returned. a is row * col matrix, b is column vector
int i;
double[] b1 = new double[b.Length];
Array.Copy(b, b1, b.Length);
int info = Lapack.LAPACKE_dgels(Lapack.LAPACK_ROW_MAJOR, 'N', rows, cols, 1, a, cols, b1, 1);
if (info != 0)
{
throw new Exception(string.Format("LAPACKE_dgels returned {0}", info));
}
double[] c = new double[cols];
for (i = 0; i < cols; ++i)
{
c[i] = b1[i];
}
return(c);
}
// DO NOT EDIT INSIDE THIS REGION !! CHANGES WILL BE LOST !!
/// <summary>
/// GEneral Matrix Multiply this array
/// </summary>
/// <overloads>General Matrix Multiply for double, float, complex and fcomplex arrays</overloads>
/// <param name="A"><![CDATA[ILArray<>]]> matrix A</param>
/// <param name="B"><![CDATA[ILArray<>]]> matrix B</param>
/// <returns><![CDATA[ILArray<double>]]> new array - result of matrix multiplication</returns>
/// <remarks>Both arrays must be matrices. The matrix will be multiplied only
/// if dimensions match accordingly. Therefore B's number of rows must
/// equal A's number of columns. An Exception will be thrown otherwise.
/// The multiplication will carried out on BLAS libraries, if availiable and the
/// storage memory structure meets BLAS's requirements. If not it will be done inside .NET's
/// framework 'by hand'. This is especially true for referencing storages with
/// irregular dimensions. However, even GEMM on those reference storages linking into
/// a physical storage can (an will) be carried out via BLAS dll's, if the spacing
/// into dimensions matches the requirements of BLAS. Those are:
/// <list>
/// <item>the elements of one dimension will be adjecently layed out, and</item>
/// <item>the elements of the second dimension must be regular (evenly) spaced</item>
/// </list>
/// <para>For reference arrays where the spacing between adjecent elements do not meet the
/// requirements above, the matrix multiplication will be made without optimization and
/// therefore suffer from low performance in relation to solid arrays. See <a href="http://ilnumerics.net?site=5142">online documentation: referencing for ILNumerics.Net</a></para>
/// </remarks>
/// <exception cref="ILNumerics.Exceptions.ILArgumentSizeException">if at least one arrays is not a matrix</exception>
/// <exception cref="ILNumerics.Exceptions.ILDimensionMismatchException">if the size of both matrices do not match</exception>
public static ILArray <complex> multiply(ILArray <complex> A, ILArray <complex> B)
{
ILArray <complex> ret = null;
if (A.Dimensions.NumberOfDimensions != 2 ||
B.Dimensions.NumberOfDimensions != 2)
{
throw new ILArgumentSizeException("Matrix multiply: arguments must be 2-d.");
}
if (A.Dimensions[1] != B.Dimensions[0])
{
throw new ILDimensionMismatchException("Matrix multiply: inner matrix dimensions must match.");
}
// decide wich method to use
// test auf Regelmigkeit der Dimensionen
int spacingA0;
int spacingA1;
int spacingB0;
int spacingB1;
char transA, transB;
complex [] retArr = null;
isSuitableForLapack(A, B, out spacingA0, out spacingA1, out spacingB0, out spacingB1, out transA, out transB);
if (A.m_dimensions.NumberOfElements > ILAtlasMinimumElementSize ||
B.m_dimensions.NumberOfElements > ILAtlasMinimumElementSize)
{
// do BLAS GEMM
retArr = new complex [A.m_dimensions[0] * B.m_dimensions[1]];
if (((spacingA0 == 1 && spacingA1 > int.MinValue) || (spacingA1 == 1 && spacingA0 > int.MinValue)) &&
((spacingB0 == 1 && spacingB1 > int.MinValue) || (spacingB1 == 1 && spacingB0 > int.MinValue)))
{
ret = new ILArray <complex> (retArr, new ILDimension(A.m_dimensions[0], B.m_dimensions[1]));
if (transA == 't')
{
spacingA1 = spacingA0;
}
if (transB == 't')
{
spacingB1 = spacingB0;
}
unsafe
{
fixed(complex *ptrC = retArr)
fixed(complex * pA = A.m_data)
fixed(complex * pB = B.m_data)
{
complex *ptrA = pA + A.getBaseIndex(0);
complex *ptrB = pB + B.getBaseIndex(0);
if (transA == 't')
{
spacingA1 = spacingA0;
}
if (transB == 't')
{
spacingB1 = spacingB0;
}
Lapack.zgemm(transA, transB, A.m_dimensions[0], B.m_dimensions[1],
A.m_dimensions[1], ( complex )1.0, (IntPtr)ptrA, spacingA1,
(IntPtr)ptrB, spacingB1, ( complex )1.0, retArr, A.m_dimensions[0]);
}
}
return(ret);
}
}
// do GEMM by hand
retArr = new complex [A.m_dimensions[0] * B.m_dimensions[1]];
ret = new ILArray <complex> (retArr, A.m_dimensions[0], B.m_dimensions[1]);
unsafe {
int in2Len1 = B.m_dimensions[1];
int in1Len0 = A.m_dimensions[0];
int in1Len1 = A.m_dimensions[1];
fixed(complex *ptrC = retArr)
{
complex *pC = ptrC;
for (int c = 0; c < in2Len1; c++)
{
for (int r = 0; r < in1Len0; r++)
{
for (int n = 0; n < in1Len1; n++)
{
*pC += A.GetValue(r, n) * B.GetValue(n, c);
}
pC++;
}
}
}
}
return(ret);
}
private static void Main()
{
CompareTimeDot(10);
CompareTimeDot(100);
CompareTimeDot(100000);
CompareTimeLU();
void CompareTimeDot(int size)
{
var sw = new Stopwatch();
(var x, var y) = GenerateVector();
WriteLine($"Calc dot product by raw C# : size = {size}");
sw.Reset();
var res = 0.0;
for (var i = 0; i < LoopDot; i++)
{
sw.Start();
res = Dot(x, y);
sw.Stop();
}
WriteLine($"Result : {res}\tTime : {sw.Elapsed / (double) LoopDot}");
WriteLine($"Calc dot product by BLAS : size = {size}");
sw.Reset();
for (var i = 0; i < LoopDot; i++)
{
sw.Start();
res = Blas1.dot(size, x, 1, y, 1);
sw.Stop();
}
WriteLine($"Result : {res}\tTime : {sw.Elapsed / (double) LoopDot}\n");
(double[] x, double[] y) GenerateVector()
{
x = new double[size];
y = new double[size];
for (var i = 0; i < size; i++)
{
x[i] = 1.0;
y[i] = 1.0;
}
return(x, y);
}
}
void CompareTimeLU()
{
const int M = 49;
const int N = M * M;
const double h = 1.0 / (M + 1);
const double Heat = 4.0;
var aBase = new double[N * N];
var bBase = new double[N];
var ipiv = new int[N];
for (var i = 1; i <= M; i++)
{
for (var j = 1; j <= M; j++)
{
var k = (j - 1) * M + i - 1;
aBase[k * N + k] = 4.0 / (h * h);
if (i > 1)
{
var kl = k - 1;
aBase[kl * N + k] = -1.0 / (h * h);
}
if (i < M)
{
var kr = k + 1;
aBase[kr * N + k] = -1.0 / (h * h);
}
if (j > 1)
{
var kd = k - M;
aBase[kd * N + k] = -1.0 / (h * h);
}
if (j < M)
{
var ku = k + M;
aBase[ku * N + k] = -1.0 / (h * h);
}
bBase[k] = Heat;
}
}
var sw = new Stopwatch();
WriteLine("Calc Poisson eq by raw C#");
sw.Reset();
var res = new double[bBase.Length];
for (var i = 0; i < LoopLU; i++)
{
Blas1.copy(aBase.Length, aBase, 1, out var a, 1);
Blas1.copy(bBase.Length, bBase, 1, out var b, 1);
sw.Start();
Decomp(N, N, a, ipiv);
Solve(N, N, a, b, ipiv);
sw.Stop();
if (i == LoopLU - 1)
{
Blas1.copy(b.Length, b, 1, res, 1);
}
}
WriteLine($"Result : {res[((M + 1) / 2 - 1) * M + M + 1]}\tTime : {sw.Elapsed / (double) LoopLU}");
WriteLine("Calc Poisson eq by LAPACK");
sw.Reset();
for (var i = 0; i < LoopLU; i++)
{
Blas1.copy(aBase.Length, aBase, 1, out var a, 1);
Blas1.copy(bBase.Length, bBase, 1, out var b, 1);
sw.Start();
Lapack.getrf(LapackLayout.RowMajor, N, N, a, N, ipiv);
Lapack.getrs(LapackLayout.RowMajor, LapackTranspose.NoTrans, N, 1, a, N, ipiv, b, 1);
sw.Stop();
if (i == LoopLU - 1)
{
Blas1.copy(b.Length, b, 1, res, 1);
}
}
WriteLine($"Result : {res[((M + 1) / 2 - 1) * M + M + 1]}\tTime : {sw.Elapsed / (double) LoopLU}");
}
}
/// <summary> /// See https://software.intel.com/en-us/mkl-developer-reference-fortran-potri#64544865-D81B-4811-84AA-D218A680AA3D /// </summary> public void Dpotri(string uplo, int n, double[] a, int offsetA, int ldA, ref int info) => Lapack.Dpotri(uplo, ref n, ref a[offsetA], ref ldA, ref info);
/// <summary>
/// See https://software.intel.com/en-us/mkl-developer-reference-fortran-ormqr#BE4B1C37-0E36-48EB-B44A-A40CACE43821
/// </summary>
public void Dormqr(string side, string transQ, int m, int n, int k, double[] a, int offsetA, int ldA, double[] tau,
int offsetTau, double[] c, int offsetC, int ldC, double[] work, int offsetWork, int lWork, ref int info)
=> Lapack.Dormqr(side, transQ, ref m, ref n, ref k, ref a[offsetA], ref ldA, ref tau[offsetTau],
ref c[offsetC], ref ldC, ref work[offsetWork], ref lWork, ref info);
/// <summary>
/// See https://software.intel.com/en-us/mkl-developer-reference-fortran-orgqr#8CE6CEB0-18AA-4CF6-80F4-D47C9A754019
/// </summary>
public void Dorgqr(int m, int n, int k, double[] a, int offsetA, int ldA, double[] tau, int offsetTau,
double[] work, int offsetWork, int lWork, ref int info)
=> Lapack.Dorgqr(ref m, ref n, ref k, ref a[offsetA], ref ldA, ref tau[offsetTau],
ref work[offsetWork], ref lWork, ref info);
/// <summary>
/// See https://software.intel.com/en-us/mkl-developer-reference-fortran-getrs#C286AE91-D0E0-44FB-94B4-5C262C037CAF
/// </summary>
public void Dgetrs(string transA, int n, int nRhs, double[] a, int offsetA, int ldA, int[] ipiv, int offsetIpiv,
double[] b, int offsetB, int ldB, ref int info)
=> Lapack.Dgetrs(transA, ref n, ref nRhs, ref a[offsetA], ref ldA, ref ipiv[offsetIpiv],
ref b[offsetB], ref ldB, ref info);
/// <summary>
/// See https://software.intel.com/en-us/mkl-developer-reference-fortran-getri#626EB2AE-CA6A-4233-A6FA-04F54EF7A6E6
/// </summary>
public void Dgetri(int n, double[] a, int offsetA, int ldA, int[] ipiv, int offsetIpiv,
double[] work, int offsetWork, int lWork, ref int info)
=> Lapack.Dgetri(ref n, ref a[offsetA], ref ldA, ref ipiv[offsetIpiv], ref work[offsetWork], ref lWork, ref info);
/// <summary> /// See https://software.intel.com/en-us/mkl-developer-reference-fortran-getrf#42740A2C-4898-4EFA-88B9-94CA6EAAC4DB /// </summary> public void Dgetrf(int m, int n, double[] a, int offsetA, int ldA, int[] ipiv, int offsetIpiv, ref int info) => Lapack.Dgetrf(ref m, ref n, ref a[offsetA], ref ldA, ref ipiv[offsetIpiv], ref info);
/// <summary> /// See https://software.intel.com/en-us/mkl-developer-reference-fortran-pptrs#B8D4E277-E28A-42BD-8496-9A72A66EACC3 /// </summary> public void Dpptrs(string uplo, int n, int nRhs, double[] a, int offsetA, double[] b, int offsetB, int ldB, ref int info) => Lapack.Dpptrs(uplo, ref n, ref nRhs, ref a[offsetA], ref b[offsetB], ref ldB, ref info);
/// <summary> /// See https://software.intel.com/en-us/mkl-developer-reference-fortran-pptrf#A2934477-60D2-40B4-B07D-2AD982989C47 /// </summary> public void Dpptrf(string uplo, int n, double[] a, int offsetA, ref int info) => Lapack.Dpptrf(uplo, ref n, ref a[offsetA], ref info);
