9d1626fb010d40921c50647a62bcc695c2b7477e.svn-base 22 KB

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