For God so loved the world, that He gave His only begotten Son, that all who believe in Him should not perish but have everlasting life
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

864 lines
32 KiB

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