PageRenderTime 982ms CodeModel.GetById 6ms RepoModel.GetById 21ms app.codeStats 1ms

/MatrixSparse.pm

https://github.com/gitpan/Math-MatrixSparse
Perl | 3600 lines | 2851 code | 658 blank | 91 comment | 316 complexity | d6af8b8fbc5bd482abf7c0722187a6e4 MD5 | raw file
  1. package Math::MatrixSparse;
  2. use 5.006;
  3. use strict;
  4. use warnings;
  5. use Carp;
  6. require Exporter;
  7. our @ISA = qw(Exporter);
  8. # Items to export into callers namespace by default. Note: do not export
  9. # names by default without a very good reason. Use EXPORT_OK instead.
  10. # Do not simply export all your public functions/methods/constants.
  11. # This allows declaration use Math::MatrixSparse ':all';
  12. # If you do not need this, moving things directly into @EXPORT or @EXPORT_OK
  13. # will save memory.
  14. our %EXPORT_TAGS = ( 'all' => [ qw(
  15. splitkey
  16. makekey
  17. ) ] );
  18. our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} });
  19. our @EXPORT = qw(
  20. );
  21. our $VERSION = '0.01';
  22. use overload
  23. "+" => "add",
  24. "*" => "quickmultiply",
  25. "x" => "kronecker",
  26. "-" => "subtract",
  27. "neg" => "negate",
  28. "~" => "transpose",
  29. "**" => "exponentiate",
  30. "==" => "equals",
  31. '""' => "print",
  32. "&" => "matrixand",
  33. "|" => "matrixor",
  34. "fallback" => undef;
  35. # Preloaded methods go here.
  36. ### CREATION METHODS
  37. sub new {
  38. my ($proto,$name) = @_;
  39. my $this;
  40. $this->{data} = undef;
  41. $this->{name} = $name;
  42. $this->{rows} = 0;
  43. $this->{columns} =0;
  44. $this->{special}->{bandwidth} = 0;
  45. $this->{special}->{structure} = "";
  46. $this->{special}->{shape} = "";
  47. $this->{special}->{sign} = "";
  48. $this->{special}->{pattern} = 0;
  49. $this->{special}->{field} = "real";
  50. bless ($this);
  51. return $this;
  52. }
  53. sub newfromstring {
  54. my ($proto, $string,$name) = @_;
  55. my $this=new Math::MatrixSparse;
  56. my @entries = split(/\n/,$string);
  57. $this->{special}->{structure} = ".";
  58. foreach my $entry (@entries) {
  59. my ($i,$j,$value) = $entry=~m/^\s*(\d+)\s+(\d+)\s+(.+)\s*$/;
  60. $this->assign($i,$j,$value);
  61. }
  62. $this->{name} =$name;
  63. $this->{special}->{field} = "real";
  64. return $this;
  65. }
  66. sub newdiag {
  67. my ($proto, $diag, $name) = @_;
  68. my @data = @{$diag};
  69. my $this = new Math::MatrixSparse;
  70. $this->name($name);
  71. my $i=1;
  72. foreach my $entry (@data){
  73. $this->assign($i,$i,$entry);
  74. $i++;
  75. }
  76. $this->{special}->{structure} = "symmetric";
  77. $this->{special}->{shape} = "diagonal";
  78. $this->{special}->{field} = "real";
  79. $this->{special}->{square} = 1;
  80. return $this;
  81. }
  82. sub newdiagfromstring {
  83. my ($proto, $string, $name) = @_;
  84. my $this=new Math::MatrixSparse;
  85. my @entries = split(/\n/,$string);
  86. foreach my $entry (@entries) {
  87. my ($i,$value) = $entry=~m/^(\d+)\s+(.+)$/;
  88. $this->assign($i,$i,$value);
  89. }
  90. $this->{name} =$name;
  91. $this->{special}->{structure} = "symmetric";
  92. $this->{special}->{field} = "real";
  93. $this->{special}->{shape} = "diagonal";
  94. $this->{special}->{square} = 1;
  95. return $this;
  96. }
  97. sub newidentity {
  98. my ($proto, $n,$m) = @_;
  99. my $this = new Math::MatrixSparse;
  100. $m=$n unless ($m);
  101. $this->{name} = "I$n";
  102. my $min = $m<$n ? $m :$n;
  103. for my $i (1..$min) {
  104. $this->assign($i,$i,1);
  105. }
  106. $this->{rows} = $n;
  107. $this->{columns} = $m;
  108. $this->{special}->{structure} = "symmetric";
  109. $this->{special}->{field} = "real";
  110. $this->{special}->{shape} = "diagonal";
  111. $this->{special}->{sign} = "nonnegative";
  112. $this->{special}->{square} = 1 if $m==$n;
  113. $this->{special}->{pattern} = 0;
  114. return $this;
  115. }
  116. sub newrandom {
  117. my ($proto,$maxrow,$maxcol,$max,$density,$name) = @_;
  118. $maxcol = $maxrow unless defined $maxcol;
  119. $density = 1 unless (defined $density)&&($density>=0) && ($density<=1);
  120. my $stoch = new Math::MatrixSparse($name);
  121. unless (defined $max) {
  122. for my $i (1..$maxrow) {
  123. for my $j (1..$maxcol) {
  124. my $uniform = rand;
  125. next unless $uniform<=$density;
  126. $stoch->assign($i,$j,rand);
  127. }
  128. }
  129. return $stoch;
  130. }
  131. $name = "" unless defined $name;
  132. $stoch->assign($maxrow,$maxcol,0);
  133. my $k = 1;
  134. while ($k<=$max) {
  135. my ($i,$j) = (int($maxrow* rand)+1,int($maxcol* rand)+1);
  136. next if $stoch->element($i,$j);
  137. my $uniform = rand;
  138. if ($uniform>$density) {
  139. carp "Math::MatrixReal::newrandom ignoring element";
  140. }
  141. next unless $uniform <= $density;
  142. $stoch->assign($i,$j,rand);
  143. $k++;
  144. }
  145. $stoch->{special}->{sign}="nonnegative";
  146. return $stoch;
  147. }
  148. ### INPUT-OUTPUT METHODS
  149. sub newharwellboeing {
  150. my ($proto, $filename) = @_;
  151. open(HB,"<$filename" ) || croak "Math::MatrixSparse::newharwellboeing Can't open $filename\n";
  152. my $this = new Math::MatrixSparse;
  153. $_ = <HB>;
  154. chomp();
  155. my ($ident, $key) = $_ =~ m/^(.*)(........)\s*$/;
  156. $key =~ s/\s*$//;
  157. $this->{name} = $key;
  158. $_ = <HB>;
  159. chomp();
  160. my ($lines, $pline, $rline, $nvline, $rhsline) = $_ =~
  161. m/^\s*(\d{1,14})\s*(\d{1,14})\s*(\d{1,14})\s*(\d{1,14})\s*(\d{1,14})\s*$/;
  162. $_ = <HB>;
  163. chomp();
  164. my ($mattype, $rows, $columns, $rvi, $eme) = $_ =~
  165. m/^\s*(...)\s*(\d{1,14})\s*(\d{1,14})\s*(\d{1,14})\s*(\d{1,14})\s*$/;
  166. if ($mattype =~ /^C/) {
  167. croak "Math::MatrixSparse::newharwellboeing Complex types not implemented, exiting\n";
  168. } else {
  169. $this->{special}->{field} = "real";
  170. }
  171. $this->{rows} = $rows;
  172. $this->{columns} = $columns;
  173. my $formatline = <HB>;
  174. chomp($formatline);
  175. my ($colft, $rowft, $valft,$rhsft) = $formatline =~ m/(\([a-zA-Z0-9.+-+]+\))/g;
  176. unless (($colft =~ /I/i)&&($rowft =~ /I/i)) {
  177. carp "Math::MatrixSparse::newharwellboeing non-integer format for rows and columns";
  178. }
  179. $valft =~ s/\d+P//g;
  180. my ($valrep, $valsize) = $valft =~ m/(\d+)[a-zA-Z](\d+)/;
  181. my $valregex = '.' x $valsize;
  182. my $rhsspec;
  183. if ($rhsline) {
  184. $rhsspec = <HB>;
  185. chomp($rhsspec);
  186. }
  187. #now read the column pointer data...
  188. my @colpointers;
  189. for my $i (1..$pline) {
  190. $_ = <HB>;
  191. s/^\s*//;
  192. s/\s*$//;
  193. push @colpointers, split(/\s+/);
  194. }
  195. #...and the row data...
  196. my @rowindex;
  197. for my $i (1..$rline) {
  198. $_ = <HB>;
  199. s/^\s*//;
  200. s/\s*$//;
  201. push @rowindex, split(/\s+/);
  202. }
  203. #...and any value data. If the matrix is a pattern type, fill
  204. # @values with ones.
  205. my @values;
  206. if ($mattype =~ m/^P..$/i) {
  207. @values = (1) x $rvi;
  208. } else {
  209. for my $i (1..$nvline) {
  210. $_ = <HB>;
  211. s/D/e/g;
  212. push @values, map {s/\s//g; $_+0} m/$valregex/g;
  213. }
  214. }
  215. my $curcol = 1;
  216. foreach my $i (0..($#colpointers-1)) {
  217. my $thiscol = $colpointers[$i];
  218. my $nextcol = $colpointers[$i+1];
  219. my @rowslice = @rowindex[$thiscol-1..$nextcol-2];
  220. my @valslice = @values[$thiscol-1..$nextcol-2];
  221. foreach my $j (0..$#rowslice) {
  222. $this->assign($rowslice[$j],$curcol,$valslice[$j]);
  223. }
  224. $curcol++;
  225. }
  226. if ($mattype =~ /^.S.$/) {
  227. $this->_symmetrify();
  228. } elsif ($mattype =~ /^.Z.$/) {
  229. $this->_skewsymmetrify();
  230. }
  231. return $this;
  232. }
  233. sub newmatrixmarket {
  234. my ($proto, $filename) = @_;
  235. my $this = new Math::MatrixSparse;
  236. confess "Math::MatrixSparse::newmatrixmarket undefined filename" unless defined $filename;
  237. open(MM,"<$filename" ) || croak "Math::MatrixSparse::newmatrixmarket Can't open $filename for reading";
  238. $_=<MM>;
  239. unless (/^\%\%MatrixMarket/) {
  240. confess "Math::MatrixSparse::newmatrixmarket Invalid start of file";
  241. }
  242. unless (/coordinate/i) {
  243. confess "Math::MatrixSparse::newmatrixmarket dense format not implemented";
  244. }
  245. if (/complex/i) {
  246. carp "Math::MatrixSparse::newmatrixmarket Complex matrices not implemented, ignoring imaginary part\n";
  247. $this->{special}->{field} = "real";
  248. } else {
  249. $this->{special}->{field} = "real";
  250. }
  251. my $specifications = $_;
  252. my $ispattern;
  253. my $issymmetric;
  254. my $isskewsymmetric;
  255. if ($specifications =~ /pattern/i) {
  256. $ispattern = 1;
  257. $this->{special}->{pattern} = 1;
  258. }
  259. $this->{name} = $filename;
  260. my $startdata=0;
  261. my $entries =0;
  262. my ($rows,$columns);
  263. while (<MM>) {
  264. next if /^\%/;
  265. unless ($startdata) {
  266. s/^\s*//;
  267. s/\s*$//;
  268. ($rows,$columns,$entries) = split(/\s+/);
  269. $this->{rows} = $rows;
  270. $this->{columns} = $columns;
  271. $startdata = 1;
  272. } else {
  273. s/^\s*//;
  274. s/\s*$//;
  275. ($rows,$columns,$entries) = split(/\s+/);
  276. $entries = 1 if $ispattern;
  277. $this->assign($rows,$columns,$entries);
  278. }
  279. }
  280. if ($specifications =~ /\Wsymmetric/i) {
  281. $this->{special}->{structure} = "symmetric";
  282. return $this->symmetrify();
  283. }
  284. if ($specifications =~ /skewsymmetric/i) {
  285. $this->{special}->{structure} = "skewsymmetric";
  286. return $this->skewsymmetrify();
  287. }
  288. # if ($specifications =~ /hermetian/i) {
  289. # $this->{special}->{structure} = "hermetian";
  290. # return $this->symmetrify();
  291. # }
  292. return $this;
  293. }
  294. sub writematrixmarket {
  295. my ($matrix, $filename) = @_;
  296. open(MM,">$filename" ) || croak "Math::MatrixSparse::newmatrixmarket Can't open $filename for writing";
  297. print MM '%%MatrixMarket matrix coordinate ';
  298. print MM $matrix->{special}->{pattern} ? "pattern " : "real ";
  299. if ($matrix->{special}->{structure} =~ m/^symmetric/i) {
  300. $matrix=$matrix->symmetrify();
  301. print MM "symmetric";
  302. } elsif ($matrix->{special}->{structure} =~ m/skewsymmetric/i) {
  303. $matrix=$matrix->skewsymmetrify();
  304. print MM "skewsymmetric";
  305. } else {
  306. print MM "general\n";
  307. }
  308. print MM "$matrix->{rows} $matrix->{columns} ";
  309. print MM $matrix->count() , "\n";
  310. if ($matrix->{special}->{pattern}) {
  311. foreach my $key ($matrix->sortbycolumn()) {
  312. my ($i,$j) = &splitkey($key);
  313. next unless $matrix->element($i,$j);
  314. print MM "$i $j\n";
  315. }
  316. } else {
  317. foreach my $key ($matrix->sortbycolumn()) {
  318. my ($i,$j) = &splitkey($key);
  319. print MM "$i $j ", $matrix->{data}{$key}, "\n";
  320. }
  321. }
  322. return;
  323. }
  324. sub copy {
  325. my ($proto,$name) = @_;
  326. my $this = new Math::MatrixSparse;
  327. return $this unless defined $proto;
  328. if (defined $proto->{data}) {
  329. %{$this->{data}} = %{$proto->{data}};
  330. }
  331. %{$this->{special}} = %{$proto->{special}};
  332. $this->{name} = defined $name ? $name : $proto->{name};
  333. $this->{rows} = $proto->{rows};
  334. $this->{columns} = $proto->{columns};
  335. return $this;
  336. }
  337. sub name {
  338. my ($object,$name) = @_;
  339. $object->{name} = $name;
  340. return $name;
  341. }
  342. ### INSERTION AND LOOKUP METHODS
  343. sub assign {
  344. my ($object, $i,$j,$x)=@_;
  345. return undef unless ((defined $i) && (defined $j)&&(defined $object));
  346. $x = 1 if $object->{special}->{pattern};
  347. return undef unless defined $x;
  348. #update matrix's shape if necessary.
  349. if ((defined $object->{special}) &&
  350. ($object->{special}->{shape} =~ m/diagonal/i) &&
  351. ($i!= $j) ) {
  352. if ($i<$j) {
  353. $object->{special}->{shape} = "upper"
  354. } else {
  355. $object->{special}->{shape} = "lower"
  356. }
  357. } elsif (($object->{special}->{shape} =~ m/strictlower/i)
  358. && ($i<= $j) ) {
  359. if ($i==$j) {
  360. $object->{special}->{shape} = "lower";
  361. } else {
  362. $object->{special}->{shape}="";
  363. }
  364. } elsif (($object->{special}->{shape} =~ m/strictupper/i)
  365. && ($i>= $j) ) {
  366. if ($i==$j) {
  367. $object->{special}->{shape} = "upper";
  368. } else {
  369. $object->{special}->{shape}="";
  370. }
  371. } elsif (($object->{special}->{shape} =~ m/^lower/i) && ($i< $j) ) {
  372. $object->{special}->{shape}="";
  373. } elsif (($object->{special}->{shape} =~ m/^upper/i) && ($i= $j) ) {
  374. $object->{special}->{shape}="";
  375. }
  376. $object->{special}->{pattern} = 0 unless ($x==1);
  377. #update bandwidth
  378. if (abs($i-$j) > $object->{special}->{bandwidth}) {
  379. $object->{special}->{bandwidth} = abs($i-$j);
  380. }
  381. #update symmetric and skew-symmetric structure if necessary
  382. if (
  383. ($i!=$j) && ( defined $object->{special}->{structure}) &&
  384. (
  385. ($object->{special}->{structure} =~ /symmetric/i)
  386. # ||($object->{special}->{structure} =~ /hermetian/i)
  387. )
  388. ) {
  389. $object->{special}->{structure} = "";
  390. } elsif (($i==$j)&&
  391. ($object->{special}->{structure} =~ /skewsymmetric/i)&&
  392. ($x)) {
  393. #skew-symmetric matrices must have zero diagonal
  394. $object->{special}->{structure} = "";
  395. }
  396. #update sign if necessary
  397. if ( ($object->{special}->{sign} =~ /^positive/) && ($x<=0) ) {
  398. if ($x<0) {
  399. $object->{special}->{sign}="";
  400. } else {
  401. $object->{special}->{sign} = "nonnegative";
  402. }
  403. } elsif ( ($object->{special}->{sign} =~ /^negative/) && ($x>=0) ) {
  404. if ($x>0) {
  405. $object->{special}->{sign}="";
  406. } else {
  407. $object->{special}->{sign} = "nonpositive";
  408. }
  409. } elsif ( ($object->{special}->{sign} =~ /nonnegative/i) && ($x<0) ) {
  410. $object->{special}->{sign}="";
  411. } elsif ( ($object->{special}->{sign} =~ /nonpositive/i) && ($x>0) ) {
  412. $object->{special}->{sign}="";
  413. }
  414. my $key = &makekey($i,$j);
  415. delete $object->{sortedrows};
  416. delete $object->{sortedcolumns};
  417. delete $object->{data}->{$key};
  418. $object->{data}->{$key} = $x;
  419. #update size of matrix, and squareness, if necessary
  420. $object->{rows} = $i if ($i>$object->{rows});
  421. $object->{columns} = $j if ($j>$object->{columns});
  422. $object->{special}->{square} = ( $object->{columns}==$object->{rows});
  423. return $x;
  424. }
  425. sub assignspecial {
  426. #as assign, except that it respects special properties of
  427. #the matrix. For example, symmetrical matrices are kept symmetric.
  428. my ($object, $i,$j,$x)=@_;
  429. return undef unless ((defined $i) && (defined $j)&&(defined $object));
  430. $x = 1 if $object->{special}->{pattern};
  431. return undef unless defined $x;
  432. my $key = &makekey($i,$j);
  433. my $revkey = &makekey($j,$i);
  434. if ($object->{special}->{structure} =~ m/^symmetric/i) {
  435. if ($i==$j) {
  436. $object->{data}{$key} = $x;
  437. } else {
  438. $object->{data}{$key} = $x;
  439. $object->{data}{$revkey} = $x;
  440. }
  441. } elsif ($object->{special}->{structure} =~ m/^symmetric/i) {
  442. if (($i==$j)&&($x)) {
  443. croak "Math::MatrixSparse::assignspecial skewsymmetric matrices must have zero diagonal";
  444. } else {
  445. $object->{data}{$key} = $x;
  446. $object->{data}{$revkey} = -$x;
  447. }
  448. } else {
  449. $object->assign($i,$j,$x);
  450. }
  451. return $x;
  452. }
  453. sub assignkey {
  454. my ($object, $key,$x)=@_;
  455. my ($i,$j) = &splitkey($key);
  456. return unless ((defined $i) && (defined $j));
  457. $object->assign($i,$j,$x);
  458. return $x;
  459. }
  460. sub element {
  461. my ($object, $i,$j) = @_;
  462. my $key = &makekey($i,$j);
  463. if (defined $object->{data}{$key}) {
  464. return $object->{data}{$key};
  465. } else {
  466. return 0;
  467. }
  468. }
  469. sub elementkey {
  470. my ($object, $key) = @_;
  471. if (defined $object->{data}{$key}) {
  472. return $object->{data}{$key};
  473. } else {
  474. return 0;
  475. }
  476. }
  477. sub elements {
  478. my ($matrix) = @_;
  479. return keys %{$matrix->{data}};
  480. }
  481. #returns row number $row of matrix as a row matrix
  482. sub row {
  483. my ($matrix, $row,$persist) = @_;
  484. my $matrow = new Math::MatrixSparse;
  485. $matrow->{columns} = $matrix->{columns};
  486. $matrow->{rows} = 1;
  487. $matrow->name($matrix->{name});
  488. reuturn $matrow unless $row;
  489. if ($persist) {
  490. @{$matrix->{sortedrows}} = $matrix->sortbyrow()
  491. unless defined $matrix->{sortedrows};
  492. }
  493. if (defined $matrix->{sortedrows}) {
  494. #binary search for proper values
  495. my @rows = @{$matrix->{sortedrows}};
  496. my ($left,$right) = (0,$#rows);
  497. my $mid = int(($right+$left)/2.0);
  498. while (
  499. ((&splitkey($rows[$mid]))[0] != $row )
  500. && ($right-$left>0)
  501. ) {
  502. if ((&splitkey($rows[$mid]))[0] < $row) {
  503. $left = $mid;
  504. } else {
  505. $right = $mid;
  506. }
  507. $mid = int(($right+$left)/2.0);
  508. }
  509. return $matrow unless (&splitkey($rows[$mid]))[0]==$row;
  510. $right = $mid;
  511. while ( ($right<=$#rows)&&
  512. ((&splitkey($rows[$right]))[0]==$row)
  513. )
  514. {
  515. $matrow->assign(1,
  516. (&splitkey($rows[$right]))[1],
  517. $matrix->elementkey($rows[$right]));
  518. $right++;
  519. }
  520. $left = $mid-1;
  521. while ( ($left) &&
  522. ((&splitkey($rows[$left]))[0]==$row)
  523. ){
  524. $matrow->assign(1,
  525. (&splitkey($rows[$left]))[1],
  526. $matrix->elementkey($rows[$left]));
  527. $left--;
  528. }
  529. return $matrow;
  530. }
  531. foreach my $key (keys %{$matrix->{data}}){
  532. my ($i,$j) = &splitkey($key);
  533. $matrow->assignkey($key, $matrix->{data}{$key}) if ($i==$row);
  534. }
  535. return $matrow;
  536. }
  537. #returns column number $col of matrix as a column matrix
  538. sub column {
  539. my ($matrix, $col,$persist) = @_;
  540. my $matcol = new Math::MatrixSparse;
  541. $matcol->{columns} = $matrix->{columns};
  542. $matcol->{cols} = 1;
  543. $matcol->name($matrix->{name});
  544. if ($persist) {
  545. @{$matrix->{sortedcols}} = $matrix->sortbycolumn() unless defined $matrix->{sortedcols};
  546. }
  547. if (defined $matrix->{sortedcols}) {
  548. #binary search for proper values
  549. my @cols = @{$matrix->{sortedcols}};
  550. my ($left,$right) = (0,$#cols);
  551. my $mid = int(($right+$left)/2.0);
  552. while (
  553. ((&splitkey($cols[$mid]))[1] != $col )
  554. && ($right-$left>0)
  555. ) {
  556. if ((&splitkey($cols[$mid]))[1] < $col) {
  557. $left = $mid;
  558. } else {
  559. $right = $mid;
  560. }
  561. $mid = int(($right+$left)/2.0);
  562. }
  563. return $matcol unless (&splitkey($cols[$mid]))[1]==$col;
  564. $right = $mid;
  565. while ( ($right<=$#cols)&&
  566. ((&splitkey($cols[$right]))[1]==$col)
  567. )
  568. {
  569. $matcol->assign((&splitkey($cols[$right]))[0],1,
  570. $matrix->elementkey($cols[$right]));
  571. $right++;
  572. }
  573. $left = $mid-1;
  574. while ( ($left) &&
  575. ((&splitkey($cols[$left]))[1]==$col)
  576. ){
  577. $matcol->assign((&splitkey($cols[$left]))[0],1,
  578. $matrix->elementkey($cols[$left]));
  579. $left--;
  580. }
  581. return $matcol;
  582. }
  583. foreach my $key (keys %{$matrix->{data}}){
  584. my ($i,$j) = &splitkey($key);
  585. $matcol->assignkey($key, $matrix->{data}{$key}) if ($j==$col);
  586. }
  587. return $matcol;
  588. }
  589. ### PRINT
  590. sub print {
  591. my ($object,$name,$rc) = @_;
  592. return unless defined $object;
  593. my $label = $name ? $name : $object->{name};
  594. my @order ;
  595. $rc = "n" unless defined($rc);
  596. if ($rc =~ /^r/i) {
  597. @order = $object->sortbyrow();
  598. } elsif ($rc =~ /^c/i) {
  599. @order = $object->sortbycolumn();
  600. } else {
  601. @order = keys %{$object->{data}};
  602. }
  603. foreach my $key (@order){
  604. my ($i,$j) = &splitkey($key);
  605. print "$label($i, $j) = ", $object->{data}{$key},"\n";
  606. }
  607. return "";
  608. }
  609. ###ARITHMETIC METHODS
  610. #left+$right, dimensions must be identical
  611. sub add {
  612. my ($left,$right,$switch) = @_;
  613. if (($left->{rows} == $right->{rows})&&($left->{columns} == $right->{columns})) {
  614. my $sum= $left->addfree($right);
  615. $sum->{rows} = $left->{rows};
  616. $sum->{columns} = $left->{columns};
  617. return $sum;
  618. } else {
  619. return undef;
  620. }
  621. }
  622. #as add, but no restrictions on dimensions.
  623. sub addfree {
  624. my ($left, $right,$switch) = @_;
  625. my $sum = new Math::MatrixSparse;
  626. $sum = $left->copy();
  627. if ((defined $left->{name})&&(defined $right->{name})) {
  628. $sum->{name} = $left->{name} . "+" . $right->{name};
  629. }
  630. foreach my $rightkey (keys %{$right->{data}}) {
  631. if (defined $sum->{data}{$rightkey}) {
  632. $sum->{data}{$rightkey}+= $right->{data}{$rightkey};
  633. } else {
  634. $sum->{data}{$rightkey} = $right->{data}{$rightkey};
  635. }
  636. }
  637. $sum->{rows} = $left->{rows} >$right->{rows} ?
  638. $left->{rows} : $right->{rows};
  639. $sum->{columns} = $left->{columns} >$right->{columns} ?
  640. $left->{columns} : $right->{columns};
  641. if ($left->{special}->{structure} eq $right->{special}->{structure}) {
  642. $sum->{special}->{structure} = $left->{special}->{structure};
  643. }
  644. if ($left->{special}->{shape} eq $right->{special}->{shape}) {
  645. $sum->{special}->{shape} = $left->{special}->{shape};
  646. }
  647. return $sum;
  648. }
  649. sub subtract {
  650. my ($left, $right, $switch) = @_;
  651. if ($switch) {
  652. ($left,$right) = ($right, $left);
  653. }
  654. if (
  655. ($left->{rows} == $right->{rows})&&
  656. ($left->{columns} == $right->{columns})
  657. ) {
  658. my $diff= $left->subtractfree($right);
  659. $diff->{rows} = $left->{rows};
  660. $diff->{columns} = $left->{columns};
  661. return $diff;
  662. } else {
  663. return undef;
  664. }
  665. }
  666. #as subtract, but no restrictions on dimensions.
  667. sub subtractfree {
  668. my ($left, $right,$switch) = @_;
  669. my $diff = new Math::MatrixSparse;
  670. $diff = $left->copy();
  671. foreach my $rightkey (keys %{$right->{data}}) {
  672. if (defined $diff->{data}{$rightkey}) {
  673. $diff->{data}{$rightkey}-= $right->{data}{$rightkey};
  674. } else {
  675. $diff->{data}{$rightkey} = -1* $right->{data}{$rightkey};
  676. }
  677. }
  678. if ((defined $left->{name})&&(defined $right->{name})) {
  679. $diff->{name} = $left->{name} . "-" . $right->{name};
  680. }
  681. $diff->{rows} = $left->{rows} >$right->{rows} ?
  682. $left->{rows} : $right->{rows};
  683. $diff->{columns} = $left->{columns} >$right->{columns} ?
  684. $left->{columns} : $right->{columns};
  685. if ($left->{special}->{structure} eq $right->{special}->{structure}) {
  686. $diff->{special}->{structure} = $left->{special}->{structure};
  687. }
  688. if ($left->{special}->{shape} eq $right->{special}->{shape}) {
  689. $diff->{special}->{shape} = $left->{special}->{shape};
  690. }
  691. return $diff;
  692. }
  693. sub negate {
  694. my ($matrix) = @_;
  695. return $matrix->multiplyscalar(-1);
  696. }
  697. sub _negate {
  698. my ($matrix) = @_;
  699. return $matrix->_multiplyscalar(-1);
  700. }
  701. sub multiplyscalar {
  702. my ($matrix, $scalar) = @_;
  703. my $product = $matrix->copy();
  704. $scalar = 0 unless $scalar;
  705. foreach my $key (keys %{$product->{data}}) {
  706. $product->assignkey($key,$matrix->elementkey($key)*$scalar);
  707. }
  708. $product->{name} = "$scalar*".$product->{name} if defined $product->{name};
  709. if ($scalar <0 ) {
  710. if ($matrix->{special}->{sign} =~ m/positive/i) {
  711. $product->{special}->{sign} = "negative";
  712. } elsif ($matrix->{special}->{sign} =~ m/negative/i) {
  713. $product->{special}->{sign} = "positive";
  714. } elsif ($matrix->{special}->{sign} =~ m/nonpositive/i) {
  715. $product->{special}->{sign} = "nonnegative";
  716. } elsif ($matrix->{special}->{sign} =~ m/nonnegative/i) {
  717. $product->{special}->{sign} = "nonpositive";
  718. }
  719. } else {
  720. $product->{special}->{sign} =$matrix->{special}->{sign};
  721. }
  722. $product->{special}->{sign} = "zero" unless $scalar;
  723. return $product;
  724. }
  725. sub _multiplyscalar {
  726. my ($matrix, $scalar) = @_;
  727. $scalar = 0 unless $scalar;
  728. foreach my $key (keys %{$matrix->{data}}) {
  729. $matrix->{data}{$key} = $matrix->{data}{$key}*$scalar;
  730. }
  731. if ($scalar <0 ) {
  732. if ($matrix->{special}->{sign} =~ m/positive/i) {
  733. $matrix->{special}->{sign} = "negative";
  734. } elsif ($matrix->{special}->{sign} =~ m/negative/i) {
  735. $matrix->{special}->{sign} = "positive";
  736. } elsif ($matrix->{special}->{sign} =~ m/nonpositive/i) {
  737. $matrix->{special}->{sign} = "nonnegative";
  738. } elsif ($matrix->{special}->{sign} =~ m/nonnegative/i) {
  739. $matrix->{special}->{sign} = "nonpositive";
  740. }
  741. }
  742. $matrix->{special}->{sign} = "zero" unless $scalar;
  743. return $matrix;
  744. }
  745. #finds $left*$right, if compatible
  746. sub multiply {
  747. my ($left,$right,$switch) = @_;
  748. unless (ref($right)) {
  749. return $left->multiplyscalar($right);
  750. }
  751. return undef if ($left->{columns} != $right->{rows});
  752. my $product = new Math::MatrixSparse;
  753. $product->{rows} = $left->{rows};
  754. $product->{columns} = $right->{columns};
  755. if ((defined $left->{name})&&(defined $right->{name})) {
  756. $product->{name} = $left->{name} . "*" . $right->{name};
  757. }
  758. foreach my $leftkey (keys %{$left->{data}}) {
  759. my ($li,$lj) = &splitkey($leftkey);
  760. foreach my $rightkey (keys %{$right->{data}}) {
  761. my ($ri,$rj) = &splitkey($rightkey);
  762. next unless ($lj==$ri);
  763. my $thiskey = &makekey($li, $rj);
  764. my $prod = $left->{data}{$leftkey}*$right->{data}{$rightkey};
  765. if (defined $product->{data}{$thiskey}) {
  766. $product->{data}{$thiskey} += $prod;
  767. } else {
  768. $product->{data}{$thiskey} = $prod;
  769. }
  770. }
  771. }
  772. if (
  773. ($left->{special}->{sign} =~ /zero/i)||
  774. ($right->{special}->{sign} =~ /zero/i)) {
  775. $product->{special}->{sign} = "zero";
  776. return $product;
  777. }
  778. if ($left->{special}->{sign} =~ /^positive/i) {
  779. $product->{special}->{sign} = $right->{special}->{sign};
  780. } elsif ($left->{special}->{sign} =~ /nonpositive/i) {
  781. if ($right->{special}->{sign} =~ /^positive/i) {
  782. $product->{special}->{sign} = "nonpositive";
  783. } elsif ($right->{special}->{sign} =~ /nonpositive/i) {
  784. $product->{special}->{sign} = "nonnegative";
  785. } elsif ($right->{special}->{sign} =~ /^negative/i) {
  786. $product->{special}->{sign} = "nonnegative";
  787. } elsif ($right->{special}->{sign} =~ /nonnegative/i) {
  788. $product->{special}->{sign} = "nonpositive";
  789. }
  790. } elsif ($left->{special}->{sign} =~ /^negative/i) {
  791. if ($right->{special}->{sign} =~ /^positive/i) {
  792. $product->{special}->{sign} = "negative";
  793. } elsif ($right->{special}->{sign} =~ /nonpositive/i) {
  794. $product->{special}->{sign} = "nonnegative";
  795. } elsif ($right->{special}->{sign} =~ /^negative/i) {
  796. $product->{special}->{sign} = "positive";
  797. } elsif ($right->{special}->{sign} =~ /nonnegative/i) {
  798. $product->{special}->{sign} = "nonpositive";
  799. }
  800. } elsif ($left->{special}->{sign} =~ /nonnegative/i) {
  801. if ($right->{special}->{sign} =~ /^positive/i) {
  802. $product->{special}->{sign} = "nonnegative";
  803. } elsif ($right->{special}->{sign} =~ /nonpositive/i) {
  804. $product->{special}->{sign} = "nonpositive";
  805. } elsif ($right->{special}->{sign} =~ /^negative/i) {
  806. $product->{special}->{sign} = "nonpositive";
  807. } elsif ($right->{special}->{sign} =~ /nonnegative/i) {
  808. $product->{special}->{sign} = "nonnegative";
  809. }
  810. }
  811. return $product;
  812. }
  813. sub quickmultiply {
  814. my ($left,$right,$switch) = @_;
  815. unless (ref($right)) {
  816. return $left->multiplyscalar($right);
  817. }
  818. return undef if ($left->{columns} != $right->{rows});
  819. my $product = new Math::MatrixSparse;
  820. $product->{special}->{structure} = "";
  821. $product->{special}->{pattern}=0;
  822. $product->{special}->{shape} = "";
  823. $product->{rows} = $left->{rows};
  824. $product->{columns} = $right->{columns};
  825. my @leftcols = $left->sortbycolumn();
  826. my @rightrows = $right->sortbyrow();
  827. if ((defined $left->{name})&&(defined $right->{name})) {
  828. $product->{name} = $left->{name} . "*" . $right->{name};
  829. }
  830. my $lastrow = 0;
  831. foreach my $leftkey (@leftcols) {
  832. my ($li,$lj) = &splitkey($leftkey);
  833. my $i = 0;
  834. my $thiskey;
  835. if ($lj >$lastrow ) {
  836. $lastrow = $lj;
  837. #remove elements that won't be used again in multiplication
  838. while (defined ($thiskey = $rightrows[0])){
  839. my ($ri,$rj) = &splitkey($thiskey);
  840. last if $ri>=$lj;
  841. shift @rightrows;
  842. }
  843. }
  844. foreach my $rightkey (@rightrows) {
  845. my ($ri,$rj) = &splitkey($rightkey);
  846. last if ($ri>$lj);
  847. next if ($ri<$lj);
  848. my $thiskey = &makekey($li, $rj);
  849. my $prod = $left->{data}{$leftkey}*$right->{data}{$rightkey};
  850. if (defined $product->{data}{$thiskey}) {
  851. $product->{data}{$thiskey} += $prod;
  852. } else {
  853. $product->{data}{$thiskey} = $prod;
  854. }
  855. }
  856. }
  857. if (
  858. ($left->{special}->{sign} =~ /zero/i)||
  859. ($right->{special}->{sign} =~ /zero/i)) {
  860. $product->{special}->{sign} = "zero";
  861. return $product;
  862. }
  863. if ($left->{special}->{sign} =~ /^positive/i) {
  864. $product->{special}->{sign} = $right->{special}->{sign};
  865. } elsif ($left->{special}->{sign} =~ /nonpositive/i) {
  866. if ($right->{special}->{sign} =~ /^positive/i) {
  867. $product->{special}->{sign} = "nonpositive";
  868. } elsif ($right->{special}->{sign} =~ /nonpositive/i) {
  869. $product->{special}->{sign} = "nonnegative";
  870. } elsif ($right->{special}->{sign} =~ /^negative/i) {
  871. $product->{special}->{sign} = "nonnegative";
  872. } elsif ($right->{special}->{sign} =~ /nonnegative/i) {
  873. $product->{special}->{sign} = "nonpositive";
  874. }
  875. } elsif ($left->{special}->{sign} =~ /^negative/i) {
  876. if ($right->{special}->{sign} =~ /^positive/i) {
  877. $product->{special}->{sign} = "negative";
  878. } elsif ($right->{special}->{sign} =~ /nonpositive/i) {
  879. $product->{special}->{sign} = "nonnegative";
  880. } elsif ($right->{special}->{sign} =~ /^negative/i) {
  881. $product->{special}->{sign} = "positive";
  882. } elsif ($right->{special}->{sign} =~ /nonnegative/i) {
  883. $product->{special}->{sign} = "nonpositive";
  884. }
  885. } elsif ($left->{special}->{sign} =~ /nonnegative/i) {
  886. if ($right->{special}->{sign} =~ /^positive/i) {
  887. $product->{special}->{sign} = "nonnegative";
  888. } elsif ($right->{special}->{sign} =~ /nonpositive/i) {
  889. $product->{special}->{sign} = "nonpositive";
  890. } elsif ($right->{special}->{sign} =~ /^negative/i) {
  891. $product->{special}->{sign} = "nonpositive";
  892. } elsif ($right->{special}->{sign} =~ /nonnegative/i) {
  893. $product->{special}->{sign} = "nonnegative";
  894. }
  895. }
  896. return $product;
  897. }
  898. sub quickmultiplyfree {
  899. my ($left,$right,$switch) = @_;
  900. unless (ref($right)) {
  901. return $left->multiplyscalar($right);
  902. }
  903. my $product = new Math::MatrixSparse;
  904. $product->{rows} = $left->{rows};
  905. $product->{columns} = $right->{columns};
  906. my @leftcols = $left->sortbycolumn();
  907. my @rightrows = $right->sortbyrow();
  908. if ((defined $left->{name})&&(defined $right->{name})) {
  909. $product->{name} = $left->{name} . "*" . $right->{name};
  910. }
  911. my $lastrow = 0;
  912. foreach my $leftkey (@leftcols) {
  913. my ($li,$lj) = &splitkey($leftkey);
  914. my $i = 0;
  915. my $thiskey;
  916. if ($lj >$lastrow ) {
  917. $lastrow = $lj;
  918. #remove elements that won't be used again in multiplication
  919. while (defined ($thiskey = $rightrows[0])){
  920. my ($ri,$rj) = &splitkey($thiskey);
  921. last if $ri>=$lj;
  922. shift @rightrows;
  923. }
  924. }
  925. foreach my $rightkey (@rightrows) {
  926. my ($ri,$rj) = &splitkey($rightkey);
  927. last if ($ri>$lj);
  928. next if ($ri<$lj);
  929. my $thiskey = &makekey($li , $rj);
  930. my $prod = $left->{data}{$leftkey}*$right->{data}{$rightkey};
  931. if (defined $product->{data}{$thiskey}) {
  932. $product->{data}{$thiskey} += $prod;
  933. } else {
  934. $product->{data}{$thiskey} = $prod;
  935. }
  936. }
  937. }
  938. if (
  939. ($left->{special}->{sign} =~ /zero/i)||
  940. ($right->{special}->{sign} =~ /zero/i)) {
  941. $product->{special}->{sign} = "zero";
  942. return $product;
  943. }
  944. if ($left->{special}->{sign} =~ /^positive/i) {
  945. $product->{special}->{sign} = $right->{special}->{sign};
  946. } elsif ($left->{special}->{sign} =~ /nonpositive/i) {
  947. if ($right->{special}->{sign} =~ /^positive/i) {
  948. $product->{special}->{sign} = "nonpositive";
  949. } elsif ($right->{special}->{sign} =~ /nonpositive/i) {
  950. $product->{special}->{sign} = "nonnegative";
  951. } elsif ($right->{special}->{sign} =~ /^negative/i) {
  952. $product->{special}->{sign} = "nonnegative";
  953. } elsif ($right->{special}->{sign} =~ /nonnegative/i) {
  954. $product->{special}->{sign} = "nonpositive";
  955. }
  956. } elsif ($left->{special}->{sign} =~ /^negative/i) {
  957. if ($right->{special}->{sign} =~ /^positive/i) {
  958. $product->{special}->{sign} = "negative";
  959. } elsif ($right->{special}->{sign} =~ /nonpositive/i) {
  960. $product->{special}->{sign} = "nonnegative";
  961. } elsif ($right->{special}->{sign} =~ /^negative/i) {
  962. $product->{special}->{sign} = "positive";
  963. } elsif ($right->{special}->{sign} =~ /nonnegative/i) {
  964. $product->{special}->{sign} = "nonpositive";
  965. }
  966. } elsif ($left->{special}->{sign} =~ /nonnegative/i) {
  967. if ($right->{special}->{sign} =~ /^positive/i) {
  968. $product->{special}->{sign} = "nonnegative";
  969. } elsif ($right->{special}->{sign} =~ /nonpositive/i) {
  970. $product->{special}->{sign} = "nonpositive";
  971. } elsif ($right->{special}->{sign} =~ /^negative/i) {
  972. $product->{special}->{sign} = "nonpositive";
  973. } elsif ($right->{special}->{sign} =~ /nonnegative/i) {
  974. $product->{special}->{sign} = "nonnegative";
  975. }
  976. }
  977. return $product;
  978. }
  979. #as multiply, but no restrictions on dimensions.
  980. sub multiplyfree {
  981. my ($left,$right,$switch) = @_;
  982. my $product = new Math::MatrixSparse;
  983. $product->{rows} = $left->{rows};
  984. $product->{columns} = $right->{columns};
  985. if ((defined $left->{name})&&(defined $right->{name})) {
  986. $product->{name} = $left->{name} . "*" . $right->{name};
  987. }
  988. foreach my $leftkey (keys %{$left->{data}}) {
  989. my ($li,$lj) = &splitkey($leftkey);
  990. foreach my $rightkey (keys %{$right->{data}}) {
  991. my ($ri,$rj) = &splitkey($rightkey);
  992. next unless ($lj==$ri);
  993. my $thiskey = &makekey($li, $rj);
  994. my $prod = $left->{data}{$leftkey}*$right->{data}{$rightkey};
  995. if (defined $product->{data}{$thiskey}) {
  996. $product->{data}{$thiskey} += $prod;
  997. } else {
  998. $product->{data}{$thiskey} = $prod;
  999. }
  1000. }
  1001. }
  1002. if (
  1003. ($left->{special}->{sign} =~ /zero/i)||
  1004. ($right->{special}->{sign} =~ /zero/i)) {
  1005. $product->{special}->{sign} = "zero";
  1006. return $product;
  1007. }
  1008. if ($left->{special}->{sign} =~ /^positive/i) {
  1009. $product->{special}->{sign} = $right->{special}->{sign};
  1010. } elsif ($left->{special}->{sign} =~ /nonpositive/i) {
  1011. if ($right->{special}->{sign} =~ /^positive/i) {
  1012. $product->{special}->{sign} = "nonpositive";
  1013. } elsif ($right->{special}->{sign} =~ /nonpositive/i) {
  1014. $product->{special}->{sign} = "nonnegative";
  1015. } elsif ($right->{special}->{sign} =~ /^negative/i) {
  1016. $product->{special}->{sign} = "nonnegative";
  1017. } elsif ($right->{special}->{sign} =~ /nonnegative/i) {
  1018. $product->{special}->{sign} = "nonpositive";
  1019. }
  1020. } elsif ($left->{special}->{sign} =~ /^negative/i) {
  1021. if ($right->{special}->{sign} =~ /^positive/i) {
  1022. $product->{special}->{sign} = "negative";
  1023. } elsif ($right->{special}->{sign} =~ /nonpositive/i) {
  1024. $product->{special}->{sign} = "nonnegative";
  1025. } elsif ($right->{special}->{sign} =~ /^negative/i) {
  1026. $product->{special}->{sign} = "positive";
  1027. } elsif ($right->{special}->{sign} =~ /nonnegative/i) {
  1028. $product->{special}->{sign} = "nonpositive";
  1029. }
  1030. } elsif ($left->{special}->{sign} =~ /nonnegative/i) {
  1031. if ($right->{special}->{sign} =~ /^positive/i) {
  1032. $product->{special}->{sign} = "nonnegative";
  1033. } elsif ($right->{special}->{sign} =~ /nonpositive/i) {
  1034. $product->{special}->{sign} = "nonpositive";
  1035. } elsif ($right->{special}->{sign} =~ /^negative/i) {
  1036. $product->{special}->{sign} = "nonpositive";
  1037. } elsif ($right->{special}->{sign} =~ /nonnegative/i) {
  1038. $product->{special}->{sign} = "nonnegative";
  1039. }
  1040. }
  1041. return $product;
  1042. }
  1043. sub kronecker {
  1044. my ($left,$right);
  1045. my ($rr,$rc) = $right->size();
  1046. return undef unless ($rr&&$rc);
  1047. my $kroprod = new Math::MatrixSparse;
  1048. foreach my $key (keys %{$left->{data}}) {
  1049. my ($i,$j) = &splitkey($key);
  1050. $kroprod->_insert($i*$rr,$j*$rc,$right*$left->elementkey($key));
  1051. }
  1052. if ((defined $left->{name})&&(defined $right->{name})) {
  1053. $kroprod->{name} = $left->{name} . "x" . $right->{name};
  1054. }
  1055. return $kroprod;
  1056. }
  1057. sub termmult {
  1058. my ($left,$right) = @_;
  1059. my $termprod = $left->copy();
  1060. foreach my $key (keys %{$termprod->{data}}) {
  1061. $termprod->assignkey($key,$termprod->elementkey($key)* $right->elementkey($key));
  1062. }
  1063. return $termprod;
  1064. }
  1065. sub exponentiate {
  1066. my ($matrix,$power) = @_;
  1067. unless ($matrix->is_square()) {
  1068. carp "Math::MatrixSparse::exponentiate matrix must be square";
  1069. return undef ;
  1070. }
  1071. return Math::MatrixSparse->newidentity($matrix->{rows}) unless $power;
  1072. unless ($power>0) {
  1073. carp "Math::MatrixSparse::exponentiate exponent must be positive";
  1074. return undef ;
  1075. }
  1076. unless ($power =~ /^[+]?\d+/) {
  1077. carp "Math::MatrixSparse::exponentiate exponent must be an integer";
  1078. return undef ;
  1079. }
  1080. my $product = $matrix->copy();
  1081. # $product->clearspecials();
  1082. for my $i (2..$power) {
  1083. $product = $product->quickmultiply($matrix);
  1084. }
  1085. $product->{name} = $matrix->{name} ."^$power" if $matrix->{name};
  1086. return $product;
  1087. }
  1088. sub largeexponentiate {
  1089. #find matrix^power using the square-and-multiply method
  1090. my ($matrix,$power) = @_;
  1091. unless ($matrix->is_square()) {
  1092. carp "Math::MatrixSparse::exponentiate matrix must be square";
  1093. return undef ;
  1094. }
  1095. return Math::MatrixSparse->newidentity($matrix->{rows}) unless $power;
  1096. unless ($power>0) {
  1097. carp "Math::MatrixSparse::exponentiate exponent must be positive";
  1098. return undef ;
  1099. }
  1100. unless ($power =~ /^[+]?\d+/) {
  1101. carp "Math::MatrixSparse::exponentiate exponent must be an integer";
  1102. return undef ;
  1103. }
  1104. #get a representation of $exponent in binary
  1105. my $bitstr = unpack('B32',pack('N',$power));
  1106. $bitstr =~s/^0*//;
  1107. my @bitstr=split(//,$bitstr);
  1108. my $z = Math::MatrixSparse->newidentity($matrix->{rows});
  1109. foreach my $bit (@bitstr){
  1110. $z = ($z*$z);
  1111. if ($bit){
  1112. $z = ($z*$matrix);
  1113. }
  1114. }
  1115. $z->{name} = "";
  1116. $z->{name} = $matrix->{name} . "^$power" if $matrix->{name};
  1117. return $z;
  1118. }
  1119. sub transpose {
  1120. my ($matrix) = @_;
  1121. my $this= new Math::MatrixSparse;
  1122. $this->{rows} = $matrix->{columns};
  1123. $this->{columns} = $matrix->{rows};
  1124. foreach my $key (keys %{$matrix->{data}}) {
  1125. my ($i,$j) = &splitkey($key);
  1126. $this->assign($j,$i,$matrix->{data}{$key});
  1127. }
  1128. $this->{name} = $matrix->{name} . "'" if $matrix->{name};
  1129. $this->{special}->{structure} = $matrix->{special}->{structure};
  1130. $this->{special}->{sign} = $matrix->{special}->{sign};
  1131. $this->{special}->{pattern} = $matrix->{special}->{pattern};
  1132. $this->{special}->{square} = $matrix->{special}->{square};
  1133. if ($matrix->{special}->{shape} =~ /diagonal/i) {
  1134. $this->{special}->{shape} = "diagonal";
  1135. } elsif ($matrix->{special}->{shape} =~ /^lower/i) {
  1136. $this->{special}->{shape} = "upper";
  1137. } elsif ($matrix->{special}->{shape} =~ /^upper/i) {
  1138. $this->{special}->{shape} = "lower";
  1139. } elsif ($matrix->{special}->{shape} =~ /strictupper/i) {
  1140. $this->{special}->{shape} = "strictlower";
  1141. } elsif ($matrix->{special}->{shape} =~ /strictlower/i) {
  1142. $this->{special}->{shape} = "strictlower";
  1143. } else {
  1144. $this->{special}->{shape} = "";
  1145. }
  1146. return $this;
  1147. }
  1148. sub terminvert {
  1149. my ($matrix) = @_;
  1150. my $this = $matrix->copy();
  1151. foreach my $key (keys %{$this->{data}}) {
  1152. next unless $this->{data}{$key};
  1153. $this->{data}{$key} = 1.0/($this->{data}{$key});
  1154. }
  1155. return $this;
  1156. }
  1157. sub _terminvert {
  1158. my ($matrix) = @_;
  1159. foreach my $key (keys %{$matrix->{data}}) {
  1160. next unless $matrix->{data}{$key};
  1161. $matrix->{data}{$key} = 1.0/($matrix->{data}{$key});
  1162. }
  1163. return $matrix;
  1164. }
  1165. ### DISSECTION METHODS
  1166. sub diagpart {
  1167. my ($matrix,$offset) = @_;
  1168. my $diag = new Math::MatrixSparse;
  1169. $offset = 0 unless defined $offset;
  1170. foreach my $key (keys %{$matrix->{data}}){
  1171. my ($i,$j) = &splitkey($key);
  1172. next unless ($i == ($j+$offset));
  1173. $diag->assign($i,$j,$matrix->{data}{$key});
  1174. }
  1175. $diag->{rows} = $matrix->{rows};
  1176. $diag->{columns} = $matrix->{columns};
  1177. $diag->{special}->{shape} = "diagonal";
  1178. return $diag;
  1179. }
  1180. sub nondiagpart {
  1181. my ($matrix,$offset) = @_;
  1182. my $diag = new Math::MatrixSparse;
  1183. $offset = 0 unless defined $offset;
  1184. foreach my $key (keys %{$matrix->{data}}){
  1185. my ($i,$j) = &splitkey($key);
  1186. next if ($i == ($j+$offset));
  1187. $diag->assign($i,$j,$matrix->{data}{$key});
  1188. }
  1189. $diag->{rows} = $matrix->{rows};
  1190. $diag->{columns} = $matrix->{columns};
  1191. return $diag;
  1192. }
  1193. sub lowerpart {
  1194. my ($matrix) = @_;
  1195. my $lower = new Math::MatrixSparse;
  1196. foreach my $key (keys %{$matrix->{data}}){
  1197. my ($i,$j) = &splitkey($key);
  1198. next unless ($i > $j);
  1199. $lower->assign($i,$j,$matrix->{data}{$key});
  1200. }
  1201. $lower->{rows} = $matrix->{rows};
  1202. $lower->{columns} = $matrix->{columns};
  1203. $lower->{special}->{shape} = "strictlower";
  1204. return $lower;
  1205. }
  1206. sub nonlowerpart {
  1207. my ($matrix) = @_;
  1208. my $lower = new Math::MatrixSparse;
  1209. foreach my $key (keys %{$matrix->{data}}){
  1210. my ($i,$j) = &splitkey($key);
  1211. next if ($i > $j);
  1212. $lower->assign($i,$j,$matrix->{data}{$key});
  1213. }
  1214. $lower->{rows} = $matrix->{rows};
  1215. $lower->{columns} = $matrix->{columns};
  1216. $lower->{special}->{shape} = "upper";
  1217. return $lower;
  1218. }
  1219. sub upperpart {
  1220. my ($matrix) = @_;
  1221. my $upper = new Math::MatrixSparse;
  1222. foreach my $key (keys %{$matrix->{data}}){
  1223. my ($i,$j) = &splitkey($key);
  1224. next unless ($i < $j);
  1225. $upper->assign($i,$j,$matrix->{data}{$key});
  1226. }
  1227. $upper->{rows} = $matrix->{rows};
  1228. $upper->{columns} = $matrix->{columns};
  1229. $upper->{special}->{shape} = "strictupper";
  1230. return $upper;
  1231. }
  1232. sub nonupperpart {
  1233. my ($matrix) = @_;
  1234. my $upper = new Math::MatrixSparse;
  1235. foreach my $key (keys %{$matrix->{data}}){
  1236. my ($i,$j) = &splitkey($key);
  1237. next if ($i < $j);
  1238. $upper->assign($i,$j,$matrix->{data}{$key});
  1239. }
  1240. $upper->{rows} = $matrix->{rows};
  1241. $upper->{columns} = $matrix->{columns};
  1242. $upper->{special}->{shape} = "lower";
  1243. return $upper;
  1244. }
  1245. sub _diagpart {
  1246. my ($matrix,$offset) = @_;
  1247. $offset = 0 unless defined $offset;
  1248. foreach my $key (keys %{$matrix->{data}}){
  1249. my ($i,$j) = &splitkey($key);
  1250. $matrix->delete($i,$j) unless ($i == ($j+$offset));
  1251. }
  1252. $matrix->{special}->{shape} = "diagonal";
  1253. return $matrix;
  1254. }
  1255. sub _nondiagpart {
  1256. my ($matrix,$offset) = @_;
  1257. $offset = 0 unless defined $offset;
  1258. foreach my $key (keys %{$matrix->{data}}){
  1259. my ($i,$j) = &splitkey($key);
  1260. $matrix->delete($i,$j) if ($i == ($j+$offset));
  1261. }
  1262. $matrix->{special}->{shape}="" if
  1263. $matrix->{special}->{shape} =~ m/diagonal/i;
  1264. return $matrix;
  1265. }
  1266. sub _lowerpart {
  1267. my ($matrix) = @_;
  1268. foreach my $key (keys %{$matrix->{data}}){
  1269. my ($i,$j) = &splitkey($key);
  1270. $matrix->delete($i,$j) unless ($i > $j);
  1271. }
  1272. $matrix->{special}->{shape} = "strictlower";
  1273. return $matrix;
  1274. }
  1275. sub _nonlowerpart {
  1276. my ($matrix) = @_;
  1277. foreach my $key (keys %{$matrix->{data}}){
  1278. my ($i,$j) = &splitkey($key);
  1279. $matrix->delete($i,$j) if ($i > $j);
  1280. }
  1281. $matrix->{special}->{shape} = "upper";
  1282. return $matrix;
  1283. }
  1284. sub _upperpart {
  1285. my ($matrix) = @_;
  1286. foreach my $key (keys %{$matrix->{data}}){
  1287. my ($i,$j) = &splitkey($key);
  1288. $matrix->delete($i,$j) unless ($i < $j);
  1289. }
  1290. $matrix->{special}->{shape} = "strictupper";
  1291. return $matrix;
  1292. }
  1293. sub _nonupperpart {
  1294. my ($matrix) = @_;
  1295. foreach my $key (keys %{$matrix->{data}}){
  1296. my ($i,$j) = &splitkey($key);
  1297. $matrix->delete($i,$j) if ($i < $j);
  1298. }
  1299. $matrix->{special}->{shape} = "lower";
  1300. return $matrix;
  1301. }
  1302. sub symmetricpart {
  1303. #.5*( A+A' )
  1304. my ($matrix) = @_;
  1305. my $sp =($matrix+$matrix->transpose());
  1306. $sp = 0.5*$sp;
  1307. $sp->{special}->{structure} = "symmetric";
  1308. return $sp;
  1309. }
  1310. sub _symmetricpart {
  1311. #.5*( A+A' )
  1312. my ($matrix) = @_;
  1313. my $sp =($matrix+$matrix->transpose());
  1314. $sp = 0.5*$sp;
  1315. $sp->{special}->{structure} = "symmetric";
  1316. return $matrix=$sp->copy();
  1317. }
  1318. sub skewsymmetricpart {
  1319. #.5*( A-A' )
  1320. my ($matrix) = @_;
  1321. my $ssp= 0.5*($matrix-$matrix->transpose());
  1322. $ssp->{special}->{structure} = "skewsymmetric";
  1323. return $ssp;
  1324. }
  1325. sub _skewsymmetricpart {
  1326. #.5*( A-A' )
  1327. my ($matrix) = @_;
  1328. my $ssp= 0.5*($matrix-$matrix->transpose());
  1329. $ssp->{special}->{structure} = "skewsymmetric";
  1330. return $matrix=$ssp->copy();
  1331. }
  1332. sub positivepart {
  1333. my ($matrix) = @_;
  1334. my $pos = new Math::MatrixSparse;
  1335. foreach my $key (keys %{$matrix->{data}}){
  1336. next unless $matrix->elementkey($key) >0;
  1337. $pos->assignkey($key,$matrix->{data}{$key});
  1338. }
  1339. $pos->{rows} = $matrix->{rows};
  1340. $pos->{columns} = $matrix->{columns};
  1341. return $pos;
  1342. }
  1343. sub negativepart {
  1344. my ($matrix) = @_;
  1345. my $neg = new Math::MatrixSparse;
  1346. foreach my $key (keys %{$matrix->{data}}){
  1347. next unless $matrix->elementkey($key) <0;
  1348. $neg->assignkey($key,$matrix->{data}{$key});
  1349. }
  1350. $neg->{rows} = $matrix->{rows};
  1351. $neg->{columns} = $matrix->{columns};
  1352. return $neg;
  1353. }
  1354. sub _positivepart {
  1355. my ($matrix) = @_;
  1356. foreach my $key (keys %{$matrix->{data}}){
  1357. next if $matrix->elementkey($key) >0;
  1358. $matrix->deletekey($key,$matrix->{data}{$key});
  1359. }
  1360. return $matrix;
  1361. }
  1362. sub _negativepart {
  1363. my ($matrix) = @_;
  1364. foreach my $key (keys %{$matrix->{data}}){
  1365. next if $matrix->elementkey($key) <0;
  1366. $matrix->deletekey($key,$matrix->{data}{$key});
  1367. }
  1368. return $matrix;
  1369. }
  1370. sub mask{
  1371. my ($matrix, $i1,$i2,$j1,$j2) = @_;
  1372. return undef unless (($i1<=$i2)&&($j1<=$j2));
  1373. my $mask = new Math::MatrixSparse;
  1374. foreach my $key (keys %{$matrix->{data}}) {
  1375. my ($i,$j) = &splitkey($key);
  1376. next unless (($i>=$i1)&&($i<=$i2));
  1377. next unless (($j>=$j1)&&($j<=$j2));
  1378. $mask->assignkey($key,$matrix->{data}{$key});
  1379. }
  1380. return $mask;
  1381. }
  1382. sub _mask{
  1383. my ($matrix, $i1,$i2,$j1,$j2) = @_;
  1384. return undef unless (($i1<=$i2)&&($j1<=$j2));
  1385. foreach my $key (keys %{$matrix->{data}}) {
  1386. my ($i,$j) = &splitkey($key);
  1387. next if (($i>=$i1)&&($i<=$i2));
  1388. next if (($j>=$j1)&&($j<=$j2));
  1389. $matrix->assignkey($key,0);
  1390. }
  1391. return $matrix;
  1392. }
  1393. sub submatrix{
  1394. my ($matrix, $i1,$i2,$j1,$j2) = @_;
  1395. return undef unless (($i1<=$i2)&&($j1<=$j2));
  1396. my $subm = new Math::MatrixSparse;
  1397. foreach my $key (keys %{$matrix->{data}}) {
  1398. my ($i,$j) = &splitkey($key);
  1399. next unless (($i>=$i1)&&($i<=$i2));
  1400. next unless (($j>=$j1)&&($j<=$j2));
  1401. $subm->assign($i-$i1,$j-$j1,$matrix->{data}{$key});
  1402. }
  1403. return $subm;
  1404. }
  1405. sub insert {
  1406. my ($big, $i0,$j0,$small) = @_;
  1407. my $insert = $big->copy();
  1408. foreach my $key (keys %{$small->{data}}){
  1409. my ($i,$j) = &splitkey($key);
  1410. $insert->assignkey($i+$i0,$j+$j0,$small->elementkey($key));
  1411. }
  1412. return $insert;
  1413. }
  1414. sub _insert {
  1415. my ($big, $i0,$j0,$small) = @_;
  1416. foreach my $key (keys %{$small->{data}}){
  1417. my ($i,$j) = &splitkey($key);
  1418. $big->assignkey($i+$i0,$j+$j0,$small->elementkey($key));
  1419. }
  1420. return $big;
  1421. }
  1422. sub shift {
  1423. my ($matrix, $i1,$j1) = @_;
  1424. my $this = new Math::MatrixSparse;
  1425. $this->{name}=$matrix->{name};
  1426. foreach my $key (keys %{$matrix->{data}}) {
  1427. my ($i,$j) = &splitkey($key);
  1428. $this->assign($i+$i1,$j+$j1,$matrix->{data}{$key});
  1429. }
  1430. return $this;
  1431. }
  1432. sub each {
  1433. my ($matrix,$coderef) = @_;
  1434. my $this = $matrix->copy();
  1435. foreach my $key (keys %{$this->{data}}) {
  1436. my ($i,$j) = &splitkey($key);
  1437. $this->assign($i,$j,&$coderef($this->{data}{$key},$i,$j));
  1438. }
  1439. return $this;
  1440. }
  1441. sub _each {
  1442. my ($matrix,$coderef) = @_;
  1443. foreach my $key (keys %{$matrix->{data}}) {
  1444. my ($i,$j) = &splitkey($key);
  1445. $matrix->assign($i,$j,&$coderef($matrix->{data}{$key},$i,$j));
  1446. }
  1447. return $matrix;
  1448. }
  1449. ### INFORMATIONAL AND STATISTICAL METHODS
  1450. sub printstats {
  1451. my ($matrix,$name) = @_;
  1452. return unless defined $matrix;
  1453. $name = $name || $matrix->{name} || "unnamed matrix";
  1454. print "Statistics for $name :\n";
  1455. print "rows: $matrix->{rows}\t";
  1456. print "columns: $matrix->{columns}\tdefined elements: ";
  1457. print $matrix->count(), "\n";
  1458. my ($width) = $matrix->width();
  1459. print "Bandwidth: $width\t";
  1460. print "Symmetric " if $matrix->is_symmetric();
  1461. print "Skew-Symmetric " if $matrix->is_skewsymmetric();
  1462. # print "Hermetian " if $matrix->{special}->{structure} =~m/^hermetian/i;
  1463. print "Real " if $matrix->{special}->{field} =~ m/real/i;
  1464. # print "Complex " if $matrix->{special}->{field} =~ m/complex/i;
  1465. print "Strictly " if $matrix->{special}->{shape} =~ m/strict/;
  1466. print "Upper Triangular " if $matrix->{special}->{shape} =~ m/upper/;
  1467. print "Lower Triangular " if $matrix->{special}->{shape} =~ m/lower/;
  1468. print "Diagonal" if $matrix->is_diagonal();
  1469. print "Pattern " if $matrix->is_pattern();
  1470. print "Square " if $matrix->is_square();
  1471. print "\n";
  1472. }
  1473. sub dim {
  1474. my ($matrix) = @_;
  1475. return ($matrix->{rows},$matrix->{columns});
  1476. }
  1477. sub exactdim {
  1478. my ($matrix) = @_;
  1479. my $rows=0;
  1480. my $columns = 0;
  1481. foreach my $key (keys %{$matrix->{data}}) {
  1482. my ($i,$j) = &splitkey($key);
  1483. $rows = $i if $i>$rows;
  1484. $columns = $j if $j > $rows;
  1485. }
  1486. return ($rows,$columns);
  1487. }
  1488. sub count {
  1489. my ($matrix) = @_;
  1490. return scalar keys %{$matrix->{data}};
  1491. }
  1492. sub width {
  1493. my ($matrix) = @_;
  1494. return $matrix->{special}->{bandwidth} if $matrix->{special}->{bandwidth};
  1495. my $width = 0;
  1496. foreach my $key (keys %{$matrix->{data}}) {
  1497. my ($i,$j) = &splitkey($key);
  1498. $width = abs($i- $j) if abs($i-$j) > $width;
  1499. }
  1500. return ($width);
  1501. }
  1502. sub sum {
  1503. my ($matrix) = @_;
  1504. my $sum = 0;
  1505. foreach my $key (keys %{$matrix->{data}}) {
  1506. $sum += $matrix->elementkey($key);
  1507. }
  1508. return $sum;
  1509. }
  1510. sub sumeach {
  1511. my ($matrix,$coderef) = @_;
  1512. my $sum = 0;
  1513. foreach my $key (keys %{$matrix->{data}}) {
  1514. my ($i,$j) = &splitkey( $key);
  1515. $sum += &$coderef($matrix->elementkey($key),$i,$j);
  1516. }
  1517. return $sum;
  1518. }
  1519. sub abssum {
  1520. my ($matrix) = @_;
  1521. my $sum = 0;
  1522. foreach my $key (keys %{$matrix->{data}}) {
  1523. $sum += abs($matrix->elementkey($key));
  1524. }
  1525. return $sum;
  1526. }
  1527. sub rownorm {
  1528. my ($matrix) = @_;
  1529. my %rowsums;
  1530. return 0 unless defined $matrix;
  1531. foreach my $key (keys %{$matrix->{data}}) {
  1532. my ($i,$j) = &splitkey($key);
  1533. $rowsums{$i}+= abs($matrix->elementkey($key));
  1534. }
  1535. return (sort {$a <=> $b} values %rowsums)[0];
  1536. }
  1537. sub columnnorm {
  1538. my ($matrix) = @_;
  1539. my %columnsums;
  1540. return 0 unless defined $matrix;
  1541. foreach my $key (keys %{$matrix->{data}}) {
  1542. my ($i,$j) = &splitkey($key);
  1543. $columnsums{$i}+= $matrix->elementkey($key);
  1544. }
  1545. return (sort {$a <=> $b} values %columnsums)[0];
  1546. }
  1547. sub norm_max {
  1548. return $_[0]->rownorm();
  1549. }
  1550. sub norm_one {
  1551. return $_[0]->columnnorm();
  1552. }
  1553. sub norm_frobenius {
  1554. return sqrt($_[0]->sumeach(sub {$_[0]*$_[0]}));
  1555. }
  1556. sub trace {
  1557. my ($matrix) = @_;
  1558. return $matrix->diagpart()->sum();
  1559. }
  1560. ### BOOLEAN METHODS
  1561. sub equals {
  1562. my ($left,$right) = @_;
  1563. return 1 unless ( defined $left|| defined $right);
  1564. return 0 unless defined $left;
  1565. return 0 unless defined $right;
  1566. my $truth = 1;
  1567. foreach my $key (keys %{$left->{data}}, keys %{$right->{data}}) {
  1568. $truth *= ($left->elementkey($key) == $right->elementkey($key));
  1569. }
  1570. return $truth;
  1571. }
  1572. sub is_square {
  1573. my ($matrix) = @_;
  1574. return 0 unless defined $matrix;
  1575. return $matrix->{rows} == $matrix->{columns};
  1576. }
  1577. sub is_quadratic {
  1578. my ($matrix) = @_;
  1579. return 0 unless defined $matrix;
  1580. return $matrix->{rows} == $matrix->{columns};
  1581. }
  1582. sub is_symmetric {
  1583. my ($matrix) = @_;
  1584. return 0 unless defined $matrix;
  1585. return 1 if $matrix->{special}->{structure} =~ m/^symmetric/;
  1586. return 0 if $matrix->{special}->{structure} =~ m/skewsymmetric/;
  1587. # return 0 if $matrix->{special}->{structure} =~ m/hermetian/;
  1588. my $truth = 1;
  1589. foreach my $key (keys %{$matrix->{data}}) {
  1590. my ($i,$j) = &splitkey($key);
  1591. my $reversekey = &makekey($j, $i);
  1592. $truth *= ($matrix->elementkey($key)
  1593. == $matrix->elementkey($reversekey));
  1594. return 0 unless $truth;
  1595. }
  1596. return $truth;
  1597. }
  1598. sub is_skewsymmetric {
  1599. my ($matrix) = @_;
  1600. return 0 unless defined $matrix;
  1601. return 0 if $matrix->{special}->{structure} =~ m/^symmetric/;
  1602. return 1 if $matrix->{special}->{structure} =~ m/^skewsymmetric/;
  1603. my $truth = 1;
  1604. foreach my $key (keys %{$matrix->{data}}) {
  1605. my ($i,$j) = &splitkey($key);
  1606. my $reversekey = &makekey($j , $i);
  1607. $truth *= ($matrix->elementkey($key)
  1608. == -1*$matrix->elementkey($reversekey));
  1609. return 0 unless $truth;
  1610. }
  1611. return $truth;
  1612. }
  1613. sub is_diagonal {
  1614. my ($matrix) = @_;
  1615. return 0 unless defined $matrix;
  1616. return 1 if $matrix->{special}->{shape}=~m/diagonal/i;
  1617. my $truth = 1;
  1618. foreach my $key (keys %{$matrix->{data}}) {
  1619. my ($i,$j) = &splitkey($key);
  1620. $truth *= ($i==$j);
  1621. return 0 unless $truth;
  1622. }
  1623. return $truth;
  1624. }
  1625. sub is_strictlowertriangular {
  1626. my ($matrix) = @_;
  1627. return 0 unless defined $matrix;
  1628. return 1 if $matrix->{special}->{shape}=~m/strictlower/i;
  1629. my $truth = 1;
  1630. foreach my $key (keys %{$matrix->{data}}) {
  1631. my ($i,$j) = &splitkey($key);
  1632. $truth *= ($i > $j);
  1633. return 0 unless $truth;
  1634. }
  1635. return $truth;
  1636. }
  1637. sub is_strictuppertriangular {
  1638. my ($matrix) = @_;
  1639. return 0 unless defined $matrix;
  1640. return 1 if $matrix->{special}->{shape}=~m/strictupper/i;
  1641. my $truth = 1;
  1642. foreach my $key (keys %{$matrix->{data}}) {
  1643. my ($i,$j) = &splitkey($key);
  1644. $truth *= ($i < $j);
  1645. return 0 unless $truth;
  1646. }
  1647. return $truth;
  1648. }
  1649. sub is_lowertriangular {
  1650. my ($matrix) = @_;
  1651. return 0 unless defined $matrix;
  1652. my $truth = 1;
  1653. return 1 if $matrix->{special}->{shape}=~m/lower/i;
  1654. foreach my $key (keys %{$matrix->{data}}) {
  1655. my ($i,$j) = &splitkey($key);
  1656. $truth *= ($i >= $j);
  1657. return 0 unless $truth;
  1658. }
  1659. return $truth;
  1660. }
  1661. sub is_uppertriangular {
  1662. my ($matrix) = @_;
  1663. return 0 unless defined $matrix;
  1664. my $truth = 1;
  1665. return 1 if $matrix->{special}->{shape}=~m/upper/i;
  1666. foreach my $key (keys %{$matrix->{data}}) {
  1667. my ($i,$j) = &splitkey($key);
  1668. $truth *= ($i <= $j);
  1669. return 0 unless $truth;
  1670. }
  1671. return $truth;
  1672. }
  1673. sub is_positive {
  1674. my ($matrix) = @_;
  1675. return 0 unless defined $matrix;
  1676. return 1 if $matrix->{special}->{sign} =~ m/^positive/i;
  1677. my $truth = 1;
  1678. foreach my $key (keys %{$matrix->{data}}) {
  1679. $truth *= ($matrix->elementkey($key)>0);
  1680. return 0 unless $truth;
  1681. }
  1682. return $truth;
  1683. }
  1684. sub is_zero {
  1685. my ($matrix) = @_;
  1686. return 0 unless defined $matrix;
  1687. my $truth = 1;
  1688. return 1 if $matrix->{special}->{sign} =~ /zero/i;
  1689. foreach my $key (keys %{$matrix->{data}}) {
  1690. $truth *= ($matrix->elementkey($key)==0);
  1691. return 0 unless $truth;
  1692. }
  1693. return $truth;
  1694. }
  1695. sub is_nonpositive {
  1696. my ($matrix) = @_;
  1697. my $truth = 1;
  1698. return 0 unless defined $matrix;
  1699. foreach my $key (keys %{$matrix->{data}}) {
  1700. $truth *= ($matrix->elementkey($key)<=0);
  1701. return 0 unless $truth;
  1702. }
  1703. return $truth;
  1704. }
  1705. sub is_negative {
  1706. my ($matrix) = @_;
  1707. my $truth = 1;
  1708. return 0 unless defined $matrix;
  1709. foreach my $key (keys %{$matrix->{data}}) {
  1710. $truth *= ($matrix->elementkey($key)<0);
  1711. return 0 unless $truth;
  1712. }
  1713. return $truth;
  1714. }
  1715. sub is_nonnegative {
  1716. my ($matrix) = @_;
  1717. my $truth = 1;
  1718. return 0 unless defined $matrix;
  1719. foreach my $key (keys %{$matrix->{data}}) {
  1720. $truth *= ($matrix->elementkey($key)>=0);
  1721. return 0 unless $truth;
  1722. }
  1723. return $truth;
  1724. }
  1725. sub is_boolean {
  1726. my ($matrix) = @_;
  1727. return 0 unless defined $matrix;
  1728. return 1 if $matrix->{special}->{pattern};
  1729. my $truth = 1;
  1730. foreach my $key (keys %{$matrix->{data}}) {
  1731. $truth *= (($matrix->elementkey($key) == 0)||($matrix->elementkey($key) == 1));
  1732. return 0 unless $truth;
  1733. }
  1734. return $truth;
  1735. }
  1736. sub is_pattern {
  1737. my ($matrix) = @_;
  1738. return 0 unless defined $matrix;
  1739. return 1 if $matrix->{special}->{pattern};
  1740. my $truth = 1;
  1741. foreach my $key (keys %{$matrix->{data}}) {
  1742. $truth *= (($matrix->elementkey($key) == 0)||($matrix->elementkey($key) == 1));
  1743. return 0 unless $truth;
  1744. }
  1745. return $truth;
  1746. }
  1747. sub diagnose {
  1748. my ($matrix) = @_;
  1749. return 0 unless defined $matrix;
  1750. my $boolean = 1;
  1751. $matrix->_sizetofit();
  1752. $matrix->{special}->{square} = ($matrix->{rows} == $matrix->{columns});
  1753. my $upper = 1;
  1754. my $diagonal = 1;
  1755. my $lower = 1;
  1756. my $strictupper = 1;
  1757. my $strictlower = 1;
  1758. my $positive = 1;
  1759. my $nonpositive = 1;
  1760. my $negative = 1;
  1761. my $nonnegative = 1;
  1762. my $zero = 1;
  1763. my $symmetric = 1;
  1764. my $skewsymmetric = 1;
  1765. foreach my $key (keys %{$matrix->{data}}) {
  1766. my ($i,$j) = &splitkey($key);
  1767. my $reversekey = &makekey($j,$i);
  1768. $symmetric *= ($matrix->elementkey($key)
  1769. == $matrix->elementkey($reversekey));
  1770. $skewsymmetric *= ($matrix->elementkey($key)
  1771. == -1*$matrix->elementkey($reversekey));
  1772. $diagonal *= ($i==$j);
  1773. $strictlower *= ($i > $j);
  1774. $lower *= ($i >= $j);
  1775. $strictupper *= ($i > $j);
  1776. $upper *= ($i >= $j);
  1777. $positive *= ($matrix->elementkey($key)>0);
  1778. $nonpositive *= ($matrix->elementkey($key)<=0);
  1779. $negative *= ($matrix->elementkey($key)<0);
  1780. $nonnegative *= ($matrix->elementkey($key)>=0);
  1781. $boolean *= (($matrix->elementkey($key) == 0)
  1782. ||($matrix->elementkey($key) == 1));
  1783. $zero *= !($matrix->elementkey($key));
  1784. }
  1785. $matrix->{special}->{pattern} = $boolean;
  1786. if ($diagonal) {
  1787. $matrix->{special}->{shape} = "diagonal";
  1788. } elsif ($lower) {
  1789. if ($strictlower) {
  1790. $matrix->{special}->{shape} = "strictlower";
  1791. } else {
  1792. $matrix->{special}->{shape} = "lower";
  1793. }
  1794. } elsif ($upper) {
  1795. if ($strictlower) {
  1796. $matrix->{special}->{shape} = "strictupper";
  1797. } else {
  1798. $matrix->{special}->{shape} = "upper";
  1799. }
  1800. } else {
  1801. $matrix->{special}->{shape}="";
  1802. }
  1803. if ($symmetric) {
  1804. $matrix->{special}->{structure}="symmetric";
  1805. } elsif ($skewsymmetric) {
  1806. $matrix->{special}->{structure}="skewsymmetric";
  1807. } else {
  1808. $matrix->{special}->{structure}="";
  1809. }
  1810. if ($zero) {
  1811. $matrix->{special}->{sign} = "zero";
  1812. } elsif ($nonpositive) {
  1813. if ($negative) {
  1814. $matrix->{special}->{sign}="negative";
  1815. } else {
  1816. $matrix->{special}->{sign}="nonpositive";
  1817. }
  1818. } elsif ($nonnegative) {
  1819. if ($positive) {
  1820. $matrix->{special}->{sign}="positive";
  1821. } else {
  1822. $matrix->{special}->{sign}="nonnegative";
  1823. }
  1824. } else {
  1825. $matrix->{special}->{sign}="";
  1826. }
  1827. return $matrix;
  1828. }
  1829. ### BOOLEAN ARITHMETIC METHODS
  1830. sub matrixand {
  1831. my ($matrix1, $matrix2) = @_;
  1832. my $truth = new Math::MatrixSparse;
  1833. $truth->{rows} = ($matrix1->{rows}<$matrix2->{rows}) ? $matrix1->{rows} : $matrix2->{rows};
  1834. $truth->{columns} = ($matrix1->{columns}<$matrix2->{columns}) ? $matrix1->{columns} : $matrix2->{columns};
  1835. foreach my $key (keys %{$matrix1->{data}}) {
  1836. $truth->assignkey($key,$matrix1->elementkey($key)&&
  1837. $matrix2->elementkey($key));
  1838. }
  1839. if ((defined $matrix1->{name})&&(defined $matrix2->{name})) {
  1840. $truth->{name} = $matrix1->{name} . "&" . $matrix2->{name};
  1841. }
  1842. #should be updated already.
  1843. $truth->{special}->{pattern} = 1;
  1844. return $truth;
  1845. }
  1846. sub matrixor {
  1847. my ($matrix1, $matrix2) = @_;
  1848. my $truth = new Math::MatrixSparse;
  1849. $truth->{rows} = ($matrix1->{rows}<$matrix2->{rows}) ? $matrix1->{rows} : $matrix2->{rows};
  1850. $truth->{columns} = ($matrix1->{columns}<$matrix2->{columns}) ? $matrix1->{columns} : $matrix2->{columns};
  1851. foreach my $key (keys %{$matrix1->{data}}) {
  1852. $truth->assignkey($key,$matrix1->elementkey($key)||
  1853. $matrix2->elementkey($key));
  1854. }
  1855. if ((defined $matrix1->{name})&&(defined $matrix2->{name})) {
  1856. $truth->{name} = $matrix1->{name} . "|" . $matrix2->{name};
  1857. }
  1858. #should be updated already.
  1859. $truth->{special}->{pattern} = 1;
  1860. return $truth;
  1861. }
  1862. ### DELETION FUNCTIONS
  1863. sub delete {
  1864. my ($matrix,$i,$j) = @_;
  1865. my $key = &makekey($i,$j);
  1866. $matrix->deletekey($key);
  1867. return;
  1868. }
  1869. sub deletekey {
  1870. my ($matrix, $key) = @_;
  1871. my $old = $matrix->elementkey($key);
  1872. my ($i,$j) = &splitkey($key);
  1873. delete $matrix->{data}{$key};
  1874. #sign
  1875. if ($matrix->{special}->{sign} =~ /^positive/i) {
  1876. $matrix->{special}->{sign} = "nonnegative";
  1877. } elsif ($matrix->{special}->{sign} =~ /^positive/i) {
  1878. $matrix->{special}->{sign} = "nonpositive";
  1879. }
  1880. #structure
  1881. if (
  1882. ($matrix->{special}->{structure} =~ m/symmetric/i)
  1883. &&($i!=$j)
  1884. ) {
  1885. $matrix->{special}->{structure} = "";
  1886. }
  1887. #band
  1888. if (abs($i-$j) >= $matrix->{special}->{bandwidth}) {
  1889. $matrix->{special}->{bandwidth} = 0;
  1890. }
  1891. #pattern--no change necessary
  1892. #shape--no change necessary
  1893. #persistent row and column data
  1894. delete $matrix->{sortedrows};
  1895. delete $matrix->{sortedcolumns};
  1896. return undef;
  1897. }
  1898. sub cull {
  1899. my ($matrix) = @_;
  1900. my $this = $matrix->copy();
  1901. foreach my $key (keys %{$this->{data}}) {
  1902. next if $this->{data}{$key};
  1903. $this->deletekey($key);
  1904. }
  1905. return $this;
  1906. }
  1907. sub _cull {
  1908. my ($matrix) = @_;
  1909. foreach my $key (keys %{$matrix->{data}}) {
  1910. next if $matrix->{data}{$key};
  1911. $matrix->deletekey($key);
  1912. }
  1913. return $matrix;
  1914. }
  1915. sub threshold {
  1916. my ($matrix,$thresh) = @_;
  1917. return undef if $thresh <0;
  1918. my $this = $matrix->copy();
  1919. foreach my $key (keys %{$this->{data}}) {
  1920. next if abs($this->{data}{$key})>$thresh;
  1921. $this->deletekey($key);
  1922. }
  1923. return $this;
  1924. }
  1925. sub _threshold {
  1926. my ($matrix,$thresh) = @_;
  1927. return undef if $thresh <0;
  1928. foreach my $key (keys %{$matrix->{data}}) {
  1929. next if abs($matrix->{data}{$key})>$thresh;
  1930. $matrix->deletekey($key);
  1931. }
  1932. return $matrix;
  1933. }
  1934. sub sizetofit {
  1935. my ($matrix) = @_;
  1936. my $this = $matrix->copy();
  1937. my ($maxrow,$maxcol) = $this->exactdim();
  1938. $this->{rows} = $maxrow;
  1939. $this->{columns} = $maxcol;
  1940. return $this;
  1941. }
  1942. sub _sizetofit {
  1943. my ($matrix) = @_;
  1944. my ($maxrow,$maxcol) = $matrix->exactdim();
  1945. $matrix->{rows} = $maxrow;
  1946. $matrix->{columns} = $maxcol;
  1947. return $matrix;
  1948. }
  1949. sub clearspecials {
  1950. my ($matrix) = @_;
  1951. $matrix->{special}->{pattern} = 0;
  1952. $matrix->{special}->{sign} = "";
  1953. $matrix->{special}->{structure} = "";
  1954. $matrix->{special}->{shape} = "";
  1955. }
  1956. ### SOLVER METHODS
  1957. sub gaussseidel {
  1958. #solves Ax=b by Gauss-Seidel, or SOR with relaxation parameter 1.
  1959. #b ($constant) and x0 ($guess) should be column vectors.
  1960. my ($matrix, $constant, $guess,$tol, $steps) = @_;
  1961. return $matrix->SOR($constant,$guess,1,$tol,$steps);
  1962. }
  1963. sub SOR {
  1964. #solves Ax=b by Symmetric Over-Relaxation
  1965. #b ($constant) and x0 ($guess) should be column vectors.
  1966. my ($matrix, $constant, $guess, $omega,$tol, $steps) = @_;
  1967. my $diag = $matrix->diagpart();
  1968. my $lower = $matrix->lowerpart();
  1969. my $upper = $matrix->upperpart();
  1970. my $iterator;
  1971. my $dinv = $diag->terminvert();
  1972. my $soln = $guess->copy();
  1973. foreach my $key (keys %{$constant->{data}}) {
  1974. next if defined $soln->{data}{$key};
  1975. $soln->{data}{$key} = 0;
  1976. }
  1977. my @lowerkeys = $lower->sortbyrow();
  1978. my @upperkeys = $upper->sortbyrow();
  1979. my @solnkeys = $soln->sortbyrow();
  1980. $steps = 100 unless $steps;
  1981. for my $k (1 .. $steps) {
  1982. my $oldsoln = $soln->copy();
  1983. foreach my $thissolnkey (keys %{$soln->{data}}) {
  1984. my ($i,$j) = &splitkey($thissolnkey);
  1985. next unless $j == 1;
  1986. my $prev = $oldsoln->{data}{$thissolnkey}*(1.0-$omega);
  1987. my $scal = $omega * $dinv->element($i,$i);
  1988. my $lowersum=0;
  1989. my $uppersum = 0;
  1990. foreach my $lowerkey (@lowerkeys) {
  1991. my ($li,$lj) = &splitkey($lowerkey);
  1992. #unnecessary b/c of source of @lowerkeys
  1993. next if $lj > ($i-1);
  1994. # print "L $li $lj\n";
  1995. $lowersum += $soln->element($lj,1)*$lower->{data}{$lowerkey};
  1996. }
  1997. foreach my $upperkey (@upperkeys) {
  1998. my ($ui,$uj) = &splitkey($upperkey);
  1999. #unnecessary b/c of source of @upperkeys
  2000. next if $uj < ($i+1);
  2001. $uppersum += $soln->element($uj,1)*$upper->{data}{$upperkey};
  2002. }
  2003. my $update = $prev+$scal*($constant->element($i,1)-$lowersum-$uppersum);
  2004. $soln->assign($i,1,$update);
  2005. }
  2006. my $err = &abssum($oldsoln-$soln);
  2007. return $soln if $err<$tol;
  2008. }
  2009. return undef;
  2010. }
  2011. sub jacobi {
  2012. #solves Ax=b by Jacobi iteration.
  2013. #Note that b doesn't have to be a column vector
  2014. #$guess (x0) should be the same size as $constant (b)
  2015. my ($matrix, $constant, $guess,$tol, $steps) = @_;
  2016. my $diag = $matrix->diagpart();
  2017. my $lower = $matrix->lowerpart();
  2018. my $upper = $matrix->upperpart();
  2019. my $iterator;
  2020. my $dinv = $diag->terminvert();
  2021. my $nondiag = ($lower+$upper);
  2022. my $soln = $guess->copy();
  2023. my $oldsoln;
  2024. $steps = 100 unless $steps;
  2025. for my $i (1 .. $steps) {
  2026. $oldsoln=$soln->copy();;
  2027. $soln = $dinv*$constant - $dinv*$nondiag*$soln;
  2028. my $err = &abssum($oldsoln-$soln);
  2029. return $soln if $err<$tol;
  2030. }
  2031. return undef;
  2032. }
  2033. ### SORTING METHODS
  2034. #note: column is a secondary sort criterion
  2035. # 1 2 3
  2036. # 4 5 6
  2037. # 7 8 9
  2038. sub sortbyrow {
  2039. my ($matrix) = @_;
  2040. my @sorted = map { $_->[0] }
  2041. sort { ($a->[1] <=> $b->[1])||($a->[2]<=>$b->[2]) }
  2042. map { [ $_, &splitkey($_) ] } keys %{$matrix->{data}};
  2043. return @sorted;
  2044. }
  2045. #note: row is a secondary sort criterion
  2046. # 1 4 7
  2047. # 2 5 8
  2048. # 3 6 9
  2049. sub sortbycolumn {
  2050. my ($matrix) = @_;
  2051. my @sorted = map { $_->[0] }
  2052. sort { ($a->[2] <=> $b->[2])||($a->[1]<=>$b->[1]) }
  2053. map { [ $_, &splitkey($_) ] } keys %{$matrix->{data}};
  2054. return @sorted;
  2055. }
  2056. #note: row is a secondary sort criterion
  2057. #lower diagonals are sorted in front of higher ones
  2058. #4 7 9
  2059. #2 5 8
  2060. #1 3 6
  2061. sub sortbydiagonal {
  2062. my ($matrix) = @_;
  2063. my @sorted = map { $_->[0] }
  2064. sort { (($a->[1]-$a->[2]) <=> ($b->[1]-$b->[2]))||($a->[1]<=>$b->[1]) }
  2065. map { [ $_, &splitkey($_) ] } keys %{$matrix->{data}};
  2066. return @sorted;
  2067. }
  2068. #sorts the elements of $matrix by value, smallest first.
  2069. #row is a secondary criterion, and column is tertiaty.
  2070. sub sortbyvalue {
  2071. my ($matrix) = @_;
  2072. my @sorted = map { $_->[0] }
  2073. sort {
  2074. ($matrix->elementkey($a->[0]) <=> $matrix->elementkey($a->[0]))
  2075. || ($a->[1]<=>$b->[1])
  2076. ||($a->[2]<=>$b->[2])
  2077. }
  2078. map { [ $_, &splitkey($_) ] } keys %{$matrix->{data}};
  2079. return @sorted;
  2080. }
  2081. ### SYMMETRIC METHODS
  2082. sub symmetrify {
  2083. #takes a matrix, returns the matrix obtained by reflecting
  2084. #non-lower part around main diagonal
  2085. my ($matrix) = @_;
  2086. return $matrix if $matrix->{special}->{shape} =~ /diagonal/i;
  2087. my $this = $matrix->copy();
  2088. $this->_symmetrify();
  2089. return $this;
  2090. }
  2091. sub _symmetrify {
  2092. #takes a matrix, reflects it about main diagonal
  2093. my ($matrix) = @_;
  2094. return $matrix if $matrix->{special}->{shape} =~ /diagonal/i;
  2095. $matrix->_nonlowerpart();
  2096. foreach my $key (keys %{$matrix->{data}}) {
  2097. my ($i,$j) = &splitkey($key);
  2098. unless ($i==$j) {
  2099. my $transkey = &makekey($j , $i);
  2100. $matrix->assign($j,$i,$matrix->element($i,$j));
  2101. }
  2102. }
  2103. $matrix->_sizetofit();
  2104. $matrix->{special}->{shape} = "";
  2105. $matrix->{special}->{structure} = "symmetric";
  2106. return $matrix;
  2107. }
  2108. sub skewsymmetrify {
  2109. #takes a matrix, returns the matrix obtained by reflecting
  2110. #upper part around main diagonal
  2111. my ($matrix) = @_;
  2112. my $this = $matrix->copy();
  2113. return $this->_skewsymmetrify();
  2114. }
  2115. sub _skewsymmetrify {
  2116. #takes a matrix, reflects upper part about main diagonal
  2117. my ($matrix) = @_;
  2118. $matrix->_upperpart();
  2119. foreach my $key (keys %{$matrix->{data}}) {
  2120. my ($i,$j) = &splitkey($key);
  2121. my $transkey = &makekey($j , $i);
  2122. $matrix->assign($j,$i,-1*$matrix->element($i,$j));
  2123. }
  2124. $matrix->{special}->{shape} = "";
  2125. $matrix->{special}->{structure} = "skewsymmetric";
  2126. return $matrix;
  2127. }
  2128. ### PROBABILISTIC METHODS
  2129. sub normalize {
  2130. my ($matrix) = @_;
  2131. return undef unless defined $matrix;
  2132. my $name = $matrix->{name};
  2133. unless ($matrix->is_nonnegative()) {
  2134. carp "Math::MatrixSparse::normalize matrix has negative elements";
  2135. return undef;
  2136. }
  2137. my $matsum = 0;
  2138. foreach my $key (keys %{$matrix->{data}}) {
  2139. $matsum += $matrix->elementkey($key);
  2140. }
  2141. $matrix= $matrix->multiplyscalar(1.0/$matsum) if $matsum;
  2142. $matrix->name($name . "/||" . $name . "||") if ($name);
  2143. return $matrix;
  2144. }
  2145. sub _normalize {
  2146. my ($matrix) = @_;
  2147. return undef unless defined $matrix;
  2148. my $name = $matrix->{name};
  2149. unless ($matrix->is_nonnegative()) {
  2150. carp "Math::MatrixSparse::normalize matrix has negative elements";
  2151. return undef;
  2152. }
  2153. my $matsum = 0;
  2154. foreach my $key (keys %{$matrix->{data}}) {
  2155. $matsum += $matrix->elementkey($key);
  2156. }
  2157. $matrix= $matrix->_multiplyscalar(1.0/$matsum) if $matsum;
  2158. $matrix->name($name . "/||" . $name . "||") if ($name);
  2159. return $matrix;
  2160. }
  2161. sub normalizerows {
  2162. my ($matrix) = @_;
  2163. my %rowsums;
  2164. return undef unless defined $matrix;
  2165. unless ($matrix->is_nonnegative()) {
  2166. carp "Math::MatrixSparse::normalizerows matrix has negative elements";
  2167. return undef;
  2168. }
  2169. foreach my $key (keys %{$matrix->{data}}) {
  2170. my ($i,$j) = &splitkey($key);
  2171. $rowsums{$i}+= $matrix->elementkey($key);
  2172. }
  2173. my $rownormed = $matrix->cull();
  2174. foreach my $key (keys %{$rownormed->{data}}) {
  2175. my ($i,$j) = &splitkey($key);
  2176. next unless $rowsums{$i};
  2177. $rownormed->assign($i,$j,($rownormed->elementkey($key))/$rowsums{$i});
  2178. }
  2179. my $name = $matrix->{name};
  2180. $rownormed->name($name . "/||" . $name . "||") if ($name);
  2181. return $rownormed;
  2182. }
  2183. sub _normalizerows {
  2184. my ($matrix) = @_;
  2185. my %rowsums;
  2186. return undef unless defined $matrix;
  2187. unless ($matrix->is_nonnegative()) {
  2188. carp "Math::MatrixSparse::normalizerows matrix has negative elements";
  2189. return undef;
  2190. }
  2191. foreach my $key (keys %{$matrix->{data}}) {
  2192. my ($i,$j) = &splitkey($key);
  2193. $rowsums{$i}+= $matrix->{data}{$key};
  2194. }
  2195. $matrix->_cull();
  2196. foreach my $key (keys %{$matrix->{data}}) {
  2197. my ($i,$j) = &splitkey($key);
  2198. next unless $rowsums{$i};
  2199. $matrix->assign($i,$j,($matrix->elementkey($key))/$rowsums{$i});
  2200. }
  2201. my $name = $matrix->{name};
  2202. $matrix->name($name . "/||" . $name . "||") if ($name);
  2203. return $matrix;
  2204. }
  2205. sub normalizecolumns {
  2206. my ($matrix) = @_;
  2207. my %columnsums;
  2208. return undef unless defined $matrix;
  2209. unless ($matrix->is_nonnegative()) {
  2210. carp "Math::MatrixSparse::normalizecolumns matrix has negative elements";
  2211. return undef;
  2212. }
  2213. foreach my $key (keys %{$matrix->{data}}) {
  2214. my ($i,$j) = &splitkey($key);
  2215. $columnsums{$j}+= $matrix->elementkey($key);
  2216. }
  2217. my $columnnormed = $matrix->copy();
  2218. foreach my $key (keys %{$columnnormed->{data}}) {
  2219. my ($i,$j) = &splitkey($key);
  2220. $columnnormed->assign($i,$j,$columnnormed->elementkey($key)/$columnsums{$j});
  2221. }
  2222. my $name = $matrix->{name};
  2223. $columnnormed->name($name . "/||" . $name . "||") if ($name);
  2224. return $columnnormed;
  2225. }
  2226. sub _normalizecolumns {
  2227. my ($matrix) = @_;
  2228. my %columnsums;
  2229. return undef unless defined $matrix;
  2230. unless ($matrix->is_nonnegative()) {
  2231. carp "Math::MatrixSparse::normalizecolumns matrix has negative elements";
  2232. return undef;
  2233. }
  2234. foreach my $key (keys %{$matrix->{data}}) {
  2235. my ($i,$j) = &splitkey($key);
  2236. $columnsums{$j}+= $matrix->elementkey($key);
  2237. }
  2238. $matrix->_cull();
  2239. foreach my $key (keys %{$matrix->{data}}) {
  2240. my ($i,$j) = &splitkey($key);
  2241. $matrix->assign($i,$j,$matrix->elementkey($key)/$columnsums{$j});
  2242. }
  2243. my $name = $matrix->{name};
  2244. $matrix->name($name . "/||" . $name . "||") if ($name);
  2245. return $matrix;
  2246. }
  2247. sub discretepdf {
  2248. my ($matrix) = @_;
  2249. my $uniform = rand;
  2250. my $current;
  2251. my $curpos = 0;
  2252. foreach my $key (keys %{$matrix->{data}}) {
  2253. last if $curpos >=$uniform;
  2254. $current = $key;
  2255. $curpos += $matrix->{data}{$key};
  2256. }
  2257. return $current;
  2258. }
  2259. ### KEY-INTERFACE METHODS
  2260. sub splitkey {
  2261. my ($key) = @_;
  2262. my ($i,$j) = split(/\0/,$key);
  2263. return ($i,$j);
  2264. }
  2265. sub makekey {
  2266. my ($i,$j) = @_;
  2267. return ($i . "\0" . $j) if ((defined $i)&&(defined $j));
  2268. }
  2269. 1;
  2270. __END__
  2271. =head1 NAME
  2272. Math::MatrixSparse - Perl extension for sparse matrices.
  2273. =head1 SYNOPSIS
  2274. Math::MatrixSparse is a module implementing naive sparse matrices. Its
  2275. syntax is designed to partially overlap with Math::MatrixReal where
  2276. possible and reasonable.
  2277. Basic matrix operations are present, including addition, subtraction,
  2278. scalar multiplication, matrix multiplication, transposition,
  2279. and exponentiation.
  2280. Three methods of solving systems iteratively are available, including
  2281. Jacobi, Gauss-Seidel, and Symmetric Over-Relaxation.
  2282. Real-valued matrices can be read from files in the Matrix Market and
  2283. Harwell Boeing formats, and written in the Matrix Market format. In
  2284. addition, they can be read from a given string.
  2285. Certain special types of matrices are understood, but not optimized
  2286. for, such as upper and lower triangular, diagonal, symmetric,
  2287. skew-symmetric, positive, negative, and pattern. Methods are
  2288. available to determine the properties of a given matrix.
  2289. Individual rows, columns, and diagonals of matrices can be obtained,
  2290. as can the upper and lower triangular, symmetric, skew symmetric,
  2291. positive and negative portions.
  2292. =head1 DESCRIPTION
  2293. =over 4
  2294. =item *
  2295. C<< use Math::MatrixSparse; >>
  2296. Load the module and make its methods and operators available.
  2297. =back
  2298. =head2 CREATION AND INPUT-OUTPUT METHODS
  2299. =over 4
  2300. =item *
  2301. C<< Math::MatrixSparse->new($name) >>
  2302. C<< new Math::MatrixSparse($name) >>
  2303. Creates a new empty matrix named $name, which may be undef.
  2304. =item *
  2305. C<< Math::MatrixSparse->newfromstring($string,$name) >>
  2306. Creates a new matrix named $name based on $string.
  2307. $string is of the pattern /(\d+)\s+(\d+)\s+(.+)\n/,
  2308. where ($row, $column, $value) = ($1,$2,$3).
  2309. Example:
  2310. $matrixspec = <<MATRIX;
  2311. 1 1 1
  2312. 1 2 2
  2313. 2 1 3
  2314. 3 3 4
  2315. MATRIX
  2316. my $MS = Math::MatrixSparse->newfromstring($matrixspec,"MS");
  2317. $MS has four elements, (1,1), (1,2), (2,1), and (3,3), with the values
  2318. 1,2,3, and 4.
  2319. =item *
  2320. C<< Math::MatrixSparse->newdiag($arrayref,$name) >>
  2321. Creates a new square matrix named $name from the elements in $arrayref.
  2322. $arrayref[0] will become $matrix(1,1), etc.
  2323. =item *
  2324. C<< Math::MatrixSparse->newdiagfromstring($string, $name) >>
  2325. Similar to C<< Math::MatrixSparse->newfromstring >> except that
  2326. $string is of the pattern /(\d+)\s+(.+)\n/, and
  2327. ($row, $column, $value) = ($1, $1, $2).
  2328. Example:
  2329. $diagspec = <<MATRIX;
  2330. 1 1
  2331. 2 -1
  2332. 20 1
  2333. 300 -1
  2334. MATRIX
  2335. my $MD = Math::MatrixSparse->newdiagfromstring($matrixspec,"MS");
  2336. $MD has four elements, (1,1), (2,2), (20,20), and (300,300), with the values
  2337. 1, -1, 1, and -1, and is square.
  2338. =item *
  2339. C<< Math::MatrixSparse->newrandom($maxrow, $maxcol, $maxentries, $density,$name) >>
  2340. Creates a new matrix of the specified size ($maxrow*$maxcol) with at most
  2341. $maxentries. If $density is between 0 and 1 (inclusive), the expected
  2342. number of entries is $maxentries*$density. If $maxentries is undef,
  2343. it is set to $maxrow*$maxcol; if $maxcol is missing, it is set to
  2344. $maxrow. If $density is missing, or outside the valid range, it
  2345. is set to one.
  2346. =item *
  2347. C<< Math::MatrixSparse->newmatrixmarket($filename) >>
  2348. Creates a new matrix based on data stored in the file $filename,
  2349. in Matrix Market format. See http://www.nist.gov/MatrixMarket/
  2350. for more information on this format.
  2351. Pattern matrix data has elements set to one. Matrices flagged
  2352. as symmetric or skew symmetric have symmetrify() or skewsymmetrify()
  2353. applied.
  2354. Exits with an error if $filename cannot be read from.
  2355. =item *
  2356. C<< Math::MatrixSparse->newharwellboeing($filename) >>
  2357. Creates a new matrix based on data stored in the file $filename,
  2358. in Harwell-Boeing format. See
  2359. http://math.nist.gov/MatrixMarket/collections/hb.html
  2360. for more information on this format.
  2361. Pattern matrix data has elements set to one. Matrices flagged
  2362. as symmetric or skew symmetric have symmetrify() or skewsymmetrify()
  2363. applied.
  2364. Exits with an error if $filename cannot be read from.
  2365. =item *
  2366. C<< $matrix->writematrixmarket($filename) >>
  2367. The contents of $matrix are written, in Matrix Market format, to
  2368. $filename. It is assumed that $matrix->{rows} and $matrix->{columns}
  2369. are accurate--$matrix->sizetofit() should be called if this is not
  2370. the case. No optimizations are performed for symmetric, skew symmetric,
  2371. or pattern data, and real values are assumed.
  2372. See http://www.nist.gov/MatrixMarket/ for more information on this format.
  2373. Exits with an error if $filename cannot be written to.
  2374. =item *
  2375. C<< Math::MatrixSparse->newidentity($n,$m) >>
  2376. Creates an identity matrix with $n rows and $m columns. If $m
  2377. is omitted it is assumed equal to $n.
  2378. =item *
  2379. C<< print $matrix >>
  2380. C<< $matrix->print($name) >>
  2381. C<< $matrix->print() >>
  2382. Prints the element in the matrix in the format
  2383. $name($row,$colum) = $value
  2384. Calling this as a method with an argument overrides the value in
  2385. $matrix->{name}.
  2386. =back
  2387. =head2 INTERFACE METHODS
  2388. =over 4
  2389. =item *
  2390. C<< ($i,$j) = &splitkey($key) >>
  2391. C<< $key = &makekey($i,$j) >>
  2392. These two routines convert a position ($i,$j) of the matrix into a
  2393. key $key. Programs that use Math::MatrixSparse should not have to use keys
  2394. at all, but if they do, they should use these routines.
  2395. =back
  2396. =head2 GENERAL METHODS
  2397. =over 4
  2398. =item *
  2399. C<< $matrix2 = $matrix1->copy() >>
  2400. C<< $matrix2 = $matrix1->copy($name) >>
  2401. Returns an exact copy of $matrix1, including dimensions, name,
  2402. and special flags. If $name is given, it will be the name of
  2403. $matrix2.
  2404. =item *
  2405. C<< $matrix->name($name) >>
  2406. Gives a name to $matrix. Useful mostly in printing. Certain methods
  2407. attempt to create useful names, but you probably want to set your
  2408. own.
  2409. =item *
  2410. C<< $matrix->assign($i,$j,$value) >>
  2411. Puts $value in row $i, column $j of $matrix. Updates $matrix->{row}
  2412. and $matrix->{column} if necessary. Removes or modifies special flags when
  2413. necessary.
  2414. =item *
  2415. C<< $matrix->assignspecial($i,$j,$value) >>
  2416. As $matrix->assign(), except that it preserves symmetry and skew-symmetry.
  2417. That is, if $matrix is marked symmetric, assigning a value to ($i,$j)
  2418. also assigns the value to ($j,$i). Also preserves patterns.
  2419. =item *
  2420. C<< $matrix->assignkey($key,$value) >>
  2421. As $matrix->assign(), except $i and $j have already been combined into $key.
  2422. =item *
  2423. C<< $matrix->element($i,$j) >>
  2424. Returns the element at row $i column $j of $matrix.
  2425. =item *
  2426. C<< $matrix->elementkey($key) >>
  2427. As $matrix->element(), except $i and $j have already been combined into $key.
  2428. =item *
  2429. C<< $matrix->elements() >>
  2430. Returns an array consisting of all the elements of $matrix, in
  2431. key form, suitable for a loop.
  2432. See also SORTING METHODS below if the order of the elements is important.
  2433. Example:
  2434. foreach my $key ($matrix->elements()) {
  2435. my ($i,$j) = &splitkey($key);
  2436. ...
  2437. }
  2438. =item *
  2439. C<< $matrix->delete($i,$j) >>
  2440. Deletes the ($i,$j) element of $matrix.
  2441. =item *
  2442. C<< $matrix->deletekey($key) >>
  2443. As $matrix->delete(), except $i and $j have already been combined into $key.
  2444. =item *
  2445. C<< $matrix->cull() >>
  2446. Returns a copy of $matrix with any zero elements removed.
  2447. Equivalent to $matrix->threshold(0).
  2448. =item *
  2449. C<< $matrix->threshold($thresh) >>
  2450. Returns a copy of $matrix with any elements with absolute value less
  2451. than $thresh removed.
  2452. =item *
  2453. C<< $matrix->sizetofit() >>
  2454. Returns a copy of $matrix with dimensions sufficient only to cover its data.
  2455. =item *
  2456. C<< $matrix->clearspecials() >>
  2457. Removes all knowledge of special properties of $matrix. Use
  2458. $matrix->diagnose() to put them back.
  2459. =back
  2460. =head2 DECOMPOSITIONAL METHODS
  2461. =over 4
  2462. =item *
  2463. C<< $matrix->row($i) >>
  2464. C<< $matrix->row($i,$persist) >>
  2465. Returns a matrix consisting only of the $i th row of $matrix. If
  2466. $persist is non-zero, the elements of $matrix are sorted by row,
  2467. to speed up future calls to row().
  2468. Note that many methods, most notably assign() and delete(), remove the
  2469. data necessary to use the fast algorithm. If this data is present, a
  2470. binary search is used instead of an exhaustive term-by-term search.
  2471. There is an intial cost of O(n log n) operations (n==$matrix->count())
  2472. to use this data, but each search costs O(log n) operations. This is
  2473. in comparison to O(n) operations without the data.
  2474. So, in summary, if many separate rows are needed, and the matrix
  2475. is unchanging, the first (at least) call to row() should have
  2476. a non-zero value of $persist.
  2477. =item *
  2478. C<< $matrix->column($j) >>
  2479. C<< $matrix->column($j,$persist) >>
  2480. Returns a matrix consisting only of the $j th column of $matrix. See
  2481. also $matrix->row().
  2482. =item *
  2483. C<< $matrix->diagpart($offset) >>
  2484. If $offset is zero or undefined, returns a matrix consisting of the
  2485. diagonal elements of $matrix, if any. If $offset is non-zero, returns
  2486. a parallel diagonal. For example, if $offset=1, the first superdiagonal is
  2487. returned. Posive $offset s return diagonals above the main diagonal, negative
  2488. offsets return diagonals below the main diagonal.
  2489. The returned matrix is the same size as $matrix.
  2490. =item *
  2491. C<< $matrix->lowerpart() >>
  2492. Returns a matrix consisting of the strictly lower triangular parts of $matrix,
  2493. if any. The returned matrix is the same size as $matrix.
  2494. =item *
  2495. C<< $matrix->upperpart() >>
  2496. Returns a matrix consisting of the strictly upper triangular parts of $matrix,
  2497. if any. The returned matrix is the same size as $matrix.
  2498. =item *
  2499. C<< $matrix->nondiagpart($offset) >>
  2500. C<< $matrix->nonlowerpart() >>
  2501. C<< $matrix->nonupperpart() >>
  2502. As before, except that the returned matrix is everything except the
  2503. part specified.
  2504. Example:
  2505. A = D1 U1 U2
  2506. L1 D2 U3
  2507. L2 L3 D3
  2508. $A->lowerpart() == L1 L2 L3
  2509. $A->diagpart() == D1 D2 D3
  2510. $A->diagpart(1) == U1 U3
  2511. $A->diagpart(-1) == L1 L3
  2512. $A->upperpart() == U1 U2 U3
  2513. $A->nonlowerpart() == D1 U1 U2 D2 U3 D3
  2514. $A->nondiagpart(1) == D1 U2 L1 D2 L2 L3 D3
  2515. =item *
  2516. C<< $matrix->symmetricpart() >>
  2517. Returns the symmetric part of $matrix, i.e. 0.5*($matrix+$matrix->transpose()).
  2518. =item *
  2519. C<< $matrix->skewsymmetricpart() >>
  2520. Returns the skewsymmetric part of $matrix,
  2521. i.e. 0.5*($matrix-$matrix->transpose()).
  2522. =item *
  2523. C<< $matrix->positivepart() >>
  2524. Returns the positive part of $matrix, i.e. those elements of $matrix
  2525. larger than zero.
  2526. =item *
  2527. C<< $matrix->negativepart() >>
  2528. Returns the positive part of $matrix, i.e. those elements of $matrix
  2529. larger than zero.
  2530. =item *
  2531. C<< $matrix->mask($i1,$i2,$j1,$j2) >>
  2532. Returns a matrix whose only elements are inside
  2533. ($i1,$j1) ($i1,$j2)
  2534. ($i2,$j1) ($i2,$j2)
  2535. =item *
  2536. C<< $matrix->submatrix($i1,$i2,$j1,$j2) >>
  2537. Returns that portion of $matrix between
  2538. ($i1,$j1) ($i1,$j2)
  2539. ($i2,$j1) ($i2,$j2)
  2540. Subscripts are changed, so $matrix($i1,$j1) is $submatrix(1,1).
  2541. =item *
  2542. C<< $matrix1->insert($i,$j,$matrix2) >>
  2543. The values of $matrix2 are assigned to the values of $matrix1, offset by
  2544. ($i,$j). That is, $matrix1($i+$k,$j+$l)=$matrix2($j,$l).
  2545. =item *
  2546. C<< $A = $matrix->shift($row,$col) >>
  2547. Creates a new matrix $A, $matrix($i,$j) == $A($i+$row,$j+$col)
  2548. =back
  2549. =head2 INFORMATIONAL METHODS
  2550. =over 4
  2551. =item *
  2552. C<< $matrix->dim() >>
  2553. Returns
  2554. ($matrix->{rows}, $matrix->{columns})
  2555. =item *
  2556. C<< $matrix->exactdim() >>
  2557. Calculates explicitly the dimension of $matrix. This differs from
  2558. $matrix->dim() in that $matrix->{rows} and $matrix->{columns}
  2559. may not have been updated properly.
  2560. =item *
  2561. C<< $matrix->count() >>
  2562. Returns the number of defined elements in $matrix, 0 or otherwise.
  2563. =item *
  2564. C<< $matrix->width() >>
  2565. Calculates the bandwidth of $matrix, i.e. the maximum value of abs($i-$j)
  2566. for all elements at ($i,$j) in $matrix.
  2567. =item *
  2568. C<< $matrix->sum() >>
  2569. Finds the sum of all elements in $matrix.
  2570. =item *
  2571. C<< $matrix->abssum() >>
  2572. Finds the sum of the absolute values of all elements in $matrix.
  2573. =item *
  2574. C<< $matrix->sumeach($coderef) >>
  2575. Applies &$coderef to each of the elements of $matrix, and sums the
  2576. result. See C<< $matrix->each($coderef) >> for more details.
  2577. =item *
  2578. C<< $matrix->columnnorm() >>
  2579. C<< $matrix->norm_one() >>
  2580. Finds the maximum column sum of $matrix. That is, for each column of
  2581. $matrix, find the sum of absolute values of its elements, then
  2582. return the largest such sum. C<< norm_one >> is provided for compatibility
  2583. with Math::MatrixReal.
  2584. =item *
  2585. C<< $matrix->rownorm() >>
  2586. C<< $matrix->norm_max() >>
  2587. Finds the maximum row sum of $matrix. That is, for each row of
  2588. $matrix, find the sum of absolute values of its elements, then
  2589. return the largest such sum. C<< norm_max >> is provided for compatibility
  2590. with Math::MatrixReal.
  2591. =item *
  2592. C<< $matrix->norm_frobenius() >>
  2593. Finds the Frobenius norm of $matrix. This is just an alias of
  2594. sqrt($matrix->sumeach(sub {$_[0]*$_[0]}).
  2595. =item *
  2596. C<< $matrix->trace() >>
  2597. Finds the trace of $matrix, which is the sum of its diagonal elements.
  2598. This just is an alias for $matrix->diagpart->sum().
  2599. =item *
  2600. C<< $matrix->diagnose() >>
  2601. Sets the special flags of $matrix.
  2602. =back
  2603. =head2 BOOLEAN INFORMATIONAL METHODS
  2604. The following is_xxx() methods use the special flags if they are present.
  2605. If more than one will be called for a given matrix, consider calling
  2606. $matrix->diagnose() to set the flags.
  2607. =over 4
  2608. =item *
  2609. C<< $matrix->is_square() >>
  2610. C<< $matrix->is_quadratic() >>
  2611. Returns the value of the comparison
  2612. $matrix->{rows}==$matrix->{columns}
  2613. That is, it returns 1 if the matrix is square, 0 otherwise.
  2614. =item *
  2615. C<< $matrix->is_diagonal() >>
  2616. Returns 1 if $matrix is a diagonal matrix, 0 otherwise. $matrix need
  2617. not be square.
  2618. =item *
  2619. C<< $matrix->is_lowertriangular() >>
  2620. Returns 1 if $matrix is a lower triangular matrix, 0 otherwise. $matrix need
  2621. not be square. Diagonal elements are allowed.
  2622. =item *
  2623. C<< $matrix->is_strictlowertriangular() >>
  2624. Returns 1 if $matrix is a lower triangular matrix, 0 otherwise. $matrix need
  2625. not be square. Diagonal elements are not allowed.
  2626. =item *
  2627. C<< $matrix->is_uppertriangular() >>
  2628. Returns 1 if $matrix is an upper triangular matrix, 0 otherwise. $matrix need
  2629. not be square. Diagonal elements are allowed.
  2630. =item *
  2631. C<< $matrix->is_strictuppertriangular() >>
  2632. Returns 1 if $matrix is an upper triangular matrix, 0 otherwise. $matrix need
  2633. not be square. Diagonal elements are not allowed.
  2634. =item *
  2635. C<< $matrix->is_positive() >>
  2636. Returns 1 if all elements of $matrix are positive, 0 otherwise.
  2637. =item *
  2638. C<< $matrix->is_negative() >>
  2639. Returns 1 if all elements of $matrix are negative, 0 otherwise.
  2640. =item *
  2641. C<< $matrix->is_nonpositive() >>
  2642. Returns 1 if all elements of $matrix are nonpositive (i.e. <=0), 0 otherwise.
  2643. =item *
  2644. C<< $matrix->is_nonnegative() >>
  2645. Returns 1 if all elements of $matrix are nonnegative (i.e. >=0), 0 otherwise.
  2646. =item *
  2647. C<< $matrix->is_boolean() >>
  2648. C<< $matrix->is_pattern() >>
  2649. Returns 1 if all elements of $matrix are 0 or 1, 0 otherwise.
  2650. =item *
  2651. C<< $matrix->is_symmetric() >>
  2652. Returns 1 if $matrix is symmetric, i.e. $matrix==$matrix->transpose(),
  2653. 0 otherwise. $matrix is assumed to be square.
  2654. =item *
  2655. C<< $matrix->is_skewsymmetric() >>
  2656. Returns 1 if $matrix is skew-symmetric, i.e. $matrix==-1*$matrix->transpose(),
  2657. 0 otherwise. $matrix is assumed to be square.
  2658. =back
  2659. =head2 ARITHMETIC METHODS
  2660. =over 4
  2661. =item *
  2662. C<< $matrix1->add($matrix2) >>
  2663. Finds and returns $matrix1 + $matrix2. Matrices must be of the same
  2664. size.
  2665. =item *
  2666. C<< $matrix1->multiply($matrix2) >>
  2667. Finds and returns $matrix1 * $matrix2. $matrix1->{columns} must
  2668. equal $matrix2->{rows}.
  2669. =item *
  2670. C<< $matrix1->multiplyfree($matrix2) >>
  2671. C<< $matrix1->addfree($matrix2) >>
  2672. As add() and multiply(), but with no limitations on the dimensions
  2673. of the matrices.
  2674. =item *
  2675. C<< $matrix1->quickmultiply($matrix2) >>
  2676. C<< $matrix1->quickmultiplyfree($matrix2) >>
  2677. As multiply() and multiplyfree(), but with a different algorithm that
  2678. is faster for larger matrices.
  2679. =item *
  2680. C<< $matrix->multiplyscalar($scalar) >>
  2681. Returns the product of $matrix and $scalar.
  2682. =item *
  2683. C<< $matrix1->kronecker($matrix2) >>
  2684. Returns the direct product of $matrix1 and $matrix2. Every element
  2685. of $matrix1 is multiplied by the entirely of $matrix2, and those
  2686. matrices assembled into a big matrix and returned.
  2687. =item *
  2688. C<< $matrix->exponentiate($n) >>
  2689. C<< $matrix->largeexponentiate($n) >>
  2690. Finds and returns $matrix raised to the $n th power. $n must be
  2691. nonnegative and integral, and $matrix must be square.
  2692. For large values of $n, largeexponentiate() is faster.
  2693. =item *
  2694. C<< $matrix->terminvert() >>
  2695. Returns the matrix whose elements are the multiplicative inverses of
  2696. $matrix. If $matrix is square diagonal, C<< $matrix->terminvert() >> is
  2697. the multiplicative inverse of $matrix.
  2698. =item *
  2699. C<< $matrix->transpose() >>
  2700. Returns the transpose of $matrix.
  2701. =item *
  2702. C<< $matrix->each($coderef) >>
  2703. Applies a subroutine referred to by $coderef to each element of $matrix.
  2704. &$coderef should take three arguments ($value, $row, $column).
  2705. =item *
  2706. C<< $matrix->symmetrify() >>
  2707. Returns a matrix obtained by reflecting $matrix about its main
  2708. diagonal. $matrix does not need to be square.
  2709. Exits with an error if $matrix(i,j) and $matrix(j,i) both exist
  2710. and are not identical.
  2711. =item *
  2712. C<< $matrix->skewsymmetrify() >>
  2713. As symmetrify(), except that the reflected terms are made negative.
  2714. Exits with an error if $matrix(i,j) and $matrix(j,i) both exist
  2715. and are not negatives of each other.
  2716. =item *
  2717. C<< $matrix1->matrixand($matrix2) >>
  2718. Finds and returns the matrix whose ($i,$j) element is
  2719. $matrix1($i,$j) && $matrix2($i,$j).
  2720. The returned matrix is a pattern matrix.
  2721. =item *
  2722. C<< $matrix1->matrixor($matrix2) >>
  2723. Finds and returns the matrix whose ($i,$j) element is
  2724. $matrix1($i,$j) || $matrix2($i,$j).
  2725. The returned matrix is a pattern matrix.
  2726. =back
  2727. =head2 PROBABILISTIC METHODS
  2728. =over 4
  2729. =item *
  2730. C<< $matrix->normalize() >>
  2731. Returns a matrix $matrix2 scaled so that $matrix2->sum()==1.
  2732. Exits on error if $matrix is not nonnegative.
  2733. =item *
  2734. C<< $matrix->normalizerows() >>
  2735. As $matrix->normalize(), except that each row is scaled to have a
  2736. sum of 1.
  2737. Exits on error if $matrix is not nonnegative.
  2738. =item *
  2739. C<< $matrix->normalizecolumns() >>
  2740. As $matrix->normalizerows(), except with columns. Mathematically equivalent to
  2741. $matrix->transpose()->normalizerows()->transpose().
  2742. Exits on error if $matrix is not nonnegative.
  2743. =item *
  2744. C<< $matrix->discretepdf() >>
  2745. Assuming that $matrix->sum()==1 and $matrix is non-negative, chooses a
  2746. random element from $matrix based on the assumption that
  2747. the entry at ($i,$j) is the probability of choosing ($i,$j).
  2748. =back
  2749. =head2 SOLUTION OF SYSTEMS METHODS
  2750. =over 4
  2751. =item *
  2752. C<< $matrix->jacobi($constant,$guess, $tol, $steps) >>
  2753. Uses Jacobi iteration to find and return the solution to the
  2754. system of equations $matrix * x = $constant, with initial guess
  2755. $constant, tolerance $tol, and maximum iterations $steps.
  2756. If $steps is undefined, the default value of 100 is used.
  2757. Care should be taken to ensure that $matrix is such that the
  2758. iteration actually converges.
  2759. =item *
  2760. C<< $matrix->gaussseidel($constant,$guess, $tol, $steps) >>
  2761. Uses Gauss-Seidel iteration to find and return the solution to the
  2762. system of equations $matrix * x = $constant, with initial guess
  2763. $constant, tolerance $tol, and maximum
  2764. iterations $steps. This is equivalent to $matrix->SOR with
  2765. relaxation parameter 1.
  2766. Care should be taken to ensure that $matrix is such that the
  2767. iteration actually converges.
  2768. =item *
  2769. C<< $matrix->SOR($constant,$guess, $relax, $tol, $steps) >>
  2770. Uses Successive Over-Relaxation to find and return the solution to the
  2771. system of equations $matrix * x = $constant, with initial guess
  2772. $constant, relaxation parameter $relax, tolerance $tol, and maximum
  2773. iterations $steps.
  2774. Care should be taken to ensure that $matrix is such that the
  2775. iteration actually converges.
  2776. =back
  2777. =head2 SORTING METHODS
  2778. =over 4
  2779. =item *
  2780. C<< $matrix->sortbycolumn() >>
  2781. C<< $matrix->sortbyrow() >>
  2782. Returns an array containing the keys of $matrix, sorted primarily
  2783. by either column or row (and secondarily by row or column).
  2784. C<< $matrix->sortbydiagonal() >>
  2785. Returns an array containing the keys of $matrix, sorted primarily by
  2786. their distance from elements on the main diagonal, lower diagonals
  2787. first. The row of the key is a secondary criterion.
  2788. C<< $matrix->sortbyvalue() >>
  2789. Returns an array containing the keys of $matrix, sorted primarily by
  2790. the value of the element indexed by the key. Row and column are
  2791. secondary and tertiaty criteria.
  2792. These methods are suitable for using inside a loop. See also
  2793. $matrix->elements() if the order of the elements is not important.
  2794. Example:
  2795. A 3x3 matrix will be sorted in the following manners:
  2796. sortbycolumn()
  2797. 1 4 7
  2798. 2 5 8
  2799. 3 6 9
  2800. sortbyrow()
  2801. 1 2 3
  2802. 4 5 6
  2803. 7 8 9
  2804. sortbydiagonal()
  2805. 4 7 9
  2806. 2 5 8
  2807. 1 3 6
  2808. =back
  2809. =head2 IN-LINE METHODS
  2810. The following are as described above, except that they modify their
  2811. calling object instead of a copy thereof.
  2812. C<< _each >>
  2813. C<< _mask >>
  2814. C<< _insert >>
  2815. C<< _cull >>
  2816. C<< _threshold >>
  2817. C<< _sizetofit >>
  2818. C<< _negate >>
  2819. C<< _multiplyscalar >>
  2820. C<< _terminvert >>
  2821. C<< _symmetrify >>
  2822. C<< _skewsymmetrify >>
  2823. C<< _normalize() >>
  2824. C<< _normalizerows() >>
  2825. C<< _normalizecolumns() >>
  2826. C<< _diagpart() >>
  2827. C<< _nondiagpart() >>
  2828. C<< _upperpart() >>
  2829. C<< _nonupperpart() >>
  2830. C<< _lowerpart() >>
  2831. C<< _nonlowerpart() >>
  2832. C<< _positivepart() >>
  2833. C<< _negativepart() >>
  2834. C<< _symmetricpart() >>
  2835. C<< _skewsymmetricpart() >>
  2836. In addition to these, the following methods modify the calling object.
  2837. C<< name() >>
  2838. C<< assign() >>
  2839. C<< assignspecial() >>
  2840. C<< assignkey() >>
  2841. C<< row() >> (if called with the optional second argument)
  2842. C<< column() >> (if called with the optional second argument)
  2843. C<< diagnose() >>
  2844. C<< delete() >>
  2845. C<< deletekey() >>
  2846. C<< clearspecials() >>
  2847. =head2 OVERLOADED OPERATORS
  2848. C<< + >> add()
  2849. C<< - >> subtract()
  2850. C<< * >> quickmultiply()
  2851. C<< x >> kronecker()
  2852. C<< ** >> exponential()
  2853. C<< ~ >> transpose()
  2854. C<< & >> matrixand()
  2855. C<< | >> matrixor()
  2856. C<< "" >> print()
  2857. Unary C<< - >> negate()
  2858. =head2 SPECIAL MATRIX FLAGS
  2859. Certain information is stored about the matrix, and is updated
  2860. when necessary. See also C<< $matrix->diagnose() >>. All
  2861. flags can also be C<undef>. These should not be accessed
  2862. directly--use the boolean is_whatever() methods instead.
  2863. =over 4
  2864. =item I<structure>
  2865. The symmetry of the matrix. Can be C<symmetric> or C<skewsymmetric>.
  2866. =item I<shape>
  2867. The shape of the matrix. Can be C<diagonal>, C<lower> (triangular),
  2868. C<upper>, C<strictlower> or C<strictupper>.
  2869. =item I<sign>
  2870. The sign of all the elemetns of a matrix. Can be C<positive>,
  2871. C<negative>, C<nonpostive>, C<nonnegative>, or C<zero>.
  2872. =item I<pattern>
  2873. Indicates whether the matrix should be treated as a pattern.
  2874. Is non-zero if so.
  2875. =item I<bandwidth>
  2876. Calculates the bandwidth of $matrix, i.e. the maximum value of abs($i-$j)
  2877. for all elements at ($i,$j) in $matrix.
  2878. =item I<field>
  2879. The underlying field of the elements of the matrix. Currently, can
  2880. only be C<real>.
  2881. =back
  2882. =head2 INTERFACING
  2883. The user should not attempt to access the pieces of a Math::MatrixReal
  2884. object directly, but instead use the routines provided. Certain
  2885. methods, such as the sorters, return keys to the elements of the matrix,
  2886. and these should be fed into C<< splitkey() >> to obtain row-column
  2887. indices.
  2888. =head1 EXPORT
  2889. None.
  2890. =head1 EXPORT_OK
  2891. &splitkey() and &makekey().
  2892. =head1 BUGS
  2893. Horribly, hideously inefficient.
  2894. No checks are made to be sure that values are of a proper type, or
  2895. even that indices are integers. It is entirely possible to
  2896. assign() a value that is, say, another Math::MatrixSparse.
  2897. However, because of the lack of these checks, indices can start at
  2898. zero, or even negative values, if an algorithm calls for it.
  2899. Harwell Boeing support is not robust, and output is not implemented.
  2900. Complex matrices in Harwell Boeing and Matrix Market are not supported.
  2901. In Matrix Market format, only the real part is read--the imaginary
  2902. part is discarded.
  2903. Many methods do not modify their calling object, but instead return a
  2904. new object. This can be inefficent and a waste of resources,
  2905. especially when it will be assigned to the new object anyway. Use the
  2906. analogous methods listed in IN-LINE METHODS instead if this is an
  2907. issue.
  2908. =head1 AUTHOR
  2909. Jacob C. Kesinger, E<lt>kesinger@math.ttu.eduE<gt>
  2910. =head1 SEE ALSO
  2911. L<perl>, Math::MatrixReal.
  2912. =cut