/// <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); }
/*!HC:TYPELIST: <hycalper> <type> <source locate="after"> inArr1 </source> <destination>complex</destination> </type> <type> <source locate="after"> dllfunc </source> <destination>zgeqp3</destination> </type> <type> <source locate="nextline"> dll1func </source> <destination>lapack_zgeqp3 (ref M, ref N, A, ref LDA, JPVT, tau, work, ref lwork, rwork, ref info);</destination> </type> <type> <source locate="nextline"> cmplxRwork </source> <destination>double[] rwork = new double[2 * N];</destination> </type> </hycalper> */ public void /*!HC:dllfunc*/ dgeqp3 ( int M,int N,/*!HC:inArr1*/ double [] A,int LDA,int [] JPVT,/*!HC:inArr1*/ double [] tau, ref int info ) { /*!HC:inArr1*/ double [] work = new /*!HC:inArr1*/ double [1]; int lwork = -1; try { /*!HC:cmplxRwork*/ /*dummy*/ /*!HC:dll1func*/ lapack_dgeqp3 (ref M, ref N, A, ref LDA, JPVT, tau, work, ref lwork, ref info); lwork = (int)work[0]; if (lwork > 0 && info == 0) { work = new /*!HC:inArr1*/ double [lwork]; /*!HC:dll1func*/ lapack_dgeqp3 (ref M, ref N, A, ref LDA, JPVT, tau, work, ref lwork, ref info); } else { throw new ILException("error in lapack_?geqp3"); } } catch (OutOfMemoryException e) { throw new ILException("error on ?geqp3. Not enough memory! " + (lwork * Marshal.SizeOf( work[0] )).ToString() + " bytes has been requested.",e); } }
/*!HC:TYPELIST: <hycalper> <type> <source locate="after"> inArr1 </source> <destination>complex</destination> </type> <type> <source locate="after"> outArr1 </source> <destination>complex</destination> </type> <type> <source locate="after"> dllfunc </source> <destination>zungqr</destination> </type> <type> <source locate="after"> lapack_***gqr </source> <destination>lapack_zungqr</destination> </type> </hycalper> */ public void /*!HC:dllfunc*/ dorgqr (int M, int N, int K, /*!HC:inArr1*/ double [] A, int lda, /*!HC:inArr1*/ double [] tau, ref int info) { /*!HC:inArr1*/ double [] work = new /*!HC:inArr1*/ double [1]; int lwork = -1; try { /*!HC:lapack_***gqr*/ lapack_dorgqr (ref M, ref N, ref K, A, ref lda, tau, work, ref lwork, ref info); lwork = (int)work[0]; if (lwork > 0 && info == 0) { work = new /*!HC:inArr1*/ double [lwork]; /*!HC:lapack_***gqr*/ lapack_dorgqr (ref M, ref N, ref K, A, ref lda, tau, work, ref lwork, ref info); } else { throw new ILException("error in lapack_?[un/or]gqr"); } } catch (OutOfMemoryException e) { throw new ILException("error on ?[un/or]gqr. Not enough memory! " + (lwork * Marshal.SizeOf( work[0] )).ToString() + " bytes has been requested.",e); } }
/*!HC:TYPELIST: <hycalper> <type> <source locate="after"> inArr1 </source> <destination>complex</destination> </type> <type> <source locate="after"> outArrS </source> <destination>double</destination> </type> <type> <source locate="after"> outArrU </source> <destination>complex</destination> </type> <type> <source locate="after"> dllfunc </source> <destination>zgetri</destination> </type> <type> <source locate="after"> dll1func </source> <destination>lapack_zgetri</destination> </type> </hycalper> */ public void /*!HC:dllfunc*/ dgetri (int N, /*!HC:inArr1*/ double [] A, int LDA, int[] IPIV, ref int info) { /*!HC:inArr1*/ double [] work = new /*!HC:inArr1*/ double [1]; int lwork = -1; try { /*!HC:dll1func*/ lapack_dgetri (ref N, A, ref LDA, IPIV, work, ref lwork, ref info); lwork = (int)work[0]; if (lwork > 0 && info == 0) { work = new /*!HC:inArr1*/ double [lwork]; /*!HC:dll1func*/ lapack_dgetri (ref N, A, ref LDA, IPIV, work, ref lwork, ref info); } else { throw new ILException("error in lapack_dgetri"); } } catch (OutOfMemoryException e) { throw new ILException("error on dgetri. Not enough memory! " + (lwork * Marshal.SizeOf( work[0] )).ToString() + " bytes has been requested.",e); } }
/*!HC:TYPELIST: <hycalper> <type> <source locate="after"> inArr1 </source> <destination>complex</destination> </type> <type> <source locate="after"> outArrS </source> <destination>double</destination> </type> <type> <source locate="after"> outArrU </source> <destination>complex</destination> </type> <type> <source locate="after"> dllfunc </source> <destination>zgesvd</destination> </type> <type> <source locate="after"> dll1func </source> <destination>lapack_zgesvd</destination> </type> </hycalper> */ /// <summary> /// singular value decomposition /// </summary> /// <param name="jobz"></param> /// <param name="m"></param> /// <param name="n"></param> /// <param name="a"></param> /// <param name="lda"></param> /// <param name="s"></param> /// <param name="u"></param> /// <param name="ldu"></param> /// <param name="vt"></param> /// <param name="ldvt"></param> /// <param name="info"></param> public void /*!HC:dllfunc*/ dgesvd (char jobz, int m, int n, /*!HC:inArr1*/ double [] a, int lda, /*!HC:outArrS*/ double [] s, /*!HC:outArrU*/ double [] u, int ldu, /*!HC:outArrU*/ double [] vt, int ldvt, ref int info) { if (jobz != 'A' && jobz != 'S' && jobz != 'N') throw new ILArgumentException("Argument jobz must be one of 'A','S' or 'N'"); try { /*!HC:inArr1*/ double [] work = new /*!HC:inArr1*/ double [1] { (/*!HC:inArr1*/ double )0.0 }; int lwork = -1; int[] iwork = new int[((m < n) ? m : n) * 8]; /*!HC:dll1func*/ lapack_dgesvd (ref jobz, ref jobz, ref m, ref n, a, ref lda, s, u, ref ldu, vt, ref ldvt, work, ref lwork, iwork, ref info); if (work[0] != 0) { work = new /*!HC:inArr1*/ double [(int)work[0]]; lwork = work.Length; /*!HC:dll1func*/ lapack_dgesvd (ref jobz, ref jobz, ref m, ref n, a, ref lda, s, u, ref ldu, vt, ref ldvt, work, ref lwork, iwork, ref info); } } catch (Exception e) { if (e is OutOfMemoryException) { throw new ILMemoryException("Not enough memory for given arguments."); } throw new ILException("Unable to do gesvd.", e); } }
/*!HC:TYPELIST: <hycalper> <type> <source locate="after"> inArr1 </source> <destination>fcomplex</destination> <destination>complex</destination> <destination>float</destination> </type> <type> <source locate="after"> dllfunc </source> <destination>cgeqrf</destination> <destination>zgeqrf</destination> <destination>sgeqrf</destination> </type> <type> <source locate="after"> dll1func </source> <destination>mkl_cgeqrf</destination> <destination>mkl_zgeqrf</destination> <destination>mkl_sgeqrf</destination> </type> </hycalper> */ public void /*!HC:dllfunc*/ dgeqrf (int M, int N, /*!HC:inArr1*/ double [] A, int lda, /*!HC:inArr1*/ double [] tau, ref int info) { /*!HC:inArr1*/ double [] work = new /*!HC:inArr1*/ double [1]; int lwork = -1; try { /*!HC:dll1func*/ mkl_dgeqrf (ref M, ref N, A, ref lda, tau, work, ref lwork, ref info); lwork = (int)work[0]; if (lwork > 0 && info == 0) { work = new /*!HC:inArr1*/ double [lwork]; /*!HC:dll1func*/ mkl_dgeqrf (ref M, ref N, A, ref lda, tau, work, ref lwork, ref info); } else { throw new ILException("error in mkl_?geqrf"); } } catch (OutOfMemoryException e) { throw new ILException("error on ?geqrf. Not enough memory! " + (lwork * Marshal.SizeOf( work[0] )).ToString() + " bytes has been requested.",e); } }
/*!HC:TYPELIST: <hycalper> <type> <source locate="after"> inArr1 </source> <destination>float</destination> </type> <type> <source locate="after"> outArrS </source> <destination>float</destination> </type> <type> <source locate="after"> outArrU </source> <destination>float</destination> </type> <type> <source locate="after"> dllfunc </source> <destination>sgesdd</destination> </type> <type> <source locate="after"> dllQuotefunc </source> <destination><![CDATA["sgesdd"]]></destination> </type> <type> <source locate="after"> dll1func </source> <destination>mkl_sgesdd</destination> </type> <type> <source locate="after"> dll2func </source> <destination>sgesvd</destination> </type> </hycalper> */ public void /*!HC:dllfunc*/ dgesdd (char jobz, int m, int n, /*!HC:inArr1*/ double [] a, int lda, /*!HC:outArrS*/ double [] s, /*!HC:outArrU*/ double [] u, int ldu, /*!HC:outArrU*/ double [] vt, int ldvt, ref int info) { try { /*!HC:inArr1*/ double [] work = new /*!HC:inArr1*/ double [1] { (/*!HC:inArr1*/ double )0.0 }; int lwork = -1; int[] iwork = new int[((m < n) ? m : n) * 8]; /*!HC:dll1func*/ mkl_dgesdd (ref jobz, ref m, ref n, a, ref lda, s, u, ref ldu, vt, ref ldvt, work, ref lwork, iwork, ref info); if (work[0] != 0) { work = new /*!HC:inArr1*/ double [(int)work[0]]; lwork = work.Length; /*!HC:dll1func*/ mkl_dgesdd (ref jobz, ref m, ref n, a, ref lda, s, u, ref ldu, vt, ref ldvt, work, ref lwork, iwork, ref info); } } catch (Exception e) { if (e is OutOfMemoryException) { /*!HC:dll2func*/ dgesvd (jobz, m, n, a, lda, s, u, ldu, vt, ldvt, ref info); } throw new ILException("Unable to do " + /*!HC:dllQuotefunc*/ "dgesdd" + ".", e); } }
/// <summary> /// singular value decomposition /// </summary> /// <param name="X">matrix X. The elements of X will not be altered.</param> /// <param name="U">(return value) left singular vectors of X as columns of matrix U. /// If this parameter is set, it must be not null. It might be an empty array. On return /// it will be set to a physical array accordingly.</param> /// <param name="V">right singular vectors of X as rows of matrix V. /// If this parameter is set, it must be not null. It might be an empty array. On return /// it will be set to a physical array accordingly.</param> /// <param name="small">if true: return only first min(M,N) columns of U and S will be /// of size [min(M,N),min(M,N)]</param> /// <param name="discardFiniteTest">if true: the matrix given will not be checked for infinte or NaN values. If such elements /// are contained nevertheless, this may result in failing convergence or error. In worst case /// the function may hang inside the Lapack lib. Use with care! </param> /// <returns>singluar values as diagonal matrix of same size as X</returns> /// <remarks>the right singular vectors V will be returned as reference array.</remarks> public static /*!HC:outClsS*/ ILArray <double> svd(/*!HC:inCls1*/ ILArray <double> X, ref /*!HC:outClsU*/ ILArray <double> U, ref /*!HC:outClsV*/ ILArray <double> V, bool small, bool discardFiniteTest) { if (!X.IsMatrix) { throw new ILArgumentSizeException("svd is defined for matrices only!"); } // early exit for small matrices if (X.Dimensions[1] < 4 && X.Dimensions[0] == X.Dimensions[1]) { switch (X.Dimensions[0]) { case 1: if (!Object.Equals(U, null)) { U = (/*!HC:outArrU*/ double )1.0; } if (!Object.Equals(V, null)) { V = (/*!HC:outArrV*/ double )1.0; } return(new /*!HC:outClsS*/ ILArray <double> (ILMath.abs(X))); //case 2: // return -1; //case 3: // return -1; } } if (!discardFiniteTest && !all(all(isfinite(X)))) { throw new ILArgumentException("svd: input must have only finite elements!"); } if (Lapack == null) { throw new ILMathException("No Lapack package available."); } // parameter evaluation int M = X.Dimensions[0]; int N = X.Dimensions[1]; int minMN = (M < N) ? M : N; int LDU = M; int LDVT = N; int LDA = M; /*!HC:outArrS*/ double [] dS = new /*!HC:outArrS*/ double [minMN]; char jobz = (small) ? 'S' : 'A'; /*!HC:outArrU*/ double [] dU = null; /*!HC:outArrV*/ double [] dVT = null; int info = 0; if (!Object.Equals(U, null) || !Object.Equals(V, null)) { // need to return U and VT if (small) { dU = new /*!HC:outArrU*/ double [M * minMN]; dVT = new /*!HC:outArrV*/ double [N * minMN]; } else { dU = new /*!HC:outArrU*/ double [M * M]; dVT = new /*!HC:outArrV*/ double [N * N]; } } else { jobz = 'N'; } // must create copy of input ! /*!HC:inArr1*/ double [] dInput = new /*!HC:inArr1*/ double [X.m_data.Length]; System.Array.Copy(X.m_data, dInput, X.m_data.Length); /*!HC:lapack_dgesdd*/ Lapack.dgesdd(jobz, M, N, dInput, LDA, dS, dU, LDU, dVT, LDVT, ref info); if (info < 0) { throw new ILArgumentException("ILMath.svd: the " + (-info).ToString() + "th argument was invalid."); } if (info > 0) { throw new ILArgumentException("svd was not converging!"); } /*!HC:outClsS*/ ILArray <double> ret = null; if (info == 0) { // success if (!Object.Equals(U, null) || !Object.Equals(V, null)) { if (small) { ret = /*!HC:outClsS*/ ILArray <double> .zeros(minMN, minMN); } else { ret = /*!HC:outClsS*/ ILArray <double> .zeros(M, N); } for (int i = 0; i < minMN; i++) { ret.SetValue(dS[i], i, i); } if (!Object.Equals(U, null)) { U = new /*!HC:outClsU*/ ILArray <double> (dU, M, dU.Length / M); } if (!Object.Equals(V, null)) { /*!HC:complxConj*/ V = new ILArray <double> (dVT, N, dVT.Length / N).T; } } else { ret = new /*!HC:outClsS*/ ILArray <double> (dS, minMN, 1); } } 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 - 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; }
/// <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); }
/*!HC:TYPELIST: <hycalper> <type> <source locate="after"> inArr1 </source> <destination>complex</destination> </type> <type> <source locate="after"> inArr2 </source> <destination>double</destination> </type> <type> <source locate="after"> dllfunc </source> <destination>zgelsd </destination> </type> <type> <source locate="after"> dll1func </source> <destination>lapack_zgeqrf</destination> </type> <type> <source locate="after"> lapack_?gelsd </source> <destination>lapack_zgelsd</destination> </type> <type> <source locate="nextline"> HycalpTag1 </source> <destination>double [] rwork = new double [1]; lapack_zgelsd (ref m, ref n, ref nrhs, A, ref lda, B, ref ldb, S,ref RCond, ref rank, work, ref lwork, rwork, iwork, ref info);</destination> </type> <type> <source locate="nextline"> HycalpTag2 </source> <destination>rwork = new double [(int)rwork[0]]; lapack_zgelsd (ref m, ref n, ref nrhs, A, ref lda, B, ref ldb, S,ref RCond, ref rank, work, ref lwork, rwork, iwork, ref info);</destination> </type> </hycalper> */ public void /*!HC:dllfunc*/ dgelsd (int m, int n, int nrhs, /*!HC:inArr1*/ double [] A, int lda, /*!HC:inArr1*/ double [] B, int ldb, /*!HC:inArr2*/ double [] S, /*!HC:inArr2*/ double RCond, ref int rank, ref int info) { /*!HC:inArr1*/ double [] work = new /*!HC:inArr1*/ double [1]; int [] iwork = new int[1]; int lwork = -1; /*HC:HycalpTag1*/ lapack_dgelsd (ref m, ref n, ref nrhs, A, ref lda, B, ref ldb, S,ref RCond, ref rank, work, ref lwork, iwork, ref info); if (info != 0) throw new ILArgumentException("dgelsd: invalid parameter: #" + (-info).ToString()); lwork = ILAENV(9, "dgelsd", " ",0,0,0,0); if (lwork <= 0) throw new ILArgumentException("dgelsd: unknown error determining working size liwork"); iwork = new int[lwork]; lwork = (int)work[0]; work = new /*!HC:inArr1*/ double [lwork]; /*HC:HycalpTag2*/ lapack_dgelsd (ref m, ref n, ref nrhs, A, ref lda, B, ref ldb, S,ref RCond, ref rank, work, ref lwork, iwork, ref info); }
// DO NOT EDIT INSIDE THIS REGION !! CHANGES WILL BE LOST !! #endregion HYCALPER AUTO GENERATED CODE #region HYCALPER LOOPSTART Matrix_multiply /*!HC:TYPELIST: * <hycalper> * <type> * <source locate="after"> * inArr1 * </source> * <destination>complex</destination> * </type> * <type> * <source locate="after"> * inArr2 * </source> * <destination>complex</destination> * </type> * <type> * <source locate="after"> * outArr1 * </source> * <destination>complex</destination> * </type> * <type> * <source locate="after"> * inCls1 * </source> * <destination><![CDATA[ILArray<complex>]]></destination> * </type> * <type> * <source locate="after"> * inCls2 * </source> * <destination><![CDATA[ILArray<complex>]]></destination> * </type> * <type> * <source locate="after"> * outCls1 * </source> * <destination><![CDATA[ILArray<complex>]]></destination> * </type> * <type> * <source locate="after"> * lapackfunc * </source> * <destination>Lapack.zgemm</destination> * </type> * </hycalper> */ /// <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 /*!HC:outCls1*/ ILArray <double> multiply(/*!HC:inCls1*/ ILArray <double> A, /*!HC:inCls2*/ ILArray <double> B) { /*!HC:outCls1*/ ILArray <double> 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; /*!HC:inArr1*/ double [] 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 /*!HC:inArr1*/ double [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 /*!HC:outCls1*/ ILArray <double> (retArr, new ILDimension(A.m_dimensions[0], B.m_dimensions[1])); if (transA == 't') { spacingA1 = spacingA0; } if (transB == 't') { spacingB1 = spacingB0; } unsafe { fixed(/*!HC:outArr1*/ double *ptrC = retArr) fixed(/*!HC:inArr1*/ double *pA = A.m_data) fixed(/*!HC:inArr2*/ double *pB = B.m_data) { /*!HC:inArr1*/ double *ptrA = pA + A.getBaseIndex(0); /*!HC:inArr2*/ double *ptrB = pB + B.getBaseIndex(0); if (transA == 't') { spacingA1 = spacingA0; } if (transB == 't') { spacingB1 = spacingB0; } /*!HC:lapackfunc*/ Lapack.dgemm(transA, transB, A.m_dimensions[0], B.m_dimensions[1], A.m_dimensions[1], (/*!HC:inArr1*/ double )1.0, (IntPtr)ptrA, spacingA1, (IntPtr)ptrB, spacingB1, (/*!HC:inArr1*/ double )1.0, retArr, A.m_dimensions[0]); } } return(ret); } } // do GEMM by hand retArr = new /*!HC:outArr1*/ double [A.m_dimensions[0] * B.m_dimensions[1]]; ret = new /*!HC:outCls1*/ ILArray <double> (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(/*!HC:outArr1*/ double *ptrC = retArr) { /*!HC:outArr1*/ double *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); }
/*!HC:TYPELIST: <hycalper> <type> <source locate="after"> inArr1 </source> <destination>complex</destination> </type> <type> <source locate="after"> inArr2 </source> <destination>double</destination> </type> <type> <source locate="after"> dllfunc </source> <destination>zgelsy </destination> </type> <type> <source locate="nextline"> lapack_?gelsy </source> <destination>lapack_zgelsy (ref m,ref n,ref nrhs,A,ref lda,B,ref ldb,JPVT0,ref RCond,ref rank,work,ref lwork, rwork, ref info);</destination> </type> <type> <source locate="after"> hycalpRwork1 </source> <destination>double[] rwork = new double[1];</destination> </type> <type> <source locate="after"> hycalpRwork2 </source> <destination>rwork = new double[lwork];</destination> </type> </hycalper> */ public void /*!HC:dllfunc*/ dgelsy (int m, int n, int nrhs, /*!HC:inArr1*/ double [] A, int lda, /*!HC:inArr1*/ double [] B, int ldb, int[] JPVT0, /*!HC:inArr2*/ double RCond, ref int rank, ref int info) { int lwork = -1; /*!HC:inArr1*/ double [] work = new /*!HC:inArr1*/ double [1]; /*!HC:hycalpRwork1*/ // /*!HC:lapack_?gelsy*/ lapack_dgelsy (ref m,ref n,ref nrhs,A,ref lda,B,ref ldb,JPVT0,ref RCond,ref rank,work,ref lwork,ref info); if (info != 0) throw new ILArgumentException("?gelsy: unable to determine optimal block size. cancelling..."); lwork = (int) work[0]; work = new /*!HC:inArr1*/ double [lwork]; /*!HC:hycalpRwork2*/ // /*!HC:lapack_?gelsy*/ lapack_dgelsy (ref m,ref n,ref nrhs,A,ref lda,B,ref ldb,JPVT0,ref RCond,ref rank,work,ref lwork,ref info); }
/// <summary> /// singular value decomposition /// </summary> /// <param name="X">matrix X. The elements of X will not be altered.</param> /// <param name="U">(return value) left singular vectors of X as columns of matrix U. /// If this parameter is set, it must be not null. It might be an empty array. On return /// it will be set to a physical array accordingly.</param> /// <param name="V">right singular vectors of X as rows of matrix V. /// If this parameter is set, it must be not null. It might be an empty array. On return /// it will be set to a physical array accordingly.</param> /// <param name="small">if true: return only first min(M,N) columns of U and S will be /// of size [min(M,N),min(M,N)]</param> /// <param name="discardFiniteTest">if true: the matrix given will not be checked for infinte or NaN values. If such elements /// are contained nevertheless, this may result in failing convergence or error. In worst case /// the function may hang inside the Lapack lib. Use with care! </param> /// <returns>singluar values as diagonal matrix of same size as X</returns> /// <remarks>the right singular vectors V will be returned as reference array.</remarks> public static /*!HC:outClsS*/ ILArray<double> svd(/*!HC:inCls1*/ ILArray<double> X, ref /*!HC:outClsU*/ ILArray<double> U, ref /*!HC:outClsV*/ ILArray<double> V, bool small, bool discardFiniteTest) { if (!X.IsMatrix) throw new ILArgumentSizeException("svd is defined for matrices only!"); // early exit for small matrices if (X.Dimensions[1] < 4 && X.Dimensions[0] == X.Dimensions[1]) { switch (X.Dimensions[0]) { case 1: if (!Object.Equals(U,null)) U = (/*!HC:outArrU*/ double ) 1.0; if (!Object.Equals(V,null)) V = (/*!HC:outArrV*/ double ) 1.0; return new /*!HC:outClsS*/ ILArray<double> ( ILMath.abs(X)); //case 2: // return -1; //case 3: // return -1; } } if (!discardFiniteTest && !all(all(isfinite( X )))) throw new ILArgumentException("svd: input must have only finite elements!"); if (Lapack == null) throw new ILMathException("No Lapack package available."); // parameter evaluation int M = X.Dimensions[0]; int N = X.Dimensions[1]; int minMN = (M < N) ? M : N; int LDU = M; int LDVT = N; int LDA = M; /*!HC:outArrS*/ double [] dS = new /*!HC:outArrS*/ double [minMN]; char jobz = (small) ? 'S' : 'A'; /*!HC:outArrU*/ double [] dU = null; /*!HC:outArrV*/ double [] dVT = null; int info = 0; if (!Object.Equals(U, null) || !Object.Equals(V, null)) { // need to return U and VT if (small) { dU = new /*!HC:outArrU*/ double [M * minMN]; dVT = new /*!HC:outArrV*/ double [N * minMN]; } else { dU = new /*!HC:outArrU*/ double [M * M]; dVT = new /*!HC:outArrV*/ double [N * N]; } } else { jobz = 'N'; } if (X.IsReference) { X.Detach(); } // must create copy of input ! /*!HC:inArr1*/ double [] dInput = new /*!HC:inArr1*/ double [X.m_data.Length]; System.Array.Copy(X.m_data, dInput, X.m_data.Length); /*!HC:lapack_dgesdd*/ Lapack.dgesdd(jobz, M, N, dInput, LDA, dS, dU, LDU, dVT, LDVT, ref info); if (info < 0) throw new ILArgumentException ("ILMath.svd: the " + (-info).ToString() +"th argument was invalid."); if (info > 0) throw new ILArgumentException("svd was not converging!"); /*!HC:outClsS*/ ILArray<double> ret = null; if (info == 0) { // success if (!Object.Equals(U, null) || !Object.Equals(V, null)) { if (small) { ret = /*!HC:outClsS*/ ILArray<double> .zeros(minMN,minMN); } else { ret = /*!HC:outClsS*/ ILArray<double> .zeros(M, N); } for (int i = 0; i < minMN; i++) { ret.SetValue(dS[i],i,i); } if (!Object.Equals(U, null)) U = new /*!HC:outClsU*/ ILArray<double> (dU,M,dU.Length / M); if (!Object.Equals(V, null)) { /*!HC:complxConj*/ V = new ILArray<double> (dVT,N,dVT.Length / N).T; } } else { ret = new /*!HC:outClsS*/ ILArray<double> (dS,minMN,1); } } return ret; }