/// <summary> /// Nonsymmetric reduction from Hessenberg to real Schur form. /// </summary> /// <param name="matrixH">Array for internal storage of nonsymmetric Hessenberg form.</param> /// <param name="order">Order of initial matrix</param> /// <remarks>This is derived from the Algol procedure hqr2, /// by Martin and Wilkinson, Handbook for Auto. Comp., /// Vol.ii-Linear Algebra, and the corresponding /// Fortran subroutine in EISPACK.</remarks> private void NonsymmetricReduceHessenberToRealSchur(Complex32[,] matrixH, int order) { // Initialize var n = order - 1; var eps = (float)Precision.SingleMachinePrecision; float norm; Complex32 x, y, z, exshift = Complex32.Zero; // Outer loop over eigenvalue index var iter = 0; while (n >= 0) { // Look for single small sub-diagonal element var l = n; while (l > 0) { var tst1 = Math.Abs(matrixH[l - 1, l - 1].Real) + Math.Abs(matrixH[l - 1, l - 1].Imaginary) + Math.Abs(matrixH[l, l].Real) + Math.Abs(matrixH[l, l].Imaginary); if (Math.Abs(matrixH[l, l - 1].Real) < eps * tst1) { break; } l--; } // Check for convergence // One root found if (l == n) { matrixH[n, n] += exshift; VectorEv[n] = matrixH[n, n].ToComplex(); n--; iter = 0; } else { // Form shift Complex32 s; if (iter != 10 && iter != 20) { s = matrixH[n, n]; x = matrixH[n - 1, n] * matrixH[n, n - 1].Real; if (x.Real != 0.0f || x.Imaginary != 0.0f) { y = (matrixH[n - 1, n - 1] - s) / 2.0f; z = ((y * y) + x).SquareRoot(); if ((y.Real * z.Real) + (y.Imaginary * z.Imaginary) < 0.0f) { z *= -1.0f; } x /= y + z; s = s - x; } } else { // Form exceptional shift s = Math.Abs(matrixH[n, n - 1].Real) + Math.Abs(matrixH[n - 1, n - 2].Real); } for (var i = 0; i <= n; i++) { matrixH[i, i] -= s; } exshift += s; iter++; // Reduce to triangle (rows) for (var i = l + 1; i <= n; i++) { s = matrixH[i, i - 1].Real; norm = SpecialFunctions.Hypotenuse(matrixH[i - 1, i - 1].Magnitude, s.Real); x = matrixH[i - 1, i - 1] / norm; VectorEv[i - 1] = x.ToComplex(); matrixH[i - 1, i - 1] = norm; matrixH[i, i - 1] = new Complex32(0.0f, s.Real / norm); for (var j = i; j < order; j++) { y = matrixH[i - 1, j]; z = matrixH[i, j]; matrixH[i - 1, j] = (x.Conjugate() * y) + (matrixH[i, i - 1].Imaginary * z); matrixH[i, j] = (x * z) - (matrixH[i, i - 1].Imaginary * y); } } s = matrixH[n, n]; if (s.Imaginary != 0.0f) { s /= matrixH[n, n].Magnitude; matrixH[n, n] = matrixH[n, n].Magnitude; for (var j = n + 1; j < order; j++) { matrixH[n, j] *= s.Conjugate(); } } // Inverse operation (columns). for (var j = l + 1; j <= n; j++) { x = (Complex32)VectorEv[j - 1]; for (var i = 0; i <= j; i++) { z = matrixH[i, j]; if (i != j) { y = matrixH[i, j - 1]; matrixH[i, j - 1] = (x * y) + (matrixH[j, j - 1].Imaginary * z); } else { y = matrixH[i, j - 1].Real; matrixH[i, j - 1] = new Complex32((x.Real * y.Real) - (x.Imaginary * y.Imaginary) + (matrixH[j, j - 1].Imaginary * z.Real), matrixH[i, j - 1].Imaginary); } matrixH[i, j] = (x.Conjugate() * z) - (matrixH[j, j - 1].Imaginary * y); } for (var i = 0; i < order; i++) { y = MatrixEv.At(i, j - 1); z = MatrixEv.At(i, j); MatrixEv.At(i, j - 1, (x * y) + (matrixH[j, j - 1].Imaginary * z)); MatrixEv.At(i, j, (x.Conjugate() * z) - (matrixH[j, j - 1].Imaginary * y)); } } if (s.Imaginary != 0.0f) { for (var i = 0; i <= n; i++) { matrixH[i, n] *= s; } for (var i = 0; i < order; i++) { MatrixEv.At(i, n, MatrixEv.At(i, n) * s); } } } } // All roots found. // Backsubstitute to find vectors of upper triangular form norm = 0.0f; for (var i = 0; i < order; i++) { for (var j = i; j < order; j++) { norm = Math.Max(norm, Math.Abs(matrixH[i, j].Real) + Math.Abs(matrixH[i, j].Imaginary)); } } if (order == 1) { return; } if (norm == 0.0f) { return; } for (n = order - 1; n > 0; n--) { x = (Complex32)VectorEv[n]; matrixH[n, n] = 1.0f; for (var i = n - 1; i >= 0; i--) { z = 0.0f; for (var j = i + 1; j <= n; j++) { z += matrixH[i, j] * matrixH[j, n]; } y = x - (Complex32)VectorEv[i]; if (y.Real == 0.0f && y.Imaginary == 0.0f) { y = eps * norm; } matrixH[i, n] = z / y; // Overflow control var tr = Math.Abs(matrixH[i, n].Real) + Math.Abs(matrixH[i, n].Imaginary); if ((eps * tr) * tr > 1) { for (var j = i; j <= n; j++) { matrixH[j, n] = matrixH[j, n] / tr; } } } } // Back transformation to get eigenvectors of original matrix for (var j = order - 1; j > 0; j--) { for (var i = 0; i < order; i++) { z = Complex32.Zero; for (var k = 0; k <= j; k++) { z += MatrixEv.At(i, k) * matrixH[k, j]; } MatrixEv.At(i, j, z); } } }
/// <summary> /// Symmetric tridiagonal QL algorithm. /// </summary> /// <param name="d">Arrays for internal storage of real parts of eigenvalues</param> /// <param name="e">Arrays for internal storage of imaginary parts of eigenvalues</param> /// <param name="order">Order of initial matrix</param> /// <remarks>This is derived from the Algol procedures tql2, by /// Bowdler, Martin, Reinsch, and Wilkinson, Handbook for /// Auto. Comp., Vol.ii-Linear Algebra, and the corresponding /// Fortran subroutine in EISPACK.</remarks> /// <exception cref="NonConvergenceException"></exception> private void SymmetricDiagonalize(float[] d, float[] e, int order) { const int Maxiter = 1000; for (var i = 1; i < order; i++) { e[i - 1] = e[i]; } e[order - 1] = 0.0f; var f = 0.0f; var tst1 = 0.0f; var eps = Precision.DoubleMachinePrecision; for (var l = 0; l < order; l++) { // Find small subdiagonal element tst1 = Math.Max(tst1, Math.Abs(d[l]) + Math.Abs(e[l])); var m = l; while (m < order) { if (Math.Abs(e[m]) <= eps * tst1) { break; } m++; } // If m == l, d[l] is an eigenvalue, // otherwise, iterate. if (m > l) { var iter = 0; do { iter = iter + 1; // (Could check iteration count here.) // Compute implicit shift var g = d[l]; var p = (d[l + 1] - g) / (2.0f * e[l]); var r = SpecialFunctions.Hypotenuse(p, 1.0f); if (p < 0) { r = -r; } d[l] = e[l] / (p + r); d[l + 1] = e[l] * (p + r); var dl1 = d[l + 1]; var h = g - d[l]; for (var i = l + 2; i < order; i++) { d[i] -= h; } f = f + h; // Implicit QL transformation. p = d[m]; var c = 1.0f; var c2 = c; var c3 = c; var el1 = e[l + 1]; var s = 0.0f; var s2 = 0.0f; for (var i = m - 1; i >= l; i--) { c3 = c2; c2 = c; s2 = s; g = c * e[i]; h = c * p; r = SpecialFunctions.Hypotenuse(p, e[i]); e[i + 1] = s * r; s = e[i] / r; c = p / r; p = (c * d[i]) - (s * g); d[i + 1] = h + (s * ((c * g) + (s * d[i]))); // Accumulate transformation. for (var k = 0; k < order; k++) { h = MatrixEv.At(k, i + 1).Real; MatrixEv.At(k, i + 1, (s * MatrixEv.At(k, i).Real) + (c * h)); MatrixEv.At(k, i, (c * MatrixEv.At(k, i).Real) - (s * h)); } } p = (-s) * s2 * c3 * el1 * e[l] / dl1; e[l] = s * p; d[l] = c * p; // Check for convergence. If too many iterations have been performed, // throw exception that Convergence Failed if (iter >= Maxiter) { throw new NonConvergenceException(); } }while (Math.Abs(e[l]) > eps * tst1); } d[l] = d[l] + f; e[l] = 0.0f; } // Sort eigenvalues and corresponding vectors. for (var i = 0; i < order - 1; i++) { var k = i; var p = d[i]; for (var j = i + 1; j < order; j++) { if (d[j] < p) { k = j; p = d[j]; } } if (k != i) { d[k] = d[i]; d[i] = p; for (var j = 0; j < order; j++) { p = MatrixEv.At(j, i).Real; MatrixEv.At(j, i, MatrixEv.At(j, k)); MatrixEv.At(j, k, p); } } } }
/// <summary> /// Nonsymmetric reduction to Hessenberg form. /// </summary> /// <param name="matrixH">Array for internal storage of nonsymmetric Hessenberg form.</param> /// <param name="order">Order of initial matrix</param> /// <remarks>This is derived from the Algol procedures orthes and ortran, /// by Martin and Wilkinson, Handbook for Auto. Comp., /// Vol.ii-Linear Algebra, and the corresponding /// Fortran subroutines in EISPACK.</remarks> private void NonsymmetricReduceToHessenberg(Complex32[,] matrixH, int order) { var ort = new Complex32[order]; for (var m = 1; m < order - 1; m++) { // Scale column. var scale = 0.0f; for (var i = m; i < order; i++) { scale += Math.Abs(matrixH[i, m - 1].Real) + Math.Abs(matrixH[i, m - 1].Imaginary); } if (scale != 0.0f) { // Compute Householder transformation. var h = 0.0f; for (var i = order - 1; i >= m; i--) { ort[i] = matrixH[i, m - 1] / scale; h += ort[i].MagnitudeSquared; } var g = (float)Math.Sqrt(h); if (ort[m].Magnitude != 0) { h = h + (ort[m].Magnitude * g); g /= ort[m].Magnitude; ort[m] = (1.0f + g) * ort[m]; } else { ort[m] = g; matrixH[m, m - 1] = scale; } // Apply Householder similarity transformation // H = (I-u*u'/h)*H*(I-u*u')/h) for (var j = m; j < order; j++) { var f = Complex32.Zero; for (var i = order - 1; i >= m; i--) { f += ort[i].Conjugate() * matrixH[i, j]; } f = f / h; for (var i = m; i < order; i++) { matrixH[i, j] -= f * ort[i]; } } for (var i = 0; i < order; i++) { var f = Complex32.Zero; for (var j = order - 1; j >= m; j--) { f += ort[j] * matrixH[i, j]; } f = f / h; for (var j = m; j < order; j++) { matrixH[i, j] -= f * ort[j].Conjugate(); } } ort[m] = scale * ort[m]; matrixH[m, m - 1] *= -g; } } // Accumulate transformations (Algol's ortran). for (var i = 0; i < order; i++) { for (var j = 0; j < order; j++) { MatrixEv.At(i, j, i == j ? Complex32.One : Complex32.Zero); } } for (var m = order - 2; m >= 1; m--) { if (matrixH[m, m - 1] != Complex32.Zero && ort[m] != Complex32.Zero) { var norm = (matrixH[m, m - 1].Real * ort[m].Real) + (matrixH[m, m - 1].Imaginary * ort[m].Imaginary); for (var i = m + 1; i < order; i++) { ort[i] = matrixH[i, m - 1]; } for (var j = m; j < order; j++) { var g = Complex32.Zero; for (var i = m; i < order; i++) { g += ort[i].Conjugate() * MatrixEv.At(i, j); } // Double division avoids possible underflow g /= norm; for (var i = m; i < order; i++) { MatrixEv.At(i, j, MatrixEv.At(i, j) + g * ort[i]); } } } } // Create real subdiagonal elements. for (var i = 1; i < order; i++) { if (matrixH[i, i - 1].Imaginary != 0.0f) { var y = matrixH[i, i - 1] / matrixH[i, i - 1].Magnitude; matrixH[i, i - 1] = matrixH[i, i - 1].Magnitude; for (var j = i; j < order; j++) { matrixH[i, j] *= y.Conjugate(); } for (var j = 0; j <= Math.Min(i + 1, order - 1); j++) { matrixH[j, i] *= y; } for (var j = 0; j < order; j++) { MatrixEv.At(j, i, MatrixEv.At(j, i) * y); } } } }
/// <summary> /// Nonsymmetric reduction from Hessenberg to real Schur form. /// </summary> /// <param name="matrixH">Array for internal storage of nonsymmetric Hessenberg form.</param> /// <param name="d">Arrays for internal storage of real parts of eigenvalues</param> /// <param name="e">Arrays for internal storage of imaginary parts of eigenvalues</param> /// <param name="order">Order of initial matrix</param> /// <remarks>This is derived from the Algol procedure hqr2, /// by Martin and Wilkinson, Handbook for Auto. Comp., /// Vol.ii-Linear Algebra, and the corresponding /// Fortran subroutine in EISPACK.</remarks> private void NonsymmetricReduceHessenberToRealSchur(double[,] matrixH, double[] d, double[] e, int order) { // Initialize var n = order - 1; var eps = Precision.DoubleMachinePrecision; var exshift = 0.0; double p = 0, q = 0, r = 0, s = 0, z = 0, w, x, y; // Store roots isolated by balanc and compute matrix norm var norm = 0.0; for (var i = 0; i < order; i++) { for (var j = Math.Max(i - 1, 0); j < order; j++) { norm = norm + Math.Abs(matrixH[i, j]); } } // Outer loop over eigenvalue index var iter = 0; while (n >= 0) { // Look for single small sub-diagonal element var l = n; while (l > 0) { s = Math.Abs(matrixH[l - 1, l - 1]) + Math.Abs(matrixH[l, l]); if (s == 0.0) { s = norm; } if (Math.Abs(matrixH[l, l - 1]) < eps * s) { break; } l--; } // Check for convergence // One root found if (l == n) { matrixH[n, n] = matrixH[n, n] + exshift; d[n] = matrixH[n, n]; e[n] = 0.0; n--; iter = 0; // Two roots found } else if (l == n - 1) { w = matrixH[n, n - 1] * matrixH[n - 1, n]; p = (matrixH[n - 1, n - 1] - matrixH[n, n]) / 2.0; q = (p * p) + w; z = Math.Sqrt(Math.Abs(q)); matrixH[n, n] = matrixH[n, n] + exshift; matrixH[n - 1, n - 1] = matrixH[n - 1, n - 1] + exshift; x = matrixH[n, n]; // Real pair if (q >= 0) { if (p >= 0) { z = p + z; } else { z = p - z; } d[n - 1] = x + z; d[n] = d[n - 1]; if (z != 0.0) { d[n] = x - (w / z); } e[n - 1] = 0.0; e[n] = 0.0; x = matrixH[n, n - 1]; s = Math.Abs(x) + Math.Abs(z); p = x / s; q = z / s; r = Math.Sqrt((p * p) + (q * q)); p = p / r; q = q / r; // Row modification for (var j = n - 1; j < order; j++) { z = matrixH[n - 1, j]; matrixH[n - 1, j] = (q * z) + (p * matrixH[n, j]); matrixH[n, j] = (q * matrixH[n, j]) - (p * z); } // Column modification for (var i = 0; i <= n; i++) { z = matrixH[i, n - 1]; matrixH[i, n - 1] = (q * z) + (p * matrixH[i, n]); matrixH[i, n] = (q * matrixH[i, n]) - (p * z); } // Accumulate transformations for (var i = 0; i < order; i++) { z = MatrixEv.At(i, n - 1); MatrixEv.At(i, n - 1, (q * z) + (p * MatrixEv.At(i, n))); MatrixEv.At(i, n, (q * MatrixEv.At(i, n)) - (p * z)); } // Complex pair } else { d[n - 1] = x + p; d[n] = x + p; e[n - 1] = z; e[n] = -z; } n = n - 2; iter = 0; // No convergence yet } else { // Form shift x = matrixH[n, n]; y = 0.0; w = 0.0; if (l < n) { y = matrixH[n - 1, n - 1]; w = matrixH[n, n - 1] * matrixH[n - 1, n]; } // Wilkinson's original ad hoc shift if (iter == 10) { exshift += x; for (var i = 0; i <= n; i++) { matrixH[i, i] -= x; } s = Math.Abs(matrixH[n, n - 1]) + Math.Abs(matrixH[n - 1, n - 2]); x = y = 0.75 * s; w = (-0.4375) * s * s; } // MATLAB's new ad hoc shift if (iter == 30) { s = (y - x) / 2.0; s = (s * s) + w; if (s > 0) { s = Math.Sqrt(s); if (y < x) { s = -s; } s = x - (w / (((y - x) / 2.0) + s)); for (var i = 0; i <= n; i++) { matrixH[i, i] -= s; } exshift += s; x = y = w = 0.964; } } iter = iter + 1; // (Could check iteration count here.) // Look for two consecutive small sub-diagonal elements var m = n - 2; while (m >= l) { z = matrixH[m, m]; r = x - z; s = y - z; p = (((r * s) - w) / matrixH[m + 1, m]) + matrixH[m, m + 1]; q = matrixH[m + 1, m + 1] - z - r - s; r = matrixH[m + 2, m + 1]; s = Math.Abs(p) + Math.Abs(q) + Math.Abs(r); p = p / s; q = q / s; r = r / s; if (m == l) { break; } if (Math.Abs(matrixH[m, m - 1]) * (Math.Abs(q) + Math.Abs(r)) < eps * (Math.Abs(p) * (Math.Abs(matrixH[m - 1, m - 1]) + Math.Abs(z) + Math.Abs(matrixH[m + 1, m + 1])))) { break; } m--; } for (var i = m + 2; i <= n; i++) { matrixH[i, i - 2] = 0.0; if (i > m + 2) { matrixH[i, i - 3] = 0.0; } } // Double QR step involving rows l:n and columns m:n for (var k = m; k <= n - 1; k++) { bool notlast = k != n - 1; if (k != m) { p = matrixH[k, k - 1]; q = matrixH[k + 1, k - 1]; r = notlast ? matrixH[k + 2, k - 1] : 0.0; x = Math.Abs(p) + Math.Abs(q) + Math.Abs(r); if (x != 0.0) { p = p / x; q = q / x; r = r / x; } } if (x == 0.0) { break; } s = Math.Sqrt((p * p) + (q * q) + (r * r)); if (p < 0) { s = -s; } if (s != 0.0) { if (k != m) { matrixH[k, k - 1] = (-s) * x; } else if (l != m) { matrixH[k, k - 1] = -matrixH[k, k - 1]; } p = p + s; x = p / s; y = q / s; z = r / s; q = q / p; r = r / p; // Row modification for (var j = k; j < order; j++) { p = matrixH[k, j] + (q * matrixH[k + 1, j]); if (notlast) { p = p + (r * matrixH[k + 2, j]); matrixH[k + 2, j] = matrixH[k + 2, j] - (p * z); } matrixH[k, j] = matrixH[k, j] - (p * x); matrixH[k + 1, j] = matrixH[k + 1, j] - (p * y); } // Column modification for (var i = 0; i <= Math.Min(n, k + 3); i++) { p = (x * matrixH[i, k]) + (y * matrixH[i, k + 1]); if (notlast) { p = p + (z * matrixH[i, k + 2]); matrixH[i, k + 2] = matrixH[i, k + 2] - (p * r); } matrixH[i, k] = matrixH[i, k] - p; matrixH[i, k + 1] = matrixH[i, k + 1] - (p * q); } // Accumulate transformations for (var i = 0; i < order; i++) { p = (x * MatrixEv.At(i, k)) + (y * MatrixEv.At(i, k + 1)); if (notlast) { p = p + (z * MatrixEv.At(i, k + 2)); MatrixEv.At(i, k + 2, MatrixEv.At(i, k + 2) - (p * r)); } MatrixEv.At(i, k, MatrixEv.At(i, k) - p); MatrixEv.At(i, k + 1, MatrixEv.At(i, k + 1) - (p * q)); } } // (s != 0) } // k loop } // check convergence } // while (n >= low) // Backsubstitute to find vectors of upper triangular form if (norm == 0.0) { return; } for (n = order - 1; n >= 0; n--) { double t; p = d[n]; q = e[n]; // Real vector if (q == 0.0) { var l = n; matrixH[n, n] = 1.0; for (var i = n - 1; i >= 0; i--) { w = matrixH[i, i] - p; r = 0.0; for (var j = l; j <= n; j++) { r = r + (matrixH[i, j] * matrixH[j, n]); } if (e[i] < 0.0) { z = w; s = r; } else { l = i; if (e[i] == 0.0) { if (w != 0.0) { matrixH[i, n] = (-r) / w; } else { matrixH[i, n] = (-r) / (eps * norm); } // Solve real equations } else { x = matrixH[i, i + 1]; y = matrixH[i + 1, i]; q = ((d[i] - p) * (d[i] - p)) + (e[i] * e[i]); t = ((x * s) - (z * r)) / q; matrixH[i, n] = t; if (Math.Abs(x) > Math.Abs(z)) { matrixH[i + 1, n] = (-r - (w * t)) / x; } else { matrixH[i + 1, n] = (-s - (y * t)) / z; } } // Overflow control t = Math.Abs(matrixH[i, n]); if ((eps * t) * t > 1) { for (var j = i; j <= n; j++) { matrixH[j, n] = matrixH[j, n] / t; } } } } // Complex vector } else if (q < 0) { var l = n - 1; // Last vector component imaginary so matrix is triangular if (Math.Abs(matrixH[n, n - 1]) > Math.Abs(matrixH[n - 1, n])) { matrixH[n - 1, n - 1] = q / matrixH[n, n - 1]; matrixH[n - 1, n] = (-(matrixH[n, n] - p)) / matrixH[n, n - 1]; } else { var res = Cdiv(0.0, -matrixH[n - 1, n], matrixH[n - 1, n - 1] - p, q); matrixH[n - 1, n - 1] = res.Real; matrixH[n - 1, n] = res.Imaginary; } matrixH[n, n - 1] = 0.0; matrixH[n, n] = 1.0; for (var i = n - 2; i >= 0; i--) { double ra = 0.0; double sa = 0.0; for (var j = l; j <= n; j++) { ra = ra + (matrixH[i, j] * matrixH[j, n - 1]); sa = sa + (matrixH[i, j] * matrixH[j, n]); } w = matrixH[i, i] - p; if (e[i] < 0.0) { z = w; r = ra; s = sa; } else { l = i; if (e[i] == 0.0) { var res = Cdiv(-ra, -sa, w, q); matrixH[i, n - 1] = res.Real; matrixH[i, n] = res.Imaginary; } else { // Solve complex equations x = matrixH[i, i + 1]; y = matrixH[i + 1, i]; double vr = ((d[i] - p) * (d[i] - p)) + (e[i] * e[i]) - (q * q); double vi = (d[i] - p) * 2.0 * q; if ((vr == 0.0) && (vi == 0.0)) { vr = eps * norm * (Math.Abs(w) + Math.Abs(q) + Math.Abs(x) + Math.Abs(y) + Math.Abs(z)); } var res = Cdiv((x * r) - (z * ra) + (q * sa), (x * s) - (z * sa) - (q * ra), vr, vi); matrixH[i, n - 1] = res.Real; matrixH[i, n] = res.Imaginary; if (Math.Abs(x) > (Math.Abs(z) + Math.Abs(q))) { matrixH[i + 1, n - 1] = (-ra - (w * matrixH[i, n - 1]) + (q * matrixH[i, n])) / x; matrixH[i + 1, n] = (-sa - (w * matrixH[i, n]) - (q * matrixH[i, n - 1])) / x; } else { res = Cdiv(-r - (y * matrixH[i, n - 1]), -s - (y * matrixH[i, n]), z, q); matrixH[i + 1, n - 1] = res.Real; matrixH[i + 1, n] = res.Imaginary; } } // Overflow control t = Math.Max(Math.Abs(matrixH[i, n - 1]), Math.Abs(matrixH[i, n])); if ((eps * t) * t > 1) { for (var j = i; j <= n; j++) { matrixH[j, n - 1] = matrixH[j, n - 1] / t; matrixH[j, n] = matrixH[j, n] / t; } } } } } } // Back transformation to get eigenvectors of original matrix for (var j = order - 1; j >= 0; j--) { for (var i = 0; i < order; i++) { z = 0.0; for (var k = 0; k <= j; k++) { z = z + (MatrixEv.At(i, k) * matrixH[k, j]); } MatrixEv.At(i, j, z); } } }
/// <summary> /// Nonsymmetric reduction to Hessenberg form. /// </summary> /// <param name="matrixH">Array for internal storage of nonsymmetric Hessenberg form.</param> /// <param name="order">Order of initial matrix</param> /// <remarks>This is derived from the Algol procedures orthes and ortran, /// by Martin and Wilkinson, Handbook for Auto. Comp., /// Vol.ii-Linear Algebra, and the corresponding /// Fortran subroutines in EISPACK.</remarks> private void NonsymmetricReduceToHessenberg(double[,] matrixH, int order) { var ort = new double[order]; for (var m = 1; m < order - 1; m++) { // Scale column. var scale = 0.0; for (var i = m; i < order; i++) { scale = scale + Math.Abs(matrixH[i, m - 1]); } if (scale != 0.0) { // Compute Householder transformation. var h = 0.0; for (var i = order - 1; i >= m; i--) { ort[i] = matrixH[i, m - 1] / scale; h += ort[i] * ort[i]; } var g = Math.Sqrt(h); if (ort[m] > 0) { g = -g; } h = h - (ort[m] * g); ort[m] = ort[m] - g; // Apply Householder similarity transformation // H = (I-u*u'/h)*H*(I-u*u')/h) for (var j = m; j < order; j++) { var f = 0.0; for (var i = order - 1; i >= m; i--) { f += ort[i] * matrixH[i, j]; } f = f / h; for (var i = m; i < order; i++) { matrixH[i, j] -= f * ort[i]; } } for (var i = 0; i < order; i++) { var f = 0.0; for (var j = order - 1; j >= m; j--) { f += ort[j] * matrixH[i, j]; } f = f / h; for (var j = m; j < order; j++) { matrixH[i, j] -= f * ort[j]; } } ort[m] = scale * ort[m]; matrixH[m, m - 1] = scale * g; } } // Accumulate transformations (Algol's ortran). for (var i = 0; i < order; i++) { for (var j = 0; j < order; j++) { MatrixEv.At(i, j, i == j ? 1.0 : 0.0); } } for (var m = order - 2; m >= 1; m--) { if (matrixH[m, m - 1] != 0.0) { for (var i = m + 1; i < order; i++) { ort[i] = matrixH[i, m - 1]; } for (var j = m; j < order; j++) { var g = 0.0; for (var i = m; i < order; i++) { g += ort[i] * MatrixEv.At(i, j); } // Double division avoids possible underflow g = (g / ort[m]) / matrixH[m, m - 1]; for (var i = m; i < order; i++) { MatrixEv.At(i, j, MatrixEv.At(i, j) + g * ort[i]); } } } } }
/// <summary> /// Symmetric Householder reduction to tridiagonal form. /// </summary> /// <param name="d">Arrays for internal storage of real parts of eigenvalues</param> /// <param name="e">Arrays for internal storage of imaginary parts of eigenvalues</param> /// <param name="order">Order of initial matrix</param> /// <remarks>This is derived from the Algol procedures tred2 by /// Bowdler, Martin, Reinsch, and Wilkinson, Handbook for /// Auto. Comp., Vol.ii-Linear Algebra, and the corresponding /// Fortran subroutine in EISPACK.</remarks> private void SymmetricTridiagonalize(double[] d, double[] e, int order) { // Householder reduction to tridiagonal form. for (var i = order - 1; i > 0; i--) { // Scale to avoid under/overflow. var scale = 0.0; var h = 0.0; for (var k = 0; k < i; k++) { scale = scale + Math.Abs(d[k]); } if (scale == 0.0) { e[i] = d[i - 1]; for (var j = 0; j < i; j++) { d[j] = MatrixEv.At(i - 1, j); MatrixEv.At(i, j, 0.0); MatrixEv.At(j, i, 0.0); } } else { // Generate Householder vector. for (var k = 0; k < i; k++) { d[k] /= scale; h += d[k] * d[k]; } var f = d[i - 1]; var g = Math.Sqrt(h); if (f > 0) { g = -g; } e[i] = scale * g; h = h - (f * g); d[i - 1] = f - g; for (var j = 0; j < i; j++) { e[j] = 0.0; } // Apply similarity transformation to remaining columns. for (var j = 0; j < i; j++) { f = d[j]; MatrixEv.At(j, i, f); g = e[j] + (MatrixEv.At(j, j) * f); for (var k = j + 1; k <= i - 1; k++) { g += MatrixEv.At(k, j) * d[k]; e[k] += MatrixEv.At(k, j) * f; } e[j] = g; } f = 0.0; for (var j = 0; j < i; j++) { e[j] /= h; f += e[j] * d[j]; } var hh = f / (h + h); for (var j = 0; j < i; j++) { e[j] -= hh * d[j]; } for (var j = 0; j < i; j++) { f = d[j]; g = e[j]; for (var k = j; k <= i - 1; k++) { MatrixEv.At(k, j, MatrixEv.At(k, j) - (f * e[k]) - (g * d[k])); } d[j] = MatrixEv.At(i - 1, j); MatrixEv.At(i, j, 0.0); } } d[i] = h; } // Accumulate transformations. for (var i = 0; i < order - 1; i++) { MatrixEv.At(order - 1, i, MatrixEv.At(i, i)); MatrixEv.At(i, i, 1.0); var h = d[i + 1]; if (h != 0.0) { for (var k = 0; k <= i; k++) { d[k] = MatrixEv.At(k, i + 1) / h; } for (var j = 0; j <= i; j++) { var g = 0.0; for (var k = 0; k <= i; k++) { g += MatrixEv.At(k, i + 1) * MatrixEv.At(k, j); } for (var k = 0; k <= i; k++) { MatrixEv.At(k, j, MatrixEv.At(k, j) - g * d[k]); } } } for (var k = 0; k <= i; k++) { MatrixEv.At(k, i + 1, 0.0); } } for (var j = 0; j < order; j++) { d[j] = MatrixEv.At(order - 1, j); MatrixEv.At(order - 1, j, 0.0); } MatrixEv.At(order - 1, order - 1, 1.0); e[0] = 0.0; }
/// <summary> /// Solves a system of linear equations, <b>Ax = b</b>, with A EVD factorized. /// </summary> /// <param name="input">The right hand side vector, <b>b</b>.</param> /// <param name="result">The left hand side <see cref="Matrix{T}"/>, <b>x</b>.</param> public override void Solve(Vector <double> input, Vector <double> result) { if (input == null) { throw new ArgumentNullException("input"); } if (result == null) { throw new ArgumentNullException("result"); } // Ax=b where A is an m x m matrix // Check that b is a column vector with m entries if (VectorEv.Count != input.Count) { throw new ArgumentException(Resources.ArgumentVectorsSameLength); } // Check that x is a column vector with n entries if (VectorEv.Count != result.Count) { throw new ArgumentException(Resources.ArgumentMatrixDimensions); } if (IsSymmetric) { // Symmetric case -> x = V * inv(λ) * VT * b; var order = VectorEv.Count; var tmp = new double[order]; double value; for (var j = 0; j < order; j++) { value = 0; if (j < order) { for (var i = 0; i < order; i++) { value += MatrixEv.At(i, j) * input[i]; } value /= VectorEv[j].Real; } tmp[j] = value; } for (var j = 0; j < order; j++) { value = 0; for (int i = 0; i < order; i++) { value += MatrixEv.At(j, i) * tmp[i]; } result[j] = value; } } else { throw new ArgumentException(Resources.ArgumentMatrixSymmetric); } }
/// <summary> /// Solves a system of linear equations, <b>AX = B</b>, with A SVD factorized. /// </summary> /// <param name="input">The right hand side <see cref="Matrix{T}"/>, <b>B</b>.</param> /// <param name="result">The left hand side <see cref="Matrix{T}"/>, <b>X</b>.</param> public override void Solve(Matrix <double> input, Matrix <double> result) { // Check for proper arguments. if (input == null) { throw new ArgumentNullException("input"); } if (result == null) { throw new ArgumentNullException("result"); } // The solution X should have the same number of columns as B if (input.ColumnCount != result.ColumnCount) { throw new ArgumentException(Resources.ArgumentMatrixSameColumnDimension); } // The dimension compatibility conditions for X = A\B require the two matrices A and B to have the same number of rows if (VectorEv.Count != input.RowCount) { throw new ArgumentException(Resources.ArgumentMatrixSameRowDimension); } // The solution X row dimension is equal to the column dimension of A if (VectorEv.Count != result.RowCount) { throw new ArgumentException(Resources.ArgumentMatrixSameColumnDimension); } if (IsSymmetric) { var order = VectorEv.Count; var tmp = new double[order]; for (var k = 0; k < order; k++) { for (var j = 0; j < order; j++) { double value = 0; if (j < order) { for (var i = 0; i < order; i++) { value += MatrixEv.At(i, j) * input.At(i, k); } value /= VectorEv[j].Real; } tmp[j] = value; } for (var j = 0; j < order; j++) { double value = 0; for (var i = 0; i < order; i++) { value += MatrixEv.At(j, i) * tmp[i]; } result.At(j, k, value); } } } else { throw new ArgumentException(Resources.ArgumentMatrixSymmetric); } }