1 module measure.eigen;
2 
3 import std.math;
4 import std.algorithm.comparison;
5 
6 import measure.types;
7 // based on Java code from https://github.com/fiji/Jama
8 
9 /** Eigenvalues and eigenvectors of a real matrix. 
10 <P> 
11     If A is symmetric, then A = V*D*V' where the eigenvalue matrix D is
12     diagonal and the eigenvector matrix V is orthogonal.
13     I.e. A = V.times(D.times(V.transpose())) and 
14     V.times(V.transpose()) equals the identity matrix.
15 <P>
16     If A is not symmetric, then the eigenvalue matrix D is block diagonal
17     with the real eigenvalues in 1-by-1 blocks and any complex eigenvalues,
18     lambda + i*mu, in 2-by-2 blocks, [lambda, mu; -mu, lambda].  The
19     columns of V represent the eigenvectors in the sense that A*V = V*D,
20     i.e. A.times(V) equals V.times(D).  The matrix V may be badly
21     conditioned, or even singular, so the validity of the equation
22     A = V*D*inverse(V) depends upon V.cond().
23 **/
24 
25 class Eig{
26    
27 /* ------------------------
28    Class variables
29  * ------------------------ */
30 
31    /** Row and column dimension (square matrix).
32    @serial matrix dimension.
33    */
34    private int n;
35 
36    /** Symmetry flag.
37    @serial internal symmetry flag.
38    */
39    private bool issymmetric;
40 
41    /** Arrays for internal storage of eigenvalues.
42    @serial internal storage of eigenvalues.
43    */
44    private double[] d, e;
45 
46    /** Array for internal storage of eigenvectors.
47    @serial internal storage of eigenvectors.
48    */
49    private Mat2D!double V;
50 
51    /** Array for internal storage of nonsymmetric Hessenberg form.
52    @serial internal storage of nonsymmetric Hessenberg form.
53    */
54    private Mat2D!double H;
55 
56    /** Working storage for nonsymmetric algorithm.
57    @serial working storage for nonsymmetric algorithm.
58    */
59    private double[] ort;
60 
61 /* ------------------------
62    Private Methods
63  * ------------------------ */
64 
65    // Symmetric Householder reduction to tridiagonal form.
66 
67    private void tred2 () @nogc{
68 
69    //  This is derived from the Algol procedures tred2 by
70    //  Bowdler, Martin, Reinsch, and Wilkinson, Handbook for
71    //  Auto. Comp., Vol.ii-Linear Algebra, and the corresponding
72    //  Fortran subroutine in EISPACK.
73 
74       for (int j = 0; j < n; j++) {
75          d[j] = V[n-1, j];
76       }
77 
78       // Householder reduction to tridiagonal form.
79    
80       for (int i = n-1; i > 0; i--) {
81    
82          // Scale to avoid under/overflow.
83    
84          double scale = 0.0;
85          double h = 0.0;
86          for (int k = 0; k < i; k++) {
87             scale = scale + abs(d[k]);
88          }
89          if (scale == 0.0) {
90             e[i] = d[i-1];
91             for (int j = 0; j < i; j++) {
92                d[j] = V[i-1,j];
93                V[i,j] = 0.0;
94                V[j,i] = 0.0;
95             }
96          } else {
97    
98             // Generate Householder vector.
99    
100             for (int k = 0; k < i; k++) {
101                d[k] /= scale;
102                h += d[k] * d[k];
103             }
104             double f = d[i-1];
105             double g = sqrt(h);
106             if (f > 0) {
107                g = -g;
108             }
109             e[i] = scale * g;
110             h = h - f * g;
111             d[i-1] = f - g;
112             for (int j = 0; j < i; j++) {
113                e[j] = 0.0;
114             }
115    
116             // Apply similarity transformation to remaining columns.
117    
118             for (int j = 0; j < i; j++) {
119                f = d[j];
120                V[j,i] = f;
121                g = e[j] + V[j,j] * f;
122                for (int k = j+1; k <= i-1; k++) {
123                   g += V[k,j] * d[k];
124                   e[k] += V[k,j] * f;
125                }
126                e[j] = g;
127             }
128             f = 0.0;
129             for (int j = 0; j < i; j++) {
130                e[j] /= h;
131                f += e[j] * d[j];
132             }
133             double hh = f / (h + h);
134             for (int j = 0; j < i; j++) {
135                e[j] -= hh * d[j];
136             }
137             for (int j = 0; j < i; j++) {
138                f = d[j];
139                g = e[j];
140                for (int k = j; k <= i-1; k++) {
141                   V[k,j] = V[k,j] - (f * e[k] + g * d[k]);
142                }
143                d[j] = V[i-1,j];
144                V[i,j] = 0.0;
145             }
146          }
147          d[i] = h;
148       }
149    
150       // Accumulate transformations.
151    
152       for (int i = 0; i < n-1; i++) {
153          V[n-1,i] = V[i,i];
154          V[i,i] = 1.0;
155          double h = d[i+1];
156          if (h != 0.0) {
157             for (int k = 0; k <= i; k++) {
158                d[k] = V[k,i+1] / h;
159             }
160             for (int j = 0; j <= i; j++) {
161                double g = 0.0;
162                for (int k = 0; k <= i; k++) {
163                   g += V[k,i+1] * V[k,j];
164                }
165                for (int k = 0; k <= i; k++) {
166                   V[k,j] = V[k,j] - g * d[k];
167                }
168             }
169          }
170          for (int k = 0; k <= i; k++) {
171             V[k,i+1] = 0.0;
172          }
173       }
174       for (int j = 0; j < n; j++) {
175          d[j] = V[n-1,j];
176          V[n-1,j] = 0.0;
177       }
178       V[n-1,n-1] = 1.0;
179       e[0] = 0.0;
180    } 
181 
182    // Symmetric tridiagonal QL algorithm.
183    
184    private void tql2 () @nogc{
185 
186    //  This is derived from the Algol procedures tql2, by
187    //  Bowdler, Martin, Reinsch, and Wilkinson, Handbook for
188    //  Auto. Comp., Vol.ii-Linear Algebra, and the corresponding
189    //  Fortran subroutine in EISPACK.
190    
191       for (int i = 1; i < n; i++) {
192          e[i-1] = e[i];
193       }
194       e[n-1] = 0.0;
195    
196       double f = 0.0;
197       double tst1 = 0.0;
198       double eps = pow(2.0,-52.0);
199       for (int l = 0; l < n; l++) {
200 
201          // Find small subdiagonal element
202    
203          tst1 = max(tst1,abs(d[l]) + abs(e[l]));
204          int m = l;
205          while (m < n) {
206             if (abs(e[m]) <= eps*tst1) {
207                break;
208             }
209             m++;
210          }
211    
212          // If m == l, d[l] is an eigenvalue,
213          // otherwise, iterate.
214    
215          if (m > l) {
216             int iter = 0;
217             do {
218                iter = iter + 1;  // (Could check iteration count here.)
219    
220                // Compute implicit shift
221    
222                double g = d[l];
223                double p = (d[l+1] - g) / (2.0 * e[l]);
224                double r = hypot(p,1.0);
225                if (p < 0) {
226                   r = -r;
227                }
228                d[l] = e[l] / (p + r);
229                d[l+1] = e[l] * (p + r);
230                double dl1 = d[l+1];
231                double h = g - d[l];
232                for (int i = l+2; i < n; i++) {
233                   d[i] -= h;
234                }
235                f = f + h;
236    
237                // Implicit QL transformation.
238    
239                p = d[m];
240                double c = 1.0;
241                double c2 = c;
242                double c3 = c;
243                double el1 = e[l+1];
244                double s = 0.0;
245                double s2 = 0.0;
246                for (int i = m-1; i >= l; i--) {
247                   c3 = c2;
248                   c2 = c;
249                   s2 = s;
250                   g = c * e[i];
251                   h = c * p;
252                   r = hypot(p,e[i]);
253                   e[i+1] = s * r;
254                   s = e[i] / r;
255                   c = p / r;
256                   p = c * d[i] - s * g;
257                   d[i+1] = h + s * (c * g + s * d[i]);
258    
259                   // Accumulate transformation.
260    
261                   for (int k = 0; k < n; k++) {
262                      h = V[k,i+1];
263                      V[k,i+1] = s * V[k,i] + c * h;
264                      V[k,i] = c * V[k,i] - s * h;
265                   }
266                }
267                p = -s * s2 * c3 * el1 * e[l] / dl1;
268                e[l] = s * p;
269                d[l] = c * p;
270    
271                // Check for convergence.
272    
273             } while (abs(e[l]) > eps*tst1);
274          }
275          d[l] = d[l] + f;
276          e[l] = 0.0;
277       }
278      
279       // Sort eigenvalues and corresponding vectors.
280    
281       for (int i = 0; i < n-1; i++) {
282          int k = i;
283          double p = d[i];
284          for (int j = i+1; j < n; j++) {
285             if (d[j] < p) {
286                k = j;
287                p = d[j];
288             }
289          }
290          if (k != i) {
291             d[k] = d[i];
292             d[i] = p;
293             for (int j = 0; j < n; j++) {
294                p = V[j,i];
295                V[j,i] = V[j,k];
296                V[j,k] = p;
297             }
298          }
299       }
300    }
301 
302    // Nonsymmetric reduction to Hessenberg form.
303 
304    private void orthes () @nogc {
305    
306       //  This is derived from the Algol procedures orthes and ortran,
307       //  by Martin and Wilkinson, Handbook for Auto. Comp.,
308       //  Vol.ii-Linear Algebra, and the corresponding
309       //  Fortran subroutines in EISPACK.
310    
311       int low = 0;
312       int high = n-1;
313    
314       for (int m = low+1; m <= high-1; m++) {
315    
316          // Scale column.
317    
318          double scale = 0.0;
319          for (int i = m; i <= high; i++) {
320             scale = scale + abs(H[i,m-1]);
321          }
322          if (scale != 0.0) {
323    
324             // Compute Householder transformation.
325    
326             double h = 0.0;
327             for (int i = high; i >= m; i--) {
328                ort[i] = H[i,m-1]/scale;
329                h += ort[i] * ort[i];
330             }
331             double g = sqrt(h);
332             if (ort[m] > 0) {
333                g = -g;
334             }
335             h = h - ort[m] * g;
336             ort[m] = ort[m] - g;
337    
338             // Apply Householder similarity transformation
339             // H = (I-u*u'/h)*H*(I-u*u')/h)
340    
341             for (int j = m; j < n; j++) {
342                double f = 0.0;
343                for (int i = high; i >= m; i--) {
344                   f += ort[i]*H[i,j];
345                }
346                f = f/h;
347                for (int i = m; i <= high; i++) {
348                   H[i,j] = H[i,j] - f*ort[i];
349                }
350            }
351    
352            for (int i = 0; i <= high; i++) {
353                double f = 0.0;
354                for (int j = high; j >= m; j--) {
355                   f += ort[j]*H[i,j];
356                }
357                f = f/h;
358                for (int j = m; j <= high; j++) {
359                   H[i,j] = H[i,j] - f*ort[j];
360                }
361             }
362             ort[m] = scale*ort[m];
363             H[m,m-1] = scale*g;
364          }
365       }
366    
367       // Accumulate transformations (Algol's ortran).
368 
369       for (int i = 0; i < n; i++) {
370          for (int j = 0; j < n; j++) {
371             V[i,j] = (i == j ? 1.0 : 0.0);
372          }
373       }
374 
375       for (int m = high-1; m >= low+1; m--) {
376          if (H[m,m-1] != 0.0) {
377             for (int i = m+1; i <= high; i++) {
378                ort[i] = H[i,m-1];
379             }
380             for (int j = m; j <= high; j++) {
381                double g = 0.0;
382                for (int i = m; i <= high; i++) {
383                   g += ort[i] * V[i,j];
384                }
385                // Double division avoids possible underflow
386                g = (g / ort[m]) / H[m,m-1];
387                for (int i = m; i <= high; i++) {
388                   V[i,j] = V[i,j] + g * ort[i];
389                }
390             }
391          }
392       }
393    }
394 
395 
396    // Complex scalar division.
397 
398    private double cdivr, cdivi;
399    private void cdiv(double xr, double xi, double yr, double yi) @nogc {
400       double r,d;
401       if (abs(yr) > abs(yi)) {
402          r = yi/yr;
403          d = yr + r*yi;
404          cdivr = (xr + r*xi)/d;
405          cdivi = (xi - r*xr)/d;
406       } else {
407          r = yr/yi;
408          d = yi + r*yr;
409          cdivr = (r*xr + xi)/d;
410          cdivi = (r*xi - xr)/d;
411       }
412    }
413 
414 
415    // Nonsymmetric reduction from Hessenberg to real Schur form.
416 
417    private void hqr2 () @nogc {
418    
419       //  This is derived from the Algol procedure hqr2,
420       //  by Martin and Wilkinson, Handbook for Auto. Comp.,
421       //  Vol.ii-Linear Algebra, and the corresponding
422       //  Fortran subroutine in EISPACK.
423    
424       // Initialize
425    
426       int nn = this.n;
427       int n = nn-1;
428       int low = 0;
429       int high = nn-1;
430       double eps = pow(2.0,-52.0);
431       double exshift = 0.0;
432       double p=0,q=0,r=0,s=0,z=0,t,w,x,y;
433    
434       // Store roots isolated by balanc and compute matrix norm
435    
436       double norm = 0.0;
437       for (int i = 0; i < nn; i++) {
438          if ((i < low) | (i > high)) {
439             d[i] = H[i,i];
440             e[i] = 0.0;
441          }
442          for (int j = max(i-1,0); j < nn; j++) {
443             norm = norm + abs(H[i,j]);
444          }
445       }
446    
447       // Outer loop over eigenvalue index
448    
449       int iter = 0;
450       while (n >= low) {
451    
452          // Look for single small sub-diagonal element
453    
454          int l = n;
455          while (l > low) {
456             s = abs(H[l-1,l-1]) + abs(H[l,l]);
457             if (s == 0.0) {
458                s = norm;
459             }
460             if (abs(H[l,l-1]) < eps * s) {
461                break;
462             }
463             l--;
464          }
465        
466          // Check for convergence
467          // One root found
468    
469          if (l == n) {
470             H[n,n] = H[n,n] + exshift;
471             d[n] = H[n,n];
472             e[n] = 0.0;
473             n--;
474             iter = 0;
475    
476          // Two roots found
477    
478          } else if (l == n-1) {
479             w = H[n,n-1] * H[n-1,n];
480             p = (H[n-1,n-1] - H[n,n]) / 2.0;
481             q = p * p + w;
482             z = sqrt(abs(q));
483             H[n,n] = H[n,n] + exshift;
484             H[n-1,n-1] = H[n-1,n-1] + exshift;
485             x = H[n,n];
486    
487             // Real pair
488    
489             if (q >= 0) {
490                if (p >= 0) {
491                   z = p + z;
492                } else {
493                   z = p - z;
494                }
495                d[n-1] = x + z;
496                d[n] = d[n-1];
497                if (z != 0.0) {
498                   d[n] = x - w / z;
499                }
500                e[n-1] = 0.0;
501                e[n] = 0.0;
502                x = H[n,n-1];
503                s = abs(x) + abs(z);
504                p = x / s;
505                q = z / s;
506                r = sqrt(p * p+q * q);
507                p = p / r;
508                q = q / r;
509    
510                // Row modification
511    
512                for (int j = n-1; j < nn; j++) {
513                   z = H[n-1,j];
514                   H[n-1,j] = q * z + p * H[n,j];
515                   H[n,j] = q * H[n,j] - p * z;
516                }
517    
518                // Column modification
519    
520                for (int i = 0; i <= n; i++) {
521                   z = H[i,n-1];
522                   H[i,n-1] = q * z + p * H[i,n];
523                   H[i,n] = q * H[i,n] - p * z;
524                }
525    
526                // Accumulate transformations
527    
528                for (int i = low; i <= high; i++) {
529                   z = V[i,n-1];
530                   V[i,n-1] = q * z + p * V[i,n];
531                   V[i,n] = q * V[i,n] - p * z;
532                }
533    
534             // Complex pair
535    
536             } else {
537                d[n-1] = x + p;
538                d[n] = x + p;
539                e[n-1] = z;
540                e[n] = -z;
541             }
542             n = n - 2;
543             iter = 0;
544    
545          // No convergence yet
546    
547          } else {
548    
549             // Form shift
550    
551             x = H[n,n];
552             y = 0.0;
553             w = 0.0;
554             if (l < n) {
555                y = H[n-1,n-1];
556                w = H[n,n-1] * H[n-1,n];
557             }
558    
559             // Wilkinson's original ad hoc shift
560    
561             if (iter == 10) {
562                exshift += x;
563                for (int i = low; i <= n; i++) {
564                   H[i,i] = H[i,i] - x;
565                }
566                s = abs(H[n,n-1]) + abs(H[n-1,n-2]);
567                x = y = 0.75 * s;
568                w = -0.4375 * s * s;
569             }
570 
571             // MATLAB's new ad hoc shift
572 
573             if (iter == 30) {
574                 s = (y - x) / 2.0;
575                 s = s * s + w;
576                 if (s > 0) {
577                     s = sqrt(s);
578                     if (y < x) {
579                        s = -s;
580                     }
581                     s = x - w / ((y - x) / 2.0 + s);
582                     for (int i = low; i <= n; i++) {
583                        H[i,i] = H[i,i] - s;
584                     }
585                     exshift += s;
586                     x = y = w = 0.964;
587                 }
588             }
589    
590             iter = iter + 1;   // (Could check iteration count here.)
591    
592             // Look for two consecutive small sub-diagonal elements
593    
594             int m = n-2;
595             while (m >= l) {
596                z = H[m,m];
597                r = x - z;
598                s = y - z;
599                p = (r * s - w) / H[m+1,m] + H[m,m+1];
600                q = H[m+1,m+1] - z - r - s;
601                r = H[m+2,m+1];
602                s = abs(p) + abs(q) + abs(r);
603                p = p / s;
604                q = q / s;
605                r = r / s;
606                if (m == l) {
607                   break;
608                }
609                if (abs(H[m,m-1]) * (abs(q) + abs(r)) <
610                   eps * (abs(p) * (abs(H[m-1,m-1]) + abs(z) +
611                   abs(H[m+1,m+1])))) {
612                      break;
613                }
614                m--;
615             }
616    
617             for (int i = m+2; i <= n; i++) {
618                H[i,i-2] = 0.0;
619                if (i > m+2) {
620                   H[i,i-3] = 0.0;
621                }
622             }
623    
624             // Double QR step involving rows l:n and columns m:n
625    
626             for (int k = m; k <= n-1; k++) {
627                bool notlast = (k != n-1);
628                if (k != m) {
629                   p = H[k,k-1];
630                   q = H[k+1,k-1];
631                   r = (notlast ? H[k+2,k-1] : 0.0);
632                   x = abs(p) + abs(q) + abs(r);
633                   if (x != 0.0) {
634                      p = p / x;
635                      q = q / x;
636                      r = r / x;
637                   }
638                }
639                if (x == 0.0) {
640                   break;
641                }
642                s = sqrt(p * p + q * q + r * r);
643                if (p < 0) {
644                   s = -s;
645                }
646                if (s != 0) {
647                   if (k != m) {
648                      H[k,k-1] = -s * x;
649                   } else if (l != m) {
650                      H[k,k-1] = -H[k,k-1];
651                   }
652                   p = p + s;
653                   x = p / s;
654                   y = q / s;
655                   z = r / s;
656                   q = q / p;
657                   r = r / p;
658    
659                   // Row modification
660    
661                   for (int j = k; j < nn; j++) {
662                      p = H[k,j] + q * H[k+1,j];
663                      if (notlast) {
664                         p = p + r * H[k+2,j];
665                         H[k+2,j] = H[k+2,j] - p * z;
666                      }
667                      H[k,j] = H[k,j] - p * x;
668                      H[k+1,j] = H[k+1,j] - p * y;
669                   }
670    
671                   // Column modification
672    
673                   for (int i = 0; i <= min(n,k+3); i++) {
674                      p = x * H[i,k] + y * H[i,k+1];
675                      if (notlast) {
676                         p = p + z * H[i,k+2];
677                         H[i,k+2] = H[i,k+2] - p * r;
678                      }
679                      H[i,k] = H[i,k] - p;
680                      H[i,k+1] = H[i,k+1] - p * q;
681                   }
682    
683                   // Accumulate transformations
684    
685                   for (int i = low; i <= high; i++) {
686                      p = x * V[i,k] + y * V[i,k+1];
687                      if (notlast) {
688                         p = p + z * V[i,k+2];
689                         V[i,k+2] = V[i,k+2] - p * r;
690                      }
691                      V[i,k] = V[i,k] - p;
692                      V[i,k+1] = V[i,k+1] - p * q;
693                   }
694                }  // (s != 0)
695             }  // k loop
696          }  // check convergence
697       }  // while (n >= low)
698       
699       // Backsubstitute to find vectors of upper triangular form
700 
701       if (norm == 0.0) {
702          return;
703       }
704    
705       for (n = nn-1; n >= 0; n--) {
706          p = d[n];
707          q = e[n];
708    
709          // Real vector
710    
711          if (q == 0) {
712             int l = n;
713             H[n,n] = 1.0;
714             for (int i = n-1; i >= 0; i--) {
715                w = H[i,i] - p;
716                r = 0.0;
717                for (int j = l; j <= n; j++) {
718                   r = r + H[i,j] * H[j,n];
719                }
720                if (e[i] < 0.0) {
721                   z = w;
722                   s = r;
723                } else {
724                   l = i;
725                   if (e[i] == 0.0) {
726                      if (w != 0.0) {
727                         H[i,n] = -r / w;
728                      } else {
729                         H[i,n] = -r / (eps * norm);
730                      }
731    
732                   // Solve real equations
733    
734                   } else {
735                      x = H[i,i+1];
736                      y = H[i+1,i];
737                      q = (d[i] - p) * (d[i] - p) + e[i] * e[i];
738                      t = (x * s - z * r) / q;
739                      H[i,n] = t;
740                      if (abs(x) > abs(z)) {
741                         H[i+1,n] = (-r - w * t) / x;
742                      } else {
743                         H[i+1,n] = (-s - y * t) / z;
744                      }
745                   }
746    
747                   // Overflow control
748    
749                   t = abs(H[i,n]);
750                   if ((eps * t) * t > 1) {
751                      for (int j = i; j <= n; j++) {
752                         H[j,n] = H[j,n] / t;
753                      }
754                   }
755                }
756             }
757    
758          // Complex vector
759    
760          } else if (q < 0) {
761             int l = n-1;
762 
763             // Last vector component imaginary so matrix is triangular
764    
765             if (abs(H[n,n-1]) > abs(H[n-1,n])) {
766                H[n-1,n-1] = q / H[n,n-1];
767                H[n-1,n] = -(H[n,n] - p) / H[n,n-1];
768             } else {
769                cdiv(0.0,-H[n-1,n],H[n-1,n-1]-p,q);
770                H[n-1,n-1] = cdivr;
771                H[n-1,n] = cdivi;
772             }
773             H[n,n-1] = 0.0;
774             H[n,n] = 1.0;
775             for (int i = n-2; i >= 0; i--) {
776                double ra,sa,vr,vi;
777                ra = 0.0;
778                sa = 0.0;
779                for (int j = l; j <= n; j++) {
780                   ra = ra + H[i,j] * H[j,n-1];
781                   sa = sa + H[i,j] * H[j,n];
782                }
783                w = H[i,i] - p;
784    
785                if (e[i] < 0.0) {
786                   z = w;
787                   r = ra;
788                   s = sa;
789                } else {
790                   l = i;
791                   if (e[i] == 0) {
792                      cdiv(-ra,-sa,w,q);
793                      H[i,n-1] = cdivr;
794                      H[i,n] = cdivi;
795                   } else {
796    
797                      // Solve complex equations
798    
799                      x = H[i,i+1];
800                      y = H[i+1,i];
801                      vr = (d[i] - p) * (d[i] - p) + e[i] * e[i] - q * q;
802                      vi = (d[i] - p) * 2.0 * q;
803                      if ((vr == 0.0) && (vi == 0.0)) {
804                         vr = eps * norm * (abs(w) + abs(q) +
805                         abs(x) + abs(y) + abs(z));
806                      }
807                      cdiv(x*r-z*ra+q*sa,x*s-z*sa-q*ra,vr,vi);
808                      H[i,n-1] = cdivr;
809                      H[i,n] = cdivi;
810                      if (abs(x) > (abs(z) + abs(q))) {
811                         H[i+1,n-1] = (-ra - w * H[i,n-1] + q * H[i,n]) / x;
812                         H[i+1,n] = (-sa - w * H[i,n] - q * H[i,n-1]) / x;
813                      } else {
814                         cdiv(-r-y*H[i,n-1],-s-y*H[i,n],z,q);
815                         H[i+1,n-1] = cdivr;
816                         H[i+1,n] = cdivi;
817                      }
818                   }
819    
820                   // Overflow control
821 
822                   t = max(abs(H[i,n-1]),abs(H[i,n]));
823                   if ((eps * t) * t > 1) {
824                      for (int j = i; j <= n; j++) {
825                         H[j,n-1] = H[j,n-1] / t;
826                         H[j,n] = H[j,n] / t;
827                      }
828                   }
829                }
830             }
831          }
832       }
833    
834       // Vectors of isolated roots
835    
836       for (int i = 0; i < nn; i++) {
837          if ((i < low) || (i > high)) {
838             for (int j = i; j < nn; j++) {
839                V[i,j] = H[i,j];
840             }
841          }
842       }
843    
844       // Back transformation to get eigenvectors of original matrix
845    
846       for (int j = nn-1; j >= low; j--) {
847          for (int i = low; i <= high; i++) {
848             z = 0.0;
849             for (int k = low; k <= min(j,high); k++) {
850                z = z + V[i,k] * H[k,j];
851             }
852             V[i,j] = z;
853          }
854       }
855    }
856 
857 
858 /* ------------------------
859    Constructor
860  * ------------------------ */
861 
862    /** Check for symmetry, then construct the eigenvalue decomposition
863    @param A    Square matrix
864    @return     Structure to access D and V.
865    */
866 
867    this(Mat2D!double A) {
868       n = cast(int)A.rows;
869       V = Mat2D!double(n,n);
870       d = new double[](n);
871       e = new double[](n);
872 
873       issymmetric = true;
874       for (int j = 0; (j < n) & issymmetric; j++) {
875          for (int i = 0; (i < n) & issymmetric; i++) {
876             issymmetric = (A[i, j] == A[j, i]);
877          }
878       }
879 
880       if (issymmetric) {
881          for (int i = 0; i < n; i++) {
882             for (int j = 0; j < n; j++) {
883                V[i, j] = A[i, j];
884             }
885          }
886    
887          // Tridiagonalize.
888          tred2();
889    
890          // Diagonalize.
891          tql2();
892 
893       } else {
894          H = Mat2D!double(n,n);
895          ort = new double[](n);
896          
897          for (int j = 0; j < n; j++) {
898             for (int i = 0; i < n; i++) {
899                H[i, j] = A[i, j];
900             }
901          }
902    
903          // Reduce to Hessenberg form.
904          orthes();
905    
906          // Reduce Hessenberg to real Schur form.
907          hqr2();
908       }
909    }
910 
911 /* ------------------------
912    Public Methods
913  * ------------------------ */
914 
915    /** Return the eigenvector matrix
916    @return     V
917    */
918 
919    public Mat2D!double getV () @nogc{
920       return V;
921    }
922 
923    /** Return the real parts of the eigenvalues
924    @return     real(diag(D))
925    */
926 
927    public double[] getRealEigenvalues () @nogc{
928       return d;
929    }
930 
931    /** Return the imaginary parts of the eigenvalues
932    @return     imag(diag(D))
933    */
934 
935    public double[] getImagEigenvalues () @nogc{
936       return e;
937    }
938 
939    /** Return the block diagonal eigenvalue matrix
940    @return     D
941    */
942 
943    public Mat2D!double getD () {
944       auto D = Mat2D!double(n,n);
945       for (int i = 0; i < n; i++) {
946          for (int j = 0; j < n; j++) {
947             D[i, j] = 0.0;
948          }
949          D[i, i] = d[i];
950          if (e[i] > 0) {
951             D[i, i+1] = e[i];
952          } else if (e[i] < 0) {
953             D[i, i-1] = e[i];
954          }
955       }
956       return D;
957    }
958 }
959