/// <summary>
/// Find nonzero elements in X
/// </summary>
/// <param name="X">input array to be evaluated</param>
/// <param name="limit">number of elements to search for. If this value is <![CDATA[< 0]]> the function
/// will return at most 'limit' nonzero elements from the end of the array ordered by ascending index.
/// Set to 0 to search full array.</param>
/// <param name="C">If not null, the function will return the row indices of nonzero elements
/// as main return value. C will therefore hold the column indices of those elements. If X
/// has more than 2 dimensions, the column indices will go along the 2nd dimension.</param>
/// <param name="V">if not null on entrance, V will hold a copy of the values of nonzero elements returned.</param>
/// <returns>Vector containing (sequential) indices of nonzero elements in X. If C was
/// not null, return value will contain row indices of nonzero elements. </returns>
/// <remarks>The return type of the index vectors is always 'double'. The return type
/// of the element vector 'V' depends on the type of input array X. V and C may be null on
/// entrance, indicating their information is not needed. If V is not null (f.e. 'empty()') C must be
/// not null also. Any initial data of V or C will be lost.</remarks>
public static ILArray<double> find(/*!HC:inCls1*/ ILArray<double> X, int limit,
ref ILArray<double> C, ref /*!HC:inCls1*/ ILArray<double> V) {
double[] retArray;
bool create_row_columns = !Object.Equals(C, null);
bool return_values = !Object.Equals(V, null);
ILArray<double> ret = null;
ILDimension inDim = X.Dimensions;
if (inDim.NumberOfElements == 1) {
#region SCALAR
// scalar -> return copy
/*!HC:HCnullValue*/
if (X.GetValue(0, 0) != 0.0)
{
retArray = new double[1] { 0 };
if (create_row_columns) {
C = new ILArray<double>(0.0);
}
if (return_values) {
V = new /*!HC:inCls1*/ ILArray<double> (new /*!HC:inArr1*/ double [1]{X.GetValue(0, 0)});
}
return new ILArray<double>(retArray, 1, 1);
} else {
if (create_row_columns) {
C = ILArray<double>.empty(0,0);
}
if (return_values) {
V = /*!HC:inCls1*/ ILArray<double> .empty(0,0);
}
return ILArray<double>.empty(0,0);
}
#endregion SCALAR
}
double[] indices;
int nrElements = inDim.NumberOfElements;
/*!HC:locicalAbbrev*/
if (limit != 0) {
int lim = Math.Abs ( limit );
if (lim < nrElements)
nrElements = lim;
}
indices = ILMemoryPool.Pool.New<double>(nrElements); // init return array with most elements for non logical inarray -> shorten afterwards
int foundIdx = 0;
#region physical
// physical -> pointer arithmetic
if (limit >= 0) {
unsafe {
fixed (double* pIndices = indices)
fixed (/*!HC:inArr1*/ double * pX = X.m_data) {
/*!HC:inArr1*/ double * lastElement = pX + inDim.NumberOfElements;
/*!HC:inArr1*/ double * tmpIn = pX;
double* pI = pIndices;
double* pFoundLast = pI + indices.Length;
while (tmpIn < lastElement && pI < pFoundLast) {
/*!HC:HCcompare0*/
if (*tmpIn != 0.0)
*pI++ = (double) ( tmpIn - pX );
tmpIn++;
}
foundIdx = (int) ( pI - pIndices );
}
}
} else {
// search backwards
unsafe {
fixed (double* pIndices = indices)
fixed (/*!HC:inArr1*/ double * pX = X.m_data) {
/*!HC:inArr1*/ double * lastElementX = pX;
/*!HC:inArr1*/ double * tmpIn = pX + inDim.NumberOfElements;
double* pI = pIndices + indices.Length;
while (tmpIn > lastElementX && pI > pIndices) {
tmpIn--;
/*!HC:HCcompare0*/
if (*tmpIn != 0.0)
*(--pI) = (double) ( tmpIn - pX );
}
foundIdx = (int) ( pIndices + indices.Length - pI );
}
}
}
#endregion
if (foundIdx == 0) {
// return empty array
return ILArray<double>.empty(0,0);
}
// transform to row / columns; extract values if needed
int leadDimLen = inDim[0];
if (create_row_columns) {
#region RETURN ROWS / COLUMNS /VALUES
C = new ILArray<double> ( ILMemoryPool.Pool.New<double>(foundIdx), foundIdx, 1 );
ret = new ILArray<double> ( ILMemoryPool.Pool.New<double>(foundIdx), foundIdx, 1 );
if (return_values) {
V = new /*!HC:inCls1*/ ILArray<double> ( ILMemoryPool.Pool.New< /*!HC:inArr1*/ double >(foundIdx), foundIdx, 1 );
// copy values, transform to row/columns
unsafe {
fixed (double* pIndices = indices,
pRows = ret.m_data, pCols = C.m_data)
fixed (/*!HC:inArr1*/ double * pValues = V.m_data, pInput = X.m_data) {
double* pI = (limit >= 0) ?
pIndices : (pIndices + indices.Length - foundIdx);
double* pLastIndex = pIndices + foundIdx;
double* pR = pRows;
double* pC = pCols;
/*!HC:inArr1*/ double * pV = pValues;
/*!HC:inArr1*/ double * pX = pInput;
while (pI < pLastIndex) {
*pR++ = *( pI ) % leadDimLen;
*pC++ = (int) *( pI ) / leadDimLen;
*pV++ = *( pInput + (int) *pI++ );
}
}
}
} else {
// just return row / columns
unsafe {
fixed (double* pIndices = indices,
pRows = ret.m_data, pCols = C.m_data)
fixed (/*!HC:inArr1*/ double * pInput = X.m_data) {
double* pI = (limit >= 0) ?
pIndices : (pIndices + indices.Length - foundIdx);
double* pLastIndex = pIndices + foundIdx;
double* pR = pRows;
double* pC = pCols;
while (pI < pLastIndex) {
*pR++ = *(pI) % leadDimLen;
*pC++ = (int)(*(pI++) / leadDimLen);
}
}
}
}
#endregion RETURN ROWS / COLUMNS
} else {
#region RETURN INDICES ONLY
if (foundIdx != indices.Length) {
ret = new ILArray<double> ( ILMemoryPool.Pool.New<double>(foundIdx), foundIdx, 1 );
unsafe {
fixed (double* pIndices = indices, pRows = ret.m_data){
double* pI = (limit >= 0) ?
pIndices : (pIndices + indices.Length - foundIdx);
double* pLastIndex = pIndices + foundIdx;
double* pR = pRows;
while (pI < pLastIndex) {
*pR++ = *pI++;
}
}
}
} else {
ret = new ILArray<double> (indices, foundIdx, 1);
}
#endregion RETURN INDICES ONLY
}
return ret;
}
/// <summary>
/// Find nonzero elements in X
/// </summary>
/// <param name="X">input array to be evaluated</param>
/// <param name="limit">number of elements to search for. If this value is <![CDATA[< 0]]> the function
/// will return at most 'limit' nonzero elements from the end of the array ordered by ascending index.
/// Set to 0 to search full array.</param>
/// <param name="C">If not null, the function will return the row indices of nonzero elements
/// as main return value. C will therefore hold the column indices of those elements. If X
/// has more than 2 dimensions, the column indices will go along the 2nd dimension.</param>
/// <param name="V">if not null on entrance, V will hold a copy of the values of nonzero elements returned.</param>
/// <returns>Vector containing (sequential) indices of nonzero elements in X. If C was
/// not null, return value will contain row indices of nonzero elements. </returns>
/// <remarks>The return type of the index vectors is always 'double'. The return type
/// of the element vector 'V' depends on the type of input array X. V and C may be null on
/// entrance, indicating their information is not needed. If V is not null (f.e. 'empty()') C must be
/// not null also. Any initial data of V or C will be lost.</remarks>
public static ILArray <double> find(/*!HC:inCls1*/ ILArray <double> X, int limit,
ref ILArray <double> C, ref /*!HC:inCls1*/ ILArray <double> V)
{
double[] retArray;
bool create_row_columns = !Object.Equals(C, null);
bool return_values = !Object.Equals(V, null);
ILArray <double> ret = null;
ILDimension inDim = X.Dimensions;
if (inDim.NumberOfElements == 1)
{
#region SCALAR
// scalar -> return copy
/*!HC:HCnullValue*/
if (X.GetValue(0, 0) != 0.0)
{
retArray = new double[1] {
0
};
if (create_row_columns)
{
C = new ILArray <double>(0.0);
}
if (return_values)
{
V = new /*!HC:inCls1*/ ILArray <double> (new /*!HC:inArr1*/ double [1] {
X.GetValue(0, 0)
});
}
return(new ILArray <double>(retArray, 1, 1));
}
else
{
if (create_row_columns)
{
C = ILArray <double> .empty(0, 0);
}
if (return_values)
{
V = /*!HC:inCls1*/ ILArray <double> .empty(0, 0);
}
return(ILArray <double> .empty(0, 0));
}
#endregion SCALAR
}
double[] indices;
int nrElements = inDim.NumberOfElements;
/*!HC:locicalAbbrev*/
if (limit != 0)
{
int lim = Math.Abs(limit);
if (lim < nrElements)
{
nrElements = lim;
}
}
indices = ILMemoryPool.Pool.New <double>(nrElements); // init return array with most elements for non logical inarray -> shorten afterwards
int foundIdx = 0;
#region physical
// physical -> pointer arithmetic
if (limit >= 0)
{
unsafe
{
fixed(double *pIndices = indices)
fixed(/*!HC:inArr1*/ double *pX = X.m_data)
{
/*!HC:inArr1*/ double *lastElement = pX + inDim.NumberOfElements;
/*!HC:inArr1*/ double *tmpIn = pX;
double *pI = pIndices;
double *pFoundLast = pI + indices.Length;
while (tmpIn < lastElement && pI < pFoundLast)
{
/*!HC:HCcompare0*/
if (*tmpIn != 0.0)
{
*pI++ = (double)(tmpIn - pX);
}
tmpIn++;
}
foundIdx = (int)(pI - pIndices);
}
}
}
else
{
// search backwards
unsafe
{
fixed(double *pIndices = indices)
fixed(/*!HC:inArr1*/ double *pX = X.m_data)
{
/*!HC:inArr1*/ double *lastElementX = pX;
/*!HC:inArr1*/ double *tmpIn = pX + inDim.NumberOfElements;
double *pI = pIndices + indices.Length;
while (tmpIn > lastElementX && pI > pIndices)
{
tmpIn--;
/*!HC:HCcompare0*/
if (*tmpIn != 0.0)
{
*(--pI) = (double)(tmpIn - pX);
}
}
foundIdx = (int)(pIndices + indices.Length - pI);
}
}
}
#endregion
if (foundIdx == 0)
{
// return empty array
return(ILArray <double> .empty(0, 0));
}
// transform to row / columns; extract values if needed
int leadDimLen = inDim[0];
if (create_row_columns)
{
#region RETURN ROWS / COLUMNS /VALUES
C = new ILArray <double> (ILMemoryPool.Pool.New <double>(foundIdx), foundIdx, 1);
ret = new ILArray <double> (ILMemoryPool.Pool.New <double>(foundIdx), foundIdx, 1);
if (return_values)
{
V = new /*!HC:inCls1*/ ILArray <double> (ILMemoryPool.Pool.New </*!HC:inArr1*/ double>(foundIdx), foundIdx, 1);
// copy values, transform to row/columns
unsafe
{
fixed(double *pIndices = indices,
pRows = ret.m_data, pCols = C.m_data)
fixed(/*!HC:inArr1*/ double *pValues = V.m_data, pInput = X.m_data)
{
double *pI = (limit >= 0) ?
pIndices : (pIndices + indices.Length - foundIdx);
double *pLastIndex = pIndices + foundIdx;
double *pR = pRows;
double *pC = pCols;
/*!HC:inArr1*/ double *pV = pValues;
/*!HC:inArr1*/ double *pX = pInput;
while (pI < pLastIndex)
{
*pR++ = *(pI) % leadDimLen;
*pC++ = (int)*(pI) / leadDimLen;
*pV++ = *(pInput + (int)*pI++);
}
}
}
}
else
{
// just return row / columns
unsafe
{
fixed(double *pIndices = indices,
pRows = ret.m_data, pCols = C.m_data)
fixed(/*!HC:inArr1*/ double *pInput = X.m_data)
{
double *pI = (limit >= 0) ?
pIndices : (pIndices + indices.Length - foundIdx);
double *pLastIndex = pIndices + foundIdx;
double *pR = pRows;
double *pC = pCols;
while (pI < pLastIndex)
{
*pR++ = *(pI) % leadDimLen;
*pC++ = (int)(*(pI++) / leadDimLen);
}
}
}
}
#endregion RETURN ROWS / COLUMNS
}
else
{
#region RETURN INDICES ONLY
if (foundIdx != indices.Length)
{
ret = new ILArray <double> (ILMemoryPool.Pool.New <double>(foundIdx), foundIdx, 1);
unsafe
{
fixed(double *pIndices = indices, pRows = ret.m_data)
{
double *pI = (limit >= 0) ?
pIndices : (pIndices + indices.Length - foundIdx);
double *pLastIndex = pIndices + foundIdx;
double *pR = pRows;
while (pI < pLastIndex)
{
*pR++ = *pI++;
}
}
}
}
else
{
ret = new ILArray <double> (indices, foundIdx, 1);
}
#endregion RETURN INDICES ONLY
}
return(ret);
}
/// <summary>
/// QR decomposition, returning Q and R, optionally economical sized
/// </summary>
/// <param name="A">general input matrix A of size [m x n]</param>
/// <param name="R">output parameter. Upper triangular matrix R as
/// result of decomposition. Size [m x n] or [min(m,n) x n] (see remarks). </param>
/// <param name="economySize">if true, the size of Q and R will
/// be [m x m] and [m x n] respectively. However, if m < n,
/// the economySize parameter has no effect. </param>
/// <returns>Orthonormal real / unitary complex matrix Q as result
/// of decomposition. Size [m x m] or [m x min(m,n)], depending
/// on <paramref name="economySize"/> (see remarks below)</returns>
/// <remarks>The function returns Q and R such that the equation
/// <para>A = Q * R</para> holds with roundoff errors. ('*'
/// denotes matrix multiplication.)
/// <para>Q and R will be solid ILArray's.</para></remarks>
public static /*!HC:inCls1*/ ILArray<double> qr(
/*!HC:inCls1*/ ILArray<double> A,
ref /*!HC:inCls1*/ ILArray<double> R, bool economySize) {
if (Object.Equals(R,null)) {
return qr(A);
}
int m = A.Dimensions[0];
int n = A.Dimensions[1];
if (m < n && economySize) return qr(A,ref R, false);
/*!HC:inCls1*/ ILArray<double> ret;
if (m == 0 || n == 0) {
R = new /*!HC:inCls1*/ ILArray<double> (new /*!HC:inArr1*/ double [0],m,n);
return /*!HC:inCls1*/ ILArray<double> .empty(A.Dimensions);
}
int minMN = (m<n)?m:n;
int info = 0;
/*!HC:inArr1*/ double [] tau = new /*!HC:inArr1*/ double [minMN];
/*!HC:inArr1*/ double [] QArr;
if (m >= n) {
ret = new /*!HC:inCls1*/ ILArray<double> (
new /*!HC:inArr1*/ double [(economySize)? minMN * m : m * m],
m,(economySize)? minMN: m);
} else {
// economySize is always false ... !
// a temporary array is needed for extraction of the compact lapack Q (?geqrf)
ret = new /*!HC:inCls1*/ ILArray<double> (
new /*!HC:inArr1*/ double [m * n],m,n);
}
QArr = ret.m_data;
for (int i = m*n; i-->0;) {
QArr[i] = A.GetValue(i);
}
/*!HC:lapack_*geqrf*/ Lapack.dgeqrf (m,n,QArr,m,tau,ref info);
if (info != 0) {
throw new ILArgumentException("qr: error inside lapack library (?geqrf). info=" + info.ToString());
}
// extract R, Q
if (economySize) {
R = copyUpperTriangle(QArr,m,n,minMN);
/*!HC:lapack_*orgqr*/ Lapack.dorgqr (m,minMN,tau.Length,QArr,m,tau,ref info);
} else {
R = copyUpperTriangle(QArr,m,n,m);
/*!HC:lapack_*orgqr*/ Lapack.dorgqr (m,m,tau.Length,QArr,m,tau,ref info);
if (m < n)
ret = ret[":;0:" + (m-1)];
}
if (info != 0)
throw new ILArgumentException("qr: error in lapack library (???gqr). info=" + info.ToString());
return ret;
}
/// <summary>
/// QR decomposition with pivoting, possibly economical sized
/// </summary>
/// <param name="A">general input matrix A of size [m x n]</param>
/// <param name="R">output parameter. Upper triangular matrix R as
/// result of decomposition. Size [m x n] or [min(m,n) x n] depending
/// on <paramref name="economySize"/> (see remarks). </param>
/// <param name="economySize"><para>if true, <list type="bullet">
/// <item>the size of Q and R will be [m x m] and [m x n] respectively.
/// However, if m < n, the economySize parameter has no effect on
/// those sizes.</item>
/// <item>the output parameter E will be returned as row permutation
/// vector rather than as permutation matrix</item></list></para>
/// <para>if false, this function acts exactly as its overload
/// <see cref="ILNumerics.BuiltInFunctions.ILMath.qr(ILArray<double>,ref ILArray<double>,ref ILArray<double>)"/></para>
/// </param>
/// <param name="E">permutation matrix from pivoting. Size [m x m].
/// If this is not null, the permutation matrix/ vector E will be returned.
/// <para>E is of size [n x n], if <paramref name="economySize"/> is
/// true, a row vector of length n otherwise</para></param>
/// <returns>Orthonormal / unitary matrix Q as result of decomposition.
/// Size [m x m] or [m x min(m,n)], depending on <paramref name="economySize"/>
/// (see remarks below)</returns>
/// <remarks><para> If <paramref name="economySize"/> is false, the function
/// returns Q, R and E such that the equation A * E = Q * R holds except
/// roundoff errors. </para>
/// <para>If <paramref name="economySize"/> is true, E will be a permutation
/// vector and the equation A[null,E] == Q * R holds (except roundoff).</para>
/// <para>E reflects the pivoting of A done inside LAPACK in order to give R
/// increasingly diagonal elements.</para>
/// <para>Q, R and E will be solid ILArray's.</para></remarks>
public static /*!HC:inCls1*/ ILArray<double> qr(
/*!HC:inCls1*/ ILArray<double> A,
ref /*!HC:inCls1*/ ILArray<double> R,
ref /*!HC:inCls1*/ ILArray<double> E,
bool economySize) {
if (Object.Equals(R,null)) {
return qr(A);
}
int m = A.Dimensions[0];
int n = A.Dimensions[1];
if (m < n && economySize) return qr(A,ref R, false);
/*!HC:inCls1*/ ILArray<double> ret;
if (m == 0 || n == 0) {
R = new /*!HC:inCls1*/ ILArray<double> (new /*!HC:inArr1*/ double [0],m,n);
E = new /*!HC:inCls1*/ ILArray<double> (new /*!HC:inArr1*/ double [0],1,0);
return /*!HC:inCls1*/ ILArray<double> .empty(A.Dimensions);
}
// prepare IPVT
if (object.Equals(E,null))
return qr(A,ref R,economySize);
if (!economySize) {
E = new /*!HC:inCls1*/ ILArray<double> (new /*!HC:inArr1*/ double [n * n],n,n);
} else {
E = new /*!HC:inCls1*/ ILArray<double> (new /*!HC:inArr1*/ double [n],1,n);
}
int [] ipvt = new int[n];
int minMN = (m<n)?m:n;
int info = 0;
/*!HC:inArr1*/ double [] tau = new /*!HC:inArr1*/ double [minMN];
/*!HC:inArr1*/ double [] QArr;
if (m >= n) {
ret = new /*!HC:inCls1*/ ILArray<double> (
new /*!HC:inArr1*/ double [(economySize)? minMN * m : m * m],
m,(economySize)? minMN: m);
} else {
// economySize is always false ... !
// a temporary array is needed for extraction of the compact lapack Q (?geqrf)
ret = new /*!HC:inCls1*/ ILArray<double> (
new /*!HC:inArr1*/ double [m * n],m,n);
}
QArr = ret.m_data;
for (int i = m*n; i-->0;) {
QArr[i] = A.GetValue(i);
}
/*!HC:lapack_*geqp3*/ Lapack.dgeqp3 (m,n,QArr,m,ipvt,tau,ref info);
if (info != 0) {
throw new ILArgumentException("qr: error inside lapack library (?geqrf). info=" + info.ToString());
}
// extract R, Q
if (economySize) {
R = copyUpperTriangle(QArr,m,n,minMN);
/*!HC:lapack_*orgqr*/ Lapack.dorgqr (m,minMN,tau.Length,QArr,m,tau,ref info);
// transform E into out typed vector
for (int i = 0; i < n; i++) {
E.m_data[i] = ipvt[i] - 1;
}
} else {
R = copyUpperTriangle(QArr,m,n,m);
/*!HC:lapack_*orgqr*/ Lapack.dorgqr (m,m,tau.Length,QArr,m,tau,ref info);
if (m < n)
ret = ret[":;0:" + (m-1)];
// transform E into matrix
for (int i = 0; i < n; i++) {
E.m_data[(ipvt[i]-1) + n * i] = /*!HC:unityValNoCmplx*/ 1.0 ;
}
}
if (info != 0)
throw new ILArgumentException("qr: error in lapack library (???gqr). info=" + info.ToString());
return ret;
}
/// <summary>
/// QR decomposition with pivoting, possibly economical sized
/// </summary>
/// <param name="A">general input matrix A of size [m x n]</param>
/// <param name="R">output parameter. Upper triangular matrix R as
/// result of decomposition. Size [m x n] or [min(m,n) x n] depending
/// on <paramref name="economySize"/> (see remarks). </param>
/// <param name="economySize"><para>if true, <list type="bullet">
/// <item>the size of Q and R will be [m x m] and [m x n] respectively.
/// However, if m < n, the economySize parameter has no effect on
/// those sizes.</item>
/// <item>the output parameter E will be returned as row permutation
/// vector rather than as permutation matrix</item></list></para>
/// <para>if false, this function acts exactly as its overload
/// <see cref="ILNumerics.BuiltInFunctions.ILMath.qr(ILArray<double>,ref ILArray<double>,ref ILArray<double>)"/></para>
/// </param>
/// <param name="E">permutation matrix from pivoting. Size [m x m].
/// If this is not null, the permutation matrix/ vector E will be returned.
/// <para>E is of size [n x n], if <paramref name="economySize"/> is
/// true, a row vector of length n otherwise</para></param>
/// <returns>Orthonormal / unitary matrix Q as result of decomposition.
/// Size [m x m] or [m x min(m,n)], depending on <paramref name="economySize"/>
/// (see remarks below)</returns>
/// <remarks><para> If <paramref name="economySize"/> is false, the function
/// returns Q, R and E such that the equation A * E = Q * R holds except
/// roundoff errors. </para>
/// <para>If <paramref name="economySize"/> is true, E will be a permutation
/// vector and the equation A[null,E] == Q * R holds (except roundoff).</para>
/// <para>E reflects the pivoting of A done inside LAPACK in order to give R
/// increasingly diagonal elements.</para>
/// <para>Q, R and E will be solid ILArray's.</para></remarks>
public static /*!HC:inCls1*/ ILArray <double> qr(
/*!HC:inCls1*/ ILArray <double> A,
ref /*!HC:inCls1*/ ILArray <double> R,
ref /*!HC:inCls1*/ ILArray <double> E,
bool economySize)
{
if (Object.Equals(R, null))
{
return(qr(A));
}
int m = A.Dimensions[0];
int n = A.Dimensions[1];
if (m < n && economySize)
{
return(qr(A, ref R, false));
}
/*!HC:inCls1*/ ILArray <double> ret;
if (m == 0 || n == 0)
{
R = new /*!HC:inCls1*/ ILArray <double> (new /*!HC:inArr1*/ double [0], m, n);
E = new /*!HC:inCls1*/ ILArray <double> (new /*!HC:inArr1*/ double [0], 1, 0);
return /*!HC:inCls1*/ (ILArray <double> .empty(A.Dimensions));
}
// prepare IPVT
if (object.Equals(E, null))
{
return(qr(A, ref R, economySize));
}
if (!economySize)
{
E = new /*!HC:inCls1*/ ILArray <double> (new /*!HC:inArr1*/ double [n * n], n, n);
}
else
{
E = new /*!HC:inCls1*/ ILArray <double> (new /*!HC:inArr1*/ double [n], 1, n);
}
int [] ipvt = new int[n];
int minMN = (m < n)?m:n;
int info = 0;
/*!HC:inArr1*/ double [] tau = new /*!HC:inArr1*/ double [minMN];
/*!HC:inArr1*/ double [] QArr;
if (m >= n)
{
ret = new /*!HC:inCls1*/ ILArray <double> (
new /*!HC:inArr1*/ double [(economySize)? minMN * m : m * m],
m, (economySize)? minMN: m);
}
else
{
// economySize is always false ... !
// a temporary array is needed for extraction of the compact lapack Q (?geqrf)
ret = new /*!HC:inCls1*/ ILArray <double> (
new /*!HC:inArr1*/ double [m * n], m, n);
}
QArr = ret.m_data;
for (int i = m * n; i-- > 0;)
{
QArr[i] = A.GetValue(i);
}
/*!HC:lapack_*geqp3*/ Lapack.dgeqp3(m, n, QArr, m, ipvt, tau, ref info);
if (info != 0)
{
throw new ILArgumentException("qr: error inside lapack library (?geqrf). info=" + info.ToString());
}
// extract R, Q
if (economySize)
{
R = copyUpperTriangle(QArr, m, n, minMN);
/*!HC:lapack_*orgqr*/ Lapack.dorgqr(m, minMN, tau.Length, QArr, m, tau, ref info);
// transform E into out typed vector
for (int i = 0; i < n; i++)
{
E.m_data[i] = ipvt[i] - 1;
}
}
else
{
R = copyUpperTriangle(QArr, m, n, m);
/*!HC:lapack_*orgqr*/ Lapack.dorgqr(m, m, tau.Length, QArr, m, tau, ref info);
if (m < n)
{
ret = ret[":;0:" + (m - 1)];
}
// transform E into matrix
for (int i = 0; i < n; i++)
{
E.m_data[(ipvt[i] - 1) + n * i] = /*!HC:unityValNoCmplx*/ 1.0;
}
}
if (info != 0)
{
throw new ILArgumentException("qr: error in lapack library (???gqr). info=" + info.ToString());
}
return(ret);
}
/// <summary>
/// QR decomposition, returning Q and R, optionally economical sized
/// </summary>
/// <param name="A">general input matrix A of size [m x n]</param>
/// <param name="R">output parameter. Upper triangular matrix R as
/// result of decomposition. Size [m x n] or [min(m,n) x n] (see remarks). </param>
/// <param name="economySize">if true, the size of Q and R will
/// be [m x m] and [m x n] respectively. However, if m < n,
/// the economySize parameter has no effect. </param>
/// <returns>Orthonormal real / unitary complex matrix Q as result
/// of decomposition. Size [m x m] or [m x min(m,n)], depending
/// on <paramref name="economySize"/> (see remarks below)</returns>
/// <remarks>The function returns Q and R such that the equation
/// <para>A = Q * R</para> holds with roundoff errors. ('*'
/// denotes matrix multiplication.)
/// <para>Q and R will be solid ILArray's.</para></remarks>
public static /*!HC:inCls1*/ ILArray <double> qr(
/*!HC:inCls1*/ ILArray <double> A,
ref /*!HC:inCls1*/ ILArray <double> R, bool economySize)
{
if (Object.Equals(R, null))
{
return(qr(A));
}
int m = A.Dimensions[0];
int n = A.Dimensions[1];
if (m < n && economySize)
{
return(qr(A, ref R, false));
}
/*!HC:inCls1*/ ILArray <double> ret;
if (m == 0 || n == 0)
{
R = new /*!HC:inCls1*/ ILArray <double> (new /*!HC:inArr1*/ double [0], m, n);
return /*!HC:inCls1*/ (ILArray <double> .empty(A.Dimensions));
}
int minMN = (m < n)?m:n;
int info = 0;
/*!HC:inArr1*/ double [] tau = new /*!HC:inArr1*/ double [minMN];
/*!HC:inArr1*/ double [] QArr;
if (m >= n)
{
ret = new /*!HC:inCls1*/ ILArray <double> (
new /*!HC:inArr1*/ double [(economySize)? minMN * m : m * m],
m, (economySize)? minMN: m);
}
else
{
// economySize is always false ... !
// a temporary array is needed for extraction of the compact lapack Q (?geqrf)
ret = new /*!HC:inCls1*/ ILArray <double> (
new /*!HC:inArr1*/ double [m * n], m, n);
}
QArr = ret.m_data;
for (int i = m * n; i-- > 0;)
{
QArr[i] = A.GetValue(i);
}
/*!HC:lapack_*geqrf*/ Lapack.dgeqrf(m, n, QArr, m, tau, ref info);
if (info != 0)
{
throw new ILArgumentException("qr: error inside lapack library (?geqrf). info=" + info.ToString());
}
// extract R, Q
if (economySize)
{
R = copyUpperTriangle(QArr, m, n, minMN);
/*!HC:lapack_*orgqr*/ Lapack.dorgqr(m, minMN, tau.Length, QArr, m, tau, ref info);
}
else
{
R = copyUpperTriangle(QArr, m, n, m);
/*!HC:lapack_*orgqr*/ Lapack.dorgqr(m, m, tau.Length, QArr, m, tau, ref info);
if (m < n)
{
ret = ret[":;0:" + (m - 1)];
}
}
if (info != 0)
{
throw new ILArgumentException("qr: error in lapack library (???gqr). info=" + info.ToString());
}
return(ret);
}
/// <summary>
/// Solve linear equation system
/// </summary>
/// <param name="A">Matrix A. Size [n x q]</param>
/// <param name="B">'rigth hand side' B. Size [n x m]</param>
/// <param name="props">Matrix properties. If defined, no checks are made for the structure of A. If the matrix A was found to be (close to or) singular, the 'MatrixProperties.Singular' flag in props will be set. This flag should be tested on return, in order to verify the reliability of the solution.</param>
/// <returns>the solution x solving multiply(A,x) = B. Size [n x m]</returns>
/// <remarks><para>depending on the <paramref name="props"/> parameter the equation system will be solved differently for special structures of A:
/// <list type="bullet">
/// <item>If A is square (q == n) and an <b>upper or lower triangular</b> matrix, the system will directly be solved via backward- or forward substitution. Therefore the Lapack function ?trtrs will be used, whenever the memory layout of A is suitable. This may be the case even for reference ILArray's!
/// <example><![CDATA[ILArray<double> A = ILMath.randn(4); // construct 4 x 4 matrix
/// A = A.T; // A is a reference array now! The transpose is fast and does not consume much memory
/// // now construct a right side and solve the equations:
/// ILArray<double> B = new ILArray<double> (1.0,2.0,3.0).T;
/// ILMath.linsolve(A,B); // ... will be carried out via Lapack, even for all arrays involved beeing reference arrays! ]]></example></item>
/// <item><para>if A is square and symmetric or hermitian, A will be decomposed into a triangular equation system using cholesky factorization and Lapack. The system is than solved using performant Lapack routines.</para>
/// <para>if during the cholesky factorization A was found to be <b>not positive definite</b> - the corresponding flag in props will be cleaned and <c>null</c> will be returned.</para></item>
/// <item>otherwise if A is square only, it will be decomposed into upper and lower triangular matrices using LU decomposition and Lapack. The triangular system is than solved using performant Lapack routines.</item>
/// <item>otherwise, if A is of size [q x n] and q != n, the system is solved using QR decomposition. A may be rank deficient. The solution is computed by use of the Lapack routine '?gelsy' and may be a reference array.</item>
/// </list></para>
/// <para>Compatibility with Matlab<sup>(R)</sup>: If A is square, the algorithm used follows the same logic as Matlab up to Rel 14, with the exception of Hessenberg matrices wich are solved via LU factorization here. The un-squared case is handled differently. A direct Lapack driver function (?gelsy) is used here. Therefore the solutions might differ! However, the solution will of course fullfill the equation A * x = B without round off errrors. </para>
/// <para>For specifiying the rank of A in the unsquare case (q != n), the eps member from <see cref="ILNumerics.Settings.ILSettings"/> class is used.</para></remarks>
public static /*!HC:inCls1*/ ILArray<double> linsolve(/*!HC:inCls1*/ ILArray<double> A, /*!HC:inCls1*/ ILArray<double> B, ref MatrixProperties props) {
if (object.Equals(A,null))
throw new ILArgumentException("linsolve: input argument A must not be null!");
if (object.Equals(B,null))
throw new ILArgumentException("linsolve: input argument B must not be null!");
if (A.IsEmpty || B.IsEmpty)
return /*!HC:inCls1*/ ILArray<double> .empty(A.Dimensions);
if (A.Dimensions[0] != B.Dimensions[0])
throw new ILArgumentException("linsolve: number of rows for matrix A must match number of rows for RHS!");
int info = 0, m = A.Dimensions[0];
/*!HC:inCls1*/ ILArray<double> ret;
if (m == A.Dimensions[1]) {
props |= MatrixProperties.Square;
if ((props & MatrixProperties.LowerTriangular) != 0) {
ret = solveLowerTriangularSystem(A,B,ref info);
if (info > 0)
props |= MatrixProperties.Singular;
return ret;
}
if ((props & MatrixProperties.UpperTriangular) != 0) {
ret = solveUpperTriangularSystem(A,B, ref info);
if (info > 0)
props |= MatrixProperties.Singular;
return ret;
}
if ((props & MatrixProperties.Hermitian) != 0) {
/*!HC:inCls1*/ ILArray<double> cholFact = A.copyUpperTriangle(m);
/*!HC:lapack_*potrf*/ Lapack.dpotrf ('U', m, cholFact.m_data, m, ref info);
if (info > 0) {
props ^= MatrixProperties.Hermitian;
return null;
} else {
// solve
ret = (/*!HC:inCls1*/ ILArray<double> )B.Clone();
/*!HC:lapack_*potrs*/ Lapack.dpotrs ('U',m,B.Dimensions[1],cholFact.m_data,m,ret.m_data,m,ref info);
return ret;
}
} else {
// attempt complete (expensive) LU factorization
/*!HC:inCls1*/ ILArray<double> L = (/*!HC:inCls1*/ ILArray<double> )A.Clone();
int [] pivInd = new int[m];
/*!HC:lapack_*getrf*/ Lapack.dgetrf (m, m, L.m_data, m, pivInd ,ref info);
if (info > 0)
props |= MatrixProperties.Singular;
ret = (/*!HC:inCls1*/ ILArray<double> )B.Clone();
/*!HC:lapack_*getrs*/ Lapack.dgetrs ('N',m,B.Dimensions[1],L.m_data,m,pivInd,ret.m_data,m,ref info);
if (info < 0)
throw new ILArgumentException("linsolve: failed to solve via lapack dgetrs");
return ret;
}
} else {
// under- / overdetermined system
int n = A.Dimensions[1], rank = 0, minMN = (m < n)? m:n, maxMN = (m > n)? m:n;
int nrhs = B.Dimensions[1];
if (B.Dimensions[0] != m)
throw new ILArgumentException("linsolve: right hand side matrix B must match input A!");
/*!HC:inCls1*/ ILArray<double> tmpA = (/*!HC:inCls1*/ ILArray<double> )A.Clone();
if (m < n) {
ret = new /*!HC:inCls1*/ ILArray<double> (new /*!HC:inArr1*/ double [n * nrhs],n,nrhs);
ret["0:"+(m-1)+";:"] = B;
} else {
ret = (/*!HC:inCls1*/ ILArray<double> )B.Clone();
}
int [] JPVT = new int [n];
/*!HC:Lapack.?gelsy*/ Lapack.dgelsy (m, n, B.Dimensions[1], tmpA.m_data, m, ret.m_data,
maxMN, JPVT, /*!HC:HycalpEPS*/ ILMath.MachineParameterDouble.eps ,
ref rank, ref info);
if (n < m) {
ret = ret[ILMath.vector(0,n-1),null];
}
if (rank < minMN)
props |= MatrixProperties.RankDeficient;
return ret;
}
}
/// <summary>
/// Solve system of linear equations A*x = b, with A beeing a lower triangular matrix
/// </summary>
/// <param name="A">input matrix of Size [n x n], must be lower triangular. No check is made for that!</param>
/// <param name="B">solution vector. Size [n x 1]</param>
/// <param name="singularityDetect">output: this value gives the row of A, where a singularity has been detected (if any). If A is not singular, this will be a negative value.</param>
/// <returns>Solution x solving A * x = b.</returns>
/// <remarks><para>The solution will be determined via forward substitution</para>
/// <para>Make sure, A and b are of correct size, since no checks are made for that!</para>
/// <para>This function is used by ILMath.linsolve. There should be rare need for you to call this function directly.</para>
/// <para>Elements of A above the main diagonal will not be accessed.</para>
/// <para>If A has been found to be singular, the array returned will contain NaN values for corresponding elements!</para></remarks>
internal static /*!HC:inCls1*/ ILArray<double> solveLowerTriangularSystem (/*!HC:inCls1*/ ILArray<double> A, /*!HC:inCls1*/ ILArray<double> B, ref int singularityDetect) {
System.Diagnostics.Debug.Assert(B.Dimensions[1] >= 0);
System.Diagnostics.Debug.Assert(B.Dimensions[0] == A.Dimensions[1]);
System.Diagnostics.Debug.Assert(A.Dimensions[0] == A.Dimensions[1]);
singularityDetect = -1;
int n = A.Dimensions[0];
int m = B.Dimensions[1];
int spacingA0, spacingA1, info = 0;
char transA;
/*!HC:inCls1*/ ILArray<double> ret = (/*!HC:inCls1*/ ILArray<double> )B.Clone();
/*!HC:inArr1*/ double [] retArr = ret.m_data;
if (isSuitableForLapack(A,out spacingA0,out spacingA1,out transA)) {
// solve using Lapack
unsafe {
fixed (/*!HC:inArr1*/ double * ptrA = A.m_data)
fixed (/*!HC:inArr1*/ double * ptrB = ret.m_data) {
/*!HC:inArr1*/ double * pA = ptrA + A.getBaseIndex(0);
/*!HC:lapack.?trtrs*/ Lapack.dtrtrs ((transA == 'T')? 'U':'L',transA,'N',A.Dimensions[0],ret.Dimensions[1],(IntPtr)pA,spacingA1,(IntPtr)ptrB,n,ref info);
if (info < 0)
throw new ILArgumentException ("linsolve: error inside Lapack function ?trtrs for argument: " + (-info));
if (info > 0) {
singularityDetect = info-1;
retArr = ret.m_data;
for (spacingA0 = 0; spacingA0 < ret.Dimensions[1]; spacingA0++) {
info = spacingA0 * n + singularityDetect;
for (spacingA1 = singularityDetect; spacingA1 < n; spacingA1++) {
retArr[info++] = /*!HC:notANumber*/ double.NaN ;
}
}
} else {
singularityDetect = -1;
}
}
}
return ret;
}
// must do it manually....
System.Diagnostics.Debug.Assert(A.IsReference);
int[] Adim0 = A.m_indexOffset[0];
int[] Adim1 = A.m_indexOffset[1];
/*!HC:inArr1*/ double diagVal = /*!HC:zeroVal*/ 0.0 ;
/*!HC:inArr1*/ double tmpVal;
for (int b = 0; b < m; b++) {
for (int r = 0; r < n; r++) {
tmpVal = /*!HC:zeroVal*/ 0.0 ;
diagVal = A.GetValue(r,r);
if (diagVal == /*!HC:zeroVal*/ 0.0 ) {
singularityDetect = r;
for (; r < n; r++)
retArr[r + b * n] = /*!HC:posInfty*/ double.PositiveInfinity ;
} else {
for (int c = 0; c < r; c++) {
tmpVal += A.m_data[Adim0[r] + Adim1[c]] * retArr[c + b * n];
}
retArr[r + b * n] = (retArr[r + b * n] - tmpVal) / diagVal;
}
}
}
ret = new /*!HC:inCls1*/ ILArray<double> (retArr,n,m);
return ret;
}
/// <summary>
/// Solve linear equation system
/// </summary>
/// <param name="A">Matrix A. Size [n x q]</param>
/// <param name="B">'rigth hand side' B. Size [n x m]</param>
/// <param name="props">Matrix properties. If defined, no checks are made for the structure of A. If the matrix A was found to be (close to or) singular, the 'MatrixProperties.Singular' flag in props will be set. This flag should be tested on return, in order to verify the reliability of the solution.</param>
/// <returns>the solution x solving multiply(A,x) = B. Size [n x m]</returns>
/// <remarks><para>depending on the <paramref name="props"/> parameter the equation system will be solved differently for special structures of A:
/// <list type="bullet">
/// <item>If A is square (q == n) and an <b>upper or lower triangular</b> matrix, the system will directly be solved via backward- or forward substitution. Therefore the Lapack function ?trtrs will be used, whenever the memory layout of A is suitable. This may be the case even for reference ILArray's!
/// <example><![CDATA[ILArray<double> A = ILMath.randn(4); // construct 4 x 4 matrix
/// A = A.T; // A is a reference array now! The transpose is fast and does not consume much memory
/// // now construct a right side and solve the equations:
/// ILArray<double> B = new ILArray<double> (1.0,2.0,3.0).T;
/// ILMath.linsolve(A,B); // ... will be carried out via Lapack, even for all arrays involved beeing reference arrays! ]]></example></item>
/// <item><para>if A is square and symmetric or hermitian, A will be decomposed into a triangular equation system using cholesky factorization and Lapack. The system is than solved using performant Lapack routines.</para>
/// <para>if during the cholesky factorization A was found to be <b>not positive definite</b> - the corresponding flag in props will be cleaned and <c>null</c> will be returned.</para></item>
/// <item>otherwise if A is square only, it will be decomposed into upper and lower triangular matrices using LU decomposition and Lapack. The triangular system is than solved using performant Lapack routines.</item>
/// <item>otherwise, if A is of size [q x n] and q != n, the system is solved using QR decomposition. A may be rank deficient. The solution is computed by use of the Lapack routine '?gelsy' and may be a reference array.</item>
/// </list></para>
/// <para>Compatibility with Matlab<sup>(R)</sup>: If A is square, the algorithm used follows the same logic as Matlab up to Rel 14, with the exception of Hessenberg matrices wich are solved via LU factorization here. The un-squared case is handled differently. A direct Lapack driver function (?gelsy) is used here. Therefore the solutions might differ! However, the solution will of course fullfill the equation A * x = B without round off errrors. </para>
/// <para>For specifiying the rank of A in the unsquare case (q != n), the eps member from <see cref="ILNumerics.Settings.ILSettings"/> class is used.</para></remarks>
public static /*!HC:inCls1*/ ILArray <double> linsolve(/*!HC:inCls1*/ ILArray <double> A, /*!HC:inCls1*/ ILArray <double> B, ref MatrixProperties props)
{
if (object.Equals(A, null))
{
throw new ILArgumentException("linsolve: input argument A must not be null!");
}
if (object.Equals(B, null))
{
throw new ILArgumentException("linsolve: input argument B must not be null!");
}
if (A.IsEmpty || B.IsEmpty)
{
return /*!HC:inCls1*/ (ILArray <double> .empty(A.Dimensions));
}
if (A.Dimensions[0] != B.Dimensions[0])
{
throw new ILArgumentException("linsolve: number of rows for matrix A must match number of rows for RHS!");
}
int info = 0, m = A.Dimensions[0];
/*!HC:inCls1*/ ILArray <double> ret;
if (m == A.Dimensions[1])
{
props |= MatrixProperties.Square;
if ((props & MatrixProperties.LowerTriangular) != 0)
{
ret = solveLowerTriangularSystem(A, B, ref info);
if (info > 0)
{
props |= MatrixProperties.Singular;
}
return(ret);
}
if ((props & MatrixProperties.UpperTriangular) != 0)
{
ret = solveUpperTriangularSystem(A, B, ref info);
if (info > 0)
{
props |= MatrixProperties.Singular;
}
return(ret);
}
if ((props & MatrixProperties.Hermitian) != 0)
{
/*!HC:inCls1*/ ILArray <double> cholFact = A.copyUpperTriangle(m);
/*!HC:lapack_*potrf*/ Lapack.dpotrf('U', m, cholFact.m_data, m, ref info);
if (info > 0)
{
props ^= MatrixProperties.Hermitian;
return(null);
}
else
{
// solve
ret = (/*!HC:inCls1*/ ILArray <double>)B.Clone();
/*!HC:lapack_*potrs*/ Lapack.dpotrs('U', m, B.Dimensions[1], cholFact.m_data, m, ret.m_data, m, ref info);
return(ret);
}
}
else
{
// attempt complete (expensive) LU factorization
/*!HC:inCls1*/ ILArray <double> L = (/*!HC:inCls1*/ ILArray <double>)A.Clone();
int [] pivInd = new int[m];
/*!HC:lapack_*getrf*/ Lapack.dgetrf(m, m, L.m_data, m, pivInd, ref info);
if (info > 0)
{
props |= MatrixProperties.Singular;
}
ret = (/*!HC:inCls1*/ ILArray <double>)B.Clone();
/*!HC:lapack_*getrs*/ Lapack.dgetrs('N', m, B.Dimensions[1], L.m_data, m, pivInd, ret.m_data, m, ref info);
if (info < 0)
{
throw new ILArgumentException("linsolve: failed to solve via lapack dgetrs");
}
return(ret);
}
}
else
{
// under- / overdetermined system
int n = A.Dimensions[1], rank = 0, minMN = (m < n)? m:n, maxMN = (m > n)? m:n;
int nrhs = B.Dimensions[1];
if (B.Dimensions[0] != m)
{
throw new ILArgumentException("linsolve: right hand side matrix B must match input A!");
}
/*!HC:inCls1*/ ILArray <double> tmpA = (/*!HC:inCls1*/ ILArray <double>)A.Clone();
if (m < n)
{
ret = new /*!HC:inCls1*/ ILArray <double> (new /*!HC:inArr1*/ double [n * nrhs], n, nrhs);
ret["0:" + (m - 1) + ";:"] = B;
}
else
{
ret = (/*!HC:inCls1*/ ILArray <double>)B.Clone();
}
int [] JPVT = new int [n];
/*!HC:Lapack.?gelsy*/ Lapack.dgelsy(m, n, B.Dimensions[1], tmpA.m_data, m, ret.m_data,
maxMN, JPVT, /*!HC:HycalpEPS*/ ILMath.MachineParameterDouble.eps,
ref rank, ref info);
if (n < m)
{
ret = ret[ILMath.vector(0, n - 1), null];
}
if (rank < minMN)
{
props |= MatrixProperties.RankDeficient;
}
return(ret);
}
}
