EigenvalueDecomposition.php 33 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864
  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. }