JAMA
[ class tree: JAMA ] [ index: JAMA ] [ all elements ]

Source for file EigenvalueDecomposition.php

Documentation is available at EigenvalueDecomposition.php

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

Documentation generated on Sun, 27 Feb 2011 16:30:25 -0800 by phpDocumentor 1.4.3