Math-MatrixReal-2.1300075556105627002104 012772016550 14510 5ustar00jonathanleto000000000000Math-MatrixReal-2.13/.travis.yml00044456105627002104 62212772016550 16736 0ustar00jonathanleto000000000000language: "perl" perl: - "5.18" - "5.16" - "5.14" - "5.12" before_install: - sudo apt-get install libgmp-dev - cpanm Test::Pod # optional dependency install: - cpanm -v --installdeps --notest . script: "perl Build.PL; ./Build test" # branches: # only: # - master notifications: recipients: - duke@leto.net email: on_success: change on_failure: always #env: Math-MatrixReal-2.13/Build.PL00044456105627002104 146512772016550 16147 0ustar00jonathanleto000000000000use strict; use warnings; use Module::Build; my $builder = Module::Build->new( module_name => 'Math::MatrixReal', license => 'perl', dist_author => 'Jonathan Leto ', dist_version_from => 'lib/Math/MatrixReal.pm', dist_abstract => 'Manipulate NxN matrices of real numbers', license => 'perl', build_requires => { 'Test::Most' => 0, 'File::Spec' => 0, }, configure_requires => { 'Module::Build' => 0.38 }, add_to_cleanup => [ 'Math::MatrixReal-*' ], create_makefile_pl => 'traditional', meta_merge => { resources => { repository => 'http://github.com/leto/math--matrixreal/tree/master' }, }, ); $builder->create_build_script(); print "Have an awesome day!\n"; Math-MatrixReal-2.13/CHANGES00044456105627002104 2172512772016550 15667 0ustar00jonathanleto000000000000Changes in v2.13 - Jonathan "Duke" Leto September 2015 -------------------------- * Fix bug where as_list() did not work correctly for non-square matrices. Reported by Elia Liitiäinen in RT #116968 Changes in v2.12 - Jonathan "Duke" Leto December 2014 -------------------------- * Added as_list() function. (Ivan Baidakou (basiliscos)) Changes in v2.11 - Jonathan "Duke" Leto January 2014 -------------------------- * Add maximum/minimum functions. (Alberto Simões) * Add reshape constructor. (Alberto Simões) Changes in v2.10 - Jonathan "Duke" Leto November 2013 -------------------------- * Fix tests on Windows, thanks to Russell Jenkins Changes in v2.09 - Jonathan "Duke" Leto November 2011 -------------------------- * as_latex() now works and is tested properly Changes in v2.08 - Jonathan "Duke" Leto April 11 2011 --------------------------- * Fix t/matlab.t failing on Windows (RT #64629) * Applied patch from RT #51669 (POD rendering) * Applied patch from RT #61334 (fix croak in new_from_string) * Make reference check less strict in _new_from_row_or_cols (requested by MJD) Changes in v2.06 - leto Sun Apr 13 19:57:25 EDT 2008 ---------------------------- * added submatrix() (exactly the same behavior as sec() from PDL, for 2-D matrices ) Backstory: I was reading through "Mastering Algorithms with Perl" and it says that it is not possible to do this in Math::MatrixReal without iterating through all the elements of the matrix. Now it is wrong. * t/submatrix.t created * t/decompose_LR.t created * !!!NEED documentation for submatrix() Changes in v2.05 - leto Fri Feb 29 21:58:47 EST 2008 ---------------------------- * fix accidental use of "our" that broke old (like 5.5) Perl's Thanks to srezic@cpan.org for the first FAILed report * added $matrix->display_precision($n) to easily change the output to something a bit easier to read $a->display_precision(0) is useful for printing integer matrices nicely * NEED print_precision() docs near stringify * t/display_precision.t created * example/ directory created with some benchmark scripts Changes in v2.04 - leto Sat Feb 23 20:59:08 EST 2008 --------------------------- * fixed pod errors * $a->length does row+col vectors now * converted all tests except ext1.t to Test::More and added some overall Kwalitee * fixed error with doing $string = $matrix . "\nStuff\n"; * new funcion new_tridiag * $matrix->min and $matrix->max now return the min/max element of a matrix * new function new_random added which looks like (with default options shown ) # returns $n x $m matrix of real numbers between 0 and 10 new_random($n,$m, { symmetric => 0, tridiag => 0, bounded_by => [0,10], integer => 0 ) new_random($n, %options ) # returns a square matrix This has proven to be pretty useful in the unit tests of Math::MatrixReal so I figured others may want an easy way to generate a random matrix of your own flavor * t/rand.t created * t/tridiag.t created * t/stringify.t created * t/minimax.t created * t/positive.t created * t/gsm.t created * t/similar.t created Changes in v2.03 - leto Sun Jan 27 13:19:55 EST 2008 --------------------------- * now using Module::Build, so Math::MatrixReal should in theory be able to compile on systems without make, please test and let me know! * new concatenation operator ".", i.e $c = $a . $b concatenates two matrices side-by-side * t/concat.t created * new function assign_row * beginning of a test suite overhaul (converting to Test::More ) Changes in v2.02 - leto Sat Jun 09 12:29:08 EDT 2007 ---------------------------- * Fixed the overloading for the division operator which did not recognize $a/2, reported by Daniel Brooks * Added support for matrix division notation, so that $a/$b = $a*$b**(-1) when $a and $b are square matrices * t/div.t created Changes in v2.01 - msouth Fri Aug 19 23:40:24 EDT 2005 ---------------------------- * Changed versioning format to leading zero after the dot to make more minor versions possible this time * Integration of Math::MatrixReal::Ext1 0.07 * merged new_from_cols and new_from_rows into one private function which is called by wrappers with the old names * added tests to exercise all of the known failure modes in new_from_{rows,cols} calls * Fixes for POD * added a much needed =over 4 to the start of the POD * removed tabs * reformatted indentation of the all of the code to 4 space indent (from a mixture of tabs, 8 space, 4 space, and 2 space) Changes in v1.9 - leto Wed May 15 03:19:34 EST 2002 ---------------------------- * as_yacas() function added * t/yacas.t created * Fixed issue with infinity norm and Irix, thanks to Allen Smith and the CPAN testers Changes in v1.8 -- leto Sat Mar 23 00:13:48 EST 2002 ---------------------------- * as_matlab() function added * as_scilab() function added * t/matlab.t created * is_row_vector() function added * is_col_vector() function added * t/isrowcol.t created * norm_p() function added * norm_frobenius () function added * t/vecnorm.t created Changes in v1.7 -- leto Fri Mar 15 13:09:49 EST 2002 --------------------------- * each() and each_diag() are now one-based for consistency * removed _trace() comments * as_latex() function created * t/latex.t created * t/bool.t created * t/periodic.t created * t/rank.t created * new_from_string() shouldn't care about the case of the scientific E notation (pointed out by Jim Bowery ) * t/scinotation.t created * is_idempotent() function added * is_periodic() function added * rank_LR() function added * make is_orthogonal return 0 instead of croak when matrix is not quadratic Changes in v1.6 -- leto Sat Feb 16 09:46:51 EST 2002 ------------------------- * is_skew_symmetric() function added * fixed logic error is sym_eigenvalues ( didn't notice if not square! ) * spectral_radius() function added * is_binary() function added * is_LR() function added * t/spectral.t created * t/binary.t created * t/is_LR.t created * t/gramian.t created * is_skew_symmetric() tests added to t/symmetric.t * is_gramian() function added Changes in v1.5 -- leto Sat Jan 12 04:20:48 EST 2002 ------------------------- * t/inverse.t test 6 was numerically instable, commented out I ran it 10000 times and got values from 1e-2 to 1e-16, this caused the test to randomly fail, because it checked that the value was less than 1e-10 I did not notice this problem because my default perl install has USE_LONG_DOUBLE * changed epsilon to be 1e-8 in funcs.pl ( was 1e-10) Changes in v1.4 -- leto Jan 10 2002 -------------------------- * Steffen Beyer gave maintainer-ship to Jonathan Leto * exponent() function added * trace() function added * "**" and "**=" overloaded to exponent() * $matrix ** -1 is now a quick way to compute the inverse, if it exists * new_from_rows and new_from_cols integrated from Math::MatrixReal::Ext1 * is_diagonal() function added * is_tridiagonal() function added * each() function added * each_diag() function added * put functions used by all the test scripts into funcs.pl instead of all of them having copy+paste code * t/inverse.t created * t/diag.t created * t/exponent.t created * t/trace.t created * t/ext1.t created * some documentation spelling errors corrected * perl operators exp(),sin(),cos() overloaded only works with diagonal matrices for now * new_diag() function added * is_upper_triangular() function added * is_lower_triangular() function added * t/triang.t created * t/det.t created * inverse() function added * det() function added should be much faster for diagonal and triangular matrices * tri_diagonalize() tri_eigenvalues() and now do real tridiag check, as per TODO * t/minor.t created * t/cofactor.t created * t/adjoint.t created * t/quadratic.t created * norm_sum() function added * t/norm.t created * check if $rows and $cols are integers in new() * t/condition.t created * t/product.t created * eigenvalues() function added * t/eigen_NxN.t - added test for eigenvalues() * swap_row() function added * swap_col() function added * t/swap.t created * t/orthogonal.t created * is_orthogonal() function added Version 1.3 included the eigenvalues/eigenvectors computation methods, added by Rodolphe Ortalo. Some test/bench programs were added also, especially for these methods. The documentation of the "new_from_string()" method was also slightly changed because it had proven to be incomplete and misleading. Version 1.2 changed the "new()" and "new_from_string()" methods so that they don't fail anymore if an empty class name is given to them (instead, "Math::MatrixReal" is used as the default). Version 1.1 fixed a bug in the "kleene()" method. Version 1.0 was the initial release. Math-MatrixReal-2.13/CONTRIBUTING.md00044456105627002104 157612772016550 17107 0ustar00jonathanleto000000000000# Contributing to Math::MatrixReal I suggest reading [My First Pull Request](https://github.com/CPAN-PRC/resources/wiki/My-first-Pull-Request) and [Using Pull Requests](https://help.github.com/articles/using-pull-requests/) to learn more about pull requests. * Create a branch, probably from master ```git checkout -b descriptive_branch_name``` * Fix the bug or add the feature * Keep whatever style formatting is in the file you are editing (spaces/tabs/indentation/etc) * Update ChangeLog that describes the change * Add yourself to CREDITS if you are not there * Run the tests again and make sure they pass. ```prove -lrv t/``` * Make sure everything you think is committed is actually committed. * Push your changes to your fork on Github * Submit a Pull Request (PR) * As the PR evolves, you can keep pushing to the same branch and the PR will update with the latest commits Math-MatrixReal-2.13/CREDITS00044456105627002104 176112772016550 15672 0ustar00jonathanleto000000000000Many people deserve recoginition for their help with Math::MatrixReal: * Many thanks to Steffen Beyer himself for being very open to third-party additions. (Of course, this acknowledgment is due to Rodolphe. :-) Steffen Beyer released the original Math::MatrixReal and maintained it until v1.3a5, then handed off to Jonathan Leto . * Rodolphe Ortalo for many contributions. * As always, many thanks to Andreas Koenig for his relentless support and efforts as upload manager of the CPAN! * Also many thanks to Stu Smith for raising the questions concerning the "new_from_string()" method (whose documentation was mis- leading and incomplete)! * Mike South for the new_from_cols() and new_from_rows() functions that were integrated from Math::MatrixReal::Ext1 * Everybody involved with CPAN Testers, thanks guys/gals! Current Maintainer: Jonathan Leto Math-MatrixReal-2.13/funcs.pl00044456105627002104 355212772016550 16325 0ustar00jonathanleto000000000000$DEBUG = 0; my $eps = 1e-8; ######### help funcs sub ok_matrix ($$$) { my ($a, $b, $msg) = @_; my $res = abs($a-$b); ok( similar($a,$b) , $msg); print " (|Delta| = $res)\n" if $DEBUG; } sub ok_matrix_orthogonal ($) { my ($M) = @_; my $tmp = $M->shadow(); $tmp->one(); my $transp = $M->shadow(); $transp->transpose($M); $tmp->subtract($M->multiply($transp), $tmp); my $v = $tmp->norm_one(); ok(($v < $eps), 'matrix is orthogonal'); print " (|M * ~M - I| = $v)\n" if $DEBUG; } sub ok_eigenvectors ($$$;$) { my ($M, $L, $V, $msg) = @_; $msg ||= 'eigenvectors computed correctly'; # Now check that all of them correspond to eigenvalue * eigenvector my ($rows, $columns) = $M->dim(); unless ($rows == $columns) { ok(0,'matrix should be square to compute eigenvalues'); return; } # Computes the result of all eigenvectors... my $test = $M * $V; my $test2 = $V->clone(); for (my $i = 1; $i <= $columns; $i++) { my $lambda = $L->element($i,1); for (my $j = 1; $j <= $rows; $j++) { # Compute new vector via lambda * x $test2->assign($j, $i, $lambda * $test2->element($j, $i)); } } ok_matrix($test,$test2, $msg ); return; } sub similar($$;$) { my ($x,$y, $eps) = @_; $eps ||= 1e-8; abs($x-$y) < $eps ? 1 : 0; } sub _debug_info { my($text,$object,$argument,$flag) = @_; unless (defined $object) { $object = 'undef'; }; unless (defined $argument) { $argument = 'undef'; }; unless (defined $flag) { $flag = 'undef'; }; if (ref($object)) { $object = ref($object); } if (ref($argument)) { $argument = ref($argument); } print "$text: \$obj='$object' \$arg='$argument' \$flag='$flag'\n"; } sub assert_dies($;$) { my ($code,$msg) = @_; eval { &$code }; ok($@, $msg); } 1; Math-MatrixReal-2.13/GOALS00044456105627002104 22212772016550 15411 0ustar00jonathanleto000000000000 Some goals for Math::MatrixReal: -------------------------------- o Correctness is more important than speed o Test all methods, at least once Math-MatrixReal-2.13/Kleene.pod00044456105627002104 1250212772016550 16574 0ustar00jonathanleto000000000000 =head1 NAME Kleene's Algorithm - the theory behind it brief introduction =head1 DESCRIPTION =head2 B A Semi-Ring (S, +, ., 0, 1) is characterized by the following properties: =over 4 =item 1) a) C<(S, +, 0) is a Semi-Group with neutral element 0> b) C<(S, ., 1) is a Semi-Group with neutral element 1> c) C<0 . a = a . 0 = 0 for all a in S> =item 2) C<"+"> is commutative and B, i.e., C =item 3) Distributivity holds, i.e., a) C b) C<( a + b ) . c = a . c + b . c for all a,b,c in S> =item 4) C exists, is well-defined and unique C and associativity, commutativity and idempotency hold =item 5) Distributivity for infinite series also holds, i.e., ( SUM_{i=0}^{+infty} a[i] ) . ( SUM_{j=0}^{+infty} b[j] ) = SUM_{i=0}^{+infty} ( SUM_{j=0}^{+infty} ( a[i] . b[j] ) ) =back EXAMPLES: =over 4 =item * C Boolean Algebra See also L =item * C Positive real numbers including zero and plus infinity See also L =item * C Formal languages over Sigma (= alphabet) See also L =back =head2 B (reflexive and transitive closure) Define an operator called "*" as follows: a in S ==> a* := SUM_{i=0}^{+infty} a^i where a^0 = 1, a^(i+1) = a . a^i Then, also a* = 1 + a . a*, 0* = 1* = 1 hold. =head2 B In its general form, Kleene's algorithm goes as follows: for i := 1 to n do for j := 1 to n do begin C^0[i,j] := m(v[i],v[j]); if (i = j) then C^0[i,j] := C^0[i,j] + 1 end for k := 1 to n do for i := 1 to n do for j := 1 to n do C^k[i,j] := C^k-1[i,j] + C^k-1[i,k] . ( C^k-1[k,k] )* . C^k-1[k,j] for i := 1 to n do for j := 1 to n do c(v[i],v[j]) := C^n[i,j] =head2 B Kleene's algorithm can be applied to any Semi-Ring having the properties listed previously (above). (!) EXAMPLES: =over 4 =item * C C be a graph with set of vertices V and set of edges E: C Kleene's algorithm then calculates C using C (remember C< 0* = 1* = 1 >) =item * C C be a graph with set of vertices V and set of edges E, with costs C associated with each edge C<(v[i],v[j])> in E: C C Set C if an edge (v[i],v[j]) is not in E. C< ==E a* = 0 for all a in S2> C< ==E C^k[i,j] = min( C^k-1[i,j] ,> C< C^k-1[i,k] + C^k-1[k,j] )> Kleene's algorithm then calculates the costs of the "shortest" path from any C to any other C: C =item * C C be a Deterministic Finite Automaton with a set of states C, a subset C of C of accepting states and a transition function C Q>. Define C C< { a in Sigma | delta( q[i] , a ) = q[j] }> and C C (C<{''}> is the set containing the empty string, whereas C<{}> is the empty set!) Then Kleene's algorithm calculates the language accepted by Deterministic Finite Automaton M using C C< C^k-1[i,k] concat ( C^k-1[k,k] )* concat C^k-1[k,j]> and C (state C is assumed to be the "start" state) finally being the language recognized by Deterministic Finite Automaton M. =back Note that instead of using Kleene's algorithm, you can also use the "*" operator on the associated matrix: Define C C< ==E A*[i,j] = c(v[i],v[j])> Proof: C where C (matrix with one's in its main diagonal and zero's elsewhere) and C Induction over k yields: C =over 10 =item C C with C and C =item C k:> C C<= SUM_{l=1}^{n} m(v[i],v[l]) . c_{k-1}(v[l],v[j])> C<= SUM_{l=1}^{n} ( a[i,l] . a[l,j] )> C<= [a^{k}_{i,j}] = A^1 . A^(k-1) = A^k> =back qed In other words, the complexity of calculating the closure and doing matrix multiplications is of the same order C> in Semi-Rings! =head1 SEE ALSO Math::MatrixBool(3), Math::MatrixReal(3), DFA::Kleene(3). (All contained in the distribution of the "Set::IntegerFast" module) Dijkstra's algorithm for shortest paths. =head1 AUTHOR This document is based on lecture notes and has been put into POD format by Steffen Beyer . =head1 COPYRIGHT Copyright (c) 1997 by Steffen Beyer. All rights reserved. Math-MatrixReal-2.13/Makefile.PL00044456105627002104 57512772016550 16606 0ustar00jonathanleto000000000000# Note: this file was auto-generated by Module::Build::Compat version 0.4003 use ExtUtils::MakeMaker; WriteMakefile ( 'NAME' => 'Math::MatrixReal', 'VERSION_FROM' => 'lib/Math/MatrixReal.pm', 'PREREQ_PM' => { 'File::Spec' => 0, 'Test::Most' => 0 }, 'INSTALLDIRS' => 'site', 'EXE_FILES' => [], 'PL_FILES' => {} ) ; Math-MatrixReal-2.13/MANIFEST00044456105627002104 201312772016550 15772 0ustar00jonathanleto000000000000.travis.yml Build.PL CHANGES CONTRIBUTING.md CREDITS example/bench.pl example/bench_mult.pl example/bench_new_diag.pl example/openg-and-matrix.pl funcs.pl GOALS Kleene.pod lib/Math/.MatrixReal.pm.swo lib/Math/MatrixReal.pm MANIFEST This list of files OLD_README README.mkd t/.list.t.swo t/00-load.t t/adjoint.t t/arith.t t/assign.t t/basic.t t/bench_eigen.t t/bench_eigen2.t t/binary.t t/bool.t t/cofactor.t t/concat.t t/condition.t t/decompose_LR.t t/det.t t/diag.t t/display_precision.t t/div.t t/each.t t/eigen_3x3.t t/eigen_7x7.t t/eigen_NxN.t t/equality.t t/exponent.t t/ext1.t t/gramian.t t/gsm.t t/inequality.t t/inverse.t t/is_LR.t t/isrowcol.t t/latex.t t/length.t t/list.t t/matlab.t t/max_min.t t/minimax.t t/minor.t t/norm.t t/normality.t t/orthogonal.t t/periodic.t t/positive.t t/product.t t/quadratic.t t/rand.t t/rank.t t/scinotation.t t/similar.t t/spectral.t t/stringify.t t/submatrix.t t/swap.t t/symmetric.t t/trace.t t/transpose.t t/triang.t t/tridiag.t t/vecnorm.t t/yacas.t TODO Makefile.PL META.yml META.json Math-MatrixReal-2.13/META.json00044456105627002104 204312772016550 16265 0ustar00jonathanleto000000000000{ "abstract" : "Manipulate NxN matrices of real numbers", "author" : [ "Jonathan Leto " ], "dynamic_config" : 1, "generated_by" : "Module::Build version 0.4003, CPAN::Meta::Converter version 2.133380", "license" : [ "perl_5" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : "2" }, "name" : "Math-MatrixReal", "prereqs" : { "build" : { "requires" : { "File::Spec" : "0", "Test::Most" : "0" } }, "configure" : { "requires" : { "Module::Build" : "0.38" } } }, "provides" : { "Math::MatrixReal" : { "file" : "lib/Math/MatrixReal.pm", "version" : "2.13" } }, "release_status" : "stable", "resources" : { "license" : [ "http://dev.perl.org/licenses/" ], "repository" : { "url" : "http://github.com/leto/math--matrixreal/tree/master" } }, "version" : "2.13" } Math-MatrixReal-2.13/META.yml00044456105627002104 117312772016550 16120 0ustar00jonathanleto000000000000--- abstract: 'Manipulate NxN matrices of real numbers' author: - 'Jonathan Leto ' build_requires: File::Spec: 0 Test::Most: 0 configure_requires: Module::Build: 0.38 dynamic_config: 1 generated_by: 'Module::Build version 0.4003, CPAN::Meta::Converter version 2.133380' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: 1.4 name: Math-MatrixReal provides: Math::MatrixReal: file: lib/Math/MatrixReal.pm version: 2.13 resources: license: http://dev.perl.org/licenses/ repository: http://github.com/leto/math--matrixreal/tree/master version: 2.13 Math-MatrixReal-2.13/OLD_README00044456105627002104 152512772016550 16226 0ustar00jonathanleto000000000000# Old Installation Instructions (should still work): ## Preliminary steps for use with Perl prior to version 5.002: Edit the "Makefile.PL" file in this package and change the line 'VERSION_FROM' => 'MatrixReal.pm', to 'VERSION' => '2.04', ## How to install it: Please unpack and build this package OUTSIDE the Perl source and distribution tree!! 1) Change directory to the directory that has been created by unpacking this package ("Math-MatrixReal-1.3/"). 2) Type "perl Makefile.PL". (Or whatever the name and path of your Perl 5 binary is) Alternatively you can type, e.g., "perl Makefile.PL PREFIX=/home/doe" to install the module in the home directory, e.g. John Doe... 3) Type "make". 3.5) Optionally, type "make test" to test the build and/or benchmark your system a little. 4) Type "make install". Math-MatrixReal-2.13/README.mkd00044456105627002104 431712772016550 16304 0ustar00jonathanleto000000000000# Math::MatrixReal NxN Real Matrices in Perl [![Build Status](https://secure.travis-ci.org/leto/math--matrixreal.png)](http://travis-ci.org/leto/math--matrixreal) Report bugs and submit patches at http://github.com/leto/math--matrixreal Perl version 5.003 or higher capable of "overloading" (overload.pm). ## What does it do: ### Math::MatrixReal - Matrix of Reals Implements the data type "matrix of reals" (and consequently also "vector of reals") which can be used almost like any other basic Perl type thanks to OPERATOR OVERLOADING, i.e., $A = $matrix1 * $matrix2; $B = $A ** 2; $C = $A + 2*B; $D = $C - $B/2; $inverse = $C ** -1; $inverse = 1/$C; does what you would like it to do. Also features many important operations and methods: matrix norm, matrix transposition, matrix inverse, determinant of a matrix, order and numerical condition of a matrix, scalar product of vectors, vector product of vectors, vector length, projection of row and column vectors, a comfortable way for reading in a matrix from a file, the keyboard or your code, and many more. Allows to solve linear equation systems using an efficient algorithm known as "L-R-decomposition" and several approximative (iterative) methods. Features an implementation of Kleene's algorithm to compute the minimal costs for all paths in a graph with weighted edges (the "weights" being the costs associated with each edge). Allows to solve the eigensystem of a real symmetric matrix, using Householder transformation and QL decomposition. ## Installation Instructions Since Math::MatrixReal 2.03, Module::Build is used for the build process, but a Makefile.PL is still generated for older installations. If you do not have Module::Build, please read the OLD_README file. The build and install Math::MatrixReal run the commands perl Build.PL ./Build ./Build test ./Build install ## Version history: See the CHANGES file. ## Credits: See the CREDITS file. ## Copyright 1996-1997 by Steffen Beyer. 1999 by Rodolphe Ortalo. 2001-2013 by Jonathan "Duke" Leto. All rights reserved. This package is free software; you can redistribute it and/or modify it under the same terms as Perl itself. Math-MatrixReal-2.13/TODO00044456105627002104 711312772016550 15337 0ustar00jonathanleto000000000000============================= Package "Math-MatrixReal" ============================= Plans for the future: --------------------- * Jonathan Leto ideas: Row echelon form Column echelon form Hard: Jordan form More examples in docs print as mathematica,scilab,other,... DONE:print as latex DONE:print as matlab DONE:make each,each_diag 1-based for consistency SOON t/basic.t should check results alphabetize section of docs $matrix->set_option( expand_on_assign => 1 ); Pade' matrix exponential * Steffen Beyer ideas: Define accurate test cases (which is not so trivial since results will depend on the local implementation of floating point arithmetics on a given machine!). Compute the characteristic polynom, orthogonal matrices, ... Deal with symmetric and with orthogonal matrices, multilinear functions, ... Create a module "Math::MatrixCplx" to deal with matrices of complex numbers... Deal with hermitian matrices, multilinear functions, ... * Rodolphe Ortalo remarks and thoughts: Some restructuring/recoding ideas: RO1- Wouldn't it be better to use a hash reference for MatrixReal objects? I feel $matrix->{ROWS} is much clearer than $matrix->[1], and it is probably as efficient. Do you have objections on such evolutions? This would probably be an important update... RO2- Sparse matrix, Symetric matrix, (Tridiagonal, Permutation[1]?) Is it desirable to use special-hooks in MatrixReal objects, or would it better to use object-oriented inheritance? * In the first case, maintainance may be difficult. * In the second case, efficiency problems may arise (all value accesses should go through methods like ->element() and assign(), even for internal computation routines of the module...) I'd favour the second solution, but it would involve a big update of the existing methods (e.g. if we want MatrixReal ->multiply() to work also on derived matrix classes). RO3- Sparse matrix: use hash tables ($M->[0]{$i}{$j})? I personnally think that this would be general and simple. Real techniques for sparse matrix manipulation (e.g. Yale representation) are much better - but more difficult to use (especially as they are optimized for some operation like multiplication of a vector). Furthermore, it would be possible to use these matrix for other purposes rather efficiently (permutation matrix would be easy) and without worrying too much... (The last reason if probably the most important to me... :-) If we don't want too much maintainance problems, this is linked to RO4 - unfortunately... RO4- Add ->get() and ->set() methods, that uses index value where (i,j) is in (0...n-1,0...m-1). ->element() and ->assign() use indexes variying in (1..n,1..m) and this involves two additional '++' operations. These may be costly (IF they are used heavily for computations of course). ==> I tried! This has a VERY BAD impact on performance. It's probably unacceptable to add this method call. (Even a subroutine call is very costly.) Such modifications occur in the inner loop of all algorithms so it's very touchy of course to change these things. Well. I don't have an idea on this. Maybe future versions of Perl itself would be able to inline the call, and enable us to use such access methods. RO5- The POD documentation deserves some more structuring. For example, sections for - arithmetic ('+,-,*,/') operations, - linear system solving, - eigensystems, - Kleene transformation, etc. UPDATE: working on it -- leto [1] What I mean by "permutation matrix" is a matrix where only a single element of each column (or each row) is non-zero, and that element is equal to 1. Such a matrix allow to 'shuffle axes' easily. Math-MatrixReal-2.13/example00075556105627002104 012772016550 16143 5ustar00jonathanleto000000000000Math-MatrixReal-2.13/example/bench.pl00044456105627002104 243412772016550 17717 0ustar00jonathanleto000000000000#!/usr/bin/perl -w use Math::MatrixReal; use Benchmark; my @matrices = map { Math::MatrixReal->new_random($_) } qw(5 10 15 20); my $iter = 2000; for my $matrix ( @matrices ) { my ($r,$c) = $matrix->dim; print "Benchmarking $r x $c matrix\n"; timethese($iter, { 'overload_left_multiply ' => sub { 7*$matrix }, 'overload_right_multiply ' => sub { $matrix*7 }, # this is twice as fast, but gives you CPT 'function_multiply ' => sub { $matrix->multiply_scalar($matrix,7)}, }); timethese($iter, { 'matrix_squared ' => sub { $matrix ** 2 }, 'matrix_times_itself' => sub { $matrix * $matrix }, 'det ' => sub { $matrix->det }, 'det_LR ' => sub { $matrix->decompose_LR->det_LR }, 'inverse ' => sub { $matrix->inverse() }, 'to_negative_one ' => sub { $matrix ** -1 }, 'invert_LR ' => sub { $matrix->decompose_LR->invert_LR }, }); } Math-MatrixReal-2.13/example/bench_mult.pl00055556105627002104 145612772016550 20766 0ustar00jonathanleto000000000000#!/usr/bin/perl -w use Math::MatrixReal; use Benchmark; my @matrices = map { Math::MatrixReal->new_random($_) } qw(10 20 50 100 200 300); my $iter = 2000; for my $matrix ( @matrices ) { my ($r,$c) = $matrix->dim; my $b = $matrix->new_random($r); print "Benchmarking $r x $c matrix\n"; timethese($iter, { '* ' => sub { $matrix*$b }, 'multiply' => sub { $matrix->multiply($b) }, }); timethese($iter, { 'matrix_squared ' => sub { $matrix ** 2 }, 'matrix_times_itself ' => sub { $matrix * $matrix }, 'matrix_multiply_itself' => sub { $matrix->multiply($matrix) }, } ) } Math-MatrixReal-2.13/example/bench_new_diag.pl00055556105627002104 62012772016550 21532 0ustar00jonathanleto000000000000#!/usr/bin/perl -w use strict; use Math::MatrixReal; use Benchmark; my $diag = [ 1 .. 20 ]; my $n = scalar @$diag; my $matrix = Math::MatrixReal->new($n,$n); my $iter = shift; timethese(50000, { # quite a performance hit! new_diag_each => sub { $matrix = $matrix->each_diag( sub { shift @$diag } ); }, new_diag_elem => sub { map { $matrix->[0][$_][$_] = shift @$diag } ( 0 .. $n-1); } }); Math-MatrixReal-2.13/example/openg-and-matrix.pl00044456105627002104 1063012772016550 22027 0ustar00jonathanleto000000000000#!/usr/bin/env perl use 5.12.0; use strict; use warnings; use OpenGL qw/:all/; use AntTweakBar qw/:all/; use AntTweakBar::Type; use List::MoreUtils qw/pairwise/; use List::Util qw/reduce/; use Math::MatrixReal; use Math::Trig; use Data::Dump qw/dump/; use Time::HiRes qw/tv_interval gettimeofday/; sub display; sub reshape { my ($width, $height) = @_; glViewport(0, 0, $width, $height); glMatrixMode(GL_PROJECTION); glLoadIdentity; gluPerspective(40, $width/$height, 1, 10); glMatrixMode(GL_MODELVIEW); glLoadIdentity; gluLookAt(0,0,5, 0,0,0, 0,1,0); glTranslatef(0, 0.6, -1); AntTweakBar::window_size($width, $height); } glutInit; glutInitDisplayMode(GLUT_DOUBLE | GLUT_RGB | GLUT_DEPTH); glutInitWindowSize(640, 480); glutCreateWindow("Math::MatrixReal"); AntTweakBar::init(TW_OPENGL); glutDisplayFunc(\&display); glutReshapeFunc(\&reshape); glutMouseFunc(\&AntTweakBar::eventMouseButtonGLUT); glutMotionFunc(\&AntTweakBar::eventMouseMotionGLUT); glutPassiveMotionFunc(\&AntTweakBar::eventMouseMotionGLUT); glutKeyboardFunc(\&AntTweakBar::eventKeyboardGLUT); glutSpecialFunc(\&AntTweakBar::eventSpecialGLUT); #AntTweakBar::GLUTModifiersFunc(\&glutGetModifiers); reshape(640, 750); # variables my $zoom = 1.0; my $angle = 0.0; my $axis = [ 0.0, 0.0, 1.0 ]; my $light_multiplier = 1.0; my $light_direction = [ -0.57735, -0.57735, -0.57735 ]; my $material_ambient = [ 0.5, 0.0, 0.0]; my $material_diffuse = [ 1.0, 1.0, 0.0]; my $current_matrix = ~(rotation_matrix($axis, $angle)); my $shape_id = 1; glNewList($shape_id, GL_COMPILE); glutSolidTeapot(1.0); glEndList; sub rotation_matrix { my ($axis, $angle) = @_; my ($x, $y, $z) = @$axis; my $f = $angle; my $cos_f = cos(deg2rad($f)); my $sin_f = sin(deg2rad($f)); my $rotation = Math::MatrixReal->new_from_rows([ [$cos_f+(1-$cos_f)*$x**2, (1-$cos_f)*$x*$y-$sin_f*$z, (1-$cos_f)*$x*$z+$sin_f*$y, 0 ], [(1-$cos_f)*$y*$z+$sin_f*$z, $cos_f+(1-$cos_f)*$y**2 , (1-$cos_f)*$y*$z-$sin_f*$x, 0 ], [(1-$cos_f)*$z*$x-$sin_f*$y, (1-$cos_f)*$z*$y+$sin_f*$x, $cos_f+(1-$cos_f)*$z**2 ,0 ], [0, 0, 0, 1 ], ]); } sub display { glClearColor(0, 0, 0, 1); glClear(GL_COLOR_BUFFER_BIT | GL_DEPTH_BUFFER_BIT); glEnable(GL_DEPTH_TEST); glDisable(GL_CULL_FACE); glEnable(GL_NORMALIZE); # set light glEnable(GL_LIGHTING); glEnable(GL_LIGHT0); my $ambient_light = OpenGL::Array->new_list( GL_FLOAT, (0.4 * $light_multiplier) x 3, 1.0); my $diffuse_light = OpenGL::Array->new_list( GL_FLOAT, (0.8 * $light_multiplier) x 3, 1.0); glLightfv_c(GL_LIGHT0, GL_AMBIENT, $ambient_light->ptr); glLightfv_c(GL_LIGHT0, GL_DIFFUSE, $diffuse_light->ptr); my $light_position = OpenGL::Array->new_list( GL_FLOAT, map { $_ * -1 } @$light_direction, 0.0); glLightfv_c(GL_LIGHT0, GL_POSITION, $light_position->ptr); # set material my $oga_material_ambient = OpenGL::Array->new_list( GL_FLOAT, @$material_ambient); my $oga_material_diffuse = OpenGL::Array->new_list( GL_FLOAT, @$material_diffuse); glMaterialfv_c(GL_FRONT_AND_BACK, GL_AMBIENT, $oga_material_ambient->ptr); glMaterialfv_c(GL_FRONT_AND_BACK, GL_DIFFUSE, $oga_material_diffuse->ptr); # Rotate and draw shape glPushMatrix; { glMultMatrixf_p($current_matrix->as_list); glTranslatef(0.5, -0.3, 0.0); glCallList($shape_id); # shape_id = shape + 1 } glPopMatrix; AntTweakBar::draw; glutSwapBuffers; glutPostRedisplay; } my $bar = AntTweakBar->new( "Math::MatrixReal", ); $bar->add_variable( mode => 'rw', name => "axis", type => 'direction', value => \$axis, definition => " opened=true label='Rotation axis' ", ); $bar->add_variable( mode => 'rw', name => "angle_rw", type => 'integer', cb_read => sub { $angle }, cb_write => sub { $angle = shift; # normalizing rotation axis my $length = reduce { $a + $b } map { $_ * $_ } @$axis; my $normal = [0.0, 0.0, 1.0]; if($length) { $normal->[$_] = $axis->[$_] / $length for(0 .. @$axis-1); } $current_matrix = ~(rotation_matrix($normal, $angle)); }, definition => " label='angle' max=359 min=0", ); glutMainLoop; Math-MatrixReal-2.13/lib00075556105627002104 012772016550 15256 5ustar00jonathanleto000000000000Math-MatrixReal-2.13/lib/Math00075556105627002104 012772016550 16147 5ustar00jonathanleto000000000000Math-MatrixReal-2.13/lib/Math/.MatrixReal.pm.swo00044456105627002104 61000012772016550 21634 0ustar00jonathanleto000000000000b0VIM 7.3WA"Ijonathanletoloki.local~jonathanleto/git/math--matrixreal/lib/Math/MatrixReal.pmutf-8 3210#"! Utp/Vcj@o   y, y ~v}pu{sr`}\  ~   6  f?  v !]"ix#p$kQ%y&x5't(b!)e*u+f],q-m4.}/b0BadS~<wY   k R 6  g J (  o P (  l T 8 !   z y M L   yxWV@?FE#lk }YX'& D) po1 cSR my $matrix; my ($self,$lower,$diag,$upper) = @_; croak "Usage: \$new_matrix = Math::MatrixReal->new_tridiag( [ 1, 2, 3], [ 4, 5, 6, 7], [-1,-2,-3] );" unless (@_ == 4 );sub new_tridiag {} return $matrix; map { $matrix->[0][$_][$_] = shift @$diag } ( 0 .. $n-1); my $matrix = Math::MatrixReal->new($n,$n); croak "Math::MatrixReal::new_diag(): Third argument must be an arrayref" unless (ref($diag) eq "ARRAY"); my $n = scalar @$diag; my ($self,$diag) = @_; croak "Usage: \$new_matrix = Math::MatrixReal->new_diag( [ 1, 2, 3] );" unless (@_ == 2 );sub new_diag {} bless $this, $class; map { $this->[0][$_] = [ @$empty ] } ( 0 .. $rows-1); # Create a row at a time map { $empty->[$_] = 0.0 } ( 0 .. $cols-1 ); $#$empty = $cols - 1; my $empty = [ ]; # Create the first empty row and pre-lengthen my $this = [ [ ], $rows, $cols ]; unless ($cols > 0 and $cols == int($cols) ); croak "Math::MatrixReal::new(): number of columns must be integer > 0" unless ($rows > 0 and $rows == int($rows) ); croak "Math::MatrixReal::new(): number of rows must be integer > 0" my $class = ref($self) || $self || 'Math::MatrixReal'; my ($self,$rows,$cols) = @_; croak "Usage: \$new_matrix = Math::MatrixReal->new(\$rows,\$columns);" if (@_ != 3);{sub new=cutmy $determinant= $a->det;my $inverse = $a ** -1;my $inverse = 1/$a;my $inverse = $a->inverse; my $transpose = $c->transpose;my $transpose = ~$c;my $col = (5*$c)->col(2);my $row = ($a * $b)->row(3);print $a;my $d = $b->new_from_rows( [ [ 5, 3 ,4], [3, 4, 5], [ 2, 4, 1 ] ] );my $c = $b * $a ** 3;my $b = $a->new_random(10, 30, { symmetric=>1, bounded_by=>[-1,1] });my $a = Math::MatrixReal->new_random(5, 5);=head1 SYNOPSIS"vector of real numbers").Implements the data type "matrix of real numbers" (and consequently alsoMath::MatrixReal - Matrix of Reals=head1 NAME'fallback' => undef; '""' => '_stringify', '=' => '_clone', 'ge' => '_greater_than_or_equal', 'gt' => '_greater_than', 'le' => '_less_than_or_equal', 'lt' => '_less_than', 'ne' => '_not_equal', 'eq' => '_equal', '>=' => '_greater_than_or_equal', '>' => '_greater_than', '<=' => '_less_than_or_equal', '<' => '_less_than', '!=' => '_not_equal', '==' => '_equal', '**=' => '_assign_exponent', '*=' => '_assign_multiply', '-=' => '_assign_subtract', '+=' => '_assign_add', '**' => '_exponent', '/' => '_divide', '*' => '_multiply', '-' => '_subtract', '+' => '_add', 'abs' => '_norm', '!' => '_not_boolean', 'bool' => '_boolean', '~' => '_transpose', 'neg' => '_negate', '.' => '_concat',use overload$VERSION = '2.13';%EXPORT_TAGS = (all => [@EXPORT_OK]);@EXPORT_OK = qw(min max);@EXPORT = qw();@ISA = qw(Exporter);require Exporter;use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION);use Scalar::Util qw/reftype/;use Data::Dumper;use Carp;use warnings;use strict;package Math::MatrixReal;# modify it under the same terms as Perl itself.# This package is free software; you can redistribute it and/or# Copyright (c) 2001-2016 by Jonathan Leto. All rights reserved.# Copyright (c) 1999 by Rodolphe Ortalo. All rights reserved.# Copyright (c) 1996, 1997 by Steffen Beyer. All rights reserved.ad zyji!rq`_  f e ' modify it under the same terms as Perl itself. Fuck yeah.This package is free software; you can redistribute it and/or=head1 LICENSE AGREEMENTall the wonderful people in the AUTHORS file. All rights reserved.Steffen Beyer, Rodolphe Ortalo, the current maintainer Jonathan "Duke" Leto andCopyright (c) 1996-2016 by various authors including the original developer=head1 COPYRIGHTlectures in Numerical Analysis!to Prof. Esser and his assistant, Mr. Jarausch, for their fascinatingAlgebra and Linear Algebra at the university (RWTH Aachen, Germany), andMany thanks to Prof. Pahlings for stoking the fire of my enthusiasm for=head1 CREDITSto Github Issues: https://github.com/leto/math--matrixreal/issuesCurrently maintained by Jonathan "Duke" Leto, send all bugs/patchesadzydcYXON~< x w \ [ @ ? > = 2 1 ( '   B $ # a ` U T I H % $   ]  h g B A   ZY#"iFE<;nm_^QP('hgXWA@  ZYSRBA~}]21"!Jonathan "Duke" Leto .Steffen Beyer , Rodolphe Ortalo ,=head1 AUTHORShttps://github.com/leto/math--matrixreal .The latest code can be found atThis man page documents Math::MatrixReal version 2.13=head1 VERSIONSet::IntegerRange, Set::IntegerFast .Math::Vec, DFA::Kleene, Math::Kleene,Math::VectorReal, Math::PARI, Math::MatrixBool,=head1 SEE ALSO=backUses the "one"-norm for matrices and Perl's built-in "abs()" for scalars. if ( abs($LR) >= abs($A) ) { # ... }is simply a shortcut for: if ( $LR >= $A ) { # ... }As with the '<', '<=' and '>' operator, the followingGreater than or equal=item 'E='Uses the "one"-norm for matrices and Perl's built-in "abs()" for scalars. if ( abs( $xn - $x0 ) > abs(1E-12) ) { # ... }is just a shortcut for: if ( $xn - $x0 > 1E-12 ) { # ... }As with the '<' and '<=' operator, thisGreater than=item 'E'Uses the "one"-norm for matrices and Perl's built-in "abs()" for scalars. if ( abs( $A * $x - $b ) <= abs(1E-12) ) { # ... }which in fact is the same as: if ( $A * $x - $b <= 1E-12 ) { # ... }Example:with "abs()" around all arguments.As with the '<' operator, this is just a shortcut for the same expressionLess than or equal=item 'E='Uses the "one"-norm for matrices and Perl's built-in "abs()" for scalars. if ( abs( $A * $x - $b ) < abs(1E-12) ) { # ... } if ( abs(1E-12) < abs($vector) ) { # ... } if ( abs($vector) < abs($epsilon) ) { # ... } if ( abs($matrix1) < abs($matrix2) ) { # ... }These are just shortcuts for saying: if ( $A * $x - $b < 1E-12 ) { # ... } if ( 1E-12 < $vector ) { # ... } if ( $vector < $epsilon ) { # ... } if ( $matrix1 < $matrix2 ) { # ... }Examples:Less than=item 'E'of the two matrices with a small number instead.to compare matrices or vectors this way. Compare the norm of the differenceNote that (just like with the '==' operator), it is usually a bad idea(Stops when the iteration becomes stationary) while ($x0_vector != $xn_vector) { # proceed with iteration ... }Example:Tests two matrices for inequality.Inequality=item '!=' if ( abs( $A * $x - $b ) < 1E-12 ) { print "BINGO!\n"; }to compare and compare that norm with a small number, like this:Better use the norm of the difference of the two matrices you wantmatrices or vectors this way.precision of computer arithmetics), it is a bad idea to compare twoNote that in most cases, due to numerical errors (due to the finite if ( $A * $x == $b ) { print "EUREKA!\n"; }Example:Tests two matrices for equality.Equality=item '==' $ident = $matrix ** 0; $inv2 = $matrix ** -2; $matrix **= 2; $matrix2 = $matrix ** 2;Examples:to the absolute value of the integer. The matrix must be quadratic.it computes the inverse (if it exists) and then raised the inversethe identity matrix is returned. If a negative integer is passed,Returns the matrix raised to an integer power. If 0 is passed,Exponentiation=item '**'can also use 1/$a .Currently a shortcut for doing $a * $b ** -1 is $a / $b, which works for square matrices. One Division=item '/' $matrix_A *= -1; $matrix_B = $matrix_A * -1; $matrix_B = -1 * $matrix_A; $vector_b = $matrix_A * $vector_x; $matrix_A *= $matrix_B;ad,VMml; K F A - + *  R O K 5 E R Q Qnmj*(&J2P3e_RN2= $this = Math::MatrixReal::new($class,$rows,$cols); if ($warn) { warn "Math::MatrixReal::new_from_string(): missing elements will be set to zero!\n"; } if ($rows == 0) { croak "Math::MatrixReal::new_from_string(): empty input string"; } } croak $error_msg; my $error_msg = "Math::MatrixReal::new_from_string(): syntax error in input string: $string"; chomp $string; if ($string !~ m/^\s*$/) { } $rows++; } if ($col > $cols) { $cols = $col; } unless ($cols == 0) { $warn = 1; } if ($col != $cols) { $col = @{$values->[$rows]}; $values->[$rows] = [ ]; @{$values->[$rows]} = split(' ', $line); $line = $1; $string = $'; while ($string =~ m!^\s* \[ \s+ ( (?: [+-]? \d+ (?: \. \d*)? (?: E [+-]? \d+ )? \s+ )+ ) \] \s*? \n !ix) { $values = [ ]; $warn = $rows = $cols = 0; my ($warn,$this); my ($row,$col); my ($rows,$cols); my ($line,$values); my $class = ref($self) || $self || 'Math::MatrixReal'; my ($self,$string) = @_; if (@_ != 2); croak "Usage: \$new_matrix = Math::MatrixReal->new_from_string(\$string);"{#{{{sub new_from_string#{{{ } $options->{symmetric} ? 0.5*($matrix + ~$matrix) : $matrix; $matrix = $matrix->each( sub {my($e,$i,$j)=@_; ( abs($i-$j)>1 ) ? 0 : $e } ) if ($options->{tridiag} || $options->{tridiagonal} ); $matrix = $options->{diag} || $options->{diagonal} ? $matrix->each_diag($random_code) : $matrix->each($random_code); my $random_code = sub { $integer ? int($min + rand($max-$min)) : $min + rand($max-$min) } ; my $matrix = Math::MatrixReal->new($rows,$cols); if (($options->{diag} || $options->{diagonal}) && ($rows != $cols)); croak "Math::MatrixReal::new_random(): diagonal option only for square matrices " if (($options->{tridiag} || $options->{tridiagonal}) && $rows != $cols); croak "Math::MatrixReal::new_random(): tridiag option only for square matrices" unless (defined $min && defined $max && $min < $max ); croak "Math::MatrixReal::new_random(): bounded_by interval length must be > 0" unless ($rows > 0 and $rows == int($rows) ) && ($cols > 0 and $cols == int($cols) ) ; croak "Math::MatrixReal::new_random(): number of rows must be integer > 0" if ($rows != $cols and $options->{symmetric} ); croak "Math::MatrixReal::new_random(): number of rows must = number of cols for symmetric option" $cols ||= $rows; $self = ref($self) || $self || 'Math::MatrixReal'; my $integer = $options->{integer}; my ($min,$max) = defined $options->{bounded_by} ? @{ $options->{bounded_by} } : ( 0, 10); (($options = $cols) and ($cols = $rows)) if ref $cols eq 'HASH'; my ($self, $rows, $cols, $options ) = @_; if (@_ < 2); croak "Usage: \$new_matrix = Math::MatrixReal->new_random(\$n,\$m, { symmetric => 1, bounded_by => [-5,5], integer => 1 } );" sub new_random { } return $matrix; ); } elsif (($i-$j) == 1) { $p++; return $lower->[$p];} elsif ( $i == $j) { return $e; } if (($i-$j) == -1) { $k++; return $upper->[$k];} my ($e,$i,$j) = @_; sub { $matrix = $matrix->each( $matrix = Math::MatrixReal->new_diag($diag); ($l == $m && $n == ($l+1)); croak "Math::MatrixReal::new_tridiag(): new_tridiag(\$lower,\$diag,\$upper) diagonal dimensions incompatible" unless ref $diag eq 'ARRAY' && ref $lower eq 'ARRAY' && ref $upper eq 'ARRAY'; croak "Math::MatrixReal::new_tridiag(): Arguments must be arrayrefs" unless my ($k,$p)=(-1,-1); my ($l,$n,$m) = (scalar(@$lower),scalar(@$diag),scalar(@$upper)); ad*cgb]LBAyDB { e w h M  { d =   \   ~Q h6u)]3q3 2$k2 } else { # work out # we don't need to do anything, it will all # it's already a Math::MatrixReal something. ) ) { $current_vector->isa('Math::MatrixComplex') ( $current_vector->isa('Math::MatrixReal') || } elsif ( $ref ne 'HASH' and } $current_vector = $class->new_from_string( '[ '. join( " ]\n[ ", @array) ." ]\n" ); } else { $current_vector = $class->new_from_string( '[ '. join( " ", @array) ." ]\n" ); if ($vector_type eq 'row') { # they said they were sending us rows or columns: # we need to create the right kind of string based on whether croak "$caller_subname: one $vector_type you gave me was a ref to an array with no elements" unless @array; my @array = @$current_vector; } elsif ( $ref eq 'ARRAY' ) { $current_vector = $class->new_from_string( $current_vector ); # thing # but if not we just let the Math::MatrixReal die() do it's # we hope this is a properly formatted Math::MatrixReal string, if ( $ref eq '' ) { my $ref = ref( $current_vector ) ; # we add the 'pad' option), and gets set later # as we go. The other dimension is fixed (for now, until # starting with one here and incrementing # dimension is one-based, so we're foreach my $current_vector (@vectors) { my $current_vector_count = 1; # row and column indices are one based ); $other_type => 0, # we will correct this in a bit $vector_type => scalar( @vectors ), my %matrix_dim = ( my $other_type = {row=>'column', column=>'row'}->{$vector_type}; my $matrix; my @vectors = @{$ref_to_vectors}; croak "$caller_subname: need a reference to an array of ${vector_type}s" unless reftype($ref_to_vectors) eq 'ARRAY'; my $caller_subname = (caller(1))[3]; # step back one frame because this private method is not how the user called it die "Internal ".__PACKAGE__." error" unless $vector_type =~ /^(row|column)$/; my $vector_type = $args->{_type}; my $args = pop; # request padding # these additional args are internal at the moment, but in the future the user could pass e.g. {pad=>1} to my $ref_to_vectors = shift; my $class = ref($proto) || $proto; my $proto = shift;sub _new_from_rows_or_cols {# from Math::MatrixReal::Ext1 (msouth@fulcrum.org)} return $self->new_from_cols( \@cols ); } $p += $rows; push @cols, [@{$values}[$p .. $p + $rows - 1]]; for my $c (1..$cols) { my $p = 0; my @cols = (); my ($self, $rows, $cols, $values) = @_;sub reshape {} $self->_new_from_rows_or_cols(@_, $extra_args ); $extra_args->{_type} = 'row'; my $extra_args = ( @_ > 1 && ref($_[-1]) eq 'HASH' ) ? pop : {}; my $self = shift;sub new_from_rows {# from Math::MatrixReal::Ext1 (msouth@fulcrum.org)} $self->new_from_cols(@_); my $self = shift;sub new_from_columns {# from Math::MatrixReal::Ext1 (msouth@fulcrum.org)} $self->_new_from_rows_or_cols(@_, $extra_args ); $extra_args->{_type} = 'column'; my $extra_args = ( @_ > 1 && ref($_[-1]) eq 'HASH' ) ? pop : {}; my $self = shift;sub new_from_cols { # from Math::MatrixReal::Ext1 (msouth@fulcrum.org)}#}}}#}}} return $this; } } $this->[0][$row][$col] = $values->[$row][$col]; for ( $col = 0; $col < @{$values->[$row]}; $col++ ) { for ( $row = 0; $row < $rows; $row++ ) { adjMCB V . G F  j /  j , k]"BA*)v-{zts\ZB+{yJ65+*cB< $matrix1->[3] = $matrix2->[3]; # $sign { if (defined $matrix2->[3]) # is an LR decomposition matrix! } $matrix1->[0][$i] = $r1; @$r1 = @$r2; # Copy whole array directly my $r2 = $matrix2->[0][$i]; my $r1 = []; { for ( $i = 0; $i < $rows1; $i++ ) croak "Math::MatrixReal::copy(): matrix size mismatch" unless $rows1 == $rows2 && $cols1 == $cols2; my ($i,$j); my ($rows2,$cols2) = ($matrix2->[1],$matrix2->[2]); my ($rows1,$cols1) = ($matrix1->[1],$matrix1->[2]); my ($matrix1,$matrix2) = @_; if (@_ != 2); croak "Usage: \$matrix1->copy(\$matrix2);"{sub copy} } $self->[4] = undef; } else { $self->[4] = int $n; croak "Usage: \$matrix->display_precision(\$nonnegative_integer);" if ($n < 0); if (defined $n) { my ($self,$n) = @_;{sub display_precision =cut =backcalculations.scientific display notation. This method does not effect the precision of theentries of $matrix and $matrix->display_precision() will return to the default$matrix->display_precision(0) will only show the integer part of all theSets the default precision when matrices are printed or stringified.=item * $matrix->display_precision($integer)=over 4} return $matrix->new($matrix->[1],$matrix->[2]); my ($matrix) = @_; croak "Usage: \$new_matrix = \$some_matrix->shadow();" if (@_ != 1);{sub shadow} return $matrix; } $current_vector_count ++ ; } $matrix->assign($row_index, $column_index, $value); $value = $current_vector->element($v_r, $v_c); } $column_index = $current_vector_count; $v_r = $row_index = $element_index; } else { $v_c = $column_index = $element_index; $row_index = $current_vector_count; if ($vector_type eq 'row') { my ($row_index, $column_index, $value); # args for matrix assignment my ($v_r, $v_c) = (1,1); # one below # initialize both to one and reset the correct # args for vector assignment: foreach my $element_index ( 1..$length ){ # to the correct place in the matrix we're building # step along the vector assigning the value of each element $matrix ||= $class->new($matrix_dim{row}, $matrix_dim{column}); # create the matrix the first time through unless ($length == $matrix_dim{$other_type}) ; croak "$caller_subname: one $vector_type has [$length] elements and another one had [$matrix_dim{$other_type}]--all of the ${vector_type}s passed in must have the same dimension" # die unless length of this vector matches the first length $matrix_dim{$other_type} ||= $length; # vector the first time through # set the "other" dimension to the length of this my $length = $vector_dims[ $vector_type eq 'row' ? 1 : 0 ]; # the other dimension is the length of our vector croak "$caller_subname: I don't accept $other_type vectors" unless ($vector_dims[ $vector_type eq 'row' ? 0 : 1 ] == 1) ; #die unless the appropriate dimension is 1 my @vector_dims = $current_vector->dim; # starting now we know $current_vector isa Math::MatrixReal thingy } croak "$caller_subname: I only know how to deal with array refs, strings, and things that inherit from Math::MatrixReal\n"; # we have no idea, error time!ado<;%|p21 z y > = * (   U & e    s * v 3  cKJvA@#m/\G^7'&hS1; my (@temp); my ($rows,$cols) = $matrix->dim(); my ($matrix,$row1,$row2) = @_; croak "Usage: \$matrix->swap_row(\$row1,\$row2); " unless (@_ == 3);sub swap_row {} } $matrix->[0][$i][$col2] = $temp[$i]; $matrix->[0][$i][$col1] = $matrix->[0][$i][$col2]; $temp[$i] = $matrix->[0][$i][$col1]; for(my $i=0;$i < $rows;$i++){ $col1--;$col2--; $col2 == int($col2) ); $col1 == int($col1) && unless ( $col1 <= $cols && $col2 <= $cols && croak "Math::MatrixReal::swap_col(): col index is not valid" my (@temp); my ($rows,$cols) = $matrix->dim(); my ($matrix,$col1,$col2) = @_; croak "Usage: \$matrix->swap_col(\$col1,\$col2); " unless (@_ == 3);sub swap_col {} return ($minor); } $j = 0; } } croak "Very bad things"; } else { $minor->[0][$i][$j-1] = $matrix->[0][$i][$j]; } elsif ( $i < $r && $j >= $c ){ $minor->[0][$i][$j] = $matrix->[0][$i][$j]; } elsif ( $i < $r && $j < $c ){ $minor->[0][$i-1][$j] = $matrix->[0][$i][$j]; } elsif ( $i >= $r && $j < $c ){ $minor->[0][$i-1][$j-1] = $matrix->[0][$i][$j]; if( $i >= $r && $j >= $c ){ for(;$j < $rows; $j++ ){ for(; $i < $rows; $i++){ ## below and to the left, below and to the right ## above and to the left, above and to the right ## row and col: ## the element can be in any of 4 regions compared to the eliminated ## assign() might have been easier, but this should be faster my ($i,$j) = (0,0); my $minor = new Math::MatrixReal($rows-1,$cols-1); unless ($r <= $rows and $c <= $cols ); croak "Math::MatrixReal::minor(): matrix has no $r,$c element" unless ($r > 0 and $c > 0 ); croak "Math::MatrixReal::minor(): $r and $c must be positive" unless ($rows > 1 and $cols > 1); croak "Math::MatrixReal::minor(): \$matrix must be at least 2x2" my ($rows,$cols) = $matrix->dim(); my ($matrix,$r,$c) = @_; croak "Usage: \$minor = \$matrix->minor(\$r,\$c);" unless (@_ == 3);sub minor {## eliminate row $r and col $c , and return the $r-1 by $c-1 matrix## return the minor corresponding to $r and $c} return $submatrix; } } $submatrix->[0][$i-($x1-1)][$j-($y1-1)] = $self->[0][$i][$j]; for (my $j = $y1-1; $j < $y2; $j++ ) { for (my $i = $x1-1; $i < $x2; $i++ ) { my $submatrix = $self->new( $sr, $sc ); my($sr,$sc) = ( 1+abs($x1-$x2), 1+abs($y1-$y2) ); my($rows,$cols) = ($self->[1],$self->[2]); unless ($x1 >= 1 && $x2 >= 1 && $y1 >=1 && $y2 >=1 ); croak "Math::MatrixReal::submatrix(): indices must be positive integers" my ($x1, $y1, $x2, $y2) = @_; my $self = shift;sub submatrix {} return $trace; map { $trace += $matrix->[0][$_][$_] } (0 .. $cols-1); croak "Math::MatrixReal::trace(): matrix is not quadratic" unless ($rows == $cols); my $trace = 0; my($rows,$cols) = ($matrix->[1],$matrix->[2]); my $matrix = shift; croak "Usage: \$trace = \$matrix->trace();" if (@_ != 1);sub trace {## trace() : return the sum of the diagonal elements} return $temp; $temp->copy($matrix); $temp = $matrix->new($matrix->[1],$matrix->[2]); my($temp); my($matrix) = @_; croak "Usage: \$twin_matrix = \$some_matrix->clone();" if (@_ != 1);{sub clone} } $matrix1->[5] = $matrix2->[5]; # $perm_col $matrix1->[4] = $matrix2->[4]; # $perm_rowadJd?*rljiX  1 l T =   z g e 7 " f 7   a [ F E C B 3  wTE&zYWVNLFE9pec21%NM9 ~tn\ZYLJI{sub _undo_LR} return @list; } } push @list, $self->[0][$i][$j]; for(my $j = 0; $j < $cols; $j++){ for(my $i = 0; $i < $rows; $i++ ){ my @list; my($rows,$cols) = ($self->[1], $self->[2]); my($self) = @_; croak "Usage: \$matrix->as_list();" if (@_ != 1);{sub as_list} return $col_vector; map { $col_vector->[0][$_][0] = $matrix->[0][$_][$col] } (0 .. $rows-1); $col_vector = $matrix->new($rows,1); $col--; croak "Math::MatrixReal::column(): column index out of range" if ($col < 1 || $col > $cols); my $col_vector; #my($i); #my($temp); my($rows,$cols) = ($matrix->[1],$matrix->[2]); my($matrix,$col) = @_; croak "Usage: \$column_vector = \$matrix->column(\$column);" if (@_ != 2);{sub columnsub col{ return (shift)->column(shift) }} return($temp); } $temp->[0][0][$j] = $matrix->[0][$row][$j]; { for ( my $j = 0; $j < $cols; $j++ ) $temp = $matrix->new(1,$cols); $row--; croak "Math::MatrixReal::row(): row index out of range" if ($row < 1 || $row > $rows); my($temp); my($rows,$cols) = ($matrix->[1],$matrix->[2]); my($matrix,$row) = @_; if (@_ != 2); croak "Usage: \$row_vector = \$matrix->row(\$row);"{sub row} return ~($matrix->cofactor); my ($matrix) = @_;sub adjoint {} return ($cofactor); }); ($i+$j) % 2 == 0 ? $matrix->minor($i,$j)->det() : -1*$matrix->minor($i,$j)->det(); my($v,$i,$j) = @_; sub { my $cofactor = $matrix->each( # black magic ahead unless ($rows == $cols); croak "Math::MatrixReal::cofactor(): Matrix is not quadratic" my ($rows,$cols) = $matrix->dim(); my ($matrix) = @_;sub cofactor {} return $new_row; } $new_row->[0][0][$j] = $matrix->[0][0][$j] / $big; for(my $j = 0;$j < $cols; $j++ ){ # now $big is biggest element in row next unless $big; } ? abs($matrix->[0][0][$j]) : $big; $big = $big < abs($matrix->[0][0][$j]) for(my $j=0;$j < $cols; $j++ ){ my $big = abs($matrix->[0][0][0]); my $new_row = Math::MatrixReal->new(1,$cols); my ($rows,$cols) = $matrix->dim(); my ($matrix) = @_;sub _normalize_row {## divide a row by it's largest abs() element} return $count; map { $count++ unless $matrix->[0][0][$_] } (0 .. $cols-1); croak "_count_zeroes_row(): only 1 row, buddy" unless ($rows == 1); my $count = 0; my ($rows,$cols) = $matrix->dim(); my ($matrix) = @_;sub _count_zeroes_row {# returns the number of zeroes in a row} return $matrix; @{$matrix->[0][--$row]} = @{$row_vec->[0][0]}; croak "Math::MatrixReal::assign_row(): not a row vector" unless( $rows2 == 1); croak "Math::MatrixReal::assign_row(): number of columns mismatch" if ($cols1 != $cols2); my ($rows2,$cols2) = $row_vec->dim(); my ($rows1,$cols1) = $matrix->dim(); my ($matrix,$row,$row_vec) = @_; croak "Usage: \$matrix->assign_row(\$row,\$row_vec);" unless (@_ == 3);sub assign_row {} } $matrix->[0][$row2][$j] = $temp[$j]; $matrix->[0][$row1][$j] = $matrix->[0][$row2][$j]; $temp[$j] = $matrix->[0][$row1][$j]; for(my $j=0;$j < $cols;$j++){ $row1--;$row2--; $row2 == int($row2) ); $row1 == int($row1) && unless ( $row1 <= $rows && $row2 <= $rows && croak "Math::MatrixReal::swap_row(): row index is not valid"ad]kibYW$#idB h g 5 4 k < ; t s \ 3 1 0 $ " " c a     _^JaW1+m<*(zeLYX2jQPN!]\ for (my $i = 0; $i < $rows; $i++) my $max = 0.0; my($rows,$cols) = ($self->[1],$self->[2]); my($self) = @_; croak "Usage: \$norm_max = \$matrix->norm_max();" if (@_ != 1);{sub norm_max # maximum of sums of each row} return $s ** (1/$p); $v->each( sub { $s+= (abs(shift))**$p; } ); my $s=0; } return $max; $v->each ( sub { my $x=abs(shift); $max = $x if( $x > $max ); } ); my $max = $v->element(1,1); if( $p =~ m/^(Inf|Infinity)$/i ){ unless ($p =~ m/Inf(inity)?/i || $p >= 1); croak "Math::MatrixReal::norm_p: $p must be >= 1" unless ( $v->is_row_vector || $v->is_col_vector ); croak "Math::MatrixReal:norm_p: argument must be a row or column vector" # sanity check on $p my ($v,$p) = @_;sub norm_p {# Vector Norm } return sqrt($s); $m->each( sub { $s+=abs(shift)**2 } ); my $s=0; my ($r,$c) = $m->dim; my ($m) = @_;sub norm_frobenius {} return $norm; $matrix->each( sub { $norm+=abs(shift); } ); my $norm = 0; my ($matrix) = @_; croak "Usage: \$norm_sum = \$matrix->norm_sum();" unless (@_ == 1);sub norm_sum {## sum of absolute value of every element} return($max); } $max = $sum if ($sum > $max); } $sum += abs( $self->[0][$i][$j] ); { for (my $i = 0; $i < $rows; $i++) my $sum = 0.0; { for (my $j = 0; $j < $cols; $j++) my $max = 0.0; my($rows,$cols) = ($self->[1],$self->[2]); my($self) = @_; croak "Usage: \$norm_one = \$matrix->norm_one();" if (@_ != 1);{sub norm_one # maximum of sums of each column} return( $matrix->[1], $matrix->[2] ); my($matrix) = @_; croak "Usage: (\$rows,\$columns) = \$matrix->dim();" if (@_ != 1);{sub dim # returns dimensions of a matrix} return( $self->[0][--$row][--$col] ); croak "Math::MatrixReal::element(): column index out of range" if (($col < 1) || ($col > $cols)); croak "Math::MatrixReal::element(): row index out of range" if (($row < 1) || ($row > $rows)); my($rows,$cols) = ($self->[1],$self->[2]); my($self,$row,$col) = @_; croak "Usage: \$value = \$matrix->element(\$row,\$column);" if (@_ != 3);{sub element} $self->[0][--$row][--$col] = $value; $self->_undo_LR(); croak "Math::MatrixReal::assign(): column index out of range" if (($col < 1) || ($col > $cols)); croak "Math::MatrixReal::assign(): row index out of range" if (($row < 1) || ($row > $rows)); my($rows,$cols) = ($self->[1],$self->[2]); my($self,$row,$col,$value) = @_; croak "Usage: \$matrix->assign(\$row,\$column,\$value);" if (@_ != 4);{sub assign} return $self; map { $self->[0][$_][$_] = 1.0 } (0 .. $rows-1); $self->zero(); # We rely on zero() efficiency my ($rows,$cols) = ($self->[1],$self->[2]); my ($self) = @_; croak "Usage: \$matrix->one();" if (@_ != 1);{sub one} return $self; map { @{$self->[0][$_]} = @{$self->[0][0]} } (0 .. $rows-1); # copy that to the other rows map { $self->[0][0][$_] = 0.0 } (0 .. $cols-1); # zero out first row $self->_undo_LR(); my ($rows,$cols) = ($self->[1],$self->[2]); my ($self) = @_; croak "Usage: \$matrix->zero();" if (@_ != 1);{sub zero# brrr} undef $self->[5]; undef $self->[4]; undef $self->[3]; my($self) = @_; if (@_ != 1); croak "Usage: \$matrix->_undo_LR();"ad yvPJ865*(TS g ]    b B  l k B  u k e K I   \ 4 3 {zQ$`VP643jhgWVD  mc-rd)yk,   } } } } $matrix1->[0][$i][$j] = $matrix2->[0][$j][$i]; { for (my $j = 0; $j < $cols1; $j++) { for (my $i = 0; $i < $rows1; $i++) } else { # ($rows1 != $cols1) } $matrix1->[0][$i][$i] = $matrix2->[0][$i][$i]; } $matrix1->[0][$j][$i] = $swap; $matrix1->[0][$i][$j] = $matrix2->[0][$j][$i]; my $swap = $matrix2->[0][$i][$j]; { for (my $j = ($i + 1); $j < $cols1; $j++) { for (my $i = 0; $i < $rows1; $i++) # more complicated to make in-place possible! { if ($rows1 == $cols1) $matrix1->_undo_LR(); unless (($rows1 == $cols2) && ($cols1 == $rows2)); croak "Math::MatrixReal::transpose(): matrix size mismatch" my($rows2,$cols2) = ($matrix2->[1],$matrix2->[2]); my($rows1,$cols1) = ($matrix1->[1],$matrix1->[2]); my($matrix1,$matrix2) = @_; croak "Usage: \$matrix1->transpose(\$matrix2);" if (@_ != 2);sub transpose {} return $matrix->decompose_LR->invert_LR; my ($matrix) = @_; croak "Usage: \$inverse = \$matrix->inverse();" unless (@_ == 1);sub inverse {## Make computing the inverse more user friendly} return ($new_matrix); } } $new_matrix->[0][$i][$j] = &{ $function }($matrix->[0][$i][$j],$i+1,$j+1) ; # $i,$j are 1-based as of 1.7 no strict 'refs'; next unless ($i == $j); for (my $j = 0; $j < $cols; $j++ ) { for (my $i = 0; $i < $rows; $i++ ) { $new_matrix->_undo_LR(); croak "Matrix is not quadratic" unless ($rows == $cols); croak "Math::MatrixReal::each(): argument is not a sub reference" unless ref($function); my($new_matrix) = $matrix->clone(); my($rows,$cols) = ($matrix->[1],$matrix->[2]); my($matrix,$function) = @_; croak "Usage: \$new_matrix = \$matrix->each_diag( \&sub );" unless (@_ == 2 );sub each_diag { ## each_diag(): same as each() but only diag elements} return ($new_matrix); } } $new_matrix->[0][$i][$j] = &{ $function }($matrix->[0][$i][$j],$i+1,$j+1) ; # $i,$j are 1-based as of 1.7 no strict 'refs'; for (my $j = 0; $j < $cols; $j++ ) { for (my $i = 0; $i < $rows; $i++ ) { $new_matrix->_undo_LR(); croak "Math::MatrixReal::each(): argument is not a sub reference" unless ref($function); my($new_matrix) = $matrix->clone(); my($rows,$cols) = ($matrix->[1],$matrix->[2]); my($matrix,$function) = @_; croak "Usage: \$new_matrix = \$matrix->each( \&sub );" unless (@_ == 2 );sub each {## of said ## each(): evaluate a coderef on each element and return a new matrix} } } $matrix1->[0][$i][$j] = -($matrix2->[0][$i][$j]); { for (my $j = 0; $j < $cols1; $j++ ) { for (my $i = 0; $i < $rows1; $i++ ) $matrix1->_undo_LR(); unless (($rows1 == $rows2) && ($cols1 == $cols2)); croak "Math::MatrixReal::negate(): matrix size mismatch" my($rows2,$cols2) = ($matrix2->[1],$matrix2->[2]); my($rows1,$cols1) = ($matrix1->[1],$matrix1->[2]); my($matrix1,$matrix2) = @_; if (@_ != 2); croak "Usage: \$matrix1->negate(\$matrix2);"{sub negate} return($max); } $max = $sum if ($sum > $max); } $sum += abs( $self->[0][$i][$j] ); { for (my $j = 0; $j < $cols; $j++) my $sum = 0.0; {adyOl32 ^ T N L K > < Y " ! o n T S * $ s q .   <   _YWVIG^]{qV&usr\ wv9mCo< for( 2 .. abs($argument) ){ return($inverse) if ($argument == -1); if( $inverse ){ $temp = $inverse->clone(); } return undef; carp "Matrix has no inverse"; unless (defined $inverse){ my $inverse = $LR->invert_LR(); my $LR = $matrix->decompose_LR(); if( $argument < 0 ){ # negative exponent is (A^-1)^n $temp->_undo_LR(); return($matrix) if ($argument == 1); croak "Exponent must be integer" unless ($argument =~ m/^[+-]?\d+$/ ); croak "Matrix is not quadratic" unless ($rows == $cols); my($temp) = $matrix->clone(); my($name) = "'**'"; my($rows,$cols) = ($matrix->[1],$matrix->[2]); my($matrix,$argument) = @_; croak "Usage: \$matrix_exp = \$matrix1->exponent(\$integer);" if(@_ != 2 );sub exponent { } return($temp); } } $temp->[0][$i][$j] = $sum; } $sum += ( $matrix1->[0][$i][$k] * $matrix2->[0][$k][$j] ); { for (my $k = 0; $k < $cols1; $k++ ) my $sum = 0.0; { for (my $j = 0; $j < $cols2; $j++ ) { for (my $i = 0; $i < $rows1; $i++ ) my $temp = $matrix1->new($rows1,$cols2); croak "Math::MatrixReal::multiply(): matrix size mismatch" unless ($cols1 == $rows2); my($rows2,$cols2) = ($matrix2->[1],$matrix2->[2]); my($rows1,$cols1) = ($matrix1->[1],$matrix1->[2]); my($matrix1,$matrix2) = @_; if (@_ != 2); croak "Usage: \$product_matrix = \$matrix1->multiply(\$matrix2);"{sub multiply} } map { $matrix1->[0][$i][$_] = $matrix2->[0][$i][$_] * $scalar } (0 .. $cols1-1); { for ( my $i = 0; $i < $rows1; $i++ ) $matrix1->_undo_LR(); unless (($rows1 == $rows2) && ($cols1 == $cols2)); croak "Math::MatrixReal::multiply_scalar(): matrix size mismatch" my($rows2,$cols2) = ($matrix2->[1],$matrix2->[2]); my($rows1,$cols1) = ($matrix1->[1],$matrix1->[2]); my($matrix1,$matrix2,$scalar) = @_; if (@_ != 3); croak "Usage: \$matrix1->multiply_scalar(\$matrix2,\$scalar);"{sub multiply_scalar} } } $matrix1->[0][$i][$j] = $matrix2->[0][$i][$j] - $matrix3->[0][$i][$j]; { for ( my $j = 0; $j < $cols1; $j++ ) { for ( my $i = 0; $i < $rows1; $i++ ) $matrix1->_undo_LR(); ($cols1 == $cols2) && ($cols1 == $cols3)); unless (($rows1 == $rows2) && ($rows1 == $rows3) && croak "Math::MatrixReal::subtract(): matrix size mismatch" my($rows3,$cols3) = ($matrix3->[1],$matrix3->[2]); my($rows2,$cols2) = ($matrix2->[1],$matrix2->[2]); my($rows1,$cols1) = ($matrix1->[1],$matrix1->[2]); my($matrix1,$matrix2,$matrix3) = @_; croak "Usage: \$matrix1->subtract(\$matrix2,\$matrix3);" if (@_ != 3);{sub subtract} } } $matrix1->[0][$i][$j] = $matrix2->[0][$i][$j] + $matrix3->[0][$i][$j]; { for ( my $j = 0; $j < $cols1; $j++ ) { for ( my $i = 0; $i < $rows1; $i++ ) $matrix1->_undo_LR(); ($cols1 == $cols2) && ($cols1 == $cols3)); unless (($rows1 == $rows2) && ($rows1 == $rows3) && croak "Math::MatrixReal::add(): matrix size mismatch" my($rows3,$cols3) = ($matrix3->[1],$matrix3->[2]); my($rows2,$cols2) = ($matrix2->[1],$matrix2->[2]); my($rows1,$cols1) = ($matrix1->[1],$matrix1->[2]); my($matrix1,$matrix2,$matrix3) = @_; croak "Usage: \$matrix1->add(\$matrix2,\$matrix3);" if (@_ != 3);{sub addad}IoWQP g : 0        g % $ m k j b ` K / . ? =  w u # " ~T:#~xOE J<2,N+H&%gfE$#~K if ($val > $max) { $max = $val; } $val = abs($norm_matrix->[0][$i][$j]); { for ( $j = 0; $j < $n; $j++ ) $max = abs($norm_vector->[0][$i][0]); { for ( $i = 0; $i < $n; $i++ ) $norm_matrix->_undo_LR(); $norm_vector->copy($vector); $norm_matrix->copy($matrix); $norm_vector = $vector->new($n,1); $norm_matrix = $matrix->new($n,$n); unless ($vector->[1] == $n); croak "Math::MatrixReal::normalize(): matrix and vector size mismatch" unless ($vector->[2] == 1); croak "Math::MatrixReal::normalize(): vector is not a column vector" $n = $rows; unless ($rows == $cols); croak "Math::MatrixReal::normalize(): matrix is not quadratic" my($i,$j,$n); my($max,$val); my($norm_matrix,$norm_vector); my($rows,$cols) = ($matrix->[1],$matrix->[2]); my($matrix,$vector) = @_; if (@_ != 2); croak "Usage: (\$norm_matrix,\$norm_vector) = \$matrix->normalize(\$vector);"{sub normalize} return($temp); } } } $temp->[0][$k][$j] ) ); ( $temp->[0][$i][$k] + $temp->[0][$i][$j] = min( $temp->[0][$i][$j] , { for ( my $j = 0; $j < $n; $j++ ) { for ( my $i = 0; $i < $n; $i++ ) { for ( my $k = 0; $k < $n; $k++ ) } $temp->[0][$i][$i] = min( $temp->[0][$i][$i] , 0 ); { for ( my $i = 0; $i < $n; $i++ ) my $n = $rows; $temp->_undo_LR(); $temp->copy($matrix); my $temp = $matrix->new($rows,$cols); croak "Math::MatrixReal::kleene(): matrix is not quadratic" unless ($rows == $cols); my($rows,$cols) = ($matrix->[1],$matrix->[2]); my($matrix) = @_; croak "Usage: \$minimal_cost_matrix = \$cost_matrix->kleene();" if (@_ != 1);{sub kleene} $_[0] > $_[1] ? $_[0] : $_[1]; } return $max; $matrix->each( sub { my ($e,$i,$j) = @_; $max = $e if $e > $max; } ); my $max = $matrix->element(1,1); croak "Math::MatrixReal::max(\$matrix) \$matrix is not a Math::MatrixReal matrix" unless ref $matrix eq 'Math::MatrixReal'; croak "Usage: \$maximum = Math::MatrixReal::max(\$number1,\$number2) or $matrix->max" if (@_ > 2); my $matrix = shift; if ( @_ == 1 ) {{sub max} $_[0] < $_[1] ? $_[0] : $_[1]; } return $min; $matrix->each( sub { my ($e,$i,$j) = @_; $min = $e if $e < $min; } ); my $min = $matrix->element(1,1); croak "invalid" unless ref $matrix eq 'Math::MatrixReal'; croak "Usage: \$minimum = Math::MatrixReal::min(\$number1,\$number2) or $matrix->min" if (@_ > 2); my $matrix = shift; if ( @_ == 1 ) {{sub min} } return ($temp); } $temp = multiply($matrix,$temp); for( 2 .. $argument ){ } else { return ($temp); $temp = $temp->each_diag( sub { (shift)**$argument } ); if( $matrix->is_diagonal() ){ # if it is diagonal, just raise diagonal entries to power } return ($temp); $temp->one(); } elsif( $argument == 0 ){ # matrix to zero power is identity matrix } return undef; carp "Cannot compute negative exponent, inverse does not exist"; # TODO: is this the right behaviour? } else { return($temp); } $temp = multiply($inverse,$temp);ad 4~}o<.${H+ g f ? %  t 9 3   W E #  r > 4  c U   k]Sh>0|rE;ZY$VH>8 dPO,~}43 croak "Math::MatrixReal::solve_LR(): not an LR decomposition matrix" my($i,$j,$k,$n); my($y_vector,$sum); my($perm_row,$perm_col); my($dimension,$x_vector,$base_matrix); my($rows,$cols) = ($LR_matrix->[1],$LR_matrix->[2]); my($LR_matrix,$b_vector) = @_; if (@_ != 2); croak "Usage: (\$dimension,\$x_vector,\$base_matrix) = \$LR_matrix->solve_LR(\$b_vector);"{sub solve_LR} return($temp); $temp->[5] = $perm_col; $temp->[4] = $perm_row; $temp->[3] = $sign; } } } $temp->[0][$i][$k] = $swap; # store matrix L in same matrix as R: } $temp->[0][$i][$j] -= $temp->[0][$k][$j] * $swap; { for ( $j = ($k + 1); $j < $n; $j++ ) # calculate a row of matrix R: { if ($swap != 0) $swap = $temp->[0][$i][$k] / $temp->[0][$k][$k]; # scan the remaining rows, add multiples of row $k to row $i: { for ( $i = ($k + 1); $i < $n; $i++ ) } } $temp->[0][$i][$col] = $swap; $temp->[0][$i][$k] = $temp->[0][$i][$col]; $swap = $temp->[0][$i][$k]; { for ( $i = 0; $i < $n; $i++ ) $perm_col->[$col] = $swap; $perm_col->[$k] = $perm_col->[$col]; $swap = $perm_col->[$k]; $sign = -$sign; { if ($k != $col) # swap column $k and column $col: } } $temp->[0][$row][$j] = $swap; $temp->[0][$k][$j] = $temp->[0][$row][$j]; $swap = $temp->[0][$k][$j]; # (must run from 0 since L has to be swapped too!) { for ( $j = 0; $j < $n; $j++ ) $perm_row->[$row] = $swap; $perm_row->[$k] = $perm_row->[$row]; $swap = $perm_row->[$k]; $sign = -$sign; { if ($k != $row) # swap row $k and row $row: last NONZERO if ($max == 0); # (all remaining elements are zero) } } } $col = $j; $row = $i; $max = $swap; { if (($swap = abs($temp->[0][$i][$j])) > $max) { for ( $j = $k; $j < $n; $j++ ) { for ( $i = $k; $i < $n; $i++ ) $max = 0; # complete pivot-search: { for ( $k = 0; $k < $n; $k++ ) # use Gauss's algorithm: NONZERO: } $perm_col->[$i] = $i; $perm_row->[$i] = $i; { for ( $i = 0; $i < $n; $i++ ) $perm_col = [ ]; $perm_row = [ ]; $n = $rows; $temp->copy($matrix); $temp = $matrix->new($rows,$cols); unless ($rows == $cols); croak "Math::MatrixReal::decompose_LR(): matrix is not quadratic" my($temp); my($swap); my($sign) = 1; my($i,$j,$k,$n); my($row,$col,$max); my($perm_row,$perm_col); my($rows,$cols) = ($matrix->[1],$matrix->[2]); my($matrix) = @_; if (@_ != 1); croak "Usage: \$LR_matrix = \$matrix->decompose_LR();"{sub decompose_LR} return($norm_matrix,$norm_vector); } } } $norm_matrix->[0][$i][$j] /= $max; { for ( $j = 0; $j < $n; $j++ ) $norm_vector->[0][$i][0] /= $max; { if ($max != 0) }advhDCe: U / % U O %  } _ %   k 1 # x n M < ygIzd%yw7#" Sf@6fX*J<2 } else { return($inv_matrix); } } die "Math::MatrixReal::invert_LR(): unexpected error - please inform author!\n"; } else { } $inv_matrix->[0][$i][$j] = $x_vector->[0][$i][0]; { for ( $i = 0; $i < $n; $i++ ) { if (($rows,$x_vector,$cols) = $matrix->solve_LR($y_vector)) $y_vector->[0][$j][0] = 1; } $y_vector->[0][$j-1][0] = 0; { if ($j > 0) { for ( $j = 0; $j < $n; $j++ ) $y_vector = $matrix->new($n,1); $inv_matrix = $matrix->new($n,$n); { if ($matrix->[0][$n-1][$n-1] != 0) #print Dumper [ $matrix ]; $n = $rows; unless ((defined $matrix->[3]) && ($rows == $cols)); croak "Math::MatrixReal::invert_LR(): not an LR decomposition matrix" my($i,$j,$n); my($inv_matrix,$x_vector,$y_vector); my($rows,$cols) = ($matrix->[1],$matrix->[2]); my($matrix) = @_; if (@_ != 1); croak "Usage: \$inverse_matrix = \$LR_matrix->invert_LR();"{sub invert_LR} return( $dimension, $x_vector, $base_matrix ); } } } } $sum / $LR_matrix->[0][$i][$i]; $base_matrix->[0][($perm_col->[$i])][$k] = } $base_matrix->[0][($perm_col->[$j])][$k]; $sum -= $LR_matrix->[0][$i][$j] * { for ( $j = ($i + 1); $j < $n; $j++ ) $sum = 0; { for ( $i = ($n-$dimension-1); $i >= 0; $i-- ) $base_matrix->[0][($perm_col->[($n-$k-1)])][$k] = 1; { for ( $k = 0; $k < $dimension; $k++ ) } else { $base_matrix->one(); { if ($dimension == $n) { if ($dimension) } } $sum / $LR_matrix->[0][$i][$i]; $x_vector->[0][($perm_col->[$i])][0] = } $x_vector->[0][($perm_col->[$j])][0]; $sum -= $LR_matrix->[0][$i][$j] * { for ( $j = ($i + 1); $j < $n; $j++ ) $sum = $y_vector->[0][$i][0]; } else { } $x_vector->[0][($perm_col->[$i])][0] = 0; $dimension++; { else } return(); # a solution does not exist! { if ($y_vector->[0][$i][0] != 0) { if ($LR_matrix->[0][$i][$i] == 0) { for ( $i = ($n - 1); $i >= 0; $i-- ) # calculate $x_vector: $dimension = 0; } $y_vector->[0][$i][0] = $sum; } $sum -= $LR_matrix->[0][$i][$j] * $y_vector->[0][$j][0]; { for ( $j = 0; $j < $i; $j++ ) $sum = $b_vector->[0][($perm_row->[$i])][0]; { for ( $i = 0; $i < $n; $i++ ) # calculate $y_vector: # calculate "x" so that LRx = b ==> calculate Ly = b, Rx = y: $base_matrix = $LR_matrix->new($n,$n); $y_vector = $b_vector->new($n,1); $x_vector = $b_vector->new($n,1); $perm_col = $LR_matrix->[5]; $perm_row = $LR_matrix->[4]; unless ($b_vector->[1] == $n); croak "Math::MatrixReal::solve_LR(): matrix and vector size mismatch" unless ($b_vector->[2] == 1); croak "Math::MatrixReal::solve_LR(): vector is not a column vector" $n = $rows; unless ((defined $LR_matrix->[3]) && ($rows == $cols));adX98a*) y X W  S R H r Q L .  l _ / )    x E 4 3 rlF@.,+s_^Hu=7}ihHkj0 U my($rows2,$cols2) = ($vector2->[1],$vector2->[2]); my($rows1,$cols1) = ($vector1->[1],$vector1->[2]); my($vector1,$vector2) = @_; croak "Usage: \$vector_product = \$vector1->vector_product(\$vector2);" if (@_ != 2);{sub vector_product} return $sum; map { $sum += $vector1->[0][$_][0] * $vector2->[0][$_][0] } ( 0 .. $rows1-1); my $sum = 0; unless ($rows1 == $rows2); croak "Math::MatrixReal::scalar_product(): vector size mismatch" unless ($cols2 == 1); croak "Math::MatrixReal::scalar_product(): 2nd vector is not a column vector" unless ($cols1 == 1); croak "Math::MatrixReal::scalar_product(): 1st vector is not a column vector" my($rows2,$cols2) = ($vector2->[1],$vector2->[2]); my($rows1,$cols1) = ($vector1->[1],$vector1->[2]); my($vector1,$vector2) = @_; if (@_ != 2); croak "Usage: \$scalar_product = \$vector1->scalar_product(\$vector2);"{sub scalar_product} return(++$order); } last ZERO if ($matrix->[0][$order][$order] != 0); { for ( $order = ($rows - 1); $order >= 0; $order-- ) ZERO: unless ((defined $matrix->[3]) && ($rows == $cols)); croak "Math::MatrixReal::order_LR(): not an LR decomposition matrix" my($order); my($rows,$cols) = ($matrix->[1],$matrix->[2]); my($matrix) = @_; if (@_ != 1); croak "Usage: \$order = \$LR_matrix->order_LR();"{sub order_LR # order of LR decomposition matrix (number of non-zero equations)} return (shift)->order_LR;sub rank_LR {} return($det); } $det *= $matrix->[0][$k][$k]; { for ( $k = 0; $k < $rows; $k++ ) $det = $matrix->[3]; unless ((defined $matrix->[3]) && ($rows == $cols)); croak "Math::MatrixReal::det_LR(): not an LR decomposition matrix" my($k,$det); my($rows,$cols) = ($matrix->[1],$matrix->[2]); my($matrix) = @_; if (@_ != 1); croak "Usage: \$determinant = \$LR_matrix->det_LR();"{sub det_LR # determinant of LR decomposition matrix} return $det; } return $matrix->decompose_LR->det_LR(); } else { $matrix->each_diag( sub { $det*=shift; } ); } elsif ( $matrix->is_lower_triangular() ){ $matrix->each_diag( sub { $det*=shift; } ); if( $matrix->is_upper_triangular() ){ # diagonal will match too unless ($rows == $cols); croak "Math::MatrixReal::det(): Matrix is not quadratic" my $det = 1; my ($rows,$cols) = $matrix->dim(); my ($matrix) = @_; croak "Usage: \$determinant = \$matrix->det_LR();" unless (@_ == 1);sub det {## very fast if matrix is diagonal or triangular## easy to use determinant} return( $matrix1->norm_one() * $matrix2->norm_one() ); unless (($rows1 == $rows2) && ($cols1 == $cols2)); croak "Math::MatrixReal::condition(): matrix size mismatch" unless ($rows2 == $cols2); croak "Math::MatrixReal::condition(): 2nd matrix is not quadratic" unless ($rows1 == $cols1); croak "Math::MatrixReal::condition(): 1st matrix is not quadratic" my($rows2,$cols2) = ($matrix2->[1],$matrix2->[2]); my($rows1,$cols1) = ($matrix1->[1],$matrix1->[2]); my($matrix1,$matrix2) = @_; croak "Usage: \$condition = \$matrix->condition(\$inverse_matrix);" if (@_ != 2); # make this work when given no args # for a meaningful result! # 1st matrix MUST be the inverse of 2nd matrix (or vice-versa){sub condition} } return; warn __PACKAGE__ . qq{: matrix not invertible\n};ad:J}vu#?'& = v c a ` U S   d ; :    w u t ` ^  H ) (  xf@6 vh5'dN$s>,~pSIC#qp<q]KJI my($i,$j,$n); my($xn_vector); my($norm,$sum,$diff); my($rows3,$cols3) = ( $b_vector->[1], $b_vector->[2]); my($rows2,$cols2) = ($x0_vector->[1],$x0_vector->[2]); my($rows1,$cols1) = ( $matrix->[1], $matrix->[2]); my($matrix,$x0_vector,$b_vector,$epsilon) = @_; if (@_ != 4); croak "Usage: \$xn_vector = \$matrix->solve_GSM(\$x0_vector,\$b_vector,\$epsilon);"{sub solve_GSM # Global Step Method} else { return(0); } if ($ok) { return($norm); } } } $ok = ($max < 1) } if ($sum > $max) { $max = $sum; } $sum /= abs($matrix->[0][$i][$i]); } $sum += abs($matrix->[0][$i][$j]); { for ( $j = ($i + 1); $j < $n; $j++ ) } $sum += abs($matrix->[0][$i][$j]); { for ( $j = 0; $j < $i; $j++ ) $sum = 0; { for ( $i = 0; $i < $n; $i++ ) $max = 0; $norm = -1; # norm_max { unless ($ok) $ok = ($max < 1); } if ($sum > $max) { $max = $sum; } $sum /= abs($matrix->[0][$j][$j]); } $sum += abs($matrix->[0][$i][$j]); { for ( $i = ($j + 1); $i < $n; $i++ ) } $sum += abs($matrix->[0][$i][$j]); { for ( $i = 0; $i < $j; $i++ ) $sum = 0; { for ( $j = 0; $j < $n; $j++ ) $max = 0; $norm = 1; # norm_one { if ($ok) } if ($matrix->[0][$i][$i] == 0) { $ok = 0; } { for ( $i = 0; $i < $n; $i++ ) $n = $rows; $ok = 1; unless ($rows == $cols); croak "Math::MatrixReal::_init_iteration(): matrix is not quadratic" my($i,$j,$n); my($ok,$max,$sum,$norm); my($rows,$cols) = ($matrix->[1],$matrix->[2]); my($matrix) = @_; if (@_ != 1); croak "Usage: \$which_norm = \$matrix->_init_iteration();"{sub _init_iteration} return sqrt $sum; } $sum += $comp * $comp; $comp = $vector->[0][$k][0]; { for ( $k = 0; $k < $rows; $k++ ) $sum = 0; $vector = ~$vector if ($rows == 1 ); unless ($cols == 1 || $rows ==1 ); croak "Math::MatrixReal::length(): vector is not a row or column vector" my($k,$comp,$sum); my($rows,$cols) = ($vector->[1],$vector->[2]); my($vector) = @_; croak "Usage: \$length = \$vector->length();" if (@_ != 1);{sub length} return($temp); $vector1->[0][1][0] * $vector2->[0][0][0]; $temp->[0][2][0] = $vector1->[0][0][0] * $vector2->[0][1][0] - $vector1->[0][0][0] * $vector2->[0][2][0]; $temp->[0][1][0] = $vector1->[0][2][0] * $vector2->[0][0][0] - $vector1->[0][2][0] * $vector2->[0][1][0]; $temp->[0][0][0] = $vector1->[0][1][0] * $vector2->[0][2][0] - $temp = $vector1->new($n,1); unless ($n == 3); croak "Math::MatrixReal::vector_product(): only defined for 3 dimensions" $n = $rows1; unless ($rows1 == $rows2); croak "Math::MatrixReal::vector_product(): vector size mismatch" unless ($cols2 == 1); croak "Math::MatrixReal::vector_product(): 2nd vector is not a column vector" unless ($cols1 == 1); croak "Math::MatrixReal::vector_product(): 1st vector is not a column vector" my($n); my($temp);adp< j98 p f <   ~ p )  _ $ g e N  nm\[<  jLF m_. Jg]W?=<f+ my($rows2,$cols2) = ($x0_vector->[1],$x0_vector->[2]); my($rows1,$cols1) = ( $matrix->[1], $matrix->[2]); my($matrix,$x0_vector,$b_vector,$weight,$epsilon) = @_; if (@_ != 5); croak "Usage: \$xn_vector = \$matrix->solve_RM(\$x0_vector,\$b_vector,\$weight,\$epsilon);"{sub solve_RM # Relaxation Method} return($xn_vector); } } $x0_vector->[0][$i][0] = $xn_vector->[0][$i][0]; { for ( $i = 0; $i < $n; $i++ ) else { $diff = $x0_vector->norm_max(); } if ($norm > 0) { $diff = $x0_vector->norm_one(); } $x0_vector->subtract($x0_vector,$xn_vector); } $xn_vector->[0][$i][0] = $sum / $matrix->[0][$i][$i]; } $sum -= $matrix->[0][$i][$j] * $xn_vector->[0][$j][0]; { for ( $j = ($i + 1); $j < $n; $j++ ) } $sum -= $matrix->[0][$i][$j] * $xn_vector->[0][$j][0]; { for ( $j = 0; $j < $i; $j++ ) $sum = $b_vector->[0][$i][0]; { for ( $i = 0; $i < $n; $i++ ) { while ($diff >= $epsilon) $diff = $epsilon + 1; $xn_vector->copy($x0_vector); $xn_vector = $x0_vector->new($n,1); return() unless ($norm = $matrix->_init_iteration()); unless (($rows2 == $n) && ($rows3 == $n)); croak "Math::MatrixReal::solve_SSM(): matrix and vector size mismatch" unless ($cols3 == 1); croak "Math::MatrixReal::solve_SSM(): 2nd vector is not a column vector" unless ($cols2 == 1); croak "Math::MatrixReal::solve_SSM(): 1st vector is not a column vector" $n = $rows1; unless ($rows1 == $cols1); croak "Math::MatrixReal::solve_SSM(): matrix is not quadratic" my($i,$j,$n); my($xn_vector); my($norm,$sum,$diff); my($rows3,$cols3) = ( $b_vector->[1], $b_vector->[2]); my($rows2,$cols2) = ($x0_vector->[1],$x0_vector->[2]); my($rows1,$cols1) = ( $matrix->[1], $matrix->[2]); my($matrix,$x0_vector,$b_vector,$epsilon) = @_; if (@_ != 4); croak "Usage: \$xn_vector = \$matrix->solve_SSM(\$x0_vector,\$b_vector,\$epsilon);"{sub solve_SSM # Single Step Method} return($xn_vector); } } $x0_vector->[0][$i][0] = $xn_vector->[0][$i][0]; { for ( $i = 0; $i < $n; $i++ ) else { $diff = $x0_vector->norm_max(); } if ($norm > 0) { $diff = $x0_vector->norm_one(); } $x0_vector->subtract($x0_vector,$xn_vector); } $xn_vector->[0][$i][0] = $sum / $matrix->[0][$i][$i]; } $sum -= $matrix->[0][$i][$j] * $x0_vector->[0][$j][0]; { for ( $j = ($i + 1); $j < $n; $j++ ) } $sum -= $matrix->[0][$i][$j] * $x0_vector->[0][$j][0]; { for ( $j = 0; $j < $i; $j++ ) $sum = $b_vector->[0][$i][0]; { for ( $i = 0; $i < $n; $i++ ) { while ($diff >= $epsilon) $diff = $epsilon + 1; $xn_vector = $x0_vector->new($n,1); return() unless ($norm = $matrix->_init_iteration()); unless (($rows2 == $n) && ($rows3 == $n)); croak "Math::MatrixReal::solve_GSM(): matrix and vector size mismatch" unless ($cols3 == 1); croak "Math::MatrixReal::solve_GSM(): 2nd vector is not a column vector" unless ($cols2 == 1); croak "Math::MatrixReal::solve_GSM(): 1st vector is not a column vector" $n = $rows1; unless ($rows1 == $cols1); croak "Math::MatrixReal::solve_GSM(): matrix is not quadratic"aduB! Y=< ] ; :  x j #  2 k 0 a R "   }Oke=7 Z3z@'rF8|nM/X> { for (my $k = 0; $k <= $j; $k++) $p[$j] = $t4; my $t4 = $p[$j] - $hh * $t3; my $t3 = $Q->[0][$i][$j]; { for (my $j = 0; $j < $i; $j++) my $hh = $f / ($h + $h); } $f += $p[$j] * $Q->[0][$i][$j]; $p[$j] = $g / $h; # Form elements of P } $g += $Q->[0][$k][$j] * $Q->[0][$i][$k]; { for (my $k = $j+1; $k < $i; $k++) } $g += $Q->[0][$j][$k] * $Q->[0][$i][$k]; { for (my $k = 0; $k <= $j; $k++) my $g = 0.0; $Q->[0][$j][$i] = $Q->[0][$i][$j] / $h; { for (my $j = 0; $j < $i; $j++) my $f = 0.0; $Q->[0][$i][$i-1] -= $t2; $h -= $t1 * $t2; $e->[$i-1] = $scale * $t2; # Update off-diagonals my $t2 = (($t1 >= 0.0) ? -sqrt($h) : sqrt($h)); my $t1 = $Q->[0][$i][$i-1]; } $h += $Q->[0][$i][$k] * $Q->[0][$i][$k]; # Form sigma in h $Q->[0][$i][$k] /= $scale; { # Used scaled Q for transformation for (my $k = 0; $k < $i; $k++) my $h = 0.0; { else } $e->[$i-1] = $Q->[0][$i][$i-1]; { # skip the transformation if ($scale == 0.0) } $scale += abs($Q->[0][$i][$k]); { for (my $k = 0; $k < $i; $k++) # Computes norm of one column (below diagonal) my $scale = 0.0; { for (my $i = ($rows-1); $i > 1; $i--) my @p = (); my $e = []; # N-1 Off-Diagonal elements 0...n-2 my $d = []; # N Diagonal elements 0...n-1 # Set up tridiagonal needed elements # Creates tridiagonal my ($rows, $cols) = ($Q->[1], $Q->[2]); my ($Q) = @_;{sub _householder_vectors ($)# Adapted from: Numerical Recipes, 2nd edition.# are wanted).# Core householder reduction routine (when eigenvector} return($xn_vector); } } $x0_vector->[0][$i][0] = $xn_vector->[0][$i][0]; { for ( $i = 0; $i < $n; $i++ ) else { $diff = $x0_vector->norm_max(); } if ($norm > 0) { $diff = $x0_vector->norm_one(); } $x0_vector->subtract($x0_vector,$xn_vector); } + (1 - $weight) * $xn_vector->[0][$i][0]; $xn_vector->[0][$i][0] = $weight * ( $sum / $matrix->[0][$i][$i] ) } $sum -= $matrix->[0][$i][$j] * $xn_vector->[0][$j][0]; { for ( $j = ($i + 1); $j < $n; $j++ ) } $sum -= $matrix->[0][$i][$j] * $xn_vector->[0][$j][0]; { for ( $j = 0; $j < $i; $j++ ) $sum = $b_vector->[0][$i][0]; { for ( $i = 0; $i < $n; $i++ ) { while ($diff >= $epsilon) $diff = $epsilon + 1; $xn_vector->copy($x0_vector); $xn_vector = $x0_vector->new($n,1); return() unless ($norm = $matrix->_init_iteration()); unless (($rows2 == $n) && ($rows3 == $n)); croak "Math::MatrixReal::solve_RM(): matrix and vector size mismatch" unless ($cols3 == 1); croak "Math::MatrixReal::solve_RM(): 2nd vector is not a column vector" unless ($cols2 == 1); croak "Math::MatrixReal::solve_RM(): 1st vector is not a column vector" $n = $rows1; unless ($rows1 == $cols1); croak "Math::MatrixReal::solve_RM(): matrix is not quadratic" my($i,$j,$n); my($xn_vector); my($norm,$sum,$diff); my($rows3,$cols3) = ( $b_vector->[1], $b_vector->[2]);ad {hG# ~xQG. u < . $ y D : 4    | E * @  u O I 3 $   VH. }U+UG&`< C$g8hL>"  } return; } } while ($m != $l); } $e->[$m] = 0.0; $e->[$l] = $g; $d->[$l] -= $p; } } $EV->[0][$k][$i] = $c * $t2 - $s * $t1; $EV->[0][$k][$ii] = $s * $t2 + $c * $t1; my $t2 = $EV->[0][$k][$i]; my $t1 = $EV->[0][$k][$ii]; { for (my $k = 0; $k < $rows; $k++) $g = $c * $t2 - $b; $d->[$ii] = $g + $p; $p = $s * $t2; my $t2 = ($d->[$i] - $g) * $s + 2.0 * $c * $b; $g = $d->[$ii] - $p; $c = $g / $t; $s = $f / $t; my $b = $c * $e->[$i]; } next OUTER; $e->[$m] = 0.0; $d->[$ii] -= $p; { if ($t == 0.0) $e->[$ii] = $t; my $t = _pythag($f, $g); my $f = $s * $e->[$i]; my $ii = $i + 1; { for (my $i = ($m-1); $i >= $l; $i--) my ($p,$s,$c) = (0.0, 1.0,1.0); + $e->[$l] / ($g + (($g >= 0.0) ? abs($r) : -abs($r))); $g = $d->[$m] - $d->[$l] my $r = _pythag($g, 1.0); / (2.0 * $e->[$l]); my $g = ($d->[$l+1] - $d->[$l]) croak("Too many iterations!") if ($iter++ >= 30); ## why only allow 30 iterations? { if ($m != $l) } last if ((abs($e->[$m]) + $dd) == $dd); my $dd = abs($d->[$m]) + abs($d->[$m+1]); { for ($m = $l; $m < ($rows - 1); $m++) do { OUTER: my $m; my $iter = 0; { for (my $l = 0; $l < $rows; $l++) # Start real computation $e->[$rows-1] = 0.0; my ($rows, $cols) = ($EV->[1], $EV->[2]); my ($EV, $d, $e) = @_;{sub _tridiagonal_QLimplicit# of a tridiagonal matrix. Internal routine.# QL algorithm with implicit shifts to determine the eigenvalues} } return ($ab * sqrt(1.0 + $t*$t)); my $t = $aa / $ab; return 0.0 if ($ab == 0.0); } else { return ($aa * sqrt(1.0 + $t*$t)); my $t = $ab / $aa; # NB: Not needed!: return 0.0 if ($aa == 0.0); { if ($aa > $ab) my $ab = abs($b); my $aa = abs($a); my ($a, $b) = @_;{sub _pythag ($$)# Computes sqrt(a*a + b*b), but more carefully...} return ($d, $e); } } $Q->[0][$i][$j] = $Q->[0][$j][$i] = 0.0; { for (my $j = 0; $j < $i; $j++) $Q->[0][$i][$i] = 1.0; # Reset row and column of Q for next iteration $d->[$i] = $Q->[0][$i][$i]; } } $Q->[0][$k][$j] -= $g * $Q->[0][$k][$i]; { for (my $k = 0; $k < $i; $k++) } $g += $Q->[0][$i][$k] * $Q->[0][$k][$j]; { for (my $k = 0; $k < $i; $k++) my $g = 0.0; { for (my $j = 0; $j < $i; $j++) { for (my $i = 2; $i < $rows; $i++) $Q->[0][1][0] = $Q->[0][0][1] = 0.0; $Q->[0][1][1] = 1.0; $d->[1] = $Q->[0][1][1]; # i==1 $Q->[0][0][0] = 1.0; $d->[0] = $Q->[0][0][0]; # i==0 $e->[0] = $Q->[0][1][0]; # Updates for i == 0,1 } } } } + $t4 * $Q->[0][$i][$k]; $Q->[0][$j][$k] -= $t3 * $p[$k]ad rd83yMG. \ R E ; " y @ 2 v P 7 b P  v F 8  i9'cCtQOvgXK qc!v*c6 if ($t == 0.0) $e->[$ii] = $t; my $t = _pythag($f, $g); my $f = $s * $e->[$i]; my $ii = $i + 1; { for (my $i = ($m-1); $i >= $l; $i--) my ($p,$s,$c) = (0.0, 1.0,1.0); + $e->[$l] / ($g + (($g >= 0.0) ? abs($r) : -abs($r))); $g = $d->[$m] - $d->[$l] my $r = _pythag($g, 1.0); / (2.0 * $e->[$l]); my $g = ($d->[$l+1] - $d->[$l]) croak("Too many iterations!") if ($iter++ >= 30); { if ($m != $l) } last if ((abs($e->[$m]) + $dd) == $dd); my $dd = abs($d->[$m]) + abs($d->[$m+1]); { for ($m = $l; $m < ($rows - 1); $m++) do { OUTER: my $m; my $iter = 0; { for (my $l = 0; $l < $rows; $l++) # Start real computation $e->[$rows-1] = 0.0; my ($rows, $cols) = ($M->[1], $M->[2]); my ($M, $d, $e) = @_; # NB: M is not touched...{sub _tridiagonal_QLimplicit_values# eigenvalues ONLY. This is O(N^2) only...# QL algorithm with implicit shifts to determine the} return ($d, $e); } $d->[$i] = $Q->[0][$i][$i]; { for (my $i = 0; $i < $rows; $i++) # Updates diagonal elements $e->[0] = $Q->[0][1][0]; # Updates for i==1 } } } } + $g * $Q->[0][$i][$k]; $Q->[0][$j][$k] -= $t * $p[$k] { for (my $k = 0; $k <= $j; $k++) $p[$j] = $g; my $g = $p[$j] - $hh * $t; my $t = $Q->[0][$i][$j]; { for (my $j = 0; $j < $i; $j++) my $hh = $f / ($h + $h); } $f += $p[$j] * $Q->[0][$i][$j]; $p[$j] = $g / $h; # Form elements of P } $g += $Q->[0][$k][$j] * $Q->[0][$i][$k]; { for (my $k = $j+1; $k < $i; $k++) } $g += $Q->[0][$j][$k] * $Q->[0][$i][$k]; { for (my $k = 0; $k <= $j; $k++) my $g = 0.0; { for (my $j = 0; $j < $i; $j++) my $f = 0.0; $Q->[0][$i][$i-1] -= $t2; $h -= $t * $t2; $e->[$i-1] = $scale * $t2; # Updates off-diagonal my $t2 = (($t >= 0.0) ? -sqrt($h) : sqrt($h)); my $t = $Q->[0][$i][$i-1]; } $h += $Q->[0][$i][$k] * $Q->[0][$i][$k]; # Form sigma in h $Q->[0][$i][$k] /= $scale; { # Used scaled Q for transformation for (my $k = 0; $k < $i; $k++) my $h = 0.0; { else } $e->[$i-1] = $Q->[0][$i][$i-1]; { # skip the transformation if ($scale == 0.0) } $scale += abs($Q->[0][$i][$k]); { for (my $k = 0; $k < $i; $k++) my $scale = 0.0; { for (my $i = ($rows - 1); $i > 1; $i--) my @p = (); my $e = []; # N-1 Off-Diagonal elements 0...n-2 my $d = []; # N Diagonal elements 0...n-1 # Set up tridiagonal needed elements # Creates tridiagonal my ($rows, $cols) = ($Q->[1], $Q->[2]); my ($Q) = @_; # NB: Q is destroyed on output...{sub _householder_values ($)# are NOT wanted).# Core householder reduction routine (when eigenvectoradu_4a8 u o c a ` ) h g C # v u = ! o H B  G  qpDCl`Z?90*~xQKxED"ywv?{caO#r7 my $VEC = $M->clone(); # TODO: study if we should allow in-place modification # Copy initial matrix unless ($M->is_symmetric()); croak "Matrix is not symmetric" unless ($rows = $cols); croak "Matrix is not quadratic" my ($rows, $cols) = ($M->[1], $M->[2]); my ($M) = @_;{sub sym_diagonalize ($)# tridiagonal).# for that matrix (taking into account the transformation to# matrix and then obtaining the eigenvalues and eigenvectors# matrix M. Operates by transforming M into a tridiagonal# Main routine for diagonalization of a real symmetric} return ($v, $EV); } $v->[0][$i][0] = $diag->[$i]; { for (my $i = 0; $i < $rows; $i++) # Fills it my $v = Math::MatrixReal->new($rows,1); # Allocate eigenvalues vector $EV->_tridiagonal_QLimplicit($diag, $offdiag); # Calls the calculus routine } $offdiag->[$i-1] = $T->[0][$i][$i-1]; { for (my $i = 1; $i < $rows; $i++) my $offdiag = [ ]; # Allocate temporary vector for off-diagonal elements } $diag->[$i] = $T->[0][$i][$i]; { for (my $i = 0; $i < $rows; $i++) # Initializes it with T my $diag = [ ]; # Allocates diagonal vector } $EV->one(); $EV = $T->shadow(); { else } $EV = $Q->clone(); { if ($Q) # Obtain/Creates the todo eigenvectors matrix my $EV; unless ($T->is_tridiagonal()); # DONE croak "Matrix is not tridiagonal" unless ($rows = $cols); croak "Matrix is not quadratic" my ($rows, $cols) = ($T->[1], $T->[2]); my ($T,$Q) = @_; # Q may be 0 if the original matrix is really tridiagonal{sub tri_diagonalize ($;$)# previously reduced to tridiagonal form.# and eigenvectors of a real tridiagonal matrix - or of a matrix# QL algorithm with implicit shifts to determine the eigenvalues} return ($T, $Q); } $T->[0][$i][$i+1] = $offdiag->[$i]; $T->[0][$i+1][$i] = $offdiag->[$i]; { # Set off diagonals for (my $i = 0; $i < ($rows-1); $i++) } $T->[0][$i][$i] = $diag->[$i]; { # Set diagonal for (my $i = 0; $i < $rows; $i++) my $T = $A->shadow(); # Creates the tridiagonal matrix my ($diag, $offdiag) = $Q->_householder_vectors(); # transformation matrix # Do the computation of tridiagonal elements and of my $Q = $A->clone(); # Copy given matrix TODO: study if we should do in-place modification unless ($A->is_symmetric()); croak "Matrix is not symmetric" unless ($rows = $cols); croak "Matrix is not quadratic" my ($rows, $cols) = ($A->[1], $A->[2]); my ($A) = @_;{sub householder ($)# Q effecting the transformation between A and T.# Returns a tridiagonal matrix T and the orthogonal matrix# Householder reduction of a real, symmetric matrix A.} return; } } while ($m != $l); } $e->[$m] = 0.0; $e->[$l] = $g; $d->[$l] -= $p; } $g = $c * $t2 - $b; $d->[$ii] = $g + $p; $p = $s * $t2; my $t2 = ($d->[$i] - $g) * $s + 2.0 * $c * $b; $g = $d->[$ii] - $p; $c = $g / $t; $s = $f / $t; my $b = $c * $e->[$i]; } next OUTER; $e->[$m] = 0.0; $d->[$ii] -= $p; {ad&}r= }UO643 j i E %  q U 0 v a : 4 J  d D  xrKE _&%vpa_^1T$0m0 FE&% # Copy matrix in temporary croak "Matrix is not symmetric" unless ($M->is_symmetric); croak "Matrix is not quadratic" unless ($rows == $cols); my ($rows, $cols) = ($M->[1], $M->[2]); my ($M) = @_;{sub sym_eigenvalues ($)# tridiagonal).# for that matrix (taking into account the transformation to# matrix and then obtaining the eigenvalues and eigenvectors# matrix M. Operates by transforming M into a tridiagonal# Main routine for diagonalization of a real symmetric} return undef; carp "Math::MatrixReal::eigenvalues(): Matrix is not symmetric or triangular"; return sym_eigenvalues($matrix) if $matrix->is_symmetric(); } return $l; map { $l->[0][$_][0] = $matrix->[0][$_][$_] } (0 .. $rows-1); my $l = Math::MatrixReal->new($rows,1); if($matrix->is_upper_triangular() || $matrix->is_lower_triangular() ){ croak "Matrix is not quadratic" unless ($rows == $cols); my ($rows,$cols) = $matrix->dim(); my ($matrix) = @_;sub eigenvalues ($){## more general routine than sym_eigenvalues} return $v; } $v->[0][$i][0] = $diag->[$i]; { for (my $i = 0; $i < $rows; $i++) # Fills it my $v = Math::MatrixReal->new($rows,1); # Allocate eigenvalues vector $T->_tridiagonal_QLimplicit_values($diag, $offdiag); # Calls the calculus routine (T is not touched) } $offdiag->[$i-1] = $T->[0][$i][$i-1]; { for (my $i = 1; $i < $rows; $i++) my $offdiag = [ ]; # Allocate temporary vector for off-diagonal elements } $diag->[$i] = $T->[0][$i][$i]; { for (my $i = 0; $i < $rows; $i++) # Initializes it with T my $diag = [ ]; # Allocates diagonal vector unless ($T->is_tridiagonal() ); # DONE croak "Matrix is not tridiagonal" unless ($rows = $cols); croak "Matrix is not quadratic" my ($rows, $cols) = ($T->[1], $T->[2]); my ($T) = @_;{sub tri_eigenvalues ($;$)# matrix previously reduced to tridiagonal form.# the eigenvalues a real tridiagonal matrix - or of a# QL algorithm with implicit shifts to determine ONLY} return $T; } $T->[0][$i][$i+1] = $offdiag->[$i]; $T->[0][$i+1][$i] = $offdiag->[$i]; { # Set off diagonals for (my $i = 0; $i < ($rows-1); $i++) } $T->[0][$i][$i] = $diag->[$i]; { # Set diagonal for (my $i = 0; $i < $rows; $i++) $T->zero(); my $T = $Q; # Creates the tridiagonal matrix in Q (avoid allocation) my ($diag, $offdiag) = $Q->_householder_values(); # Q is destroyed after reduction # transformation matrix # Do the computation of tridiagonal elements and of my $Q = $A->clone(); # Copy given matrix unless ($A->is_symmetric()); croak "Matrix is not symmetric" unless ($rows = $cols); croak "Matrix is not quadratic" my ($rows, $cols) = ($A->[1], $A->[2]); my ($A) = @_;{sub householder_tridiagonal ($)# Returns a tridiagonal matrix T equivalent to A.# Householder reduction of a real, symmetric matrix A.} return ($val, $VEC); } $val->[0][$i][0] = $diag->[$i]; { for (my $i = 0; $i < $rows; $i++) # Fills it my $val = Math::MatrixReal->new($rows,1); # Allocate eigenvalues vector $VEC->_tridiagonal_QLimplicit($diag, $offdiag); # Calls the calculus routine for diagonalization my ($diag, $offdiag) = $VEC->_householder_vectors(); # transformation matrix # Do the computation of tridiagonal elements and ofad9Muf*) U f U S B # ;   U ( '   k T S ( '  x:)'qEywg=v6,&zH"!xX6S98sub is_upper_triangular {# i.e all nonzero elements are above main diagonal# Boolean check to see if matrix is upper triangular} return 1; } $j = 0; } return 0 if $M->[0][$i][$j]; next if ($i-1 == $j); next if ($i+1 == $j); next if ($i == $j); # skip diag and diag+-1 #print "debug: testing $i,$j = " . $M->[0][$i][$j] . "\n"; for(;$j < $cols; $j++ ){ for(;$i < $rows; $i++ ){ return 0 unless ($rows == $cols); # if it is not quadratic it cannot be tridiag my ($i,$j) = (0,0); my ($rows,$cols) = ($M->[1],$M->[2]); my ($M) = @_;sub is_tridiagonal ($) {# Boolean check to see if matrix is tridiagonal} return 1; } } return 0 unless ($M->[0][$i][$j] == $M->[0][$j][$i]); { for (my $j = 0; $j < $i; $j++) { for (my $i = 1; $i < $rows; $i++) # skip when $i=$j? return 0 unless ($rows == $cols); # if it is not quadratic it cannot be symmetric... my ($rows, $cols) = ($M->[1], $M->[2]); my ($M) = @_;{sub is_symmetric ($)# symmetric# Boolean check routine to see if a matrix is} return (shift)->is_periodic(1);sub is_idempotent($) {} abs($m**(int($k)+1) - $m) < 1e-12 ? return 1 : return 0; return 0 unless $m->is_quadratic(); my ($m,$k) = @_;sub is_periodic($$) {} return $neg; $m->each( sub { if( (shift) >= 0){ $neg = 0;return;} } ); my $neg = 1; my ($m) = @_;sub is_negative($) {} return $pos; $m->each( sub { if( (shift) <= 0){ $pos = 0;return;} } ); my $pos = 1; my ($m) = @_;sub is_positive($) {} abs(~$matrix * $matrix - $one) < 1e-12 ? return 1 : return 0; $one->one; my $one = $matrix->shadow(); return 0 unless $matrix->is_quadratic; my ($matrix) = @_;sub is_orthogonal($) {} $c == 1 ? 1 : 0; my $c = $m->[2]; my ($m) = @_;sub is_col_vector {} $r == 1 ? 1 : 0; my $r = $m->[1]; my ($m) = @_;sub is_row_vector {sub is_col { return (shift)->is_col_vector }sub is_row { return (shift)->is_row_vector }} return $pos; $ev->each(sub { my $x = shift; if ($x < 0){ $pos=0;return; } } ); my $pos = 1; my $ev = $matrix->eigenvalues; return 0 unless $matrix->is_symmetric; # must have nonnegative (i.e REAL) eigenvalues to be positive semidefinite croak "Math::MatrixReal::is_positive_semidefinite(): Matrix is not square" unless ($r == $c); my ($r,$c) = $matrix->dim; my ($matrix) = @_;sub is_positive_semidefinite {#TODO: docs+test} return $pos; $ev->each(sub { my $x = shift; if ($x <= 0){ $pos=0;return; } } ); my $pos = 1; my $ev = $matrix->eigenvalues; return 0 unless $matrix->is_symmetric; # must have positive (i.e REAL) eigenvalues to be positive definite croak "Math::MatrixReal::is_positive_definite(): Matrix is not square" unless ($r == $c); my ($r,$c) = $matrix->dim; my ($matrix) = @_;sub is_positive_definite {#TODO: docs+test} return $val; map { $val->[0][$_][0] = $diag->[$_] } ( 0 .. $rows-1); # Fills it my $val = Math::MatrixReal->new($rows,1); # Allocate eigenvalues vector $M->_tridiagonal_QLimplicit_values($diag, $offdiag); # (M is not touched) # Calls the calculus routine for diagonalization my ($diag, $offdiag) = $A->_householder_values(); # transformation matrix. A is destroyed # Do the computation of tridiagonal elements and of my $A = $M->clone();ad lL,kQ? X N > 8 * ( ' i L + z < % x v u f /  c b ` _ H 6  b[Z-Z.jX@, ^.p_G3  $s .= "{"; } $s = "$args{name} := "; if( $args{name} ){ my $s = ""; my ($row,$col) = $m->dim; @_); semi => 0, name => "", format => "%s", my %args = ( my ($m) = shift;sub as_yacas{#TODO: docs+test} return $s; $s .= ";" if $args{semi}; $s .= "]"; ); } $s .= ";\n" if( $j == $col && $i != $row); $s .= sprintf(" $args{format}",$x); sub { my($x,$i,$j) = @_; $m->each( $s .= "["; } $s = "$args{name} = "; if( $args{name} ){ my $s = ""; my ($row,$col) = $m->dim; @_); semi => 0, name => "", format => "%s", my %args = ( my ($m) = shift;sub as_matlab {} return (shift)->as_matlab;sub as_scilab {} return 1; } } return 0 unless ($m->[0][$i][$j] == 1 || $m->[0][$i][$j] == 0); for (my $j = 0; $j < $cols; $j++) { for (my $i = 0; $i < $rows; $i++) { my ($rows, $cols) = $m->dim; my ($m) = @_;sub is_binary{} return $neg ? 0 : 1; $ev->each(sub { $neg++ if ((shift)<0) } ); my $ev = $m->eigenvalues; # must have all non-negative eigenvalues return 0 unless $m->is_symmetric; # gramian matrix must be symmetric my $neg=0; my ($rows,$cols) = $m->dim; my ($m) = @_;sub is_gramian{####} return 1; } } return 0 unless ($m->[0][$i][$j] == -$m->[0][$j][$i]); for (my $j = 0; $j < $i; $j++) { for (my $i = 1; $i < $rows; $i++) { return 0 unless ($rows == $cols); # if it is not quadratic it cannot be skew symmetric... my ($rows, $cols) = $m->dim; my ($m) = @_;sub is_skew_symmetric{} (~$matrix * $matrix - $matrix * ~$matrix < $eps ) ? 1 : 0; $eps ||= 1e-8; my ($rows,$cols) = $matrix->dim; my ($matrix,$eps) = @_;sub is_normal{} return (shift)->[3] ? 1 : 0; croak "Usage: \$matrix->is_LR()" unless (@_ == 1);sub is_LR($) {} return (shift)->is_quadratic(); croak "Usage: \$matrix->is_square()" unless (@_ == 1);sub is_square($) {} $matrix->[1] == $matrix->[2] ? return 1 : return 0; my ($matrix) = @_; croak "Usage: \$matrix->is_quadratic()" unless (@_ == 1);sub is_quadratic ($) {} return 1; } $j = 0; } return 0 if $M->[0][$i][$j]; next if ($i == $j); # skip diag elements for(;$j < $cols; $j++ ){ for(;$i < $rows; $i++ ){ return 0 unless ($rows == $cols ); my ($i,$j) = (0,0); my ($rows,$cols) = ($M->[1],$M->[2]); my ($M) = @_;sub is_diagonal ($) {# Boolean check to see if matrix is diagonal} return 1; } $j = 0; } return 0 if $M->[0][$i][$j]; next if ($i >= $j); for(;$j < $cols;$j++ ){ for(;$i < $rows; $i++ ){ return 0 unless ($rows == $cols); my ($i,$j) = (0,1); my ($rows,$cols) = $M->dim(); my ($M) = @_;sub is_lower_triangular {# i.e all nonzero elements are lower main diagonal# Boolean check to see if matrix is lower triangular} return 1; } $j = 0; } return 0 if $M->[0][$i][$j]; next if ($i <= $j); for(;$j < $cols;$j++ ){ for(;$i < $rows; $i++ ){ return 0 unless ($rows == $cols); my ($i,$j) = (1,0); my ($rows,$cols) = $M->dim(); my ($M) = @_;ad.r>fI.%$# y Q  t T ( ' o >   ~ c ] < - + %   V B @ ? 1  {^#hfeSob^[HFE7#d)nlkYuhdaNLKJI # define overloaded operators section: # # # ########################################} return ($m, $mp); } } $mp = $l; $m = $column->element($l, 1); if ($column->element($l, 1) < $m) { for my $l (1..$rows) { my ($m, $mp) = ($column->element(1, 1), 1); my ($column, $rows) = @_; # passing $rows allows for some extra (minimal) efficiencysub _min_column {} return wantarray ? ($min, $min_p) : $min } } push @$min_p, $mp; push @$min, $m; my ($m, $mp) = _min_column($matrix->column($c), $rows); for my $c (1..$columns) { } else { ($min, $min_p) = _min_column($matrix->column(1), $rows); } elsif ($columns == 1) { ($min, $min_p) = _min_column($matrix->row(1)->_transpose, $columns); if ($rows == 1) { my $min_p = []; my $min = []; my ($rows, $columns) = $matrix->dim; my ($matrix) = @_;sub minimum {} return ($m, $mp); } } $mp = $l; $m = $column->element($l, 1); if ($column->element($l, 1) > $m) { for my $l (1..$rows) { my ($m, $mp) = ($column->element(1, 1), 1); my ($column, $rows) = @_; # passing $rows allows for some extra (minimal) efficiencysub _max_column {} return wantarray ? ($max, $max_p) : $max } } push @$max_p, $mp; push @$max, $m; my ($m, $mp) = _max_column($matrix->column($c), $rows); for my $c (1..$columns) { } else { ($max, $max_p) = _max_column($matrix->column(1), $rows); } elsif ($columns == 1) { ($max, $max_p) = _max_column($matrix->row(1)->_transpose, $columns); if ($rows == 1) { my $max_p = []; my $max = []; my ($rows, $columns) = $matrix->dim; my ($matrix) = @_;sub maximum {} return $radius; $ev->each(sub { my $x = shift; $radius = $x if (abs($x) > $radius); } ); my $radius=0; my $ev = $matrix->eigenvalues; my ($r,$c) = $matrix->dim; my ($matrix) = @_;{sub spectral_radius #### } return $s; $s =~ s/%INSIDE%/$inside/gm; } $s = "\$$s\$"; } else { $s = "\\[$s\\]"; if($args{displaymath}){ ); } } $inside .= "$x&"; } else { $inside .= "$x\n"; } elsif( $j == $col && $i == $row){ # the annoying last line has neither $inside .= "$x \\\\"."\n"; if ($j == $col && $i != $row){ # last element in each row gets a \\ $x = sprintf($args{format},$x); my ($x,$i,$j) = @_; sub { $m->each( } $s = "$args{name} = $s"; if( $args{name} ){ $s =~ s/%COLS%/$args{align} x $col/em; } croak "Math::MatrixReal::as_latex(): Invalid alignment '$args{align}'"; if( $args{align} !~ m/^(c|l|r)$/ ){ $args{align} = lc $args{align};LATEX%INSIDE%\\end{array} \\right)\\left( \\begin{array}{%COLS%} my $s = <dim; @_); display_math => 0, align => "c", name => "", format => "%s", my %args = ( my ($m) = shift;sub as_latex{} return $s; $s .= "}}"; ); } $s .= "}," if ($j == $col && $i != $row); $s .= "," if( $j != $col ); $s .= sprintf("$args{format}",$x); $s .= "{" if ($j == 1); sub { my($x,$i,$j) = @_; $m->each(ad ~Z#Z  C m l _ "    | z c +  W Q %  w u ^ M K 4 zOA$zyYXqE;}W?> ^3QKIH:8~} { (ref($argument) !~ /^SCALAR$|^ARRAY$|^HASH$|^CODE$|^REF$/)) if ((defined $argument) && ref($argument) && my($name) = "'-'"; my($object,$argument,$flag) = @_;{sub _subtract} } croak "Math::MatrixReal $name: wrong argument type"; { else } } return($object); $object->add($object,$argument); { else } return($temp); $temp->add($object,$argument); my $temp = $object->new($object->[1],$object->[2]); { if (defined $flag) { (ref($argument) !~ /^SCALAR$|^ARRAY$|^HASH$|^CODE$|^REF$/)) if ((defined $argument) && ref($argument) && my($name) = "'+'"; my($object,$argument,$flag) = @_;{sub _add} return $self->norm_one() ; my ($self) = @_;{sub _norm} return $s; } $s .= "]\n"; } $s .= sprintf $format , $self->[0][$i][$j]; { for ( my $j = 0; $j < $cols; $j++ ) $s .= "[ "; { for ( my $i = 0; $i < $rows; $i++ ) my $s = ''; $format = '% #-12d' if defined $precision && $precision == 0; my $format = !defined $precision ? '% #-19.12E ' : '% #-19.'.$precision.'f '; my $precision = $self->[4]; my ($rows,$cols) = ($self->[1],$self->[2]); my ($self) = @_;{sub _stringify} return($result); } } } last NOTBOOL; $result = 0; { if ($object->[0][$i][$j] != 0) { for ( my $j = 0; $j < $cols; $j++ ) { for ( my $i = 0; $i < $rows; $i++ ) NOTBOOL: my $result = 1; my ($rows,$cols) = ($object->[1],$object->[2]); my ($object) = @_;{sub _not_boolean#TODO: ugly copy+paste} return($result); } } } last BOOL; $result = 1; { if ($object->[0][$i][$j] != 0) { for ( my $j = 0; $j < $cols; $j++ ) { for ( my $i = 0; $i < $rows; $i++ ) BOOL: my $result = 0; my($rows,$cols) = ($object->[1],$object->[2]); my($object) = @_;{sub _boolean} return $temp; $temp->transpose($object); my $temp = $object->new($object->[2],$object->[1]); my ($object) = @_;{sub _transpose} return($temp); $temp->negate($object); my $temp = $object->new($object->[1],$object->[2]); my($object) = @_;{sub _negate} } croak "Math::MatrixReal $name: wrong argument type"; } else { return "$object" . $argument; } elsif (defined $argument) { return $result; } } $result->[0][$i][$j] = ( $j < $ocols ) ? $object->[0][$i][$j] : $argument->[0][$i][$j - $ocols] ; for ( my $j = 0; $j < $ocols + $acols; $j++ ) { for ( my $i = 0; $i < $arows; $i++ ) { my $result = $object->new($orows,$ocols+$acols); croak "Math::MatrixReal: Matrices must have same number of rows in concatenation" unless ($orows == $arows); my($arows,$acols) = ($argument->[1],$argument->[2]); if ((defined $argument) && ref($argument) && (ref($argument) !~ /^SCALAR$|^ARRAY$|^HASH$|^CODE$|^REF$/)) { my($name) = "concat"; my($orows,$ocols) = ($object->[1],$object->[2]); my($object,$argument,$flag) = @_;{sub _concat ######################################## # #ad Z\zt71/. t K  d ; 8  ` : i : j Y U D *  jK!si<,)# IC|GA&vl3 ~PNM86trqZYsub _assign_exponent {} return( &_multiply($object,$argument,undef) ); my($object,$argument) = @_;{sub _assign_multiply} return( &_subtract($object,$argument,undef) ); my($object,$argument) = @_;{sub _assign_subtract} return( &_add($object,$argument,undef) ); my($object,$argument) = @_;{sub _assign_add} } croak "Math::MatrixReal $name: wrong argument type"; { else } } return($object); $object->multiply_scalar($object,$argument); { else } return($temp); $temp->multiply_scalar($object,$argument); $temp = $object->new($object->[1],$object->[2]); { if (defined $flag) { elsif ((defined $argument) && !(ref($argument))) } } return( multiply($object,$argument) ); { else } return( multiply($argument,$object) ); { if ((defined $flag) && $flag) { (ref($argument) !~ /^SCALAR$|^ARRAY$|^HASH$|^CODE$|^REF$/)) if ((defined $argument) && ref($argument) && my($temp); my($name) = "'*'"; my($object,$argument,$flag) = @_;{sub _multiply} } } return $temp; $temp->multiply_scalar($temp,1/$argument); } else { return $temp->multiply($inv); $inv = $arg->inverse(); croak "Math::MatrixReal $name: this operation is defined only for square matrices" unless ($arows == $acols); } print "DEBUG: $arg is a col vector\n"; if( $arg->is_col_vector() ){ #print "DEBUG: matrix division\n"; if( ref($arg) =~ /Math::MatrixReal/ ){ #print $arg ."\n"; #print "DEBUG: arg=\n"; #print "DEBUG: ref(arg)= " . ref($arg) . "\n"; #print $temp . "\n"; #print "DEBUG: temp=\n"; } else { } return $temp; $temp->multiply_scalar( $temp , $argument); croak "Math::MatrixReal $name: this operation is defined only for square matrices" unless ($mrows == $mcols); #print "DEBGU:mrows,mcols=$mrows,$mcols\n"; #print "DEBUG:arows,acols=$arows,$acols\n"; #print "DEBUG: Arg is scalar\n"; } else { return $temp->multiply( $arg->inverse() ); croak "Math::MatrixReal $name: this operation is defined only for square matrices" unless ($arows == $acols); # Matrix Division = A/B = A*B^(-1) #print "DEBUG: arg is a matrix \n"; if( ref($argument) =~ /Math::MatrixReal/ ){ #print "DEBUG: ref(arg)= " . ref($arg) . "\n"; if( $flag == 1) { #print "DEBUG: arg=$arg\n"; #print "DEBUG: flag= $flag\n"; } ($arows,$acols)=($arg->[1],$arg->[2]); $arg = $argument->clone(); if( ref($argument) =~ /Math::MatrixReal/ ){ my ($inv,$m1); my $arg; my $temp = $matrix->clone(); my($name) = "'/'"; my($arows,$acols)=(0,0); my($mrows,$mcols) = ($matrix->[1],$matrix->[2]); # TODO: check dimensions of everything! my($matrix,$argument,$flag) = @_;{sub _divide} return $matrix->exponent( $exp ); my($rows,$cols) = ($matrix->[1],$matrix->[2]); my($matrix, $exp) = @_;{sub _exponent } } croak "Math::MatrixReal $name: wrong argument type"; { else } } return($object); $object->subtract($object,$argument); { else } return $temp; else { $temp->subtract($object,$argument); } if ($flag) { $temp->subtract($argument,$object); } my $temp = $object->new($object->[1],$object->[2]); { if (defined $flag)ad 9g4}TJ x f X N 5 / & W V % y g ; 1  | Y G 9 /  u t C u2("{j.$xwFw3)r5+T C98 } return( $object->norm_one() > $argument->norm_one() ); } else { return( $argument->norm_one() > $object->norm_one() ); { if ((defined $flag) && $flag) { (ref($argument) !~ /^SCALAR$|^ARRAY$|^HASH$|^CODE$|^REF$/)) if ((defined $argument) && ref($argument) && my($name) = "'>'"; my($object,$argument,$flag) = @_;{sub _greater_than} } croak "Math::MatrixReal $name: wrong argument type"; } else { } return( $object->norm_one() <= abs($argument) ); } else { return( abs($argument) <= $object->norm_one() ); { if ((defined $flag) && $flag) } elsif ((defined $argument) && !(ref($argument))) { } return( $object->norm_one() <= $argument->norm_one() ); } else { return( $argument->norm_one() <= $object->norm_one() ); { if ((defined $flag) && $flag) { (ref($argument) !~ /^SCALAR$|^ARRAY$|^HASH$|^CODE$|^REF$/)) if ((defined $argument) && ref($argument) && my($name) = "'<='"; my($object,$argument,$flag) = @_;{sub _less_than_or_equal} } croak "Math::MatrixReal $name: wrong argument type"; } else { } return( $object->norm_one() < abs($argument) ); } else { return( abs($argument) < $object->norm_one() ); { if ((defined $flag) && $flag) { elsif ((defined $argument) && !(ref($argument))) } } return( $object->norm_one() < $argument->norm_one() ); } else { return( $argument->norm_one() < $object->norm_one() ); { if ((defined $flag) && $flag) { (ref($argument) !~ /^SCALAR$|^ARRAY$|^HASH$|^CODE$|^REF$/)) if ((defined $argument) && ref($argument) && my($name) = "'<'"; my($object,$argument,$flag) = @_;{sub _less_than} } croak "Math::MatrixReal $name: wrong argument type"; } else { return $result; } } } last NOTEQUAL; $result = 1; { if ($object->[0][$i][$j] != $argument->[0][$i][$j]) { for ( my $j = 0; $j < $cols; $j++ ) { for ( my $i = 0; $i < $rows; $i++ ) NOTEQUAL: my $result = 0; return 1 unless ($r == $rows && $c == $cols ); my ($r,$c) = $argument->dim; { (ref($argument) !~ /^SCALAR$|^ARRAY$|^HASH$|^CODE$|^REF$/)) if ((defined $argument) && ref($argument) && my($rows,$cols) = ($object->[1],$object->[2]); my($name) = "'!='"; my($object,$argument,$flag) = @_;{sub _not_equal} } croak "Math::MatrixReal $name: wrong argument type"; { else } return($result); } } } last EQUAL; $result = 0; { if ($object->[0][$i][$j] != $argument->[0][$i][$j]) { for ( $j = 0; $j < $cols; $j++ ) { for ( $i = 0; $i < $rows; $i++ ) EQUAL: $result = 1; { (ref($argument) !~ /^SCALAR$|^ARRAY$|^HASH$|^CODE$|^REF$/)) if ((defined $argument) && ref($argument) && my($i,$j,$result); my($rows,$cols) = ($object->[1],$object->[2]); my($name) = "'=='"; my($object,$argument,$flag) = @_;{sub _equal} return ( &_exponent($object,$arg,undef) ); my($object,$arg) = @_;adJ[JnUT# e T   ` O   Y ? (   S B A   ~ } 5 % $ qp~}`_nm'dc RQKJ~gf[Z&JIThis method allows you to create a random matrix with various properties controlled=item * $new_matrix = Math::MatrixReal-Enew_random($rows, $cols, %options ); [ 3.000000000000E+00 4.000000000000E+00 ] [ 1.000000000000E+00 2.000000000000E+00 ]will print print $matrix; my $matrix = Math::MatrixReal->new_from_rows( [ [1,2], [3,4] ] );same dimension--no padding happens automatically. Example:You may mix and match these as you wish. However, all must be of the=back=item * strings properly formatted to create a row with Math::MatrixReal's new_from_string command=item * references to arrays=item * row vectors ( 1 by n Math::MatrixReal matrices )=over 4Creates a new matrix given a reference to an array of any of the following:=item * new_from_rows( [ $row_vector|$array_ref|$string, ... ] ) [ 2.000000000000E+00 4.000000000000E+00 ] [ 1.000000000000E+00 3.000000000000E+00 ]will print print $matrix; my $matrix = Math::MatrixReal->new_from_cols( [ [1,2], [3,4] ] );same dimension--no padding happens automatically. Example: You may mix and match these as you wish. However, all must be of the=backnew_from_string command=item * strings properly formatted to create a column with Math::MatrixReal's=item * references to arrays=item * column vectors ( n by 1 Math::MatrixReal matrices )=over 4Creates a new matrix given a reference to an array of any of the following:=item * $new_matrix = $matrix-Enew_from_cols( [ $column_vector|$array_ref|$string, ... ] )Matrix $some_matrix is not changed by this in any way.Another way of calling the matrix object constructor method.=item * $new_matrix = $some_matrix-Enew($rows,$columns);in this module.Note that this method is implicitly called by many of the other methodswill be created, with the value C<0.0> for all elements.The matrix object constructor method. A new matrix of size $rows by $columns=item * $new_matrix = new Math::MatrixReal($rows,$columns);to your program.Makes the methods and overloaded operators of this module available=item * use Math::MatrixReal;=over 4=head2 Constructor Methods And Such=head1 FUNCTIONS__END__{ no warnings; 42 }} return $temp; $temp->_undo_LR(); $temp->copy($object); my $temp = $object->new($object->[1],$object->[2]); my($object) = @_;{sub _clone} } croak "Math::MatrixReal $name: wrong argument type"; } else { } return( $object->norm_one() >= abs($argument) ); } else { return( abs($argument) >= $object->norm_one() ); { if ((defined $flag) && $flag) } elsif ((defined $argument) && !(ref($argument))) { } return( $object->norm_one() >= $argument->norm_one() ); } else { return( $argument->norm_one() >= $object->norm_one() ); { if ((defined $flag) && $flag) { (ref($argument) !~ /^SCALAR$|^ARRAY$|^HASH$|^CODE$|^REF$/)) if ((defined $argument) && ref($argument) && my($name) = "'>='"; my($object,$argument,$flag) = @_;{sub _greater_than_or_equal} } croak "Math::MatrixReal $name: wrong argument type"; } else { } return( $object->norm_one() > abs($argument) ); } else { return( abs($argument) > $object->norm_one() ); { if ((defined $flag) && $flag) } elsif ((defined $argument) && !(ref($argument))) {adAfMLA@xw o    i h /     _  [ Z   l k ` _  Wx;:mZY  vu3lIH eI@?jPOFEyour taste)(Remember that you may use spaces and tabs to format the matrix to MATRIX [ $c1 $c2 $c3 ] [ 0 3 2 ] [ 3 2 0 ] $matrix = Math::MatrixReal->new_from_string(<<"MATRIX"); $c3 = 26 / 9; $c2 = -2 / 5; $c1 = 2 / 3;You can even use variables in the matrix: MATRIX [ 1 0 0 0 0 0 -1 ] [ 0 0 0 0 0 1 0 ] [ 0 0 0 0 1 0 0 ] [ 0 0 0 1 0 0 0 ] [ 0 0 1 0 0 0 0 ] [ 0 1 0 0 0 0 0 ] [ 1 0 0 0 0 0 1 ] $matrix = Math::MatrixReal->new_from_string(<<'MATRIX');shell-like "here-document" syntax:But you can also do this in a much more comfortable way using the [ 1.000000000000E+00 1.000000000000E+00 1.000000000000E+00 ] [ 2.000000000000E+00 2.000000000000E+00 -1.000000000000E+00 ] [ 1.000000000000E+00 2.000000000000E+00 3.000000000000E+00 ]By the way, this prints print "$matrix"; $matrix = Math::MatrixReal->new_from_string($string); $string = "[ 1 2 3 ]\n[ 2 2 -1 ]\n[ 1 1 1 ]\n";Examples:Additional spaces or tabs can be added at will, but no comments.by spaces or tabs.tab) and contain one or more numbers, all separated from each other"C< ]\n>" ("C<\n>" being the newline character and "C< >" a space orThe syntax is simple: each row must start with "C<[ >" and end withinstance, from the keyboard, from a file or from your code).This method allows you to read in a matrix from a string (for=item * $new_matrix = Math::MatrixReal-Enew_from_string($string); [ 0.000000000000E+00 0.000000000000E+00 2.000000000000E+00 4.000000000000E+00 ] [ 0.000000000000E+00 4.000000000000E+00 3.000000000000E+00 9.000000000000E+00 ] [ 6.000000000000E+00 2.000000000000E+00 8.000000000000E+00 0.000000000000E+00 ] [ 1.000000000000E+00 1.000000000000E+00 0.000000000000E+00 0.000000000000E+00 ]will print print $matrix; $matrix = Math::MatrixReal->new_tridiag( [ 6, 4, 2 ], [1,2,3,4], [1, 8, 9] );the lower diagonal, diagonal and upper diagonal, respectively.This method allows you to create a tridiagonal matrix by only specifying=item * $new_matrix = Math::MatrixReal-Enew_tridiag( $lower, $diag, $upper ); [ 0.000000000000E+00 0.000000000000E+00 0.000000000000E+00 4.000000000000E+00 ] [ 0.000000000000E+00 0.000000000000E+00 3.000000000000E+00 0.000000000000E+00 ] [ 0.000000000000E+00 2.000000000000E+00 0.000000000000E+00 0.000000000000E+00 ] [ 1.000000000000E+00 0.000000000000E+00 0.000000000000E+00 0.000000000000E+00 ]will print print $matrix; $matrix = Math::MatrixReal->new_diag( [ 1,2,3,4 ] );the diagonal elements. Example: This method allows you to create a diagonal matrix by only specifying=item * $new_matrix = Math::MatrixReal-Enew_diag( $array_ref ); [ 0.000000000000E+00 0.000000000000E+00 0.000000000000E+00 8.000000000000E+00 ] [ 0.000000000000E+00 0.000000000000E+00 1.000000000000E+00 0.000000000000E+00 ] [ 0.000000000000E+00 2.000000000000E+00 0.000000000000E+00 0.000000000000E+00 ] [ 5.000000000000E+00 0.000000000000E+00 0.000000000000E+00 0.000000000000E+00 ]will print a 4x4 random diagonal matrix with integer entries between zero and ten, something like print $matrix; $matrix = Math::MatrixReal->new_random(4, { diagonal => 1, integer => 1 } ); Example: are { integer => 0, symmetric => 0, tridiagonal => 0, diagonal => 0, bounded_by => [0,10] } .by the %options matrix, which is optional. The default values of the %options matrixad$vx1  A > 4 0   | f P : 1 '   Y X L H  ~ v U * "  J I FPOVU[kj#"D;:XWON=item * $value = $matrix-Eelement($row,$column);=over 4=head2 Matrix Row, Column and Element operations=back [ 4 8 12 ] [ 3 7 11 ] [ 2 6 10 ] [ 1 5 9 ]Creates the following matrix: $matrix = Math::MatrixReal->reshape(4, 3, [1..12]);stored).the matrix are accessed in column-major order (like Fortran arrays areelements are taken from the array reference C<$array_ref>. The elements ofReturn a matrix with the specified dimensions (C<$rows> x C<$cols>) whose=item * $matrix = Math::MatrixReal->reshape($rows, $cols, $array_ref);Matrix "C<$some_matrix>" is not changed by this in any way.C<$a = $b>, when C<$a> and C<$b> are matrices.is the method that the operator "=" is overloaded to when you typeB to the new matrix "C<$twin_matrix>". Thismatrix "C<$some_matrix>". The contents of matrix "C<$some_matrix>" haveReturns an object reference to a B matrix of the B as=item * $twin_matrix = $some_matrix-Eclone();Matrix "C<$matrix2>" is not changed by this in any way.matrix "C<$matrix1>" (which must have the same size as matrix "C<$matrix2>"!).Copies the contents of matrix "C<$matrix2>" to an B=item * $matrix1-Ecopy($matrix2);Matrix "C<$some_matrix>" is not changed by this in any way.(filled with zero's) of the B as matrix "C<$some_matrix>".Returns an object reference to a B but B matrix=item * $new_matrix = $some_matrix-Eshadow();(newly allocated) matrix containing the elements you specified.If everything is okay, the method returns an object reference to the Math::MatrixReal::new_from_string(): missing elements will be set to zero!the following warning will be printed to STDERR:If the input string has rows with varying numbers of columns, Math::MatrixReal::new_from_string(): empty input string Math::MatrixReal::new_from_string(): syntax error in input stringPossible error messages of the "new_from_string()" method are: } else { last; } } print "${@}Please try again.\n"; $@ =~ s/\s+at\b.*?$//; { if ($@) Math::MatrixReal->new_from_string(join('',)); }; eval { $new_matrix = print "(multiple lines, = done):\n"; print "\nPlease enter your matrix "; { while (1)A better way is shown in this piece of code:newlines.is a little awkward, since you have to enter a lot of "\n"'s for theActually, the method shown above for reading a matrix from the keyboard # ... if ($@) MATRIX [ $c1 $c2 $c3 ] [ 0 3 2 ] [ 3 2 0 ] eval { $matrix = Math::MatrixReal->new_from_string(<<"MATRIX"); };or as follows: } # continue... { else } # (error handling) # ... print "$@"; { if ($@) eval { $matrix = Math::MatrixReal->new_from_string($string); }; $string =~ s/\\n/\n/g; $string = ; print "Please enter your matrix (in one line): ";caught by "eval" as follows:the syntax mentioned above, an exception is raised, which can beIf the string you supply (or someone else supplies) does not obeybecause only 13 digits are supported in the mantissa when printed!!Note however that you may suffer a precision loss in this processin later (for instance from a file!).any matrix into a string with C<$string = "$matrix";> and read it backmatrix as the "stringify" operator "": this means that you can convertNote that this method uses exactly the same representation for aad ]=ut2 E  s r ; : y S R   ] 0 / t n W F A &  G-("j%gf/.Cxw9i to the determinant of C<$matrix-Eminor($i,$j)> if it is an "even" element, or C<-1*$matrix-Eminor($i,$j)>and stores the row and column indexes in $i and $j. Then it sets element [$i,$j] in $cofactorThis code needs some explanation. For each element of $matrix, it throws away the actual value } ); : -1*$matrix->minor($i,$j)->det(); ($i+$j) % 2 == 0 ? $matrix->minor($i,$j)->det() my $cofactor = $matrix->each( sub { my(undef,$i,$j) = @_;Example: $matrix = $matrix->each ( sub { (shift) + 1 } ); # add 1 to every element in the matrixExample:executed statement ) is the value given to the corresponding element in $new_matrix.index, in that order. The value the function returns ( or the value of the lastgiven matrix. The function is passed the element, the row index and the columnCreates a new matrix by evaluating a code reference on each element of the =item * $new_matrix = $matrix-Eeach( \&function );L.See L, L, L, $shader->SetMatrix(model => $model_oga); # instance of OpenGL::Shader my $model_oga = OpenGL::Array->new_list(GL_FLOAT, $model->as_list); $model = ~$model; # OpenGL operates on transposed matrices my $model = $model_initial * $rotation; my $model_initial = Math::MatrixReal->new_diag( [1, 1, 1, 1] ); # identity matrix ...; ]); [0, 0, 0, 1 ], [(1-$cos_f)*$z*$x-$sin_f*$y, (1-$cos_f)*$z*$y+$sin_f*$x, $cos_f+(1-$cos_f)*$z**2 ,0 ], [(1-$cos_f)*$y*$z+$sin_f*$z, $cos_f+(1-$cos_f)*$y**2 , (1-$cos_f)*$y*$z-$sin_f*$x, 0 ], [$cos_f+(1-$cos_f)*$x**2, (1-$cos_f)*$x*$y-$sin_f*$z, (1-$cos_f)*$x*$z+$sin_f*$y, 0 ], my $rotation = Math::MatrixReal->new_from_rows([ my $sin_f = sin(deg2rad($f)); my $cos_f = cos(deg2rad($f)); my $f = $angle; my ($x, $y, $z) = @$axis; ... my $angle = 90; my $axis = [1, 0, 0]; ...; use OpenGL; use Math::Trig;rotate model around X-axis to 90 degrees clock-wise. That could be achieved via:This method is suitable for use with OpenGL. For example, there is need to my @list = $matrix->as_list; # 1, 2, 3, 4 my $matrix = Math::MatrixReal->new_from_rows([ [1, 2], [3, 4] ]);Example:Get the contents of a Math::MatrixReal object as a Perl list.=item * @all_elements = $matrix-Eas_list;Matrix "C<$matrix>" is not changed by this in any way."C<$matrix>" has already been copied.only one column) to which column number "C<$column>" of matrixa B matrix (which in fact is a (column) vector since it hasThis is a projection method which returns an object reference to=item * $column_vector = $matrix-Ecolumn($column);Matrix "C<$matrix>" is not changed by this in any way.already been copied.one row) to which row number "C<$row>" of matrix "C<$matrix>" hasa B matrix (which in fact is a (row) vector since it has onlyThis is a projection method which returns an object reference to=item * $row_vector = $matrix-Erow($row);thereby replacing the value previously stored there.matrix "C<$matrix>", located in row "C<$row>" and column "C<$column>",Explicitly assigns a value "C<$value>" to a single element of the=item * $matrix-Eassign($row,$column,$value); $elem = $matrix->element(1, 1); # first element of the matrix.first element of the matrix is placed in the B line, B column:B Unlike Perl, matrices are indexed with base-one indexes. Thus, thelocated in row "C<$row>" and column "C<$column>".Returns the value of a specific element of the matrix "C<$matrix>",ad5iR^]\-, f T S $ # l ] \   9 8 c $ # = 2 1 O98~L$#pCBA;:! o-sed\[54~/.&%WVThe "one"-norm is defined as follows:Returns the "one"-norm of the given matrix "C<$matrix>".C<$norm_one = $matrix-Enorm_one();>=item *and columns the given matrix "C<$matrix>" contains.Returns a list of two items, representing the number of rowsC<($rows,$columns) = $matrix-Edim();>=item *This is nothing but a wrapper for C<$matrix-Edecompose_LR-Einvert_LR>.undef is returned and an error is printed via C.rigamarole of computing a LR decomposition. If no inverse exists,Returns the inverse of a matrix, without going through theC<$inverse = $matrix-Einverse();>=item *determinants.there is no inverse and vice-versa. Only quadratic matrices have C<$matrix-Edecompose_LR-Edet_LR>. If the determinant is zero, triangular. Otherwise, it is just a wrapper for be much faster than LR decomposition if the matrix is diagonal orthe rigamarole of computing a LR decomposition. This method shouldReturns the determinant of the matrix, without going throughC<$det = $matrix-Edet();>=item *=over 4=head2 Matrix Operations=back # $pos = 3 ($max, $pos) = $B->maximum(); # $max = 9 # $pos = [ 1 2 2 ] ($min, $pos) = $A->minimum(); # $min = [ 1 5 2 ]When used in list context: $min = $B->minimum(); # $min = 3 $max = $A->maximum(); # $max = [ 8, 9, 6 ]When used in scalar context: [ 8 7 6 ] $A = [ 3 5 2 ] $B = [ 8 7 9 5 3 ] [ 1 9 4 ] Consider the matrix and vector below for the following examples:occurs, for matrices.position of that value in the vector (first occurrence), or the row where itelement is the maximum/minimum element (or elements) and the second is theWhen called in list context, the function returns a pair, where the firstreference.matrix, the maximum/minimum element for each column is returned in an arrayonly one element is returned. When computing the maximum or minimum from aWhen computing the maximum or minimum from a vector (vertical or horizontal),They work in a similar way as Octave/MatLab max/min functions.elements from a matrix, and the minimum element or elements from a matrix.These two methods work similarly, one for computing the maximum element or=item * $matrix-Emaximum(); and $matrix-Eminimum();C<$matrix-Eassign_row(5, $x)> would replace row 5 in $matrix with the row vector $x.with $new_row_vector and returns the resulting matrix.This method takes a one-based row number and assigns row $row_number of $matrix=item * $matrix-Eassign_row( $row_number , $new_row_vector );3 with row 2. C<$matrix-Eswap_row(2,3)> would replace row 2 in $matrix with row 3, and replace rowThis method takes two one-based row numbers and swaps the values of each element in each row.=item * $matrix-Eswap_row( $row1, $row2 );3 with column 2. C<$matrix-Eswap_col(2,3)> would replace column 2 in $matrix with column 3, and replace columnThis method takes two one-based column numbers and swaps the values of each element in each column.=item * $matrix-Eswap_col( $col1, $col2 );executed statement ) is the value given to the corresponding element in $new_matrix.index, in that order. The value the function returns ( or the value of the lastgiven matrix. The function is passed the element, the row index and the columnCreates a new matrix by evaluating a code reference on each diagonal element of the =item * $new_matrix = $matrix-Eeach_diag( \&function );if it is an "odd" element.ad$pw\[on0 h g _ ^ 6 5 K 0 / X C B   < ; 3 2 w v 6 s6t2&%gf/.{zW  onmldc10pogfCBu1  =item *largest eigenvalue may be implemented.inefficient, and in the future an algorithm that computes only the to find the largest in absolute value. Needless to say, this is veryCurrently this computes B eigenvalues, then sifts through themReturns the maximum value of the absolute value of all eigenvalues.C<$matrix-Espectral_radius();>=item *squared, this is added up, and then a square root is taken. acts on a B, not a vector. Each element of the matrix is This norm is similar to that of a p-norm where p is 2, except itC<$frob_norm> = C<$matrix-Enorm_frobenius();>=item * Distance is 1.41421356237309505, which should be 1.41421356237309505 3 3.30192724889462668 3.74165738677394139 6 (1,2,3,Inf) norm:Output: print "Distance is $dist, which should be " . sqrt(2) . "\n"; $dist = ($i1-$i2)->norm_p(2); # hypotenuse of a 1 by 1 right triangle # this should be sqrt(2) since it is the same as the $i2 = $a->new_from_rows([[0,1]]); $i1 = $a->new_from_rows([[1,0]]); print "(1,2,3,Inf) norm:\n$p1\n$p2\n$p3\n$pinf\n"; $pinf = $a->norm_p("Inf"); $p3 = $a->norm_p(3); $p2 = $a->norm_p(2); $p1 = $a->norm_p(1); $a = Math::MatrixReal->new_from_cols([[1,2,3]]);Example:equal to 2.between two vectors is just a special case of a p-norm, when p isof the vector. Also, note that the familiar Euclidean distance p-norm as p goes to infinity. It is defined as the maximum element"infinity-norm" is computed, which is really the limit of the p-th root of that number. If the string "Inf" is passed, theeach element to the p-th power, adds them up, and then takes theThe p-norm is defined as (sum(x_i^p))^(1/p). In words, it raisedmust be a number greater than or equal to 1 or the string "Inf".This function returns the "p-norm" of a vector. The argument $nC<$p_norm> = $matrix-Enorm_p($n);>=item *absolute values of every element.This is a very simple norm which is defined as the sum of the C<$norm_sum = $matrix-Enorm_sum();>=item *"solve_RM()" which use either norm depending on the matrix itself.except for the iterative methods "solve_GSM()", "solve_SSM()" andfor all comparisons, for the sake of uniformity and comparability,Throughout this package, the "one"-norm is (arbitrarily) usedusing the same norm!Therefore, you should only compare values that have been calculatedvalue.equivalent, although for the same matrix they usually yield a differentNote that the "maximum"-norm and the "one"-norm are mathematicallyof these sums is returned.different columns of that row is calculated. Finally, the maximumFor each row, the sum of the absolute values of the elements in theThe "maximum"-norm is defined as follows:Returns the "maximum"-norm of the given matrix $matrix.C<$norm_max = $matrix-Enorm_max();>=item *"solve_RM()" which use either norm depending on the matrix itself.except for the iterative methods "solve_GSM()", "solve_SSM()" andfor all comparisons, for the sake of uniformity and comparability,Throughout this package, the "one"-norm is (arbitrarily) usedusing the same norm!Therefore, you should only compare values that have been calculatedvalue.equivalent, although for the same matrix they usually yield a differentNote that the "one"-norm and the "maximum"-norm are mathematicallyof these sums is returned.different rows of that column is calculated. Finally, the maximumFor each column, the sum of the absolute values of the elements in theadkT+*> v u 1     V U ?  K g < ; 3 2   ` _ ]  h&3ke('XKJI \[SR,+The adjoint is just the transpose of the cofactor matrix. This method is C<$adjoint = $matrix-Eadjoint();>=item * cofactor: 36 wallclock secs (36.62 usr + 0.01 sys = 36.63 CPU) @ 0.27/s (n=10) inverse: 1 wallclock secs ( 0.56 usr + 0.00 sys = 0.56 CPU) @ 17.86/s (n=10) Benchmark: timing 10 iterations of LR, cofactor, inverse... } ); 'cofactor' => sub { (~$matrix1->cofactor)->each ( sub { (shift)/$det; } ) } {'inverse' => sub { $matrix1->inverse(); }, timethese( 10, $det = $matrix1->det; # $matrix1 is 15x15the native C function. Here is a small benchmark:can be used with pencil and paper for small matrices, it is comically slower than Caveat: Although the cofactor matrix is simple algorithm to compute the inverse of a matrix, and my $inverse2 = ~($matrix->cofactor)->each( sub { (shift)/$matrix->det() } ); my $inverse1 = $matrix->inverse;The following two inverses should be exactly the same:determinant of the matrix. inverse of a matrix is the cofactor matrix transposed divided by the originalThe cofactor matrix can be used to find the inverse of the matrix. One formula for theReplace the given element with this value.and j is the column index. Multiply the determinant by (-1)^(i+j), where i is the row index,rows and columns.Now, take the determinant of the matrix that is left in the otherFor each element, cross out the row and column that it sits in.The cofactor matrix is constructed as follows:C<$cofactor = $matrix-Ecofactor();>=item *the remaining rows and columns as a matrix. This method is used by C.matrix. The minor is defined as crossing out the row and the col specified and returningIf $matrix is n rows by n cols, the minor of $row and $col will be an (n-1) by (n-1)Returns the minor matrix corresponding to $row and $col. $matrix must be quadratic.C<$minor = $matrix-Eminor($row,$col);>=item *quadratic.the sum of the diagonal elements. The matrix must beThis returns the trace of the matrix, which is defined asC<$trace = $matrix-Etrace();>=item *for input, a B vector is expected!Hint: throughout this module, whenever a vector is explicitly requiredSo be careful about what you really mean! [ 1 ] [ -1 0 1 ] [ 1 ] [ 0 ] [ 0 0 0 ] [ -1 0 1 ] [ 0 ] * [ -1 0 1 ] = [ -1 ] [ 1 0 -1 ] = [ 0 0 0 ] [ -1 ] [ 1 0 -1 ] * [ -1 0 1 ] [ 1 ] [ -1 0 1 ] * [ 0 ] = [ 2 ] , whereas [ -1 ]This is especially true for the matrix product of two vectors:the one vector being the transposed of the other! [ 1 ] [ 0 ] [ -1 ]or a column vector, like this: [ -1 0 1 ]have a row vector, like this:Note that (especially for vectors) it makes a big difference if youwith those of element C<(j,i)>.swapped. In fact the contents of element C<(i,j)> are swappedAnother way of looking at it is to say that rows and columns are(2,2), (3,3) and so on) by 180 degrees.along the axis of its main diagonal (going through elements (1,1),Transposition is a symmetry operation: imagine you rotate the matrixoutput matrix may be identical.This operation can also be carried out "in-place", i.e., input andthe same size as matrix "C<$matrix2>"!).the result in matrix "C<$matrix1>" (which must already exist and haveCalculates the transposed matrix of matrix $matrix2 and storesC<$matrix1-Etranspose($matrix2);>ady-YTNMDC m O 1 & ! t s m l O N F E = <   ; : 6 Z $ # baGFYE65hFE7O(which must already exist and have the same size as matrix "C<$matrix2>"!).all elements with "-1") and stores the result in matrix "C<$matrix1>"Calculates the negative of matrix "C<$matrix2>" (i.e., multipliesC<$matrix1-Enegate($matrix2);>=item *of columns of matrix "C<$matrix2>", respectively.is determined by the number of rows of matrix "C<$matrix1>" and the numberThe number of rows and columns of the resulting matrix "C<$product_matrix>"as the number of rows of matrix "C<$matrix2>".I.e., the number of columns of matrix "C<$matrix1>" has to be the same [ 1 1 1 ] [ * * ] [ 1 1 1 ] [ * * ] [ 1 1 1 ] [ * * ] [ 1 1 1 ] [ * * ] [ 2 2 ] [ 2 2 ] [ 2 2 ]way (example):(i.e., their numbers of rows and columns) must harmonize in the followingNote that the dimensions of the two matrices "C<$matrix1>" and "C<$matrix2>"which the result of this operation has been stored.and returns an object reference to a new matrix "C<$product_matrix>" inCalculates the product of matrix "C<$matrix1>" and matrix "C<$matrix2>"C<$product_matrix = $matrix1-Emultiply($matrix2);>=item *output matrix may be identical.This operation can also be carried out "in-place", i.e., input andalready exist and have the same size as matrix "C<$matrix2>"!)."C<$scalar>") and stores the result in matrix "C<$matrix1>" (which must(i.e., multiplies each element of matrix "C<$matrix2>" with the factorCalculates the product of matrix "C<$matrix2>" and the number "C<$scalar>"C<$matrix1-Emultiply_scalar($matrix2,$scalar);>=item *a little less efficient.C<$matrix1-Eadd($matrix2,-$matrix3);>, although the latter isNote that this operation is the same asone (or both) of the input matrices may be identical.This operation can also be carried out "in-place", i.e., the output andand have the same size as matrix "C<$matrix2>" and matrix "C<$matrix3>"!).and stores the result in matrix "C<$matrix1>" (which must already existCalculates the difference of matrix "C<$matrix2>" minus matrix "C<$matrix3>"C<$matrix1-Esubtract($matrix2,$matrix3);>=item *one (or both) of the input matrices may be identical.This operation can also be carried out "in-place", i.e., the output andand have the same size as matrix "C<$matrix2>" and matrix "C<$matrix3>"!).and stores the result in matrix "C<$matrix1>" (which must already existCalculates the sum of matrix "C<$matrix2>" and matrix "C<$matrix3>"C<$matrix1-Eadd($matrix2,$matrix3);>=item *=over 4=head2 Arithmetic Operations=back [ 1 0 1 ] [ 0 1 0 ] [ 1 0 1 ]Output: print $submatrix; $submatrix->display_precision(0); my $submatrix = $matrix->submatrix(5,5,7,7); MATRIX [ 0 0 0 0 1 0 1 ] [ 0 0 0 0 0 1 0 ] [ 0 0 0 0 1 0 1 ] [ 0 0 0 0 0 0 0 ] [ 0 0 0 0 0 0 0 ] [ 0 0 0 0 0 0 0 ] [ 0 0 0 0 0 0 0 ] my $matrix = Math::MatrixReal->new_from_string(<<'MATRIX');Example:=back =item - secondly: Coordinate of bottom right corner to select (x2,y2)=item - firstly: Coordinate of top left corner to select (x1,y1)=over 6This method take four arguments to define a selection area:Submatrix permit to select only part of existing matrix in order to produce a new one.C<$part_of_matrix = $matrix-Esubmatrix(x1,y1,x2,Y2);>=item *=backjust an alias for C< ~($matrix-Ecofactor)>.adEAxZYv10*) \     e ) F   j - ^  @ `xw+utlkJIr(`('A@square matrix C<$B> such that C<$A = ~$B*$B>. This is equivalent toA matrix C<$A> is Gramian if and only if there exists aReturns a boolean value indicating if the give matrix is Gramian.C<$matrix-Eis_gramian();>=item *A matrix is binary if it contains only zeroes or ones. Returns a boolean value indicating if the given matrix is binary.C<$matrix-Eis_binary();>=item *Only quadratic matrices can orthogonal.turns out to be the identity matrix, false otherwise.method multiplies the matrix by it's transpose, and returns true if this inverse of the matrix. Instead of computing each and comparing them, thisAn orthogonal matrix is has the property that the transpose equals theReturns a boolean value indicating if the given matrix is orthogonal.C<$matrix-Eis_orthogonal();>=item *Note: diagonal matrices are both upper and lower triangular.Only quadratic matrices can be lower triangular.i.e. all of the nonzero elements not on the main diagonal are below it.Returns a boolean value indicating if the given matrix is lower triangular,C<$matrix-Eis_lower_triangular();>=item *Note: diagonal matrices are both upper and lower triangular.Only quadratic matrices can be upper triangular.i.e. all of the nonzero elements not on the main diagonal are above it.Returns a boolean value indicating if the given matrix is upper triangular, C<$matrix-Eis_upper_triangular();>=item *Only quadratic matrices can be tridiagonal.or the diagonals above and below the main diagonal.tridiagonal, i.e. all of the nonzero elements are on the main diagonalReturns a boolean value indicating if the given matrix is C<$matrix-Eis_tridiagonal();>=item * Only quadratic matrices can be diagonal.diagonal, i.e. all of the nonzero elements are on the main diagonal.Returns a boolean value indicating if the given matrix isC<$matrix-Eis_diagonal();>=item *Only quadratic matrices can be skew symmetric.C<($matrix == -(~$matrix))> but without memory allocation.if (B[I,I]=B<-M>[I,I]). This is equivalent toskew symmetric. By definition, a matrix is symmetric if and onlyReturns a boolean value indicating if the given matrix isC<$matrix-Eis_skew_symmetric();>=item *A matrix plus its transpose is always symmetric.Notes: A symmetric matrix always has real eigenvalues/eigenvectors.Only quadratic matrices can be symmetric.C<($matrix == ~$matrix)> but without memory allocation.if (B[I,I]=B[I,I]). This is equivalent tosymmetric. By definition, a matrix is symmetric if and onlyReturns a boolean value indicating if the given matrix isC<$matrix-Eis_symmetric();>=item *This is an alias for C.C<$matrix-Eis_square();>=item * quadratic if it has the same number of rows as it does columns.quadratic (also know as "square" or "n by n"). A matrix is Returns a boolean value indicating if the given matrix is C<$matrix-Eis_quadratic();>=item * =over 4=head2 Boolean Matrix Operations=backthe the absolute value of C<$integer>. The matrix must be quadratic.integer is given, the inverse will be computed (if it exists) and then raisedbe an integer. If it is zero, the identity matrix is returned. If a negativeRaises the matrix to the C<$integer> power. Obviously, C<$integer> mustC<$matrix_to_power = $matrix1-Eexponent($integer);>=item *output matrix may be identical.This operation can also be carried out "in-place", i.e., input andadt|{srYXb54,+   b a Y X 7 6 { p o g f E D  g f $ U  [ / Ij7u>|C#yIH@?zyC`'really a tridiagonal matrix, B can be omitted (ithouseholder() method, not a mere tridiagonal. If B issymmetric matrix B previously reduced by theif the desired eigenvectors correspond to a more generalduring B (eigenvectors) computation. It should be suppliedtransformation matrix B that should be used additionallyThe optional argument $Q corresponds to an orthogonaloutput values described for sym_diagonalize().matrix B. On output, $l and $V are similar to theThis method diagonalizes the symmetric tridiagonalC<($l, $V) = $T-Etri_diagonalize([$Q]);>=item *between B and B (C<$M == $Q * $T * ~$Q>).is an I matrix performing the tranformationdiagonal and off-diagonal elements are non-zero) and BOn output, B is a symmetric tridiagonal matrix (onlyin $matrix to tridiagonal form.the I by I real I matrix B containedThis method performs the Householder algorithm which reducesC<($T, $Q) = $matrix-Ehouseholder();>=item *(symmetric) matrixes.hidden by the 'O' is one of the best possible for generalis O(N^3). According to several books, the coefficientThe overall algorithmic complexity of this techniqueintermediate results are not desired.tri_diagonalize() methods described below when theirIn fact, this routine wraps the householder() andin a compact form in this routine to save memory.)tridiagonal. (The tridiagonal matrix is kept internallyfollowed by a QL algoritm with implicit shifts on thisThe method uses a Householder reduction to tridiagonal formB is of course that: B * B = I * B.The primary property of an eigenvalue I and an eigenvectorcorresponding normalized eigenvectors.of B and B is an orthogonal matrix which columns are theOn output, B is a column vector containing all the eigenvaluesI matrix B stored in $matrix.This method performs the diagonalization of the quadraticC<($l, $V) = $matrix-Esym_diagonalize();>=item *=over 2=head2 Eigensystems=back both a row and column vector.A col vector is a matrix which is nx1. Note that the 1x1 matrix isReturns a boolean value indicating if the matrix is a col vector.C<$matrix-Eis_col_vector();>=item *both a row and column vector.A row vector is a matrix which is 1xn. Note that the 1x1 matrix isReturns a boolean value indicating if the matrix is a row vector.C<$matrix-Eis_row_vector();>=item *the original matrix, i.e C<$matrix ** 2 == $matrix>.which is defined as the square of the matrix being equal to Returns a boolean value indicating if the matrix is idempotent,C<$matrix-Eis_idempotent();>=item *function. When C<$k == 1>, this reduces down to the Cwith period $k. This is true if C<$matrix ** ($k+1) == $matrix>.Returns a boolean value indicating if the matrix is periodicC<$matrix-Eis_periodic($k);>=item *will cause C to return false.negative entries. Note that a zero entry is not negative andReturns a boolean value indicating if the matrix contains onlyC<$matrix-Eis_negative();>=item *will cause C to return false.positive entries. Note that a zero entry is not positive andReturns a boolean value indicating if the matrix contains onlyC<$matrix-Eis_positive();>=item *matrix.Returns a boolean value indicating if the matrix is an LR decompositionC<$matrix-Eis_LR();>=item *is what Math::MatrixReal uses to check for this property.checking if C<$A> is symmetric and has all nonnegative eigenvalues, whichadb\[%|D  [ D C  r q 4 b { H i h & on-jQP43^q."!lu#r(' \end{array} \right) 9.10&3.00 5.68&2.00 \\ 1.23&1.00 \\ \left( \begin{array}{ll} $A = $ $ Output: print $a->as_latex( ( format => "%.2f", align => "l",name => "A" ) ); my $a = Math::MatrixReal->new_from_cols([[ 1.234, 5.678, 9.1011],[1,2,3]] );Example:element can be used so that a LaTeX string of "$name = " is prepended to the string.style of number format, such a floating point or scientific notation. The CC element is a format string that is given to C to control themay be "c","l" or "r", corresponding to center, left and right, respectively. Theargument which is used to control the style of the output. The hash element CThis function returns the matrix as a LaTeX string. It takes a hash as anC<$latex_string = $matrix-Eas_latex( align=E "c", format =E "%s", name =E "" );>=item *unchanged!)and multiplying it with some other matrix leaves that other matrixthen multiplying this matrix with itself yields this same matrix again,(If the matrix is quadratic (which this method doesn't require, though),operation in a Ring.matrix into a "one"-matrix, the neutral element of the multiplicationthereby erasing all values previously stored there and transforming the(2,2), (3,3) and so on) of matrix "C<$matrix>" and zero's to all others,Assigns one's to the elements on the main diagonal (elements (1,1),=item * $matrix-Eone();"C"!)i.e., in general, "C" is not the same ascharacteristic of a Ring is that multiplication is not commutative,and matrix addition and multiplication form a Ring. Most prominent(For instance the (quadratic) matrices with "n" rows and columnsthe neutral element of the addition operation in a Ring.transforming the matrix into a "zero"-matrix or "null"-matrix,erases all values previously stored there, thereby effectivelyAssigns a zero to every element of the matrix "C<$matrix>", i.e.,=item * $matrix-Ezero();=over 4=head2 Miscellaneous =backwhen eigenvectors are not needed.This method is much more efficient than tri_diagonalize()containing the eigenvalues (similar to C).tridiagonal matrix B. On output, $l is a vectorThis method computesthe eigenvalues of the symmetric=item * $l = $T-Etri_eigenvalues();computed.a little more efficient as the transformation matrix is notoperation is similar to the householder() method, but potentially(only diagonal and off-diagonal elements are non-zero). TheOn output, B is the obtained symmetric tridiagonal matrixin $matrix to tridiagonal form.the I by I real I matrix B containedThis method performs the Householder algorithm which reducesC<$T = $matrix-Ehouseholder_tridiagonal();>=item *intermediate tridiagonal matrix is not needed.tri_eigenvalues() methods described below when theThis routine wraps the householder_tridiagonal() andbenchmark, it's wiser.by the 'O' is better by a factor of..., well, see yourtechnique is still also O(N^3). But the coefficient hiddenHowever, understand that the algorithmic complexity of this(even though it uses a similar algorithm with two phases).C) and this method is more efficientof B. Eigenvectors are not computed (on the contrary ofOn output, B is a column vector containing all the eigenvaluesI matrix B stored in $matrix.This method computes the eigenvalues of the quadraticC<$l = $matrix-Esym_eigenvalues();>=item *The method uses a QL algorithm (with implicit shifts).will be internally created in fact as an identity matrix).adeH5X M   _ ^  w % s r i h   ~ v u   d6NFE=<po+KJv]\Ecoefficient appearing in that row. So this coefficient becomes equaleach row has been divided by (the absolute value of) the greatestApplying this method to the pair (A,b) yields a pair (A',b') wherevector "b".solves the equation system represented by the matrix "A" and theout a vector "x" so that C, i.e., the vector "x" whichSuppose you have a matrix "A" and a vector "b" and you want to findlinear equation systems.This method is used to improve the numerical stability when solvingC<($norm_matrix,$norm_vector) = $matrix-Enormalize($vector);>=item *Matrix "C<$cost_matrix>" is not changed by this method in any way.The method returns an object reference to the new matrix.See L for more details about this algorithm!applies Kleene's algorithm to it.a new matrix of the same size (i.e., "clones" the input matrix) andCopies the matrix "C<$cost_matrix>" (which has to be quadratic!) toC<$minimal_cost_matrix = $cost_matrix-Ekleene();>=item *method.or returns the value of the largest element of a matrix if called with one arguemnt or as on objectReturns the maximum of the two numbers "C" and "C" if called with two arguments,C<<$maximum = $matrix->max;>>C<$maximum = Math::MatrixReal::max($matrix);>C<$maximum = Math::MatrixReal::max($number1,$number2);>C<$maximum = Math::MatrixReal::max($number1,$number2);>=item *method.or returns the value of the smallest element of a matrix if called with one argument or as an objectReturns the minimum of the two numbers "C" and "C" if called with two arguments, C<<$minimum = $matrix->min;>>C<$minimum = Math::MatrixReal::min($matrix);>C<$minimum = Math::MatrixReal::min($number1,$number2);>=item *same matrix format.This function is just an alias for C, since both Scilab and Matlab have theC<$scilab_string = $matrix-Eas_scilab( format =E "%s", name =E "", semi =E 0 );>=item * 1.000 2.000 3.000]; A = [ 1.234 5.678 9.101;Output: print $a->as_matlab( ( format => "%.3f", name => "A",semi => 1 ) ); my $a = Math::MatrixReal->new_from_rows([[ 1.234, 5.678, 9.1011],[1,2,3]] );Example:be set to 1 to that a semicolon is appended (so Matlab does not print out the matrix.) element can be used so that "$name = " is prepended to the string. The element canstyle of number format, such a floating point or scientific notation. The CC element is a format string that is given to C to control thean an argument which controls the style of the output. TheThis function returns the matrix as a string that can be read by Matlab. It takes a hash asC<$matlab_string = $matrix-Eas_matlab( format =E "%s", name =E "", semi =E 0 );>=item * A := {{1.23,1.00},{5.68,2.00},{9.10,3.00}}Output: print $a->as_yacas( ( format => "%.2f", align => "l",name => "A" ) ); $a = Math::MatrixReal->new_from_cols([[ 1.234, 5.678, 9.1011],[1,2,3]] );Example:be set to 1 to that a semicolon is appended (so Matlab does not print out the matrix.) element can be used so that "$name = " is prepended to the string. The element canstyle of number format, such a floating point or scientific notation. The CC element is a format string that is given to C to control thean an argument which controls the style of the output. TheIt takes a hash asThis function returns the matrix as a string that can be read by Yacas.C<$yacas_string = $matrix-Eas_yacas( format =E "%s", name =E "", semi =E 0 );>=item * $ad uQ t0 b a ! i h \ [ / . v j ^ U T 8  z Q M 6  p V < 6   C  aP)(d# KJyN#Bout of account permutations of the rows and columns (these are takenC==E A * x = b> for all vectors "x", leavingNote that "C" is equivalent to matrix "A" in the sense that [ x x x x 1 ] [ 0 0 0 0 x ] [ x x x 1 0 ] [ 0 0 0 x x ] L = [ x x 1 0 0 ] R = [ 0 0 x x x ] [ x 1 0 0 0 ] [ 0 x x x x ] [ 1 0 0 0 0 ] [ x x x x x ]of the matrix, as follows:and above of the main diagonal and all zero's in the lower left half"R" has non-zero values on the main diagonal as well as to the rightand all zero's in the upper right half of the matrix.and so so), non-zero values to the left and below of the main diagonal"L" has one's on the main diagonal (the elements (1,1), (2,2), (3,3)"Left" and "Right").matrix "A" into two triangular matrices, called "L" and "R" (forof one row or column to another), it is possible to decompose anya factor, swapping two rows or two columns and adding a multipleUsing Gaussian transformations (multiplying a row or column withso that C, for C.vectors "b1".."bk" for which you need to find vectors "x1".."xk"You might also have a matrix "A" and a whole bunch of differentvector "b".solves the equation system represented by the matrix "A" and theout a vector "x" so that C, i.e., the vector "x" whichSuppose you have a matrix "A" and a vector "b" and you want to findThis method is needed to solve linear equation systems.C<$LR_matrix = $matrix-Edecompose_LR();>=item *the result is "better", i.e., more accurate!You can see that in the second example (where "normalize()" has been used), [ 2.900000000000E+01 ] [ 1.000000000000E+00 ] [ 0.000000000000E+00 ] A * x = [ -1.000000000000E+00 ] [ 1.000000000000E+00 ] [ 1.000000000000E+00 ] x = [ 2.900000000000E+01 ] [ 1.000000000000E+00 ] [ 4.440892098501E-16 ] A * x = [ -1.000000000000E+00 ] [ 1.000000000000E+00 ] [ 1.000000000000E+00 ] x =This will print: } print "A * x = \n$test"; print "x = \n$x"; $test = $A * $x; { if (($dim,$x,$B) = $LR->solve_LR($b_)) $LR = $A_->decompose_LR(); ($A_,$b_) = $A->normalize($b); } print "A * x = \n$test"; print "x = \n$x"; $test = $A * $x; { if (($dim,$x,$B) = $LR->solve_LR($b)) $LR = $A->decompose_LR(); MATRIX [ 29 ] [ 1 ] [ 0 ] $b = Math::MatrixReal->new_from_string(<<"MATRIX"); MATRIX [ 23 19 13 ] [ 5 7 11 ] [ 1 2 3 ] $A = Math::MatrixReal->new_from_string(<<"MATRIX"); use Math::MatrixReal qw(new_from_string); #!perl -wConsider the following little program:equation systems (explained immediately below following this method):Example of how this method can affect the result of the methods to solveThe input matrix and vector are not changed by this in any way.to which the operation explained above has been applied.The output matrix and vector are clones of the input matrix and vectororder.which are object references to a new matrix and a new vector, in thisnumber of rows as the input matrix) and returns a list of two items"C<$vector>" for input (the vector must be a column vector with the sameThe method requires a quadratic (!) matrix "C<$matrix>" and a vectorsign!because the same division is carried out on either side of the equationNote that this operation does not change the equation system itselfthan one and greater than minus one).to "1" (or "-1") in the new pair (A',b') (all others become smalleradf|9-, SR f S R   R  u 4   } Q P 2 1 L   ;po*bLKZYz,+#"RR('empty list otherwise (!).The method returns a list of three items if a solution exists or anrows as the input matrix "C<$LR_matrix>".C, which must be a column vector and have the same number ofThe input vector "C<$b_vector>" is the vector "b" in your equation system"A" of your equation system C.method "decompose_LR()", the LR decomposition matrix of the matrixMatrix "C<$LR_matrix>" must be a (quadratic) matrix returned by theUse this method to actually solve an equation system.C<($dimension,$x_vector,$base_matrix) = $LR_matrix>C<-E>C=item *to contain at that moment, be they meaningful as an ordinary matrix or not!).immediately reverts to an "ordinary" matrix (with the values it just happensof the matrix, its "magical" properties are stripped off, and the matrixHowever, as soon as you are applying any method that alters the contentspermutations of its rows and columns).losing its "magical" properties (for instance concerning the hiddenNote that you can "copy()" or "clone()" the result of this method withoutThe input matrix is not changed by this method in any way.matrices "L" and "R".The method returns an object reference to a new matrix containing thea matrix that has been created with "new()" or "shadow()").nothing to fill the superfluous rows if it's a "fresh" matrix, i.e.,If you don't have that many equations, fill up with zero's (i.e., doThis method requires a quadratic matrix as its input matrix.is much more efficient than a straightforward, "brute force" approach.for which you are searching solutions to C - this schemeYou can see that - especially when you have many vectors "b1".."bk"and so on. / R[n-2,n-2] x[n-2] = ( y[n-2] - R[n-2,n-1] * x[n-1] - R[n-2,n] * x[n] )and x[n-1] = ( y[n-1] - R[n-1,n] * x[n] ) / R[n-1,n-1]that C. It follows thatcalculate the vector "x" in a similar fashion: we see immediatelyHaving effortlessly calculated the vector "y", we now proceed toand so on. y[3] = b[3] - L[3,1] * y[1] - L[3,2] * y[2](and we know "C" by now!), that y[2] = b[2] - L[2,1] * y[1]C. We then deduce swiftly thatand "C" is straightforward: we immediately know thatFrom the illustration above it is clear that solving "C"finally "C" (motto: divide and rule!).decompose "A" into "L" and "R" and then solve "C" andproblem in parts: instead of solving C directly, we firstTo find the solution to our problem "C", we divide thisto get "C"!).the solution is trivial, simply divide "C" by "C"has non-zero values only on its main diagonal - in which casethat can happen to us besides a diagonal matrix (a matrix thatIt helps us because a triangular matrix is the next best thingNow what does all this help us in solving linear equation systems?the matrix "Ai'"!)(You need to apply "normalize()" to each pair (Ai,bi) B decomposingrubbish!to an "LR" decomposition matrix. Trying to do so will yield meaninglessNote also that for the same reason, you cannot apply the method "normalize()"Beware, though, that "LR" and "C" are not the same!!! [ L L L L R ] [ L L L R R ] LR = [ L L R R R ] [ L R R R R ] [ R R R R R ]loss! I.e.,store both matrices together in the same array without informationBecause we know that "L" has one's on its main diagonal, we canTrick:care of "magically" by this module!) and numerical errors.adqd`YU{1 \ @ ? H : 9   M I H 6   J F E ~}1P [WPLs+ cb<;wv.W*)Numerical stability means for example that ifcomputations carried out using this matrix).condition of the matrix (the better the stability of all subsequentThis number is always positive, and the smaller its value, the better the"C<$matrix>", i.e., a measure of the numerical stability of the matrix.The number returned is a measure of the "condition" of the given matrixas returned by the method "invert_LR()").is meaningful only if one of them is the inverse of the other (for instance,Both input matrices must be quadratic and have the same size, and the result abs($matrix) * abs($inverse_matrix)In fact this method is just a shortcut forC<$condition = $matrix-Econdition($inverse_matrix);>=item *The input matrix is not changed by this method in any way.so on) and zero's elsewhere.containing one's on the main diagonal (elements (1,1), (2,2), (3,3) andof the initial matrix and its inverse (or vice-versa) is always a matrixNote that by definition (disregarding numerical errors), the product } # do something with the fact that there is no inverse matrix... { else } # do something with the inverse matrix... { if ( $inverse_matrix = $LR->invert_LR() )Therefore, you should always use this method in the following way:otherwise.fed into "decompose_LR()" B, or an empty listthe input matrix containing the inverse of the matrix that you initiallyThe method returns an object reference to a new matrix of the same size aswhich must be a (quadratic) matrix returned by the method "decompose_LR()".Use this method to calculate the inverse of a given matrix "C<$LR_matrix>",C<$inverse_matrix = $LR_matrix-Einvert_LR();>=item *in any way.Note that the input matrix and vector are not changed by this method $vector = $x_vector + ( $base_matrix * $rand_vector ); } $rand_vector->assign($i,1, rand($machine_infinity) ); { for ( $i = 1; $i <= $dimension; $i++ ) $machine_infinity = 1E+99; # or something like that $rand_vector = $x_vector->shadow();a little more efficient as follows:By the way, note that you can actually calculate those vectors "C<$vector>"should print a number around 1E-16 or so! print abs( $A_matrix * $vector - $b_vector ), "\n";your matrix "A", thenis a solution to your problem C, i.e., if "C<$A_matrix>" contains } $vector += rand($machine_infinity) * $base_matrix->column($i); { for ( $i = 1; $i <= $dimension; $i++ ) $machine_infinity = 1E+99; # or something like that $vector = $x_vector->clone();But also any vector "C<$vector>"C.The output vector "x" is B a solution of your equation systemNow what is all this stuff with that "base" good for?contain entries, the remaining columns are all zero.Only the first "C<$dimension>" columns of this base matrix actuallythe spokes of an umbrella).solution space (a set of vectors which put up the solution space likeC) and a matrix "C<$base_matrix>" representing a base of thevector "C<$x_vector>" (which is the vector "x" of your equation systema straight line, two if the solution is a plane, and so on), the solutionspace (which is zero if only one solution exists, one if the solution isThe three items returned are: the dimension "C<$dimension>" of the solution } # do something with the fact that there is no solution... { else } # do something with the solution... { if ( ($dim,$x_vec,$base) = $LR->solve_LR($b_vec) )Therefore, you should always use this method like this:admEDu3  z 3   f $ ` # i M L D C   e d   c98t7+*"!M76n`_:aiF#"MC<$length = $vector-Elength();>=item *of each of the input vectors with the resulting vector is always zero.is the null vector, otherwise this is trivial), i.e., the scalar productvector is orthogonal to both of the input vectors (if neither of bothA characteristic property of the vector product is that the resulting z[3] = x[1] * y[2] - x[2] * y[1] z[2] = x[3] * y[1] - x[1] * y[3] z[1] = x[2] * y[3] - x[3] * y[2]This determinant evaluates to the rather simple formulain this matrix!).elsewhere (this means that you have numbers and vectors as elementsvectors with a length equal to one) with a one in row "i" and zero's"x" and "y", respectively, and the "C" are unity vectors (i.e.,where the "C" and "C" are the components of the two vectors | x[3] y[3] e[3] | determinant | x[2] y[2] e[2] | | x[1] y[1] e[1] |is defined asIn 3 dimensions, the vector product of two vectors "x" and "y"vectors with 3 rows); all other vectors trigger an error message.Currently, the vector product is only defined for 3 dimensions (i.e.,but only one column).Both vectors must be column vectors (i.e., a matrix having several rowsReturns the vector product of vector "C<$vector1>" and vector "C<$vector2>".C<$vector_product = $vector1-Evector_product($vector2);>=item *vice-versa.between them, exactly when their scalar product is zero, andthe two vectors are orthogonal, i.e., have an angle of 90 degreesProvided none of the two input vectors is the null vector, thenor the sum C of the products C. $scalar_product = $temp->element(1,1); $temp = ~$vector1 * $vector2;This is a (more efficient!) shortcut forseveral rows but only one column).Both vectors must be column vectors (i.e., a matrix havingReturns the scalar product of vector "C<$vector1>" and vector "C<$vector2>".C<$scalar_product = $vector1-Escalar_product($vector2);>=item *is usually called the "rank" in the United States.This is an alias for the C function. The "order"C<$rank = $LR_matrix-Erank_LR();>=item *associated equation system.then "n - order" is the dimension of the solution space of theIf "n" is the number of rows and columns of the (quadratic!) matrix,matrix that was initially fed into "decompose_LR()".the case of a matrix representing an equation system) of theand column vectors (= number of linear independent equations inThis number is a measure of the number of linear independent rowbe a (quadratic) matrix returned by the method "decompose_LR()").LR decomposition matrix "C<$LR_matrix>" must be given (which mustCalculates the order (called "Rang" in German) of a matrix, whoseC<$order = $LR_matrix-Eorder_LR();>=item *(The sign is taken care of "magically" by this module)of the LR decomposition matrix.elements on the main diagonal (elements (1,1), (2,2), (3,3) and so on)(in principle, that is, except for the sign) simply the product of theIn fact the determinant is a by-product of the LR decomposition: It isreturned by the method "decompose_LR()")."C<$LR_matrix>" must be given (which must be a (quadratic) matrixCalculates the determinant of a matrix, whose LR decomposition matrixC<$determinant = $LR_matrix-Edet_LR();>=item *also holds. abs( $matrix * $vec_correct - $matrix * $vec_with_error ) < $delta"C<$vec_correct>" (nor "C<$vec_with_error>", by the way) so thatholds, there must be a "C<$delta>" which doesn't depend on the vector abs( $vec_correct - $vec_with_error ) < $epsilonad }cb"K54 } ` _  ] U '  L  : 9 1 0 [ ( ' S43RA  xwVU54POKJL65%M a[i,i+1] x[i+1] + ... + a[i,n] x[n] ) ( a[i,1] x[1] + ... + a[i,i-1] x[i-1] + ( b[i] - <==> x[i] = ) / a[i,i] + a[i,i] x[i] - ( a[i,1] x[1] + ... + a[i,i] x[i] + ... + a[i,n] x[n] ) ( b[i] <==> x[i] = + a[i,i] x[i] - ( a[i,1] x[1] + ... + a[i,i] x[i] + ... + a[i,n] x[n] ) b[i] <==> a[i,i] x[i] = a[i,1] x[1] + ... + a[i,i] x[i] + ... + a[i,n] x[n] = b[i]to calculateNote that actually solving the equation system "C" meansqed ( -a[i,1] x[1] + ... + (1 - a[i,i]) x[i] + ... + -a[i,n] x[n] ) + b[i]is the same as x[i] - ( a[i,1] x[1] + ... + a[i,i] x[i] + ... + a[i,n] x[n] ) + b[i]This last step is true because <==> ( En - A ) * x + b = x <==> x - ( A * x ) + b = x <==> -( A * x ) + x + b = x <==> -( A * x ) + x = -b + x <==> -( A * x ) = -b A * x = bProof:This function has the required property.with one's on its main diagonal and zero's elsewhere.where "En" is a matrix of the same size as "A" ("n" rows and columns) Phi(x) := ( En - A ) * x + bWe can define "C" as follows: Phi(x) = x <==> A * x = bthe property:be described by an iteration function "C" which hasMethod" or "Relaxationsverfahren"), are fix-point iterations, that is, canSSM ("Single Step Method" or "Einzelschrittverfahren") and RM ("RelaxationAll three methods, GSM ("Global Step Method" or "Gesamtschrittverfahren"),of the three implemented here.greater than by using an approximative (iterative) algorithm like oneof the matrix "A", the numerical error of the obtained result can beIn fact in some cases, due to the numerical properties (the "condition")the "decompose_LR()" and "solve_LR()" method pair.equation system "C" using an analytical algorithm likeIn some cases it might not be practical or desirable to solve anC<$xn_vector = $matrix-E>C=item *C<$xn_vector = $matrix-E>C=item *C<$xn_vector = $matrix-E>C=item *for matrices applied to a vector!and if "n" goes to infinity, you have the "infinity"- or "maximum"-normvector, the case "n = 2" is the euclidian norm or length of a vector,Note that the case "n = 1" is the "one"-norm for matrices applied to a } return( $sum ** (1 / $n) ); } $sum += $comp ** $n; $comp = abs( $vector->[0][$k][0] ); { for ( $k = 0; $k < $rows; $k++ ) $sum = 0; unless ($n == int($n)); croak "Math::MatrixReal::vector_norm(): norm index must be integer" unless ($n > 0); croak "Math::MatrixReal::vector_norm(): norm index must be > 0" unless ($cols == 1); croak "Math::MatrixReal::vector_norm(): vector is not a column vector" my($k,$comp,$sum); my($rows,$cols) = ($vector->[1],$vector->[2]); my($vector,$n) = @_; if (@_ != 2); croak "Usage: \$norm = \$vector->vector_norm(\$n);" { sub vector_normThe general definition for norms of vectors is the following:"two"-norm (also know as the Euclidean norm) of a vector "C<$vector>"!Note that the "length" calculated by this method is in fact theand returns the length of a given column or row vector "C<$vector>". $length = sqrt( $vector->scalar_product($vector) );This is actually a shortcut forad1bf#c>=   u . P 4 3 ]  | E D  h ] \   QP|a`%$~}tk; vWVMDp1y6vcb$Remember that in most cases, it is probably advantageous to firstExperiment!The three methods are supposed to be of different efficiency.less than two (!).Note that the weight "C<$weight>" should be greater than zero and y[i] = weight * y[i] + (1 - weight) * x[i] ) / a[i,i] a[i,i+1] x[i+1] + ... + a[i,n] x[n] ) # note the "x[]"! - ( a[i,1] y[1] + ... + a[i,i-1] y[i-1] + # note the "y[]"! ( b[i] y[i] =water tap", according to the formula:"aperture" of both the "hot water tap" as well as of the "coldcold and hot water), and the weight "C<$weight>" determines the"C" are calculated by "mixing" old and new value (likeIn the "Relaxation method" ("RM"), the components of the vector ) / a[i,i] a[i,i+1] x[i+1] + ... + a[i,n] x[n] ) # note the "x[]"! - ( a[i,1] y[1] + ... + a[i,i-1] y[i-1] + # note the "y[]"! ( b[i] y[i] =the remaining components, i.e."C" which have already been calculated are used to calculateIn the "Single Step Method" ("SSM"), the components of the vector ) / a[i,i] a[i,i+1] x[i+1] + ... + a[i,n] x[n] ) - ( a[i,1] x[1] + ... + a[i,i-1] x[i-1] + ( b[i] y[i] =(called "x" here) according to the formula:(called "y" here) is calculated from the vector "C"In the "Global Step Method" ("GSM"), the new vector "C"The difference between the three methods is the following:iteration takes too long!)a problem. Anyway, you can always press if you think that thevector is too far "off" the solution! In practice, this shouldn't be(Beware that theoretically, infinite loops might result if the startingOtherwise, they iterate until C epsilon>. } # do something with the fact that there is no solution... { else } # do something with the solution... { if ( $xn_vector = $A_matrix->solve_GSM($x0_vector,$b_vector,1E-12) )code like:Therefore, you should always test their return value using someare not fulfilled.conditions listed above and return an empty list if these conditionsThe three methods first test the first two conditions of the threeis B checked to lie within any reasonable range!)(Note that the weight "C<$weight>" used by the "Relaxation Method" ("RM")between zero and two, and finally an error limit (real number) "C<$epsilon>".case of the "Relaxation Method" ("RM"), a real number "C<$weight>" best(which is the vector "b" in your equation system "C"), in thefirst argument, a start vector "C<$x0_vector>", a vector "C<$b_vector>"The three methods expect a (quadratic!) matrix "C<$matrix>" as their"C" is "a"!)(Remember school math: the first derivative of a straight line given by"C"."C" must be "good enough", i.e., "close enough" to the solutionnot have any zero value on its main diagonal and the initial vectorfunction, C<( En - A )>, has a value less than one, the matrix "A" mayThere must exist a norm so that the norm of the matrix of the iterationIn our case, this restriction translates to the following three conditions:See literature on Numerical Analysis for details!to do in this textual documentation!This is best verified graphically, which unfortunately is impossibleif the start vector "C" lies within that area!point "C" for which "C" is to be true, andfunction has an absolute value less than one in an area around theguaranteed to converge only if the first derivative of the iterationThere is one major restriction, though: a fix-point iteration is ) / a[i,i]ad3on;:21<;  ~ x w d c [ Z P O A @  { z 0 / . $ #   z y k j > = 3 2  m l c b @ ? 4 3 & % x w I H > =  poFE]%$qA@'ih^]65 ~}^]54gf\[432 $matrix_P = $matrix_A * $matrix_B;Examples:the product of the given matrix and scalar factor.Returns the matrix product of the two given matrices orMultiplication=item '*'(The latter are less efficient, though) $matrix_A += -$matrix_B; $matrix_S = $matrix_A + -$matrix_B;Note that this is the same as: $matrix_A -= $matrix_B; $matrix_D = $matrix_A - $matrix_B;Examples:Returns the difference of the two given matrices.Subtraction=item '-' $matrix_A += $matrix_B; $matrix_S = $matrix_A + $matrix_B;Examples:Returns the sum of the two given matrices.Addition=item '+' if ($test == $matrix) { print ":-)\n"; } else { print ":-(\n"; } $test = Math::MatrixReal->new_from_string($string); $string = "$matrix"; [ 0.000000000000E+00 -1.000000000000E+00 ] [ 1.000000000000E+00 0.000000000000E+00 ] print "$matrix"; MATRIX [ 0 -1 ] [ 1 0 ] $matrix = Math::MatrixReal->new_from_string(<<"MATRIX");Examples:so that lines will wrap nicely on an 80-column screen. By default a 13-digit mantissa and a 20-character field for each element is usedyou want to read this string back in again later with "new_from_string()".Uses scientific representation to keep precision loss to a minimum in caseConverts the given matrix into a string."Stringify" operator=item '""""' unless ($x_vector) { # not the null-vector! } else { # homogenous equation system ... } if (! $b_vector) { # heterogenous equation system ... }Examples:Tests wether the matrix contains only zero's.Negated boolean test=item '!' if ($xn_vector) { # result of iteration is not zero ... }Example:Tests wether there is at least one non-zero element in the matrix.Boolean test=item test $error = abs( $A * $x - $b );Example:Returns the "one"-Norm of the given matrix.Norm=item abs if (~$matrix == $matrix) { # matrix is symmetric ... } $length = sqrt( $temp->element(1,1) ); $temp = ~$vector * $vector;Examples:Returns the transposed of the given matrix.Transposition=item '~' $matrix = -$matrix;Example:all elements multiplied with the factor "-1".Returns the negative of the given matrix, i.e., the matrix withUnary minus=item '-'Note that only matrices with the same number of rows may be concatenated. [ 3 4 7 8 ] $c=[ 1 2 5 6 ]then [ 3 4 ] [ 7 8 ] $a=[ 1 2 ] $b=[ 5 6 ] if For example, $c = $a . $b;Example:Returns the two matrices concatenated side by side.Concatenation=item '.'=over 5=head2 DESCRIPTION=backonly.of the former ("C<==>", "C", ... ), defined for convenienceNote that the latter ("C", "C", ... ) are just synonyms"C", "C", "C", "C", "C", "C""C<==>", "C", "C>", "C=>", "C>", "C=>"Binary (relational) operators:=item *"C<+=>", "C<-=>", "C<*=>", "C","C<**=>""C<+>", "C<->", "C<*>", "C<**>",Binary (arithmetic) operators:"C<.>"Binary operators:=item *"C<->", "C<~>", "C", C, "C", 'C<"">'Unary operators:=item *=over 2=head2 SYNOPSIS=head1 OVERLOADED OPERATORS=back"normalize()" your equation system prior to solving it!Math-MatrixReal-2.13/lib/Math/MatrixReal.pm00044456105627002104 50125612772016550 20763 0ustar00jonathanleto000000000000# Copyright (c) 1996, 1997 by Steffen Beyer. All rights reserved. # Copyright (c) 1999 by Rodolphe Ortalo. All rights reserved. # Copyright (c) 2001-2016 by Jonathan Leto. All rights reserved. # This package is free software; you can redistribute it and/or # modify it under the same terms as Perl itself. package Math::MatrixReal; use strict; use warnings; use Carp; use Data::Dumper; use Scalar::Util qw/reftype/; use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION); require Exporter; @ISA = qw(Exporter); @EXPORT = qw(); @EXPORT_OK = qw(min max); %EXPORT_TAGS = (all => [@EXPORT_OK]); $VERSION = '2.13'; use overload '.' => '_concat', 'neg' => '_negate', '~' => '_transpose', 'bool' => '_boolean', '!' => '_not_boolean', 'abs' => '_norm', '+' => '_add', '-' => '_subtract', '*' => '_multiply', '/' => '_divide', '**' => '_exponent', '+=' => '_assign_add', '-=' => '_assign_subtract', '*=' => '_assign_multiply', '**=' => '_assign_exponent', '==' => '_equal', '!=' => '_not_equal', '<' => '_less_than', '<=' => '_less_than_or_equal', '>' => '_greater_than', '>=' => '_greater_than_or_equal', 'eq' => '_equal', 'ne' => '_not_equal', 'lt' => '_less_than', 'le' => '_less_than_or_equal', 'gt' => '_greater_than', 'ge' => '_greater_than_or_equal', '=' => '_clone', '""' => '_stringify', 'fallback' => undef; =head1 NAME Math::MatrixReal - Matrix of Reals Implements the data type "matrix of real numbers" (and consequently also "vector of real numbers"). =head1 SYNOPSIS my $a = Math::MatrixReal->new_random(5, 5); my $b = $a->new_random(10, 30, { symmetric=>1, bounded_by=>[-1,1] }); my $c = $b * $a ** 3; my $d = $b->new_from_rows( [ [ 5, 3 ,4], [3, 4, 5], [ 2, 4, 1 ] ] ); print $a; my $row = ($a * $b)->row(3); my $col = (5*$c)->col(2); my $transpose = ~$c; my $transpose = $c->transpose; my $inverse = $a->inverse; my $inverse = 1/$a; my $inverse = $a ** -1; my $determinant= $a->det; =cut sub new { croak "Usage: \$new_matrix = Math::MatrixReal->new(\$rows,\$columns);" if (@_ != 3); my ($self,$rows,$cols) = @_; my $class = ref($self) || $self || 'Math::MatrixReal'; croak "Math::MatrixReal::new(): number of rows must be integer > 0" unless ($rows > 0 and $rows == int($rows) ); croak "Math::MatrixReal::new(): number of columns must be integer > 0" unless ($cols > 0 and $cols == int($cols) ); my $this = [ [ ], $rows, $cols ]; # Create the first empty row and pre-lengthen my $empty = [ ]; $#$empty = $cols - 1; map { $empty->[$_] = 0.0 } ( 0 .. $cols-1 ); # Create a row at a time map { $this->[0][$_] = [ @$empty ] } ( 0 .. $rows-1); bless $this, $class; } sub new_diag { croak "Usage: \$new_matrix = Math::MatrixReal->new_diag( [ 1, 2, 3] );" unless (@_ == 2 ); my ($self,$diag) = @_; my $n = scalar @$diag; croak "Math::MatrixReal::new_diag(): Third argument must be an arrayref" unless (ref($diag) eq "ARRAY"); my $matrix = Math::MatrixReal->new($n,$n); map { $matrix->[0][$_][$_] = shift @$diag } ( 0 .. $n-1); return $matrix; } sub new_tridiag { croak "Usage: \$new_matrix = Math::MatrixReal->new_tridiag( [ 1, 2, 3], [ 4, 5, 6, 7], [-1,-2,-3] );" unless (@_ == 4 ); my ($self,$lower,$diag,$upper) = @_; my $matrix; my ($l,$n,$m) = (scalar(@$lower),scalar(@$diag),scalar(@$upper)); my ($k,$p)=(-1,-1); croak "Math::MatrixReal::new_tridiag(): Arguments must be arrayrefs" unless ref $diag eq 'ARRAY' && ref $lower eq 'ARRAY' && ref $upper eq 'ARRAY'; croak "Math::MatrixReal::new_tridiag(): new_tridiag(\$lower,\$diag,\$upper) diagonal dimensions incompatible" unless ($l == $m && $n == ($l+1)); $matrix = Math::MatrixReal->new_diag($diag); $matrix = $matrix->each( sub { my ($e,$i,$j) = @_; if (($i-$j) == -1) { $k++; return $upper->[$k];} elsif ( $i == $j) { return $e; } elsif (($i-$j) == 1) { $p++; return $lower->[$p];} } ); return $matrix; } sub new_random { croak "Usage: \$new_matrix = Math::MatrixReal->new_random(\$n,\$m, { symmetric => 1, bounded_by => [-5,5], integer => 1 } );" if (@_ < 2); my ($self, $rows, $cols, $options ) = @_; (($options = $cols) and ($cols = $rows)) if ref $cols eq 'HASH'; my ($min,$max) = defined $options->{bounded_by} ? @{ $options->{bounded_by} } : ( 0, 10); my $integer = $options->{integer}; $self = ref($self) || $self || 'Math::MatrixReal'; $cols ||= $rows; croak "Math::MatrixReal::new_random(): number of rows must = number of cols for symmetric option" if ($rows != $cols and $options->{symmetric} ); croak "Math::MatrixReal::new_random(): number of rows must be integer > 0" unless ($rows > 0 and $rows == int($rows) ) && ($cols > 0 and $cols == int($cols) ) ; croak "Math::MatrixReal::new_random(): bounded_by interval length must be > 0" unless (defined $min && defined $max && $min < $max ); croak "Math::MatrixReal::new_random(): tridiag option only for square matrices" if (($options->{tridiag} || $options->{tridiagonal}) && $rows != $cols); croak "Math::MatrixReal::new_random(): diagonal option only for square matrices " if (($options->{diag} || $options->{diagonal}) && ($rows != $cols)); my $matrix = Math::MatrixReal->new($rows,$cols); my $random_code = sub { $integer ? int($min + rand($max-$min)) : $min + rand($max-$min) } ; $matrix = $options->{diag} || $options->{diagonal} ? $matrix->each_diag($random_code) : $matrix->each($random_code); $matrix = $matrix->each( sub {my($e,$i,$j)=@_; ( abs($i-$j)>1 ) ? 0 : $e } ) if ($options->{tridiag} || $options->{tridiagonal} ); $options->{symmetric} ? 0.5*($matrix + ~$matrix) : $matrix; } sub new_from_string#{{{ {#{{{ croak "Usage: \$new_matrix = Math::MatrixReal->new_from_string(\$string);" if (@_ != 2); my ($self,$string) = @_; my $class = ref($self) || $self || 'Math::MatrixReal'; my ($line,$values); my ($rows,$cols); my ($row,$col); my ($warn,$this); $warn = $rows = $cols = 0; $values = [ ]; while ($string =~ m!^\s* \[ \s+ ( (?: [+-]? \d+ (?: \. \d*)? (?: E [+-]? \d+ )? \s+ )+ ) \] \s*? \n !ix) { $line = $1; $string = $'; $values->[$rows] = [ ]; @{$values->[$rows]} = split(' ', $line); $col = @{$values->[$rows]}; if ($col != $cols) { unless ($cols == 0) { $warn = 1; } if ($col > $cols) { $cols = $col; } } $rows++; } if ($string !~ m/^\s*$/) { chomp $string; my $error_msg = "Math::MatrixReal::new_from_string(): syntax error in input string: $string"; croak $error_msg; } if ($rows == 0) { croak "Math::MatrixReal::new_from_string(): empty input string"; } if ($warn) { warn "Math::MatrixReal::new_from_string(): missing elements will be set to zero!\n"; } $this = Math::MatrixReal::new($class,$rows,$cols); for ( $row = 0; $row < $rows; $row++ ) { for ( $col = 0; $col < @{$values->[$row]}; $col++ ) { $this->[0][$row][$col] = $values->[$row][$col]; } } return $this; }#}}}#}}} # from Math::MatrixReal::Ext1 (msouth@fulcrum.org) sub new_from_cols { my $self = shift; my $extra_args = ( @_ > 1 && ref($_[-1]) eq 'HASH' ) ? pop : {}; $extra_args->{_type} = 'column'; $self->_new_from_rows_or_cols(@_, $extra_args ); } # from Math::MatrixReal::Ext1 (msouth@fulcrum.org) sub new_from_columns { my $self = shift; $self->new_from_cols(@_); } # from Math::MatrixReal::Ext1 (msouth@fulcrum.org) sub new_from_rows { my $self = shift; my $extra_args = ( @_ > 1 && ref($_[-1]) eq 'HASH' ) ? pop : {}; $extra_args->{_type} = 'row'; $self->_new_from_rows_or_cols(@_, $extra_args ); } sub reshape { my ($self, $rows, $cols, $values) = @_; my @cols = (); my $p = 0; for my $c (1..$cols) { push @cols, [@{$values}[$p .. $p + $rows - 1]]; $p += $rows; } return $self->new_from_cols( \@cols ); } # from Math::MatrixReal::Ext1 (msouth@fulcrum.org) sub _new_from_rows_or_cols { my $proto = shift; my $class = ref($proto) || $proto; my $ref_to_vectors = shift; # these additional args are internal at the moment, but in the future the user could pass e.g. {pad=>1} to # request padding my $args = pop; my $vector_type = $args->{_type}; die "Internal ".__PACKAGE__." error" unless $vector_type =~ /^(row|column)$/; # step back one frame because this private method is not how the user called it my $caller_subname = (caller(1))[3]; croak "$caller_subname: need a reference to an array of ${vector_type}s" unless reftype($ref_to_vectors) eq 'ARRAY'; my @vectors = @{$ref_to_vectors}; my $matrix; my $other_type = {row=>'column', column=>'row'}->{$vector_type}; my %matrix_dim = ( $vector_type => scalar( @vectors ), $other_type => 0, # we will correct this in a bit ); # row and column indices are one based my $current_vector_count = 1; foreach my $current_vector (@vectors) { # dimension is one-based, so we're # starting with one here and incrementing # as we go. The other dimension is fixed (for now, until # we add the 'pad' option), and gets set later my $ref = ref( $current_vector ) ; if ( $ref eq '' ) { # we hope this is a properly formatted Math::MatrixReal string, # but if not we just let the Math::MatrixReal die() do it's # thing $current_vector = $class->new_from_string( $current_vector ); } elsif ( $ref eq 'ARRAY' ) { my @array = @$current_vector; croak "$caller_subname: one $vector_type you gave me was a ref to an array with no elements" unless @array; # we need to create the right kind of string based on whether # they said they were sending us rows or columns: if ($vector_type eq 'row') { $current_vector = $class->new_from_string( '[ '. join( " ", @array) ." ]\n" ); } else { $current_vector = $class->new_from_string( '[ '. join( " ]\n[ ", @array) ." ]\n" ); } } elsif ( $ref ne 'HASH' and ( $current_vector->isa('Math::MatrixReal') || $current_vector->isa('Math::MatrixComplex') ) ) { # it's already a Math::MatrixReal something. # we don't need to do anything, it will all # work out } else { # we have no idea, error time! croak "$caller_subname: I only know how to deal with array refs, strings, and things that inherit from Math::MatrixReal\n"; } # starting now we know $current_vector isa Math::MatrixReal thingy my @vector_dims = $current_vector->dim; #die unless the appropriate dimension is 1 croak "$caller_subname: I don't accept $other_type vectors" unless ($vector_dims[ $vector_type eq 'row' ? 0 : 1 ] == 1) ; # the other dimension is the length of our vector my $length = $vector_dims[ $vector_type eq 'row' ? 1 : 0 ]; # set the "other" dimension to the length of this # vector the first time through $matrix_dim{$other_type} ||= $length; # die unless length of this vector matches the first length croak "$caller_subname: one $vector_type has [$length] elements and another one had [$matrix_dim{$other_type}]--all of the ${vector_type}s passed in must have the same dimension" unless ($length == $matrix_dim{$other_type}) ; # create the matrix the first time through $matrix ||= $class->new($matrix_dim{row}, $matrix_dim{column}); # step along the vector assigning the value of each element # to the correct place in the matrix we're building foreach my $element_index ( 1..$length ){ # args for vector assignment: # initialize both to one and reset the correct # one below my ($v_r, $v_c) = (1,1); # args for matrix assignment my ($row_index, $column_index, $value); if ($vector_type eq 'row') { $row_index = $current_vector_count; $v_c = $column_index = $element_index; } else { $v_r = $row_index = $element_index; $column_index = $current_vector_count; } $value = $current_vector->element($v_r, $v_c); $matrix->assign($row_index, $column_index, $value); } $current_vector_count ++ ; } return $matrix; } sub shadow { croak "Usage: \$new_matrix = \$some_matrix->shadow();" if (@_ != 1); my ($matrix) = @_; return $matrix->new($matrix->[1],$matrix->[2]); } =over 4 =item * $matrix->display_precision($integer) Sets the default precision when matrices are printed or stringified. $matrix->display_precision(0) will only show the integer part of all the entries of $matrix and $matrix->display_precision() will return to the default scientific display notation. This method does not effect the precision of the calculations. =back =cut sub display_precision { my ($self,$n) = @_; if (defined $n) { croak "Usage: \$matrix->display_precision(\$nonnegative_integer);" if ($n < 0); $self->[4] = int $n; } else { $self->[4] = undef; } } sub copy { croak "Usage: \$matrix1->copy(\$matrix2);" if (@_ != 2); my ($matrix1,$matrix2) = @_; my ($rows1,$cols1) = ($matrix1->[1],$matrix1->[2]); my ($rows2,$cols2) = ($matrix2->[1],$matrix2->[2]); my ($i,$j); croak "Math::MatrixReal::copy(): matrix size mismatch" unless $rows1 == $rows2 && $cols1 == $cols2; for ( $i = 0; $i < $rows1; $i++ ) { my $r1 = []; my $r2 = $matrix2->[0][$i]; @$r1 = @$r2; # Copy whole array directly $matrix1->[0][$i] = $r1; } if (defined $matrix2->[3]) # is an LR decomposition matrix! { $matrix1->[3] = $matrix2->[3]; # $sign $matrix1->[4] = $matrix2->[4]; # $perm_row $matrix1->[5] = $matrix2->[5]; # $perm_col } } sub clone { croak "Usage: \$twin_matrix = \$some_matrix->clone();" if (@_ != 1); my($matrix) = @_; my($temp); $temp = $matrix->new($matrix->[1],$matrix->[2]); $temp->copy($matrix); return $temp; } ## trace() : return the sum of the diagonal elements sub trace { croak "Usage: \$trace = \$matrix->trace();" if (@_ != 1); my $matrix = shift; my($rows,$cols) = ($matrix->[1],$matrix->[2]); my $trace = 0; croak "Math::MatrixReal::trace(): matrix is not quadratic" unless ($rows == $cols); map { $trace += $matrix->[0][$_][$_] } (0 .. $cols-1); return $trace; } sub submatrix { my $self = shift; my ($x1, $y1, $x2, $y2) = @_; croak "Math::MatrixReal::submatrix(): indices must be positive integers" unless ($x1 >= 1 && $x2 >= 1 && $y1 >=1 && $y2 >=1 ); my($rows,$cols) = ($self->[1],$self->[2]); my($sr,$sc) = ( 1+abs($x1-$x2), 1+abs($y1-$y2) ); my $submatrix = $self->new( $sr, $sc ); for (my $i = $x1-1; $i < $x2; $i++ ) { for (my $j = $y1-1; $j < $y2; $j++ ) { $submatrix->[0][$i-($x1-1)][$j-($y1-1)] = $self->[0][$i][$j]; } } return $submatrix; } ## return the minor corresponding to $r and $c ## eliminate row $r and col $c , and return the $r-1 by $c-1 matrix sub minor { croak "Usage: \$minor = \$matrix->minor(\$r,\$c);" unless (@_ == 3); my ($matrix,$r,$c) = @_; my ($rows,$cols) = $matrix->dim(); croak "Math::MatrixReal::minor(): \$matrix must be at least 2x2" unless ($rows > 1 and $cols > 1); croak "Math::MatrixReal::minor(): $r and $c must be positive" unless ($r > 0 and $c > 0 ); croak "Math::MatrixReal::minor(): matrix has no $r,$c element" unless ($r <= $rows and $c <= $cols ); my $minor = new Math::MatrixReal($rows-1,$cols-1); my ($i,$j) = (0,0); ## assign() might have been easier, but this should be faster ## the element can be in any of 4 regions compared to the eliminated ## row and col: ## above and to the left, above and to the right ## below and to the left, below and to the right for(; $i < $rows; $i++){ for(;$j < $rows; $j++ ){ if( $i >= $r && $j >= $c ){ $minor->[0][$i-1][$j-1] = $matrix->[0][$i][$j]; } elsif ( $i >= $r && $j < $c ){ $minor->[0][$i-1][$j] = $matrix->[0][$i][$j]; } elsif ( $i < $r && $j < $c ){ $minor->[0][$i][$j] = $matrix->[0][$i][$j]; } elsif ( $i < $r && $j >= $c ){ $minor->[0][$i][$j-1] = $matrix->[0][$i][$j]; } else { croak "Very bad things"; } } $j = 0; } return ($minor); } sub swap_col { croak "Usage: \$matrix->swap_col(\$col1,\$col2); " unless (@_ == 3); my ($matrix,$col1,$col2) = @_; my ($rows,$cols) = $matrix->dim(); my (@temp); croak "Math::MatrixReal::swap_col(): col index is not valid" unless ( $col1 <= $cols && $col2 <= $cols && $col1 == int($col1) && $col2 == int($col2) ); $col1--;$col2--; for(my $i=0;$i < $rows;$i++){ $temp[$i] = $matrix->[0][$i][$col1]; $matrix->[0][$i][$col1] = $matrix->[0][$i][$col2]; $matrix->[0][$i][$col2] = $temp[$i]; } } sub swap_row { croak "Usage: \$matrix->swap_row(\$row1,\$row2); " unless (@_ == 3); my ($matrix,$row1,$row2) = @_; my ($rows,$cols) = $matrix->dim(); my (@temp); croak "Math::MatrixReal::swap_row(): row index is not valid" unless ( $row1 <= $rows && $row2 <= $rows && $row1 == int($row1) && $row2 == int($row2) ); $row1--;$row2--; for(my $j=0;$j < $cols;$j++){ $temp[$j] = $matrix->[0][$row1][$j]; $matrix->[0][$row1][$j] = $matrix->[0][$row2][$j]; $matrix->[0][$row2][$j] = $temp[$j]; } } sub assign_row { croak "Usage: \$matrix->assign_row(\$row,\$row_vec);" unless (@_ == 3); my ($matrix,$row,$row_vec) = @_; my ($rows1,$cols1) = $matrix->dim(); my ($rows2,$cols2) = $row_vec->dim(); croak "Math::MatrixReal::assign_row(): number of columns mismatch" if ($cols1 != $cols2); croak "Math::MatrixReal::assign_row(): not a row vector" unless( $rows2 == 1); @{$matrix->[0][--$row]} = @{$row_vec->[0][0]}; return $matrix; } # returns the number of zeroes in a row sub _count_zeroes_row { my ($matrix) = @_; my ($rows,$cols) = $matrix->dim(); my $count = 0; croak "_count_zeroes_row(): only 1 row, buddy" unless ($rows == 1); map { $count++ unless $matrix->[0][0][$_] } (0 .. $cols-1); return $count; } ## divide a row by it's largest abs() element sub _normalize_row { my ($matrix) = @_; my ($rows,$cols) = $matrix->dim(); my $new_row = Math::MatrixReal->new(1,$cols); my $big = abs($matrix->[0][0][0]); for(my $j=0;$j < $cols; $j++ ){ $big = $big < abs($matrix->[0][0][$j]) ? abs($matrix->[0][0][$j]) : $big; } next unless $big; # now $big is biggest element in row for(my $j = 0;$j < $cols; $j++ ){ $new_row->[0][0][$j] = $matrix->[0][0][$j] / $big; } return $new_row; } sub cofactor { my ($matrix) = @_; my ($rows,$cols) = $matrix->dim(); croak "Math::MatrixReal::cofactor(): Matrix is not quadratic" unless ($rows == $cols); # black magic ahead my $cofactor = $matrix->each( sub { my($v,$i,$j) = @_; ($i+$j) % 2 == 0 ? $matrix->minor($i,$j)->det() : -1*$matrix->minor($i,$j)->det(); }); return ($cofactor); } sub adjoint { my ($matrix) = @_; return ~($matrix->cofactor); } sub row { croak "Usage: \$row_vector = \$matrix->row(\$row);" if (@_ != 2); my($matrix,$row) = @_; my($rows,$cols) = ($matrix->[1],$matrix->[2]); my($temp); croak "Math::MatrixReal::row(): row index out of range" if ($row < 1 || $row > $rows); $row--; $temp = $matrix->new(1,$cols); for ( my $j = 0; $j < $cols; $j++ ) { $temp->[0][0][$j] = $matrix->[0][$row][$j]; } return($temp); } sub col{ return (shift)->column(shift) } sub column { croak "Usage: \$column_vector = \$matrix->column(\$column);" if (@_ != 2); my($matrix,$col) = @_; my($rows,$cols) = ($matrix->[1],$matrix->[2]); #my($temp); #my($i); my $col_vector; croak "Math::MatrixReal::column(): column index out of range" if ($col < 1 || $col > $cols); $col--; $col_vector = $matrix->new($rows,1); map { $col_vector->[0][$_][0] = $matrix->[0][$_][$col] } (0 .. $rows-1); return $col_vector; } sub as_list { croak "Usage: \$matrix->as_list();" if (@_ != 1); my($self) = @_; my($rows,$cols) = ($self->[1], $self->[2]); my @list; for(my $i = 0; $i < $rows; $i++ ){ for(my $j = 0; $j < $cols; $j++){ push @list, $self->[0][$i][$j]; } } return @list; } sub _undo_LR { croak "Usage: \$matrix->_undo_LR();" if (@_ != 1); my($self) = @_; undef $self->[3]; undef $self->[4]; undef $self->[5]; } # brrr sub zero { croak "Usage: \$matrix->zero();" if (@_ != 1); my ($self) = @_; my ($rows,$cols) = ($self->[1],$self->[2]); $self->_undo_LR(); # zero out first row map { $self->[0][0][$_] = 0.0 } (0 .. $cols-1); # copy that to the other rows map { @{$self->[0][$_]} = @{$self->[0][0]} } (0 .. $rows-1); return $self; } sub one { croak "Usage: \$matrix->one();" if (@_ != 1); my ($self) = @_; my ($rows,$cols) = ($self->[1],$self->[2]); $self->zero(); # We rely on zero() efficiency map { $self->[0][$_][$_] = 1.0 } (0 .. $rows-1); return $self; } sub assign { croak "Usage: \$matrix->assign(\$row,\$column,\$value);" if (@_ != 4); my($self,$row,$col,$value) = @_; my($rows,$cols) = ($self->[1],$self->[2]); croak "Math::MatrixReal::assign(): row index out of range" if (($row < 1) || ($row > $rows)); croak "Math::MatrixReal::assign(): column index out of range" if (($col < 1) || ($col > $cols)); $self->_undo_LR(); $self->[0][--$row][--$col] = $value; } sub element { croak "Usage: \$value = \$matrix->element(\$row,\$column);" if (@_ != 3); my($self,$row,$col) = @_; my($rows,$cols) = ($self->[1],$self->[2]); croak "Math::MatrixReal::element(): row index out of range" if (($row < 1) || ($row > $rows)); croak "Math::MatrixReal::element(): column index out of range" if (($col < 1) || ($col > $cols)); return( $self->[0][--$row][--$col] ); } sub dim # returns dimensions of a matrix { croak "Usage: (\$rows,\$columns) = \$matrix->dim();" if (@_ != 1); my($matrix) = @_; return( $matrix->[1], $matrix->[2] ); } sub norm_one # maximum of sums of each column { croak "Usage: \$norm_one = \$matrix->norm_one();" if (@_ != 1); my($self) = @_; my($rows,$cols) = ($self->[1],$self->[2]); my $max = 0.0; for (my $j = 0; $j < $cols; $j++) { my $sum = 0.0; for (my $i = 0; $i < $rows; $i++) { $sum += abs( $self->[0][$i][$j] ); } $max = $sum if ($sum > $max); } return($max); } ## sum of absolute value of every element sub norm_sum { croak "Usage: \$norm_sum = \$matrix->norm_sum();" unless (@_ == 1); my ($matrix) = @_; my $norm = 0; $matrix->each( sub { $norm+=abs(shift); } ); return $norm; } sub norm_frobenius { my ($m) = @_; my ($r,$c) = $m->dim; my $s=0; $m->each( sub { $s+=abs(shift)**2 } ); return sqrt($s); } # Vector Norm sub norm_p { my ($v,$p) = @_; # sanity check on $p croak "Math::MatrixReal:norm_p: argument must be a row or column vector" unless ( $v->is_row_vector || $v->is_col_vector ); croak "Math::MatrixReal::norm_p: $p must be >= 1" unless ($p =~ m/Inf(inity)?/i || $p >= 1); if( $p =~ m/^(Inf|Infinity)$/i ){ my $max = $v->element(1,1); $v->each ( sub { my $x=abs(shift); $max = $x if( $x > $max ); } ); return $max; } my $s=0; $v->each( sub { $s+= (abs(shift))**$p; } ); return $s ** (1/$p); } sub norm_max # maximum of sums of each row { croak "Usage: \$norm_max = \$matrix->norm_max();" if (@_ != 1); my($self) = @_; my($rows,$cols) = ($self->[1],$self->[2]); my $max = 0.0; for (my $i = 0; $i < $rows; $i++) { my $sum = 0.0; for (my $j = 0; $j < $cols; $j++) { $sum += abs( $self->[0][$i][$j] ); } $max = $sum if ($sum > $max); } return($max); } sub negate { croak "Usage: \$matrix1->negate(\$matrix2);" if (@_ != 2); my($matrix1,$matrix2) = @_; my($rows1,$cols1) = ($matrix1->[1],$matrix1->[2]); my($rows2,$cols2) = ($matrix2->[1],$matrix2->[2]); croak "Math::MatrixReal::negate(): matrix size mismatch" unless (($rows1 == $rows2) && ($cols1 == $cols2)); $matrix1->_undo_LR(); for (my $i = 0; $i < $rows1; $i++ ) { for (my $j = 0; $j < $cols1; $j++ ) { $matrix1->[0][$i][$j] = -($matrix2->[0][$i][$j]); } } } ## each(): evaluate a coderef on each element and return a new matrix ## of said sub each { croak "Usage: \$new_matrix = \$matrix->each( \&sub );" unless (@_ == 2 ); my($matrix,$function) = @_; my($rows,$cols) = ($matrix->[1],$matrix->[2]); my($new_matrix) = $matrix->clone(); croak "Math::MatrixReal::each(): argument is not a sub reference" unless ref($function); $new_matrix->_undo_LR(); for (my $i = 0; $i < $rows; $i++ ) { for (my $j = 0; $j < $cols; $j++ ) { no strict 'refs'; # $i,$j are 1-based as of 1.7 $new_matrix->[0][$i][$j] = &{ $function }($matrix->[0][$i][$j],$i+1,$j+1) ; } } return ($new_matrix); } ## each_diag(): same as each() but only diag elements sub each_diag { croak "Usage: \$new_matrix = \$matrix->each_diag( \&sub );" unless (@_ == 2 ); my($matrix,$function) = @_; my($rows,$cols) = ($matrix->[1],$matrix->[2]); my($new_matrix) = $matrix->clone(); croak "Math::MatrixReal::each(): argument is not a sub reference" unless ref($function); croak "Matrix is not quadratic" unless ($rows == $cols); $new_matrix->_undo_LR(); for (my $i = 0; $i < $rows; $i++ ) { for (my $j = 0; $j < $cols; $j++ ) { next unless ($i == $j); no strict 'refs'; # $i,$j are 1-based as of 1.7 $new_matrix->[0][$i][$j] = &{ $function }($matrix->[0][$i][$j],$i+1,$j+1) ; } } return ($new_matrix); } ## Make computing the inverse more user friendly sub inverse { croak "Usage: \$inverse = \$matrix->inverse();" unless (@_ == 1); my ($matrix) = @_; return $matrix->decompose_LR->invert_LR; } sub transpose { croak "Usage: \$matrix1->transpose(\$matrix2);" if (@_ != 2); my($matrix1,$matrix2) = @_; my($rows1,$cols1) = ($matrix1->[1],$matrix1->[2]); my($rows2,$cols2) = ($matrix2->[1],$matrix2->[2]); croak "Math::MatrixReal::transpose(): matrix size mismatch" unless (($rows1 == $cols2) && ($cols1 == $rows2)); $matrix1->_undo_LR(); if ($rows1 == $cols1) { # more complicated to make in-place possible! for (my $i = 0; $i < $rows1; $i++) { for (my $j = ($i + 1); $j < $cols1; $j++) { my $swap = $matrix2->[0][$i][$j]; $matrix1->[0][$i][$j] = $matrix2->[0][$j][$i]; $matrix1->[0][$j][$i] = $swap; } $matrix1->[0][$i][$i] = $matrix2->[0][$i][$i]; } } else { # ($rows1 != $cols1) for (my $i = 0; $i < $rows1; $i++) { for (my $j = 0; $j < $cols1; $j++) { $matrix1->[0][$i][$j] = $matrix2->[0][$j][$i]; } } } } sub add { croak "Usage: \$matrix1->add(\$matrix2,\$matrix3);" if (@_ != 3); my($matrix1,$matrix2,$matrix3) = @_; my($rows1,$cols1) = ($matrix1->[1],$matrix1->[2]); my($rows2,$cols2) = ($matrix2->[1],$matrix2->[2]); my($rows3,$cols3) = ($matrix3->[1],$matrix3->[2]); croak "Math::MatrixReal::add(): matrix size mismatch" unless (($rows1 == $rows2) && ($rows1 == $rows3) && ($cols1 == $cols2) && ($cols1 == $cols3)); $matrix1->_undo_LR(); for ( my $i = 0; $i < $rows1; $i++ ) { for ( my $j = 0; $j < $cols1; $j++ ) { $matrix1->[0][$i][$j] = $matrix2->[0][$i][$j] + $matrix3->[0][$i][$j]; } } } sub subtract { croak "Usage: \$matrix1->subtract(\$matrix2,\$matrix3);" if (@_ != 3); my($matrix1,$matrix2,$matrix3) = @_; my($rows1,$cols1) = ($matrix1->[1],$matrix1->[2]); my($rows2,$cols2) = ($matrix2->[1],$matrix2->[2]); my($rows3,$cols3) = ($matrix3->[1],$matrix3->[2]); croak "Math::MatrixReal::subtract(): matrix size mismatch" unless (($rows1 == $rows2) && ($rows1 == $rows3) && ($cols1 == $cols2) && ($cols1 == $cols3)); $matrix1->_undo_LR(); for ( my $i = 0; $i < $rows1; $i++ ) { for ( my $j = 0; $j < $cols1; $j++ ) { $matrix1->[0][$i][$j] = $matrix2->[0][$i][$j] - $matrix3->[0][$i][$j]; } } } sub multiply_scalar { croak "Usage: \$matrix1->multiply_scalar(\$matrix2,\$scalar);" if (@_ != 3); my($matrix1,$matrix2,$scalar) = @_; my($rows1,$cols1) = ($matrix1->[1],$matrix1->[2]); my($rows2,$cols2) = ($matrix2->[1],$matrix2->[2]); croak "Math::MatrixReal::multiply_scalar(): matrix size mismatch" unless (($rows1 == $rows2) && ($cols1 == $cols2)); $matrix1->_undo_LR(); for ( my $i = 0; $i < $rows1; $i++ ) { map { $matrix1->[0][$i][$_] = $matrix2->[0][$i][$_] * $scalar } (0 .. $cols1-1); } } sub multiply { croak "Usage: \$product_matrix = \$matrix1->multiply(\$matrix2);" if (@_ != 2); my($matrix1,$matrix2) = @_; my($rows1,$cols1) = ($matrix1->[1],$matrix1->[2]); my($rows2,$cols2) = ($matrix2->[1],$matrix2->[2]); croak "Math::MatrixReal::multiply(): matrix size mismatch" unless ($cols1 == $rows2); my $temp = $matrix1->new($rows1,$cols2); for (my $i = 0; $i < $rows1; $i++ ) { for (my $j = 0; $j < $cols2; $j++ ) { my $sum = 0.0; for (my $k = 0; $k < $cols1; $k++ ) { $sum += ( $matrix1->[0][$i][$k] * $matrix2->[0][$k][$j] ); } $temp->[0][$i][$j] = $sum; } } return($temp); } sub exponent { croak "Usage: \$matrix_exp = \$matrix1->exponent(\$integer);" if(@_ != 2 ); my($matrix,$argument) = @_; my($rows,$cols) = ($matrix->[1],$matrix->[2]); my($name) = "'**'"; my($temp) = $matrix->clone(); croak "Matrix is not quadratic" unless ($rows == $cols); croak "Exponent must be integer" unless ($argument =~ m/^[+-]?\d+$/ ); return($matrix) if ($argument == 1); $temp->_undo_LR(); # negative exponent is (A^-1)^n if( $argument < 0 ){ my $LR = $matrix->decompose_LR(); my $inverse = $LR->invert_LR(); unless (defined $inverse){ carp "Matrix has no inverse"; return undef; } $temp = $inverse->clone(); if( $inverse ){ return($inverse) if ($argument == -1); for( 2 .. abs($argument) ){ $temp = multiply($inverse,$temp); } return($temp); } else { # TODO: is this the right behaviour? carp "Cannot compute negative exponent, inverse does not exist"; return undef; } # matrix to zero power is identity matrix } elsif( $argument == 0 ){ $temp->one(); return ($temp); } # if it is diagonal, just raise diagonal entries to power if( $matrix->is_diagonal() ){ $temp = $temp->each_diag( sub { (shift)**$argument } ); return ($temp); } else { for( 2 .. $argument ){ $temp = multiply($matrix,$temp); } return ($temp); } } sub min { if ( @_ == 1 ) { my $matrix = shift; croak "Usage: \$minimum = Math::MatrixReal::min(\$number1,\$number2) or $matrix->min" if (@_ > 2); croak "invalid" unless ref $matrix eq 'Math::MatrixReal'; my $min = $matrix->element(1,1); $matrix->each( sub { my ($e,$i,$j) = @_; $min = $e if $e < $min; } ); return $min; } $_[0] < $_[1] ? $_[0] : $_[1]; } sub max { if ( @_ == 1 ) { my $matrix = shift; croak "Usage: \$maximum = Math::MatrixReal::max(\$number1,\$number2) or $matrix->max" if (@_ > 2); croak "Math::MatrixReal::max(\$matrix) \$matrix is not a Math::MatrixReal matrix" unless ref $matrix eq 'Math::MatrixReal'; my $max = $matrix->element(1,1); $matrix->each( sub { my ($e,$i,$j) = @_; $max = $e if $e > $max; } ); return $max; } $_[0] > $_[1] ? $_[0] : $_[1]; } sub kleene { croak "Usage: \$minimal_cost_matrix = \$cost_matrix->kleene();" if (@_ != 1); my($matrix) = @_; my($rows,$cols) = ($matrix->[1],$matrix->[2]); croak "Math::MatrixReal::kleene(): matrix is not quadratic" unless ($rows == $cols); my $temp = $matrix->new($rows,$cols); $temp->copy($matrix); $temp->_undo_LR(); my $n = $rows; for ( my $i = 0; $i < $n; $i++ ) { $temp->[0][$i][$i] = min( $temp->[0][$i][$i] , 0 ); } for ( my $k = 0; $k < $n; $k++ ) { for ( my $i = 0; $i < $n; $i++ ) { for ( my $j = 0; $j < $n; $j++ ) { $temp->[0][$i][$j] = min( $temp->[0][$i][$j] , ( $temp->[0][$i][$k] + $temp->[0][$k][$j] ) ); } } } return($temp); } sub normalize { croak "Usage: (\$norm_matrix,\$norm_vector) = \$matrix->normalize(\$vector);" if (@_ != 2); my($matrix,$vector) = @_; my($rows,$cols) = ($matrix->[1],$matrix->[2]); my($norm_matrix,$norm_vector); my($max,$val); my($i,$j,$n); croak "Math::MatrixReal::normalize(): matrix is not quadratic" unless ($rows == $cols); $n = $rows; croak "Math::MatrixReal::normalize(): vector is not a column vector" unless ($vector->[2] == 1); croak "Math::MatrixReal::normalize(): matrix and vector size mismatch" unless ($vector->[1] == $n); $norm_matrix = $matrix->new($n,$n); $norm_vector = $vector->new($n,1); $norm_matrix->copy($matrix); $norm_vector->copy($vector); $norm_matrix->_undo_LR(); for ( $i = 0; $i < $n; $i++ ) { $max = abs($norm_vector->[0][$i][0]); for ( $j = 0; $j < $n; $j++ ) { $val = abs($norm_matrix->[0][$i][$j]); if ($val > $max) { $max = $val; } } if ($max != 0) { $norm_vector->[0][$i][0] /= $max; for ( $j = 0; $j < $n; $j++ ) { $norm_matrix->[0][$i][$j] /= $max; } } } return($norm_matrix,$norm_vector); } sub decompose_LR { croak "Usage: \$LR_matrix = \$matrix->decompose_LR();" if (@_ != 1); my($matrix) = @_; my($rows,$cols) = ($matrix->[1],$matrix->[2]); my($perm_row,$perm_col); my($row,$col,$max); my($i,$j,$k,$n); my($sign) = 1; my($swap); my($temp); croak "Math::MatrixReal::decompose_LR(): matrix is not quadratic" unless ($rows == $cols); $temp = $matrix->new($rows,$cols); $temp->copy($matrix); $n = $rows; $perm_row = [ ]; $perm_col = [ ]; for ( $i = 0; $i < $n; $i++ ) { $perm_row->[$i] = $i; $perm_col->[$i] = $i; } NONZERO: for ( $k = 0; $k < $n; $k++ ) # use Gauss's algorithm: { # complete pivot-search: $max = 0; for ( $i = $k; $i < $n; $i++ ) { for ( $j = $k; $j < $n; $j++ ) { if (($swap = abs($temp->[0][$i][$j])) > $max) { $max = $swap; $row = $i; $col = $j; } } } last NONZERO if ($max == 0); # (all remaining elements are zero) if ($k != $row) # swap row $k and row $row: { $sign = -$sign; $swap = $perm_row->[$k]; $perm_row->[$k] = $perm_row->[$row]; $perm_row->[$row] = $swap; for ( $j = 0; $j < $n; $j++ ) { # (must run from 0 since L has to be swapped too!) $swap = $temp->[0][$k][$j]; $temp->[0][$k][$j] = $temp->[0][$row][$j]; $temp->[0][$row][$j] = $swap; } } if ($k != $col) # swap column $k and column $col: { $sign = -$sign; $swap = $perm_col->[$k]; $perm_col->[$k] = $perm_col->[$col]; $perm_col->[$col] = $swap; for ( $i = 0; $i < $n; $i++ ) { $swap = $temp->[0][$i][$k]; $temp->[0][$i][$k] = $temp->[0][$i][$col]; $temp->[0][$i][$col] = $swap; } } for ( $i = ($k + 1); $i < $n; $i++ ) { # scan the remaining rows, add multiples of row $k to row $i: $swap = $temp->[0][$i][$k] / $temp->[0][$k][$k]; if ($swap != 0) { # calculate a row of matrix R: for ( $j = ($k + 1); $j < $n; $j++ ) { $temp->[0][$i][$j] -= $temp->[0][$k][$j] * $swap; } # store matrix L in same matrix as R: $temp->[0][$i][$k] = $swap; } } } $temp->[3] = $sign; $temp->[4] = $perm_row; $temp->[5] = $perm_col; return($temp); } sub solve_LR { croak "Usage: (\$dimension,\$x_vector,\$base_matrix) = \$LR_matrix->solve_LR(\$b_vector);" if (@_ != 2); my($LR_matrix,$b_vector) = @_; my($rows,$cols) = ($LR_matrix->[1],$LR_matrix->[2]); my($dimension,$x_vector,$base_matrix); my($perm_row,$perm_col); my($y_vector,$sum); my($i,$j,$k,$n); croak "Math::MatrixReal::solve_LR(): not an LR decomposition matrix" unless ((defined $LR_matrix->[3]) && ($rows == $cols)); $n = $rows; croak "Math::MatrixReal::solve_LR(): vector is not a column vector" unless ($b_vector->[2] == 1); croak "Math::MatrixReal::solve_LR(): matrix and vector size mismatch" unless ($b_vector->[1] == $n); $perm_row = $LR_matrix->[4]; $perm_col = $LR_matrix->[5]; $x_vector = $b_vector->new($n,1); $y_vector = $b_vector->new($n,1); $base_matrix = $LR_matrix->new($n,$n); # calculate "x" so that LRx = b ==> calculate Ly = b, Rx = y: for ( $i = 0; $i < $n; $i++ ) # calculate $y_vector: { $sum = $b_vector->[0][($perm_row->[$i])][0]; for ( $j = 0; $j < $i; $j++ ) { $sum -= $LR_matrix->[0][$i][$j] * $y_vector->[0][$j][0]; } $y_vector->[0][$i][0] = $sum; } $dimension = 0; for ( $i = ($n - 1); $i >= 0; $i-- ) # calculate $x_vector: { if ($LR_matrix->[0][$i][$i] == 0) { if ($y_vector->[0][$i][0] != 0) { return(); # a solution does not exist! } else { $dimension++; $x_vector->[0][($perm_col->[$i])][0] = 0; } } else { $sum = $y_vector->[0][$i][0]; for ( $j = ($i + 1); $j < $n; $j++ ) { $sum -= $LR_matrix->[0][$i][$j] * $x_vector->[0][($perm_col->[$j])][0]; } $x_vector->[0][($perm_col->[$i])][0] = $sum / $LR_matrix->[0][$i][$i]; } } if ($dimension) { if ($dimension == $n) { $base_matrix->one(); } else { for ( $k = 0; $k < $dimension; $k++ ) { $base_matrix->[0][($perm_col->[($n-$k-1)])][$k] = 1; for ( $i = ($n-$dimension-1); $i >= 0; $i-- ) { $sum = 0; for ( $j = ($i + 1); $j < $n; $j++ ) { $sum -= $LR_matrix->[0][$i][$j] * $base_matrix->[0][($perm_col->[$j])][$k]; } $base_matrix->[0][($perm_col->[$i])][$k] = $sum / $LR_matrix->[0][$i][$i]; } } } } return( $dimension, $x_vector, $base_matrix ); } sub invert_LR { croak "Usage: \$inverse_matrix = \$LR_matrix->invert_LR();" if (@_ != 1); my($matrix) = @_; my($rows,$cols) = ($matrix->[1],$matrix->[2]); my($inv_matrix,$x_vector,$y_vector); my($i,$j,$n); croak "Math::MatrixReal::invert_LR(): not an LR decomposition matrix" unless ((defined $matrix->[3]) && ($rows == $cols)); $n = $rows; #print Dumper [ $matrix ]; if ($matrix->[0][$n-1][$n-1] != 0) { $inv_matrix = $matrix->new($n,$n); $y_vector = $matrix->new($n,1); for ( $j = 0; $j < $n; $j++ ) { if ($j > 0) { $y_vector->[0][$j-1][0] = 0; } $y_vector->[0][$j][0] = 1; if (($rows,$x_vector,$cols) = $matrix->solve_LR($y_vector)) { for ( $i = 0; $i < $n; $i++ ) { $inv_matrix->[0][$i][$j] = $x_vector->[0][$i][0]; } } else { die "Math::MatrixReal::invert_LR(): unexpected error - please inform author!\n"; } } return($inv_matrix); } else { warn __PACKAGE__ . qq{: matrix not invertible\n}; return; } } sub condition { # 1st matrix MUST be the inverse of 2nd matrix (or vice-versa) # for a meaningful result! # make this work when given no args croak "Usage: \$condition = \$matrix->condition(\$inverse_matrix);" if (@_ != 2); my($matrix1,$matrix2) = @_; my($rows1,$cols1) = ($matrix1->[1],$matrix1->[2]); my($rows2,$cols2) = ($matrix2->[1],$matrix2->[2]); croak "Math::MatrixReal::condition(): 1st matrix is not quadratic" unless ($rows1 == $cols1); croak "Math::MatrixReal::condition(): 2nd matrix is not quadratic" unless ($rows2 == $cols2); croak "Math::MatrixReal::condition(): matrix size mismatch" unless (($rows1 == $rows2) && ($cols1 == $cols2)); return( $matrix1->norm_one() * $matrix2->norm_one() ); } ## easy to use determinant ## very fast if matrix is diagonal or triangular sub det { croak "Usage: \$determinant = \$matrix->det_LR();" unless (@_ == 1); my ($matrix) = @_; my ($rows,$cols) = $matrix->dim(); my $det = 1; croak "Math::MatrixReal::det(): Matrix is not quadratic" unless ($rows == $cols); # diagonal will match too if( $matrix->is_upper_triangular() ){ $matrix->each_diag( sub { $det*=shift; } ); } elsif ( $matrix->is_lower_triangular() ){ $matrix->each_diag( sub { $det*=shift; } ); } else { return $matrix->decompose_LR->det_LR(); } return $det; } sub det_LR # determinant of LR decomposition matrix { croak "Usage: \$determinant = \$LR_matrix->det_LR();" if (@_ != 1); my($matrix) = @_; my($rows,$cols) = ($matrix->[1],$matrix->[2]); my($k,$det); croak "Math::MatrixReal::det_LR(): not an LR decomposition matrix" unless ((defined $matrix->[3]) && ($rows == $cols)); $det = $matrix->[3]; for ( $k = 0; $k < $rows; $k++ ) { $det *= $matrix->[0][$k][$k]; } return($det); } sub rank_LR { return (shift)->order_LR; } sub order_LR # order of LR decomposition matrix (number of non-zero equations) { croak "Usage: \$order = \$LR_matrix->order_LR();" if (@_ != 1); my($matrix) = @_; my($rows,$cols) = ($matrix->[1],$matrix->[2]); my($order); croak "Math::MatrixReal::order_LR(): not an LR decomposition matrix" unless ((defined $matrix->[3]) && ($rows == $cols)); ZERO: for ( $order = ($rows - 1); $order >= 0; $order-- ) { last ZERO if ($matrix->[0][$order][$order] != 0); } return(++$order); } sub scalar_product { croak "Usage: \$scalar_product = \$vector1->scalar_product(\$vector2);" if (@_ != 2); my($vector1,$vector2) = @_; my($rows1,$cols1) = ($vector1->[1],$vector1->[2]); my($rows2,$cols2) = ($vector2->[1],$vector2->[2]); croak "Math::MatrixReal::scalar_product(): 1st vector is not a column vector" unless ($cols1 == 1); croak "Math::MatrixReal::scalar_product(): 2nd vector is not a column vector" unless ($cols2 == 1); croak "Math::MatrixReal::scalar_product(): vector size mismatch" unless ($rows1 == $rows2); my $sum = 0; map { $sum += $vector1->[0][$_][0] * $vector2->[0][$_][0] } ( 0 .. $rows1-1); return $sum; } sub vector_product { croak "Usage: \$vector_product = \$vector1->vector_product(\$vector2);" if (@_ != 2); my($vector1,$vector2) = @_; my($rows1,$cols1) = ($vector1->[1],$vector1->[2]); my($rows2,$cols2) = ($vector2->[1],$vector2->[2]); my($temp); my($n); croak "Math::MatrixReal::vector_product(): 1st vector is not a column vector" unless ($cols1 == 1); croak "Math::MatrixReal::vector_product(): 2nd vector is not a column vector" unless ($cols2 == 1); croak "Math::MatrixReal::vector_product(): vector size mismatch" unless ($rows1 == $rows2); $n = $rows1; croak "Math::MatrixReal::vector_product(): only defined for 3 dimensions" unless ($n == 3); $temp = $vector1->new($n,1); $temp->[0][0][0] = $vector1->[0][1][0] * $vector2->[0][2][0] - $vector1->[0][2][0] * $vector2->[0][1][0]; $temp->[0][1][0] = $vector1->[0][2][0] * $vector2->[0][0][0] - $vector1->[0][0][0] * $vector2->[0][2][0]; $temp->[0][2][0] = $vector1->[0][0][0] * $vector2->[0][1][0] - $vector1->[0][1][0] * $vector2->[0][0][0]; return($temp); } sub length { croak "Usage: \$length = \$vector->length();" if (@_ != 1); my($vector) = @_; my($rows,$cols) = ($vector->[1],$vector->[2]); my($k,$comp,$sum); croak "Math::MatrixReal::length(): vector is not a row or column vector" unless ($cols == 1 || $rows ==1 ); $vector = ~$vector if ($rows == 1 ); $sum = 0; for ( $k = 0; $k < $rows; $k++ ) { $comp = $vector->[0][$k][0]; $sum += $comp * $comp; } return sqrt $sum; } sub _init_iteration { croak "Usage: \$which_norm = \$matrix->_init_iteration();" if (@_ != 1); my($matrix) = @_; my($rows,$cols) = ($matrix->[1],$matrix->[2]); my($ok,$max,$sum,$norm); my($i,$j,$n); croak "Math::MatrixReal::_init_iteration(): matrix is not quadratic" unless ($rows == $cols); $ok = 1; $n = $rows; for ( $i = 0; $i < $n; $i++ ) { if ($matrix->[0][$i][$i] == 0) { $ok = 0; } } if ($ok) { $norm = 1; # norm_one $max = 0; for ( $j = 0; $j < $n; $j++ ) { $sum = 0; for ( $i = 0; $i < $j; $i++ ) { $sum += abs($matrix->[0][$i][$j]); } for ( $i = ($j + 1); $i < $n; $i++ ) { $sum += abs($matrix->[0][$i][$j]); } $sum /= abs($matrix->[0][$j][$j]); if ($sum > $max) { $max = $sum; } } $ok = ($max < 1); unless ($ok) { $norm = -1; # norm_max $max = 0; for ( $i = 0; $i < $n; $i++ ) { $sum = 0; for ( $j = 0; $j < $i; $j++ ) { $sum += abs($matrix->[0][$i][$j]); } for ( $j = ($i + 1); $j < $n; $j++ ) { $sum += abs($matrix->[0][$i][$j]); } $sum /= abs($matrix->[0][$i][$i]); if ($sum > $max) { $max = $sum; } } $ok = ($max < 1) } } if ($ok) { return($norm); } else { return(0); } } sub solve_GSM # Global Step Method { croak "Usage: \$xn_vector = \$matrix->solve_GSM(\$x0_vector,\$b_vector,\$epsilon);" if (@_ != 4); my($matrix,$x0_vector,$b_vector,$epsilon) = @_; my($rows1,$cols1) = ( $matrix->[1], $matrix->[2]); my($rows2,$cols2) = ($x0_vector->[1],$x0_vector->[2]); my($rows3,$cols3) = ( $b_vector->[1], $b_vector->[2]); my($norm,$sum,$diff); my($xn_vector); my($i,$j,$n); croak "Math::MatrixReal::solve_GSM(): matrix is not quadratic" unless ($rows1 == $cols1); $n = $rows1; croak "Math::MatrixReal::solve_GSM(): 1st vector is not a column vector" unless ($cols2 == 1); croak "Math::MatrixReal::solve_GSM(): 2nd vector is not a column vector" unless ($cols3 == 1); croak "Math::MatrixReal::solve_GSM(): matrix and vector size mismatch" unless (($rows2 == $n) && ($rows3 == $n)); return() unless ($norm = $matrix->_init_iteration()); $xn_vector = $x0_vector->new($n,1); $diff = $epsilon + 1; while ($diff >= $epsilon) { for ( $i = 0; $i < $n; $i++ ) { $sum = $b_vector->[0][$i][0]; for ( $j = 0; $j < $i; $j++ ) { $sum -= $matrix->[0][$i][$j] * $x0_vector->[0][$j][0]; } for ( $j = ($i + 1); $j < $n; $j++ ) { $sum -= $matrix->[0][$i][$j] * $x0_vector->[0][$j][0]; } $xn_vector->[0][$i][0] = $sum / $matrix->[0][$i][$i]; } $x0_vector->subtract($x0_vector,$xn_vector); if ($norm > 0) { $diff = $x0_vector->norm_one(); } else { $diff = $x0_vector->norm_max(); } for ( $i = 0; $i < $n; $i++ ) { $x0_vector->[0][$i][0] = $xn_vector->[0][$i][0]; } } return($xn_vector); } sub solve_SSM # Single Step Method { croak "Usage: \$xn_vector = \$matrix->solve_SSM(\$x0_vector,\$b_vector,\$epsilon);" if (@_ != 4); my($matrix,$x0_vector,$b_vector,$epsilon) = @_; my($rows1,$cols1) = ( $matrix->[1], $matrix->[2]); my($rows2,$cols2) = ($x0_vector->[1],$x0_vector->[2]); my($rows3,$cols3) = ( $b_vector->[1], $b_vector->[2]); my($norm,$sum,$diff); my($xn_vector); my($i,$j,$n); croak "Math::MatrixReal::solve_SSM(): matrix is not quadratic" unless ($rows1 == $cols1); $n = $rows1; croak "Math::MatrixReal::solve_SSM(): 1st vector is not a column vector" unless ($cols2 == 1); croak "Math::MatrixReal::solve_SSM(): 2nd vector is not a column vector" unless ($cols3 == 1); croak "Math::MatrixReal::solve_SSM(): matrix and vector size mismatch" unless (($rows2 == $n) && ($rows3 == $n)); return() unless ($norm = $matrix->_init_iteration()); $xn_vector = $x0_vector->new($n,1); $xn_vector->copy($x0_vector); $diff = $epsilon + 1; while ($diff >= $epsilon) { for ( $i = 0; $i < $n; $i++ ) { $sum = $b_vector->[0][$i][0]; for ( $j = 0; $j < $i; $j++ ) { $sum -= $matrix->[0][$i][$j] * $xn_vector->[0][$j][0]; } for ( $j = ($i + 1); $j < $n; $j++ ) { $sum -= $matrix->[0][$i][$j] * $xn_vector->[0][$j][0]; } $xn_vector->[0][$i][0] = $sum / $matrix->[0][$i][$i]; } $x0_vector->subtract($x0_vector,$xn_vector); if ($norm > 0) { $diff = $x0_vector->norm_one(); } else { $diff = $x0_vector->norm_max(); } for ( $i = 0; $i < $n; $i++ ) { $x0_vector->[0][$i][0] = $xn_vector->[0][$i][0]; } } return($xn_vector); } sub solve_RM # Relaxation Method { croak "Usage: \$xn_vector = \$matrix->solve_RM(\$x0_vector,\$b_vector,\$weight,\$epsilon);" if (@_ != 5); my($matrix,$x0_vector,$b_vector,$weight,$epsilon) = @_; my($rows1,$cols1) = ( $matrix->[1], $matrix->[2]); my($rows2,$cols2) = ($x0_vector->[1],$x0_vector->[2]); my($rows3,$cols3) = ( $b_vector->[1], $b_vector->[2]); my($norm,$sum,$diff); my($xn_vector); my($i,$j,$n); croak "Math::MatrixReal::solve_RM(): matrix is not quadratic" unless ($rows1 == $cols1); $n = $rows1; croak "Math::MatrixReal::solve_RM(): 1st vector is not a column vector" unless ($cols2 == 1); croak "Math::MatrixReal::solve_RM(): 2nd vector is not a column vector" unless ($cols3 == 1); croak "Math::MatrixReal::solve_RM(): matrix and vector size mismatch" unless (($rows2 == $n) && ($rows3 == $n)); return() unless ($norm = $matrix->_init_iteration()); $xn_vector = $x0_vector->new($n,1); $xn_vector->copy($x0_vector); $diff = $epsilon + 1; while ($diff >= $epsilon) { for ( $i = 0; $i < $n; $i++ ) { $sum = $b_vector->[0][$i][0]; for ( $j = 0; $j < $i; $j++ ) { $sum -= $matrix->[0][$i][$j] * $xn_vector->[0][$j][0]; } for ( $j = ($i + 1); $j < $n; $j++ ) { $sum -= $matrix->[0][$i][$j] * $xn_vector->[0][$j][0]; } $xn_vector->[0][$i][0] = $weight * ( $sum / $matrix->[0][$i][$i] ) + (1 - $weight) * $xn_vector->[0][$i][0]; } $x0_vector->subtract($x0_vector,$xn_vector); if ($norm > 0) { $diff = $x0_vector->norm_one(); } else { $diff = $x0_vector->norm_max(); } for ( $i = 0; $i < $n; $i++ ) { $x0_vector->[0][$i][0] = $xn_vector->[0][$i][0]; } } return($xn_vector); } # Core householder reduction routine (when eigenvector # are wanted). # Adapted from: Numerical Recipes, 2nd edition. sub _householder_vectors ($) { my ($Q) = @_; my ($rows, $cols) = ($Q->[1], $Q->[2]); # Creates tridiagonal # Set up tridiagonal needed elements my $d = []; # N Diagonal elements 0...n-1 my $e = []; # N-1 Off-Diagonal elements 0...n-2 my @p = (); for (my $i = ($rows-1); $i > 1; $i--) { my $scale = 0.0; # Computes norm of one column (below diagonal) for (my $k = 0; $k < $i; $k++) { $scale += abs($Q->[0][$i][$k]); } if ($scale == 0.0) { # skip the transformation $e->[$i-1] = $Q->[0][$i][$i-1]; } else { my $h = 0.0; for (my $k = 0; $k < $i; $k++) { # Used scaled Q for transformation $Q->[0][$i][$k] /= $scale; # Form sigma in h $h += $Q->[0][$i][$k] * $Q->[0][$i][$k]; } my $t1 = $Q->[0][$i][$i-1]; my $t2 = (($t1 >= 0.0) ? -sqrt($h) : sqrt($h)); $e->[$i-1] = $scale * $t2; # Update off-diagonals $h -= $t1 * $t2; $Q->[0][$i][$i-1] -= $t2; my $f = 0.0; for (my $j = 0; $j < $i; $j++) { $Q->[0][$j][$i] = $Q->[0][$i][$j] / $h; my $g = 0.0; for (my $k = 0; $k <= $j; $k++) { $g += $Q->[0][$j][$k] * $Q->[0][$i][$k]; } for (my $k = $j+1; $k < $i; $k++) { $g += $Q->[0][$k][$j] * $Q->[0][$i][$k]; } # Form elements of P $p[$j] = $g / $h; $f += $p[$j] * $Q->[0][$i][$j]; } my $hh = $f / ($h + $h); for (my $j = 0; $j < $i; $j++) { my $t3 = $Q->[0][$i][$j]; my $t4 = $p[$j] - $hh * $t3; $p[$j] = $t4; for (my $k = 0; $k <= $j; $k++) { $Q->[0][$j][$k] -= $t3 * $p[$k] + $t4 * $Q->[0][$i][$k]; } } } } # Updates for i == 0,1 $e->[0] = $Q->[0][1][0]; $d->[0] = $Q->[0][0][0]; # i==0 $Q->[0][0][0] = 1.0; $d->[1] = $Q->[0][1][1]; # i==1 $Q->[0][1][1] = 1.0; $Q->[0][1][0] = $Q->[0][0][1] = 0.0; for (my $i = 2; $i < $rows; $i++) { for (my $j = 0; $j < $i; $j++) { my $g = 0.0; for (my $k = 0; $k < $i; $k++) { $g += $Q->[0][$i][$k] * $Q->[0][$k][$j]; } for (my $k = 0; $k < $i; $k++) { $Q->[0][$k][$j] -= $g * $Q->[0][$k][$i]; } } $d->[$i] = $Q->[0][$i][$i]; # Reset row and column of Q for next iteration $Q->[0][$i][$i] = 1.0; for (my $j = 0; $j < $i; $j++) { $Q->[0][$i][$j] = $Q->[0][$j][$i] = 0.0; } } return ($d, $e); } # Computes sqrt(a*a + b*b), but more carefully... sub _pythag ($$) { my ($a, $b) = @_; my $aa = abs($a); my $ab = abs($b); if ($aa > $ab) { # NB: Not needed!: return 0.0 if ($aa == 0.0); my $t = $ab / $aa; return ($aa * sqrt(1.0 + $t*$t)); } else { return 0.0 if ($ab == 0.0); my $t = $aa / $ab; return ($ab * sqrt(1.0 + $t*$t)); } } # QL algorithm with implicit shifts to determine the eigenvalues # of a tridiagonal matrix. Internal routine. sub _tridiagonal_QLimplicit { my ($EV, $d, $e) = @_; my ($rows, $cols) = ($EV->[1], $EV->[2]); $e->[$rows-1] = 0.0; # Start real computation for (my $l = 0; $l < $rows; $l++) { my $iter = 0; my $m; OUTER: do { for ($m = $l; $m < ($rows - 1); $m++) { my $dd = abs($d->[$m]) + abs($d->[$m+1]); last if ((abs($e->[$m]) + $dd) == $dd); } if ($m != $l) { ## why only allow 30 iterations? croak("Too many iterations!") if ($iter++ >= 30); my $g = ($d->[$l+1] - $d->[$l]) / (2.0 * $e->[$l]); my $r = _pythag($g, 1.0); $g = $d->[$m] - $d->[$l] + $e->[$l] / ($g + (($g >= 0.0) ? abs($r) : -abs($r))); my ($p,$s,$c) = (0.0, 1.0,1.0); for (my $i = ($m-1); $i >= $l; $i--) { my $ii = $i + 1; my $f = $s * $e->[$i]; my $t = _pythag($f, $g); $e->[$ii] = $t; if ($t == 0.0) { $d->[$ii] -= $p; $e->[$m] = 0.0; next OUTER; } my $b = $c * $e->[$i]; $s = $f / $t; $c = $g / $t; $g = $d->[$ii] - $p; my $t2 = ($d->[$i] - $g) * $s + 2.0 * $c * $b; $p = $s * $t2; $d->[$ii] = $g + $p; $g = $c * $t2 - $b; for (my $k = 0; $k < $rows; $k++) { my $t1 = $EV->[0][$k][$ii]; my $t2 = $EV->[0][$k][$i]; $EV->[0][$k][$ii] = $s * $t2 + $c * $t1; $EV->[0][$k][$i] = $c * $t2 - $s * $t1; } } $d->[$l] -= $p; $e->[$l] = $g; $e->[$m] = 0.0; } } while ($m != $l); } return; } # Core householder reduction routine (when eigenvector # are NOT wanted). sub _householder_values ($) { my ($Q) = @_; # NB: Q is destroyed on output... my ($rows, $cols) = ($Q->[1], $Q->[2]); # Creates tridiagonal # Set up tridiagonal needed elements my $d = []; # N Diagonal elements 0...n-1 my $e = []; # N-1 Off-Diagonal elements 0...n-2 my @p = (); for (my $i = ($rows - 1); $i > 1; $i--) { my $scale = 0.0; for (my $k = 0; $k < $i; $k++) { $scale += abs($Q->[0][$i][$k]); } if ($scale == 0.0) { # skip the transformation $e->[$i-1] = $Q->[0][$i][$i-1]; } else { my $h = 0.0; for (my $k = 0; $k < $i; $k++) { # Used scaled Q for transformation $Q->[0][$i][$k] /= $scale; # Form sigma in h $h += $Q->[0][$i][$k] * $Q->[0][$i][$k]; } my $t = $Q->[0][$i][$i-1]; my $t2 = (($t >= 0.0) ? -sqrt($h) : sqrt($h)); $e->[$i-1] = $scale * $t2; # Updates off-diagonal $h -= $t * $t2; $Q->[0][$i][$i-1] -= $t2; my $f = 0.0; for (my $j = 0; $j < $i; $j++) { my $g = 0.0; for (my $k = 0; $k <= $j; $k++) { $g += $Q->[0][$j][$k] * $Q->[0][$i][$k]; } for (my $k = $j+1; $k < $i; $k++) { $g += $Q->[0][$k][$j] * $Q->[0][$i][$k]; } # Form elements of P $p[$j] = $g / $h; $f += $p[$j] * $Q->[0][$i][$j]; } my $hh = $f / ($h + $h); for (my $j = 0; $j < $i; $j++) { my $t = $Q->[0][$i][$j]; my $g = $p[$j] - $hh * $t; $p[$j] = $g; for (my $k = 0; $k <= $j; $k++) { $Q->[0][$j][$k] -= $t * $p[$k] + $g * $Q->[0][$i][$k]; } } } } # Updates for i==1 $e->[0] = $Q->[0][1][0]; # Updates diagonal elements for (my $i = 0; $i < $rows; $i++) { $d->[$i] = $Q->[0][$i][$i]; } return ($d, $e); } # QL algorithm with implicit shifts to determine the # eigenvalues ONLY. This is O(N^2) only... sub _tridiagonal_QLimplicit_values { my ($M, $d, $e) = @_; # NB: M is not touched... my ($rows, $cols) = ($M->[1], $M->[2]); $e->[$rows-1] = 0.0; # Start real computation for (my $l = 0; $l < $rows; $l++) { my $iter = 0; my $m; OUTER: do { for ($m = $l; $m < ($rows - 1); $m++) { my $dd = abs($d->[$m]) + abs($d->[$m+1]); last if ((abs($e->[$m]) + $dd) == $dd); } if ($m != $l) { croak("Too many iterations!") if ($iter++ >= 30); my $g = ($d->[$l+1] - $d->[$l]) / (2.0 * $e->[$l]); my $r = _pythag($g, 1.0); $g = $d->[$m] - $d->[$l] + $e->[$l] / ($g + (($g >= 0.0) ? abs($r) : -abs($r))); my ($p,$s,$c) = (0.0, 1.0,1.0); for (my $i = ($m-1); $i >= $l; $i--) { my $ii = $i + 1; my $f = $s * $e->[$i]; my $t = _pythag($f, $g); $e->[$ii] = $t; if ($t == 0.0) { $d->[$ii] -= $p; $e->[$m] = 0.0; next OUTER; } my $b = $c * $e->[$i]; $s = $f / $t; $c = $g / $t; $g = $d->[$ii] - $p; my $t2 = ($d->[$i] - $g) * $s + 2.0 * $c * $b; $p = $s * $t2; $d->[$ii] = $g + $p; $g = $c * $t2 - $b; } $d->[$l] -= $p; $e->[$l] = $g; $e->[$m] = 0.0; } } while ($m != $l); } return; } # Householder reduction of a real, symmetric matrix A. # Returns a tridiagonal matrix T and the orthogonal matrix # Q effecting the transformation between A and T. sub householder ($) { my ($A) = @_; my ($rows, $cols) = ($A->[1], $A->[2]); croak "Matrix is not quadratic" unless ($rows = $cols); croak "Matrix is not symmetric" unless ($A->is_symmetric()); # Copy given matrix TODO: study if we should do in-place modification my $Q = $A->clone(); # Do the computation of tridiagonal elements and of # transformation matrix my ($diag, $offdiag) = $Q->_householder_vectors(); # Creates the tridiagonal matrix my $T = $A->shadow(); for (my $i = 0; $i < $rows; $i++) { # Set diagonal $T->[0][$i][$i] = $diag->[$i]; } for (my $i = 0; $i < ($rows-1); $i++) { # Set off diagonals $T->[0][$i+1][$i] = $offdiag->[$i]; $T->[0][$i][$i+1] = $offdiag->[$i]; } return ($T, $Q); } # QL algorithm with implicit shifts to determine the eigenvalues # and eigenvectors of a real tridiagonal matrix - or of a matrix # previously reduced to tridiagonal form. sub tri_diagonalize ($;$) { my ($T,$Q) = @_; # Q may be 0 if the original matrix is really tridiagonal my ($rows, $cols) = ($T->[1], $T->[2]); croak "Matrix is not quadratic" unless ($rows = $cols); croak "Matrix is not tridiagonal" unless ($T->is_tridiagonal()); # DONE my $EV; # Obtain/Creates the todo eigenvectors matrix if ($Q) { $EV = $Q->clone(); } else { $EV = $T->shadow(); $EV->one(); } # Allocates diagonal vector my $diag = [ ]; # Initializes it with T for (my $i = 0; $i < $rows; $i++) { $diag->[$i] = $T->[0][$i][$i]; } # Allocate temporary vector for off-diagonal elements my $offdiag = [ ]; for (my $i = 1; $i < $rows; $i++) { $offdiag->[$i-1] = $T->[0][$i][$i-1]; } # Calls the calculus routine $EV->_tridiagonal_QLimplicit($diag, $offdiag); # Allocate eigenvalues vector my $v = Math::MatrixReal->new($rows,1); # Fills it for (my $i = 0; $i < $rows; $i++) { $v->[0][$i][0] = $diag->[$i]; } return ($v, $EV); } # Main routine for diagonalization of a real symmetric # matrix M. Operates by transforming M into a tridiagonal # matrix and then obtaining the eigenvalues and eigenvectors # for that matrix (taking into account the transformation to # tridiagonal). sub sym_diagonalize ($) { my ($M) = @_; my ($rows, $cols) = ($M->[1], $M->[2]); croak "Matrix is not quadratic" unless ($rows = $cols); croak "Matrix is not symmetric" unless ($M->is_symmetric()); # Copy initial matrix # TODO: study if we should allow in-place modification my $VEC = $M->clone(); # Do the computation of tridiagonal elements and of # transformation matrix my ($diag, $offdiag) = $VEC->_householder_vectors(); # Calls the calculus routine for diagonalization $VEC->_tridiagonal_QLimplicit($diag, $offdiag); # Allocate eigenvalues vector my $val = Math::MatrixReal->new($rows,1); # Fills it for (my $i = 0; $i < $rows; $i++) { $val->[0][$i][0] = $diag->[$i]; } return ($val, $VEC); } # Householder reduction of a real, symmetric matrix A. # Returns a tridiagonal matrix T equivalent to A. sub householder_tridiagonal ($) { my ($A) = @_; my ($rows, $cols) = ($A->[1], $A->[2]); croak "Matrix is not quadratic" unless ($rows = $cols); croak "Matrix is not symmetric" unless ($A->is_symmetric()); # Copy given matrix my $Q = $A->clone(); # Do the computation of tridiagonal elements and of # transformation matrix # Q is destroyed after reduction my ($diag, $offdiag) = $Q->_householder_values(); # Creates the tridiagonal matrix in Q (avoid allocation) my $T = $Q; $T->zero(); for (my $i = 0; $i < $rows; $i++) { # Set diagonal $T->[0][$i][$i] = $diag->[$i]; } for (my $i = 0; $i < ($rows-1); $i++) { # Set off diagonals $T->[0][$i+1][$i] = $offdiag->[$i]; $T->[0][$i][$i+1] = $offdiag->[$i]; } return $T; } # QL algorithm with implicit shifts to determine ONLY # the eigenvalues a real tridiagonal matrix - or of a # matrix previously reduced to tridiagonal form. sub tri_eigenvalues ($;$) { my ($T) = @_; my ($rows, $cols) = ($T->[1], $T->[2]); croak "Matrix is not quadratic" unless ($rows = $cols); croak "Matrix is not tridiagonal" unless ($T->is_tridiagonal() ); # DONE # Allocates diagonal vector my $diag = [ ]; # Initializes it with T for (my $i = 0; $i < $rows; $i++) { $diag->[$i] = $T->[0][$i][$i]; } # Allocate temporary vector for off-diagonal elements my $offdiag = [ ]; for (my $i = 1; $i < $rows; $i++) { $offdiag->[$i-1] = $T->[0][$i][$i-1]; } # Calls the calculus routine (T is not touched) $T->_tridiagonal_QLimplicit_values($diag, $offdiag); # Allocate eigenvalues vector my $v = Math::MatrixReal->new($rows,1); # Fills it for (my $i = 0; $i < $rows; $i++) { $v->[0][$i][0] = $diag->[$i]; } return $v; } ## more general routine than sym_eigenvalues sub eigenvalues ($){ my ($matrix) = @_; my ($rows,$cols) = $matrix->dim(); croak "Matrix is not quadratic" unless ($rows == $cols); if($matrix->is_upper_triangular() || $matrix->is_lower_triangular() ){ my $l = Math::MatrixReal->new($rows,1); map { $l->[0][$_][0] = $matrix->[0][$_][$_] } (0 .. $rows-1); return $l; } return sym_eigenvalues($matrix) if $matrix->is_symmetric(); carp "Math::MatrixReal::eigenvalues(): Matrix is not symmetric or triangular"; return undef; } # Main routine for diagonalization of a real symmetric # matrix M. Operates by transforming M into a tridiagonal # matrix and then obtaining the eigenvalues and eigenvectors # for that matrix (taking into account the transformation to # tridiagonal). sub sym_eigenvalues ($) { my ($M) = @_; my ($rows, $cols) = ($M->[1], $M->[2]); croak "Matrix is not quadratic" unless ($rows == $cols); croak "Matrix is not symmetric" unless ($M->is_symmetric); # Copy matrix in temporary my $A = $M->clone(); # Do the computation of tridiagonal elements and of # transformation matrix. A is destroyed my ($diag, $offdiag) = $A->_householder_values(); # Calls the calculus routine for diagonalization # (M is not touched) $M->_tridiagonal_QLimplicit_values($diag, $offdiag); # Allocate eigenvalues vector my $val = Math::MatrixReal->new($rows,1); # Fills it map { $val->[0][$_][0] = $diag->[$_] } ( 0 .. $rows-1); return $val; } #TODO: docs+test sub is_positive_definite { my ($matrix) = @_; my ($r,$c) = $matrix->dim; croak "Math::MatrixReal::is_positive_definite(): Matrix is not square" unless ($r == $c); # must have positive (i.e REAL) eigenvalues to be positive definite return 0 unless $matrix->is_symmetric; my $ev = $matrix->eigenvalues; my $pos = 1; $ev->each(sub { my $x = shift; if ($x <= 0){ $pos=0;return; } } ); return $pos; } #TODO: docs+test sub is_positive_semidefinite { my ($matrix) = @_; my ($r,$c) = $matrix->dim; croak "Math::MatrixReal::is_positive_semidefinite(): Matrix is not square" unless ($r == $c); # must have nonnegative (i.e REAL) eigenvalues to be positive semidefinite return 0 unless $matrix->is_symmetric; my $ev = $matrix->eigenvalues; my $pos = 1; $ev->each(sub { my $x = shift; if ($x < 0){ $pos=0;return; } } ); return $pos; } sub is_row { return (shift)->is_row_vector } sub is_col { return (shift)->is_col_vector } sub is_row_vector { my ($m) = @_; my $r = $m->[1]; $r == 1 ? 1 : 0; } sub is_col_vector { my ($m) = @_; my $c = $m->[2]; $c == 1 ? 1 : 0; } sub is_orthogonal($) { my ($matrix) = @_; return 0 unless $matrix->is_quadratic; my $one = $matrix->shadow(); $one->one; abs(~$matrix * $matrix - $one) < 1e-12 ? return 1 : return 0; } sub is_positive($) { my ($m) = @_; my $pos = 1; $m->each( sub { if( (shift) <= 0){ $pos = 0;return;} } ); return $pos; } sub is_negative($) { my ($m) = @_; my $neg = 1; $m->each( sub { if( (shift) >= 0){ $neg = 0;return;} } ); return $neg; } sub is_periodic($$) { my ($m,$k) = @_; return 0 unless $m->is_quadratic(); abs($m**(int($k)+1) - $m) < 1e-12 ? return 1 : return 0; } sub is_idempotent($) { return (shift)->is_periodic(1); } # Boolean check routine to see if a matrix is # symmetric sub is_symmetric ($) { my ($M) = @_; my ($rows, $cols) = ($M->[1], $M->[2]); # if it is not quadratic it cannot be symmetric... return 0 unless ($rows == $cols); # skip when $i=$j? for (my $i = 1; $i < $rows; $i++) { for (my $j = 0; $j < $i; $j++) { return 0 unless ($M->[0][$i][$j] == $M->[0][$j][$i]); } } return 1; } # Boolean check to see if matrix is tridiagonal sub is_tridiagonal ($) { my ($M) = @_; my ($rows,$cols) = ($M->[1],$M->[2]); my ($i,$j) = (0,0); # if it is not quadratic it cannot be tridiag return 0 unless ($rows == $cols); for(;$i < $rows; $i++ ){ for(;$j < $cols; $j++ ){ #print "debug: testing $i,$j = " . $M->[0][$i][$j] . "\n"; # skip diag and diag+-1 next if ($i == $j); next if ($i+1 == $j); next if ($i-1 == $j); return 0 if $M->[0][$i][$j]; } $j = 0; } return 1; } # Boolean check to see if matrix is upper triangular # i.e all nonzero elements are above main diagonal sub is_upper_triangular { my ($M) = @_; my ($rows,$cols) = $M->dim(); my ($i,$j) = (1,0); return 0 unless ($rows == $cols); for(;$i < $rows; $i++ ){ for(;$j < $cols;$j++ ){ next if ($i <= $j); return 0 if $M->[0][$i][$j]; } $j = 0; } return 1; } # Boolean check to see if matrix is lower triangular # i.e all nonzero elements are lower main diagonal sub is_lower_triangular { my ($M) = @_; my ($rows,$cols) = $M->dim(); my ($i,$j) = (0,1); return 0 unless ($rows == $cols); for(;$i < $rows; $i++ ){ for(;$j < $cols;$j++ ){ next if ($i >= $j); return 0 if $M->[0][$i][$j]; } $j = 0; } return 1; } # Boolean check to see if matrix is diagonal sub is_diagonal ($) { my ($M) = @_; my ($rows,$cols) = ($M->[1],$M->[2]); my ($i,$j) = (0,0); return 0 unless ($rows == $cols ); for(;$i < $rows; $i++ ){ for(;$j < $cols; $j++ ){ # skip diag elements next if ($i == $j); return 0 if $M->[0][$i][$j]; } $j = 0; } return 1; } sub is_quadratic ($) { croak "Usage: \$matrix->is_quadratic()" unless (@_ == 1); my ($matrix) = @_; $matrix->[1] == $matrix->[2] ? return 1 : return 0; } sub is_square($) { croak "Usage: \$matrix->is_square()" unless (@_ == 1); return (shift)->is_quadratic(); } sub is_LR($) { croak "Usage: \$matrix->is_LR()" unless (@_ == 1); return (shift)->[3] ? 1 : 0; } sub is_normal{ my ($matrix,$eps) = @_; my ($rows,$cols) = $matrix->dim; $eps ||= 1e-8; (~$matrix * $matrix - $matrix * ~$matrix < $eps ) ? 1 : 0; } sub is_skew_symmetric{ my ($m) = @_; my ($rows, $cols) = $m->dim; # if it is not quadratic it cannot be skew symmetric... return 0 unless ($rows == $cols); for (my $i = 1; $i < $rows; $i++) { for (my $j = 0; $j < $i; $j++) { return 0 unless ($m->[0][$i][$j] == -$m->[0][$j][$i]); } } return 1; } #### sub is_gramian{ my ($m) = @_; my ($rows,$cols) = $m->dim; my $neg=0; # gramian matrix must be symmetric return 0 unless $m->is_symmetric; # must have all non-negative eigenvalues my $ev = $m->eigenvalues; $ev->each(sub { $neg++ if ((shift)<0) } ); return $neg ? 0 : 1; } sub is_binary{ my ($m) = @_; my ($rows, $cols) = $m->dim; for (my $i = 0; $i < $rows; $i++) { for (my $j = 0; $j < $cols; $j++) { return 0 unless ($m->[0][$i][$j] == 1 || $m->[0][$i][$j] == 0); } } return 1; } sub as_scilab { return (shift)->as_matlab; } sub as_matlab { my ($m) = shift; my %args = ( format => "%s", name => "", semi => 0, @_); my ($row,$col) = $m->dim; my $s = ""; if( $args{name} ){ $s = "$args{name} = "; } $s .= "["; $m->each( sub { my($x,$i,$j) = @_; $s .= sprintf(" $args{format}",$x); $s .= ";\n" if( $j == $col && $i != $row); } ); $s .= "]"; $s .= ";" if $args{semi}; return $s; } #TODO: docs+test sub as_yacas{ my ($m) = shift; my %args = ( format => "%s", name => "", semi => 0, @_); my ($row,$col) = $m->dim; my $s = ""; if( $args{name} ){ $s = "$args{name} := "; } $s .= "{"; $m->each( sub { my($x,$i,$j) = @_; $s .= "{" if ($j == 1); $s .= sprintf("$args{format}",$x); $s .= "," if( $j != $col ); $s .= "}," if ($j == $col && $i != $row); } ); $s .= "}}"; return $s; } sub as_latex{ my ($m) = shift; my %args = ( format => "%s", name => "", align => "c", display_math => 0, @_); my ($row,$col) = $m->dim; my $inside; my $s = <each( sub { my ($x,$i,$j) = @_; $x = sprintf($args{format},$x); # last element in each row gets a \\ if ($j == $col && $i != $row){ $inside .= "$x \\\\"."\n"; # the annoying last line has neither } elsif( $j == $col && $i == $row){ $inside .= "$x\n"; } else { $inside .= "$x&"; } } ); if($args{displaymath}){ $s = "\\[$s\\]"; } else { $s = "\$$s\$"; } $s =~ s/%INSIDE%/$inside/gm; return $s; } #### sub spectral_radius { my ($matrix) = @_; my ($r,$c) = $matrix->dim; my $ev = $matrix->eigenvalues; my $radius=0; $ev->each(sub { my $x = shift; $radius = $x if (abs($x) > $radius); } ); return $radius; } sub maximum { my ($matrix) = @_; my ($rows, $columns) = $matrix->dim; my $max = []; my $max_p = []; if ($rows == 1) { ($max, $max_p) = _max_column($matrix->row(1)->_transpose, $columns); } elsif ($columns == 1) { ($max, $max_p) = _max_column($matrix->column(1), $rows); } else { for my $c (1..$columns) { my ($m, $mp) = _max_column($matrix->column($c), $rows); push @$max, $m; push @$max_p, $mp; } } return wantarray ? ($max, $max_p) : $max } sub _max_column { # passing $rows allows for some extra (minimal) efficiency my ($column, $rows) = @_; my ($m, $mp) = ($column->element(1, 1), 1); for my $l (1..$rows) { if ($column->element($l, 1) > $m) { $m = $column->element($l, 1); $mp = $l; } } return ($m, $mp); } sub minimum { my ($matrix) = @_; my ($rows, $columns) = $matrix->dim; my $min = []; my $min_p = []; if ($rows == 1) { ($min, $min_p) = _min_column($matrix->row(1)->_transpose, $columns); } elsif ($columns == 1) { ($min, $min_p) = _min_column($matrix->column(1), $rows); } else { for my $c (1..$columns) { my ($m, $mp) = _min_column($matrix->column($c), $rows); push @$min, $m; push @$min_p, $mp; } } return wantarray ? ($min, $min_p) : $min } sub _min_column { # passing $rows allows for some extra (minimal) efficiency my ($column, $rows) = @_; my ($m, $mp) = ($column->element(1, 1), 1); for my $l (1..$rows) { if ($column->element($l, 1) < $m) { $m = $column->element($l, 1); $mp = $l; } } return ($m, $mp); } ######################################## # # # define overloaded operators section: # # # ######################################## sub _concat { my($object,$argument,$flag) = @_; my($orows,$ocols) = ($object->[1],$object->[2]); my($name) = "concat"; if ((defined $argument) && ref($argument) && (ref($argument) !~ /^SCALAR$|^ARRAY$|^HASH$|^CODE$|^REF$/)) { my($arows,$acols) = ($argument->[1],$argument->[2]); croak "Math::MatrixReal: Matrices must have same number of rows in concatenation" unless ($orows == $arows); my $result = $object->new($orows,$ocols+$acols); for ( my $i = 0; $i < $arows; $i++ ) { for ( my $j = 0; $j < $ocols + $acols; $j++ ) { $result->[0][$i][$j] = ( $j < $ocols ) ? $object->[0][$i][$j] : $argument->[0][$i][$j - $ocols] ; } } return $result; } elsif (defined $argument) { return "$object" . $argument; } else { croak "Math::MatrixReal $name: wrong argument type"; } } sub _negate { my($object) = @_; my $temp = $object->new($object->[1],$object->[2]); $temp->negate($object); return($temp); } sub _transpose { my ($object) = @_; my $temp = $object->new($object->[2],$object->[1]); $temp->transpose($object); return $temp; } sub _boolean { my($object) = @_; my($rows,$cols) = ($object->[1],$object->[2]); my $result = 0; BOOL: for ( my $i = 0; $i < $rows; $i++ ) { for ( my $j = 0; $j < $cols; $j++ ) { if ($object->[0][$i][$j] != 0) { $result = 1; last BOOL; } } } return($result); } #TODO: ugly copy+paste sub _not_boolean { my ($object) = @_; my ($rows,$cols) = ($object->[1],$object->[2]); my $result = 1; NOTBOOL: for ( my $i = 0; $i < $rows; $i++ ) { for ( my $j = 0; $j < $cols; $j++ ) { if ($object->[0][$i][$j] != 0) { $result = 0; last NOTBOOL; } } } return($result); } sub _stringify { my ($self) = @_; my ($rows,$cols) = ($self->[1],$self->[2]); my $precision = $self->[4]; my $format = !defined $precision ? '% #-19.12E ' : '% #-19.'.$precision.'f '; $format = '% #-12d' if defined $precision && $precision == 0; my $s = ''; for ( my $i = 0; $i < $rows; $i++ ) { $s .= "[ "; for ( my $j = 0; $j < $cols; $j++ ) { $s .= sprintf $format , $self->[0][$i][$j]; } $s .= "]\n"; } return $s; } sub _norm { my ($self) = @_; return $self->norm_one() ; } sub _add { my($object,$argument,$flag) = @_; my($name) = "'+'"; if ((defined $argument) && ref($argument) && (ref($argument) !~ /^SCALAR$|^ARRAY$|^HASH$|^CODE$|^REF$/)) { if (defined $flag) { my $temp = $object->new($object->[1],$object->[2]); $temp->add($object,$argument); return($temp); } else { $object->add($object,$argument); return($object); } } else { croak "Math::MatrixReal $name: wrong argument type"; } } sub _subtract { my($object,$argument,$flag) = @_; my($name) = "'-'"; if ((defined $argument) && ref($argument) && (ref($argument) !~ /^SCALAR$|^ARRAY$|^HASH$|^CODE$|^REF$/)) { if (defined $flag) { my $temp = $object->new($object->[1],$object->[2]); if ($flag) { $temp->subtract($argument,$object); } else { $temp->subtract($object,$argument); } return $temp; } else { $object->subtract($object,$argument); return($object); } } else { croak "Math::MatrixReal $name: wrong argument type"; } } sub _exponent { my($matrix, $exp) = @_; my($rows,$cols) = ($matrix->[1],$matrix->[2]); return $matrix->exponent( $exp ); } sub _divide { my($matrix,$argument,$flag) = @_; # TODO: check dimensions of everything! my($mrows,$mcols) = ($matrix->[1],$matrix->[2]); my($arows,$acols)=(0,0); my($name) = "'/'"; my $temp = $matrix->clone(); my $arg; my ($inv,$m1); if( ref($argument) =~ /Math::MatrixReal/ ){ $arg = $argument->clone(); ($arows,$acols)=($arg->[1],$arg->[2]); } #print "DEBUG: flag= $flag\n"; #print "DEBUG: arg=$arg\n"; if( $flag == 1) { #print "DEBUG: ref(arg)= " . ref($arg) . "\n"; if( ref($argument) =~ /Math::MatrixReal/ ){ #print "DEBUG: arg is a matrix \n"; # Matrix Division = A/B = A*B^(-1) croak "Math::MatrixReal $name: this operation is defined only for square matrices" unless ($arows == $acols); return $temp->multiply( $arg->inverse() ); } else { #print "DEBUG: Arg is scalar\n"; #print "DEBUG:arows,acols=$arows,$acols\n"; #print "DEBGU:mrows,mcols=$mrows,$mcols\n"; croak "Math::MatrixReal $name: this operation is defined only for square matrices" unless ($mrows == $mcols); $temp->multiply_scalar( $temp , $argument); return $temp; } } else { #print "DEBUG: temp=\n"; #print $temp . "\n"; #print "DEBUG: ref(arg)= " . ref($arg) . "\n"; #print "DEBUG: arg=\n"; #print $arg ."\n"; if( ref($arg) =~ /Math::MatrixReal/ ){ #print "DEBUG: matrix division\n"; if( $arg->is_col_vector() ){ print "DEBUG: $arg is a col vector\n"; } croak "Math::MatrixReal $name: this operation is defined only for square matrices" unless ($arows == $acols); $inv = $arg->inverse(); return $temp->multiply($inv); } else { $temp->multiply_scalar($temp,1/$argument); return $temp; } } } sub _multiply { my($object,$argument,$flag) = @_; my($name) = "'*'"; my($temp); if ((defined $argument) && ref($argument) && (ref($argument) !~ /^SCALAR$|^ARRAY$|^HASH$|^CODE$|^REF$/)) { if ((defined $flag) && $flag) { return( multiply($argument,$object) ); } else { return( multiply($object,$argument) ); } } elsif ((defined $argument) && !(ref($argument))) { if (defined $flag) { $temp = $object->new($object->[1],$object->[2]); $temp->multiply_scalar($object,$argument); return($temp); } else { $object->multiply_scalar($object,$argument); return($object); } } else { croak "Math::MatrixReal $name: wrong argument type"; } } sub _assign_add { my($object,$argument) = @_; return( &_add($object,$argument,undef) ); } sub _assign_subtract { my($object,$argument) = @_; return( &_subtract($object,$argument,undef) ); } sub _assign_multiply { my($object,$argument) = @_; return( &_multiply($object,$argument,undef) ); } sub _assign_exponent { my($object,$arg) = @_; return ( &_exponent($object,$arg,undef) ); } sub _equal { my($object,$argument,$flag) = @_; my($name) = "'=='"; my($rows,$cols) = ($object->[1],$object->[2]); my($i,$j,$result); if ((defined $argument) && ref($argument) && (ref($argument) !~ /^SCALAR$|^ARRAY$|^HASH$|^CODE$|^REF$/)) { $result = 1; EQUAL: for ( $i = 0; $i < $rows; $i++ ) { for ( $j = 0; $j < $cols; $j++ ) { if ($object->[0][$i][$j] != $argument->[0][$i][$j]) { $result = 0; last EQUAL; } } } return($result); } else { croak "Math::MatrixReal $name: wrong argument type"; } } sub _not_equal { my($object,$argument,$flag) = @_; my($name) = "'!='"; my($rows,$cols) = ($object->[1],$object->[2]); if ((defined $argument) && ref($argument) && (ref($argument) !~ /^SCALAR$|^ARRAY$|^HASH$|^CODE$|^REF$/)) { my ($r,$c) = $argument->dim; return 1 unless ($r == $rows && $c == $cols ); my $result = 0; NOTEQUAL: for ( my $i = 0; $i < $rows; $i++ ) { for ( my $j = 0; $j < $cols; $j++ ) { if ($object->[0][$i][$j] != $argument->[0][$i][$j]) { $result = 1; last NOTEQUAL; } } } return $result; } else { croak "Math::MatrixReal $name: wrong argument type"; } } sub _less_than { my($object,$argument,$flag) = @_; my($name) = "'<'"; if ((defined $argument) && ref($argument) && (ref($argument) !~ /^SCALAR$|^ARRAY$|^HASH$|^CODE$|^REF$/)) { if ((defined $flag) && $flag) { return( $argument->norm_one() < $object->norm_one() ); } else { return( $object->norm_one() < $argument->norm_one() ); } } elsif ((defined $argument) && !(ref($argument))) { if ((defined $flag) && $flag) { return( abs($argument) < $object->norm_one() ); } else { return( $object->norm_one() < abs($argument) ); } } else { croak "Math::MatrixReal $name: wrong argument type"; } } sub _less_than_or_equal { my($object,$argument,$flag) = @_; my($name) = "'<='"; if ((defined $argument) && ref($argument) && (ref($argument) !~ /^SCALAR$|^ARRAY$|^HASH$|^CODE$|^REF$/)) { if ((defined $flag) && $flag) { return( $argument->norm_one() <= $object->norm_one() ); } else { return( $object->norm_one() <= $argument->norm_one() ); } } elsif ((defined $argument) && !(ref($argument))) { if ((defined $flag) && $flag) { return( abs($argument) <= $object->norm_one() ); } else { return( $object->norm_one() <= abs($argument) ); } } else { croak "Math::MatrixReal $name: wrong argument type"; } } sub _greater_than { my($object,$argument,$flag) = @_; my($name) = "'>'"; if ((defined $argument) && ref($argument) && (ref($argument) !~ /^SCALAR$|^ARRAY$|^HASH$|^CODE$|^REF$/)) { if ((defined $flag) && $flag) { return( $argument->norm_one() > $object->norm_one() ); } else { return( $object->norm_one() > $argument->norm_one() ); } } elsif ((defined $argument) && !(ref($argument))) { if ((defined $flag) && $flag) { return( abs($argument) > $object->norm_one() ); } else { return( $object->norm_one() > abs($argument) ); } } else { croak "Math::MatrixReal $name: wrong argument type"; } } sub _greater_than_or_equal { my($object,$argument,$flag) = @_; my($name) = "'>='"; if ((defined $argument) && ref($argument) && (ref($argument) !~ /^SCALAR$|^ARRAY$|^HASH$|^CODE$|^REF$/)) { if ((defined $flag) && $flag) { return( $argument->norm_one() >= $object->norm_one() ); } else { return( $object->norm_one() >= $argument->norm_one() ); } } elsif ((defined $argument) && !(ref($argument))) { if ((defined $flag) && $flag) { return( abs($argument) >= $object->norm_one() ); } else { return( $object->norm_one() >= abs($argument) ); } } else { croak "Math::MatrixReal $name: wrong argument type"; } } sub _clone { my($object) = @_; my $temp = $object->new($object->[1],$object->[2]); $temp->copy($object); $temp->_undo_LR(); return $temp; } { no warnings; 42 } __END__ =head1 FUNCTIONS =head2 Constructor Methods And Such =over 4 =item * use Math::MatrixReal; Makes the methods and overloaded operators of this module available to your program. =item * $new_matrix = new Math::MatrixReal($rows,$columns); The matrix object constructor method. A new matrix of size $rows by $columns will be created, with the value C<0.0> for all elements. Note that this method is implicitly called by many of the other methods in this module. =item * $new_matrix = $some_matrix-Enew($rows,$columns); Another way of calling the matrix object constructor method. Matrix $some_matrix is not changed by this in any way. =item * $new_matrix = $matrix-Enew_from_cols( [ $column_vector|$array_ref|$string, ... ] ) Creates a new matrix given a reference to an array of any of the following: =over 4 =item * column vectors ( n by 1 Math::MatrixReal matrices ) =item * references to arrays =item * strings properly formatted to create a column with Math::MatrixReal's new_from_string command =back You may mix and match these as you wish. However, all must be of the same dimension--no padding happens automatically. Example: my $matrix = Math::MatrixReal->new_from_cols( [ [1,2], [3,4] ] ); print $matrix; will print [ 1.000000000000E+00 3.000000000000E+00 ] [ 2.000000000000E+00 4.000000000000E+00 ] =item * new_from_rows( [ $row_vector|$array_ref|$string, ... ] ) Creates a new matrix given a reference to an array of any of the following: =over 4 =item * row vectors ( 1 by n Math::MatrixReal matrices ) =item * references to arrays =item * strings properly formatted to create a row with Math::MatrixReal's new_from_string command =back You may mix and match these as you wish. However, all must be of the same dimension--no padding happens automatically. Example: my $matrix = Math::MatrixReal->new_from_rows( [ [1,2], [3,4] ] ); print $matrix; will print [ 1.000000000000E+00 2.000000000000E+00 ] [ 3.000000000000E+00 4.000000000000E+00 ] =item * $new_matrix = Math::MatrixReal-Enew_random($rows, $cols, %options ); This method allows you to create a random matrix with various properties controlled by the %options matrix, which is optional. The default values of the %options matrix are { integer => 0, symmetric => 0, tridiagonal => 0, diagonal => 0, bounded_by => [0,10] } . Example: $matrix = Math::MatrixReal->new_random(4, { diagonal => 1, integer => 1 } ); print $matrix; will print a 4x4 random diagonal matrix with integer entries between zero and ten, something like [ 5.000000000000E+00 0.000000000000E+00 0.000000000000E+00 0.000000000000E+00 ] [ 0.000000000000E+00 2.000000000000E+00 0.000000000000E+00 0.000000000000E+00 ] [ 0.000000000000E+00 0.000000000000E+00 1.000000000000E+00 0.000000000000E+00 ] [ 0.000000000000E+00 0.000000000000E+00 0.000000000000E+00 8.000000000000E+00 ] =item * $new_matrix = Math::MatrixReal-Enew_diag( $array_ref ); This method allows you to create a diagonal matrix by only specifying the diagonal elements. Example: $matrix = Math::MatrixReal->new_diag( [ 1,2,3,4 ] ); print $matrix; will print [ 1.000000000000E+00 0.000000000000E+00 0.000000000000E+00 0.000000000000E+00 ] [ 0.000000000000E+00 2.000000000000E+00 0.000000000000E+00 0.000000000000E+00 ] [ 0.000000000000E+00 0.000000000000E+00 3.000000000000E+00 0.000000000000E+00 ] [ 0.000000000000E+00 0.000000000000E+00 0.000000000000E+00 4.000000000000E+00 ] =item * $new_matrix = Math::MatrixReal-Enew_tridiag( $lower, $diag, $upper ); This method allows you to create a tridiagonal matrix by only specifying the lower diagonal, diagonal and upper diagonal, respectively. $matrix = Math::MatrixReal->new_tridiag( [ 6, 4, 2 ], [1,2,3,4], [1, 8, 9] ); print $matrix; will print [ 1.000000000000E+00 1.000000000000E+00 0.000000000000E+00 0.000000000000E+00 ] [ 6.000000000000E+00 2.000000000000E+00 8.000000000000E+00 0.000000000000E+00 ] [ 0.000000000000E+00 4.000000000000E+00 3.000000000000E+00 9.000000000000E+00 ] [ 0.000000000000E+00 0.000000000000E+00 2.000000000000E+00 4.000000000000E+00 ] =item * $new_matrix = Math::MatrixReal-Enew_from_string($string); This method allows you to read in a matrix from a string (for instance, from the keyboard, from a file or from your code). The syntax is simple: each row must start with "C<[ >" and end with "C< ]\n>" ("C<\n>" being the newline character and "C< >" a space or tab) and contain one or more numbers, all separated from each other by spaces or tabs. Additional spaces or tabs can be added at will, but no comments. Examples: $string = "[ 1 2 3 ]\n[ 2 2 -1 ]\n[ 1 1 1 ]\n"; $matrix = Math::MatrixReal->new_from_string($string); print "$matrix"; By the way, this prints [ 1.000000000000E+00 2.000000000000E+00 3.000000000000E+00 ] [ 2.000000000000E+00 2.000000000000E+00 -1.000000000000E+00 ] [ 1.000000000000E+00 1.000000000000E+00 1.000000000000E+00 ] But you can also do this in a much more comfortable way using the shell-like "here-document" syntax: $matrix = Math::MatrixReal->new_from_string(<<'MATRIX'); [ 1 0 0 0 0 0 1 ] [ 0 1 0 0 0 0 0 ] [ 0 0 1 0 0 0 0 ] [ 0 0 0 1 0 0 0 ] [ 0 0 0 0 1 0 0 ] [ 0 0 0 0 0 1 0 ] [ 1 0 0 0 0 0 -1 ] MATRIX You can even use variables in the matrix: $c1 = 2 / 3; $c2 = -2 / 5; $c3 = 26 / 9; $matrix = Math::MatrixReal->new_from_string(<<"MATRIX"); [ 3 2 0 ] [ 0 3 2 ] [ $c1 $c2 $c3 ] MATRIX (Remember that you may use spaces and tabs to format the matrix to your taste) Note that this method uses exactly the same representation for a matrix as the "stringify" operator "": this means that you can convert any matrix into a string with C<$string = "$matrix";> and read it back in later (for instance from a file!). Note however that you may suffer a precision loss in this process because only 13 digits are supported in the mantissa when printed!! If the string you supply (or someone else supplies) does not obey the syntax mentioned above, an exception is raised, which can be caught by "eval" as follows: print "Please enter your matrix (in one line): "; $string = ; $string =~ s/\\n/\n/g; eval { $matrix = Math::MatrixReal->new_from_string($string); }; if ($@) { print "$@"; # ... # (error handling) } else { # continue... } or as follows: eval { $matrix = Math::MatrixReal->new_from_string(<<"MATRIX"); }; [ 3 2 0 ] [ 0 3 2 ] [ $c1 $c2 $c3 ] MATRIX if ($@) # ... Actually, the method shown above for reading a matrix from the keyboard is a little awkward, since you have to enter a lot of "\n"'s for the newlines. A better way is shown in this piece of code: while (1) { print "\nPlease enter your matrix "; print "(multiple lines, = done):\n"; eval { $new_matrix = Math::MatrixReal->new_from_string(join('',)); }; if ($@) { $@ =~ s/\s+at\b.*?$//; print "${@}Please try again.\n"; } else { last; } } Possible error messages of the "new_from_string()" method are: Math::MatrixReal::new_from_string(): syntax error in input string Math::MatrixReal::new_from_string(): empty input string If the input string has rows with varying numbers of columns, the following warning will be printed to STDERR: Math::MatrixReal::new_from_string(): missing elements will be set to zero! If everything is okay, the method returns an object reference to the (newly allocated) matrix containing the elements you specified. =item * $new_matrix = $some_matrix-Eshadow(); Returns an object reference to a B but B matrix (filled with zero's) of the B as matrix "C<$some_matrix>". Matrix "C<$some_matrix>" is not changed by this in any way. =item * $matrix1-Ecopy($matrix2); Copies the contents of matrix "C<$matrix2>" to an B matrix "C<$matrix1>" (which must have the same size as matrix "C<$matrix2>"!). Matrix "C<$matrix2>" is not changed by this in any way. =item * $twin_matrix = $some_matrix-Eclone(); Returns an object reference to a B matrix of the B as matrix "C<$some_matrix>". The contents of matrix "C<$some_matrix>" have B to the new matrix "C<$twin_matrix>". This is the method that the operator "=" is overloaded to when you type C<$a = $b>, when C<$a> and C<$b> are matrices. Matrix "C<$some_matrix>" is not changed by this in any way. =item * $matrix = Math::MatrixReal->reshape($rows, $cols, $array_ref); Return a matrix with the specified dimensions (C<$rows> x C<$cols>) whose elements are taken from the array reference C<$array_ref>. The elements of the matrix are accessed in column-major order (like Fortran arrays are stored). $matrix = Math::MatrixReal->reshape(4, 3, [1..12]); Creates the following matrix: [ 1 5 9 ] [ 2 6 10 ] [ 3 7 11 ] [ 4 8 12 ] =back =head2 Matrix Row, Column and Element operations =over 4 =item * $value = $matrix-Eelement($row,$column); Returns the value of a specific element of the matrix "C<$matrix>", located in row "C<$row>" and column "C<$column>". B Unlike Perl, matrices are indexed with base-one indexes. Thus, the first element of the matrix is placed in the B line, B column: $elem = $matrix->element(1, 1); # first element of the matrix. =item * $matrix-Eassign($row,$column,$value); Explicitly assigns a value "C<$value>" to a single element of the matrix "C<$matrix>", located in row "C<$row>" and column "C<$column>", thereby replacing the value previously stored there. =item * $row_vector = $matrix-Erow($row); This is a projection method which returns an object reference to a B matrix (which in fact is a (row) vector since it has only one row) to which row number "C<$row>" of matrix "C<$matrix>" has already been copied. Matrix "C<$matrix>" is not changed by this in any way. =item * $column_vector = $matrix-Ecolumn($column); This is a projection method which returns an object reference to a B matrix (which in fact is a (column) vector since it has only one column) to which column number "C<$column>" of matrix "C<$matrix>" has already been copied. Matrix "C<$matrix>" is not changed by this in any way. =item * @all_elements = $matrix-Eas_list; Get the contents of a Math::MatrixReal object as a Perl list. Example: my $matrix = Math::MatrixReal->new_from_rows([ [1, 2], [3, 4] ]); my @list = $matrix->as_list; # 1, 2, 3, 4 This method is suitable for use with OpenGL. For example, there is need to rotate model around X-axis to 90 degrees clock-wise. That could be achieved via: use Math::Trig; use OpenGL; ...; my $axis = [1, 0, 0]; my $angle = 90; ... my ($x, $y, $z) = @$axis; my $f = $angle; my $cos_f = cos(deg2rad($f)); my $sin_f = sin(deg2rad($f)); my $rotation = Math::MatrixReal->new_from_rows([ [$cos_f+(1-$cos_f)*$x**2, (1-$cos_f)*$x*$y-$sin_f*$z, (1-$cos_f)*$x*$z+$sin_f*$y, 0 ], [(1-$cos_f)*$y*$z+$sin_f*$z, $cos_f+(1-$cos_f)*$y**2 , (1-$cos_f)*$y*$z-$sin_f*$x, 0 ], [(1-$cos_f)*$z*$x-$sin_f*$y, (1-$cos_f)*$z*$y+$sin_f*$x, $cos_f+(1-$cos_f)*$z**2 ,0 ], [0, 0, 0, 1 ], ]); ...; my $model_initial = Math::MatrixReal->new_diag( [1, 1, 1, 1] ); # identity matrix my $model = $model_initial * $rotation; $model = ~$model; # OpenGL operates on transposed matrices my $model_oga = OpenGL::Array->new_list(GL_FLOAT, $model->as_list); $shader->SetMatrix(model => $model_oga); # instance of OpenGL::Shader See L, L, L, L. =item * $new_matrix = $matrix-Eeach( \&function ); Creates a new matrix by evaluating a code reference on each element of the given matrix. The function is passed the element, the row index and the column index, in that order. The value the function returns ( or the value of the last executed statement ) is the value given to the corresponding element in $new_matrix. Example: # add 1 to every element in the matrix $matrix = $matrix->each ( sub { (shift) + 1 } ); Example: my $cofactor = $matrix->each( sub { my(undef,$i,$j) = @_; ($i+$j) % 2 == 0 ? $matrix->minor($i,$j)->det() : -1*$matrix->minor($i,$j)->det(); } ); This code needs some explanation. For each element of $matrix, it throws away the actual value and stores the row and column indexes in $i and $j. Then it sets element [$i,$j] in $cofactor to the determinant of C<$matrix-Eminor($i,$j)> if it is an "even" element, or C<-1*$matrix-Eminor($i,$j)> if it is an "odd" element. =item * $new_matrix = $matrix-Eeach_diag( \&function ); Creates a new matrix by evaluating a code reference on each diagonal element of the given matrix. The function is passed the element, the row index and the column index, in that order. The value the function returns ( or the value of the last executed statement ) is the value given to the corresponding element in $new_matrix. =item * $matrix-Eswap_col( $col1, $col2 ); This method takes two one-based column numbers and swaps the values of each element in each column. C<$matrix-Eswap_col(2,3)> would replace column 2 in $matrix with column 3, and replace column 3 with column 2. =item * $matrix-Eswap_row( $row1, $row2 ); This method takes two one-based row numbers and swaps the values of each element in each row. C<$matrix-Eswap_row(2,3)> would replace row 2 in $matrix with row 3, and replace row 3 with row 2. =item * $matrix-Eassign_row( $row_number , $new_row_vector ); This method takes a one-based row number and assigns row $row_number of $matrix with $new_row_vector and returns the resulting matrix. C<$matrix-Eassign_row(5, $x)> would replace row 5 in $matrix with the row vector $x. =item * $matrix-Emaximum(); and $matrix-Eminimum(); These two methods work similarly, one for computing the maximum element or elements from a matrix, and the minimum element or elements from a matrix. They work in a similar way as Octave/MatLab max/min functions. When computing the maximum or minimum from a vector (vertical or horizontal), only one element is returned. When computing the maximum or minimum from a matrix, the maximum/minimum element for each column is returned in an array reference. When called in list context, the function returns a pair, where the first element is the maximum/minimum element (or elements) and the second is the position of that value in the vector (first occurrence), or the row where it occurs, for matrices. Consider the matrix and vector below for the following examples: [ 1 9 4 ] $A = [ 3 5 2 ] $B = [ 8 7 9 5 3 ] [ 8 7 6 ] When used in scalar context: $max = $A->maximum(); # $max = [ 8, 9, 6 ] $min = $B->minimum(); # $min = 3 When used in list context: ($min, $pos) = $A->minimum(); # $min = [ 1 5 2 ] # $pos = [ 1 2 2 ] ($max, $pos) = $B->maximum(); # $max = 9 # $pos = 3 =back =head2 Matrix Operations =over 4 =item * C<$det = $matrix-Edet();> Returns the determinant of the matrix, without going through the rigamarole of computing a LR decomposition. This method should be much faster than LR decomposition if the matrix is diagonal or triangular. Otherwise, it is just a wrapper for C<$matrix-Edecompose_LR-Edet_LR>. If the determinant is zero, there is no inverse and vice-versa. Only quadratic matrices have determinants. =item * C<$inverse = $matrix-Einverse();> Returns the inverse of a matrix, without going through the rigamarole of computing a LR decomposition. If no inverse exists, undef is returned and an error is printed via C. This is nothing but a wrapper for C<$matrix-Edecompose_LR-Einvert_LR>. =item * C<($rows,$columns) = $matrix-Edim();> Returns a list of two items, representing the number of rows and columns the given matrix "C<$matrix>" contains. =item * C<$norm_one = $matrix-Enorm_one();> Returns the "one"-norm of the given matrix "C<$matrix>". The "one"-norm is defined as follows: For each column, the sum of the absolute values of the elements in the different rows of that column is calculated. Finally, the maximum of these sums is returned. Note that the "one"-norm and the "maximum"-norm are mathematically equivalent, although for the same matrix they usually yield a different value. Therefore, you should only compare values that have been calculated using the same norm! Throughout this package, the "one"-norm is (arbitrarily) used for all comparisons, for the sake of uniformity and comparability, except for the iterative methods "solve_GSM()", "solve_SSM()" and "solve_RM()" which use either norm depending on the matrix itself. =item * C<$norm_max = $matrix-Enorm_max();> Returns the "maximum"-norm of the given matrix $matrix. The "maximum"-norm is defined as follows: For each row, the sum of the absolute values of the elements in the different columns of that row is calculated. Finally, the maximum of these sums is returned. Note that the "maximum"-norm and the "one"-norm are mathematically equivalent, although for the same matrix they usually yield a different value. Therefore, you should only compare values that have been calculated using the same norm! Throughout this package, the "one"-norm is (arbitrarily) used for all comparisons, for the sake of uniformity and comparability, except for the iterative methods "solve_GSM()", "solve_SSM()" and "solve_RM()" which use either norm depending on the matrix itself. =item * C<$norm_sum = $matrix-Enorm_sum();> This is a very simple norm which is defined as the sum of the absolute values of every element. =item * C<$p_norm> = $matrix-Enorm_p($n);> This function returns the "p-norm" of a vector. The argument $n must be a number greater than or equal to 1 or the string "Inf". The p-norm is defined as (sum(x_i^p))^(1/p). In words, it raised each element to the p-th power, adds them up, and then takes the p-th root of that number. If the string "Inf" is passed, the "infinity-norm" is computed, which is really the limit of the p-norm as p goes to infinity. It is defined as the maximum element of the vector. Also, note that the familiar Euclidean distance between two vectors is just a special case of a p-norm, when p is equal to 2. Example: $a = Math::MatrixReal->new_from_cols([[1,2,3]]); $p1 = $a->norm_p(1); $p2 = $a->norm_p(2); $p3 = $a->norm_p(3); $pinf = $a->norm_p("Inf"); print "(1,2,3,Inf) norm:\n$p1\n$p2\n$p3\n$pinf\n"; $i1 = $a->new_from_rows([[1,0]]); $i2 = $a->new_from_rows([[0,1]]); # this should be sqrt(2) since it is the same as the # hypotenuse of a 1 by 1 right triangle $dist = ($i1-$i2)->norm_p(2); print "Distance is $dist, which should be " . sqrt(2) . "\n"; Output: (1,2,3,Inf) norm: 6 3.74165738677394139 3.30192724889462668 3 Distance is 1.41421356237309505, which should be 1.41421356237309505 =item * C<$frob_norm> = C<$matrix-Enorm_frobenius();> This norm is similar to that of a p-norm where p is 2, except it acts on a B, not a vector. Each element of the matrix is squared, this is added up, and then a square root is taken. =item * C<$matrix-Espectral_radius();> Returns the maximum value of the absolute value of all eigenvalues. Currently this computes B eigenvalues, then sifts through them to find the largest in absolute value. Needless to say, this is very inefficient, and in the future an algorithm that computes only the largest eigenvalue may be implemented. =item * C<$matrix1-Etranspose($matrix2);> Calculates the transposed matrix of matrix $matrix2 and stores the result in matrix "C<$matrix1>" (which must already exist and have the same size as matrix "C<$matrix2>"!). This operation can also be carried out "in-place", i.e., input and output matrix may be identical. Transposition is a symmetry operation: imagine you rotate the matrix along the axis of its main diagonal (going through elements (1,1), (2,2), (3,3) and so on) by 180 degrees. Another way of looking at it is to say that rows and columns are swapped. In fact the contents of element C<(i,j)> are swapped with those of element C<(j,i)>. Note that (especially for vectors) it makes a big difference if you have a row vector, like this: [ -1 0 1 ] or a column vector, like this: [ -1 ] [ 0 ] [ 1 ] the one vector being the transposed of the other! This is especially true for the matrix product of two vectors: [ -1 ] [ -1 0 1 ] * [ 0 ] = [ 2 ] , whereas [ 1 ] * [ -1 0 1 ] [ -1 ] [ 1 0 -1 ] [ 0 ] * [ -1 0 1 ] = [ -1 ] [ 1 0 -1 ] = [ 0 0 0 ] [ 1 ] [ 0 ] [ 0 0 0 ] [ -1 0 1 ] [ 1 ] [ -1 0 1 ] So be careful about what you really mean! Hint: throughout this module, whenever a vector is explicitly required for input, a B vector is expected! =item * C<$trace = $matrix-Etrace();> This returns the trace of the matrix, which is defined as the sum of the diagonal elements. The matrix must be quadratic. =item * C<$minor = $matrix-Eminor($row,$col);> Returns the minor matrix corresponding to $row and $col. $matrix must be quadratic. If $matrix is n rows by n cols, the minor of $row and $col will be an (n-1) by (n-1) matrix. The minor is defined as crossing out the row and the col specified and returning the remaining rows and columns as a matrix. This method is used by C. =item * C<$cofactor = $matrix-Ecofactor();> The cofactor matrix is constructed as follows: For each element, cross out the row and column that it sits in. Now, take the determinant of the matrix that is left in the other rows and columns. Multiply the determinant by (-1)^(i+j), where i is the row index, and j is the column index. Replace the given element with this value. The cofactor matrix can be used to find the inverse of the matrix. One formula for the inverse of a matrix is the cofactor matrix transposed divided by the original determinant of the matrix. The following two inverses should be exactly the same: my $inverse1 = $matrix->inverse; my $inverse2 = ~($matrix->cofactor)->each( sub { (shift)/$matrix->det() } ); Caveat: Although the cofactor matrix is simple algorithm to compute the inverse of a matrix, and can be used with pencil and paper for small matrices, it is comically slower than the native C function. Here is a small benchmark: # $matrix1 is 15x15 $det = $matrix1->det; timethese( 10, {'inverse' => sub { $matrix1->inverse(); }, 'cofactor' => sub { (~$matrix1->cofactor)->each ( sub { (shift)/$det; } ) } } ); Benchmark: timing 10 iterations of LR, cofactor, inverse... inverse: 1 wallclock secs ( 0.56 usr + 0.00 sys = 0.56 CPU) @ 17.86/s (n=10) cofactor: 36 wallclock secs (36.62 usr + 0.01 sys = 36.63 CPU) @ 0.27/s (n=10) =item * C<$adjoint = $matrix-Eadjoint();> The adjoint is just the transpose of the cofactor matrix. This method is just an alias for C< ~($matrix-Ecofactor)>. =back =item * C<$part_of_matrix = $matrix-Esubmatrix(x1,y1,x2,Y2);> Submatrix permit to select only part of existing matrix in order to produce a new one. This method take four arguments to define a selection area: =over 6 =item - firstly: Coordinate of top left corner to select (x1,y1) =item - secondly: Coordinate of bottom right corner to select (x2,y2) =back Example: my $matrix = Math::MatrixReal->new_from_string(<<'MATRIX'); [ 0 0 0 0 0 0 0 ] [ 0 0 0 0 0 0 0 ] [ 0 0 0 0 0 0 0 ] [ 0 0 0 0 0 0 0 ] [ 0 0 0 0 1 0 1 ] [ 0 0 0 0 0 1 0 ] [ 0 0 0 0 1 0 1 ] MATRIX my $submatrix = $matrix->submatrix(5,5,7,7); $submatrix->display_precision(0); print $submatrix; Output: [ 1 0 1 ] [ 0 1 0 ] [ 1 0 1 ] =back =head2 Arithmetic Operations =over 4 =item * C<$matrix1-Eadd($matrix2,$matrix3);> Calculates the sum of matrix "C<$matrix2>" and matrix "C<$matrix3>" and stores the result in matrix "C<$matrix1>" (which must already exist and have the same size as matrix "C<$matrix2>" and matrix "C<$matrix3>"!). This operation can also be carried out "in-place", i.e., the output and one (or both) of the input matrices may be identical. =item * C<$matrix1-Esubtract($matrix2,$matrix3);> Calculates the difference of matrix "C<$matrix2>" minus matrix "C<$matrix3>" and stores the result in matrix "C<$matrix1>" (which must already exist and have the same size as matrix "C<$matrix2>" and matrix "C<$matrix3>"!). This operation can also be carried out "in-place", i.e., the output and one (or both) of the input matrices may be identical. Note that this operation is the same as C<$matrix1-Eadd($matrix2,-$matrix3);>, although the latter is a little less efficient. =item * C<$matrix1-Emultiply_scalar($matrix2,$scalar);> Calculates the product of matrix "C<$matrix2>" and the number "C<$scalar>" (i.e., multiplies each element of matrix "C<$matrix2>" with the factor "C<$scalar>") and stores the result in matrix "C<$matrix1>" (which must already exist and have the same size as matrix "C<$matrix2>"!). This operation can also be carried out "in-place", i.e., input and output matrix may be identical. =item * C<$product_matrix = $matrix1-Emultiply($matrix2);> Calculates the product of matrix "C<$matrix1>" and matrix "C<$matrix2>" and returns an object reference to a new matrix "C<$product_matrix>" in which the result of this operation has been stored. Note that the dimensions of the two matrices "C<$matrix1>" and "C<$matrix2>" (i.e., their numbers of rows and columns) must harmonize in the following way (example): [ 2 2 ] [ 2 2 ] [ 2 2 ] [ 1 1 1 ] [ * * ] [ 1 1 1 ] [ * * ] [ 1 1 1 ] [ * * ] [ 1 1 1 ] [ * * ] I.e., the number of columns of matrix "C<$matrix1>" has to be the same as the number of rows of matrix "C<$matrix2>". The number of rows and columns of the resulting matrix "C<$product_matrix>" is determined by the number of rows of matrix "C<$matrix1>" and the number of columns of matrix "C<$matrix2>", respectively. =item * C<$matrix1-Enegate($matrix2);> Calculates the negative of matrix "C<$matrix2>" (i.e., multiplies all elements with "-1") and stores the result in matrix "C<$matrix1>" (which must already exist and have the same size as matrix "C<$matrix2>"!). This operation can also be carried out "in-place", i.e., input and output matrix may be identical. =item * C<$matrix_to_power = $matrix1-Eexponent($integer);> Raises the matrix to the C<$integer> power. Obviously, C<$integer> must be an integer. If it is zero, the identity matrix is returned. If a negative integer is given, the inverse will be computed (if it exists) and then raised the the absolute value of C<$integer>. The matrix must be quadratic. =back =head2 Boolean Matrix Operations =over 4 =item * C<$matrix-Eis_quadratic();> Returns a boolean value indicating if the given matrix is quadratic (also know as "square" or "n by n"). A matrix is quadratic if it has the same number of rows as it does columns. =item * C<$matrix-Eis_square();> This is an alias for C. =item * C<$matrix-Eis_symmetric();> Returns a boolean value indicating if the given matrix is symmetric. By definition, a matrix is symmetric if and only if (B[I,I]=B[I,I]). This is equivalent to C<($matrix == ~$matrix)> but without memory allocation. Only quadratic matrices can be symmetric. Notes: A symmetric matrix always has real eigenvalues/eigenvectors. A matrix plus its transpose is always symmetric. =item * C<$matrix-Eis_skew_symmetric();> Returns a boolean value indicating if the given matrix is skew symmetric. By definition, a matrix is symmetric if and only if (B[I,I]=B<-M>[I,I]). This is equivalent to C<($matrix == -(~$matrix))> but without memory allocation. Only quadratic matrices can be skew symmetric. =item * C<$matrix-Eis_diagonal();> Returns a boolean value indicating if the given matrix is diagonal, i.e. all of the nonzero elements are on the main diagonal. Only quadratic matrices can be diagonal. =item * C<$matrix-Eis_tridiagonal();> Returns a boolean value indicating if the given matrix is tridiagonal, i.e. all of the nonzero elements are on the main diagonal or the diagonals above and below the main diagonal. Only quadratic matrices can be tridiagonal. =item * C<$matrix-Eis_upper_triangular();> Returns a boolean value indicating if the given matrix is upper triangular, i.e. all of the nonzero elements not on the main diagonal are above it. Only quadratic matrices can be upper triangular. Note: diagonal matrices are both upper and lower triangular. =item * C<$matrix-Eis_lower_triangular();> Returns a boolean value indicating if the given matrix is lower triangular, i.e. all of the nonzero elements not on the main diagonal are below it. Only quadratic matrices can be lower triangular. Note: diagonal matrices are both upper and lower triangular. =item * C<$matrix-Eis_orthogonal();> Returns a boolean value indicating if the given matrix is orthogonal. An orthogonal matrix is has the property that the transpose equals the inverse of the matrix. Instead of computing each and comparing them, this method multiplies the matrix by it's transpose, and returns true if this turns out to be the identity matrix, false otherwise. Only quadratic matrices can orthogonal. =item * C<$matrix-Eis_binary();> Returns a boolean value indicating if the given matrix is binary. A matrix is binary if it contains only zeroes or ones. =item * C<$matrix-Eis_gramian();> Returns a boolean value indicating if the give matrix is Gramian. A matrix C<$A> is Gramian if and only if there exists a square matrix C<$B> such that C<$A = ~$B*$B>. This is equivalent to checking if C<$A> is symmetric and has all nonnegative eigenvalues, which is what Math::MatrixReal uses to check for this property. =item * C<$matrix-Eis_LR();> Returns a boolean value indicating if the matrix is an LR decomposition matrix. =item * C<$matrix-Eis_positive();> Returns a boolean value indicating if the matrix contains only positive entries. Note that a zero entry is not positive and will cause C to return false. =item * C<$matrix-Eis_negative();> Returns a boolean value indicating if the matrix contains only negative entries. Note that a zero entry is not negative and will cause C to return false. =item * C<$matrix-Eis_periodic($k);> Returns a boolean value indicating if the matrix is periodic with period $k. This is true if C<$matrix ** ($k+1) == $matrix>. When C<$k == 1>, this reduces down to the C function. =item * C<$matrix-Eis_idempotent();> Returns a boolean value indicating if the matrix is idempotent, which is defined as the square of the matrix being equal to the original matrix, i.e C<$matrix ** 2 == $matrix>. =item * C<$matrix-Eis_row_vector();> Returns a boolean value indicating if the matrix is a row vector. A row vector is a matrix which is 1xn. Note that the 1x1 matrix is both a row and column vector. =item * C<$matrix-Eis_col_vector();> Returns a boolean value indicating if the matrix is a col vector. A col vector is a matrix which is nx1. Note that the 1x1 matrix is both a row and column vector. =back =head2 Eigensystems =over 2 =item * C<($l, $V) = $matrix-Esym_diagonalize();> This method performs the diagonalization of the quadratic I matrix B stored in $matrix. On output, B is a column vector containing all the eigenvalues of B and B is an orthogonal matrix which columns are the corresponding normalized eigenvectors. The primary property of an eigenvalue I and an eigenvector B is of course that: B * B = I * B. The method uses a Householder reduction to tridiagonal form followed by a QL algoritm with implicit shifts on this tridiagonal. (The tridiagonal matrix is kept internally in a compact form in this routine to save memory.) In fact, this routine wraps the householder() and tri_diagonalize() methods described below when their intermediate results are not desired. The overall algorithmic complexity of this technique is O(N^3). According to several books, the coefficient hidden by the 'O' is one of the best possible for general (symmetric) matrixes. =item * C<($T, $Q) = $matrix-Ehouseholder();> This method performs the Householder algorithm which reduces the I by I real I matrix B contained in $matrix to tridiagonal form. On output, B is a symmetric tridiagonal matrix (only diagonal and off-diagonal elements are non-zero) and B is an I matrix performing the tranformation between B and B (C<$M == $Q * $T * ~$Q>). =item * C<($l, $V) = $T-Etri_diagonalize([$Q]);> This method diagonalizes the symmetric tridiagonal matrix B. On output, $l and $V are similar to the output values described for sym_diagonalize(). The optional argument $Q corresponds to an orthogonal transformation matrix B that should be used additionally during B (eigenvectors) computation. It should be supplied if the desired eigenvectors correspond to a more general symmetric matrix B previously reduced by the householder() method, not a mere tridiagonal. If B is really a tridiagonal matrix, B can be omitted (it will be internally created in fact as an identity matrix). The method uses a QL algorithm (with implicit shifts). =item * C<$l = $matrix-Esym_eigenvalues();> This method computes the eigenvalues of the quadratic I matrix B stored in $matrix. On output, B is a column vector containing all the eigenvalues of B. Eigenvectors are not computed (on the contrary of C) and this method is more efficient (even though it uses a similar algorithm with two phases). However, understand that the algorithmic complexity of this technique is still also O(N^3). But the coefficient hidden by the 'O' is better by a factor of..., well, see your benchmark, it's wiser. This routine wraps the householder_tridiagonal() and tri_eigenvalues() methods described below when the intermediate tridiagonal matrix is not needed. =item * C<$T = $matrix-Ehouseholder_tridiagonal();> This method performs the Householder algorithm which reduces the I by I real I matrix B contained in $matrix to tridiagonal form. On output, B is the obtained symmetric tridiagonal matrix (only diagonal and off-diagonal elements are non-zero). The operation is similar to the householder() method, but potentially a little more efficient as the transformation matrix is not computed. =item * $l = $T-Etri_eigenvalues(); This method computesthe eigenvalues of the symmetric tridiagonal matrix B. On output, $l is a vector containing the eigenvalues (similar to C). This method is much more efficient than tri_diagonalize() when eigenvectors are not needed. =back =head2 Miscellaneous =over 4 =item * $matrix-Ezero(); Assigns a zero to every element of the matrix "C<$matrix>", i.e., erases all values previously stored there, thereby effectively transforming the matrix into a "zero"-matrix or "null"-matrix, the neutral element of the addition operation in a Ring. (For instance the (quadratic) matrices with "n" rows and columns and matrix addition and multiplication form a Ring. Most prominent characteristic of a Ring is that multiplication is not commutative, i.e., in general, "C" is not the same as "C"!) =item * $matrix-Eone(); Assigns one's to the elements on the main diagonal (elements (1,1), (2,2), (3,3) and so on) of matrix "C<$matrix>" and zero's to all others, thereby erasing all values previously stored there and transforming the matrix into a "one"-matrix, the neutral element of the multiplication operation in a Ring. (If the matrix is quadratic (which this method doesn't require, though), then multiplying this matrix with itself yields this same matrix again, and multiplying it with some other matrix leaves that other matrix unchanged!) =item * C<$latex_string = $matrix-Eas_latex( align=E "c", format =E "%s", name =E "" );> This function returns the matrix as a LaTeX string. It takes a hash as an argument which is used to control the style of the output. The hash element C may be "c","l" or "r", corresponding to center, left and right, respectively. The C element is a format string that is given to C to control the style of number format, such a floating point or scientific notation. The C element can be used so that a LaTeX string of "$name = " is prepended to the string. Example: my $a = Math::MatrixReal->new_from_cols([[ 1.234, 5.678, 9.1011],[1,2,3]] ); print $a->as_latex( ( format => "%.2f", align => "l",name => "A" ) ); Output: $A = $ $ \left( \begin{array}{ll} 1.23&1.00 \\ 5.68&2.00 \\ 9.10&3.00 \end{array} \right) $ =item * C<$yacas_string = $matrix-Eas_yacas( format =E "%s", name =E "", semi =E 0 );> This function returns the matrix as a string that can be read by Yacas. It takes a hash as an an argument which controls the style of the output. The C element is a format string that is given to C to control the style of number format, such a floating point or scientific notation. The C element can be used so that "$name = " is prepended to the string. The element can be set to 1 to that a semicolon is appended (so Matlab does not print out the matrix.) Example: $a = Math::MatrixReal->new_from_cols([[ 1.234, 5.678, 9.1011],[1,2,3]] ); print $a->as_yacas( ( format => "%.2f", align => "l",name => "A" ) ); Output: A := {{1.23,1.00},{5.68,2.00},{9.10,3.00}} =item * C<$matlab_string = $matrix-Eas_matlab( format =E "%s", name =E "", semi =E 0 );> This function returns the matrix as a string that can be read by Matlab. It takes a hash as an an argument which controls the style of the output. The C element is a format string that is given to C to control the style of number format, such a floating point or scientific notation. The C element can be used so that "$name = " is prepended to the string. The element can be set to 1 to that a semicolon is appended (so Matlab does not print out the matrix.) Example: my $a = Math::MatrixReal->new_from_rows([[ 1.234, 5.678, 9.1011],[1,2,3]] ); print $a->as_matlab( ( format => "%.3f", name => "A",semi => 1 ) ); Output: A = [ 1.234 5.678 9.101; 1.000 2.000 3.000]; =item * C<$scilab_string = $matrix-Eas_scilab( format =E "%s", name =E "", semi =E 0 );> This function is just an alias for C, since both Scilab and Matlab have the same matrix format. =item * C<$minimum = Math::MatrixReal::min($number1,$number2);> C<$minimum = Math::MatrixReal::min($matrix);> C<<$minimum = $matrix->min;>> Returns the minimum of the two numbers "C" and "C" if called with two arguments, or returns the value of the smallest element of a matrix if called with one argument or as an object method. =item * C<$maximum = Math::MatrixReal::max($number1,$number2);> C<$maximum = Math::MatrixReal::max($number1,$number2);> C<$maximum = Math::MatrixReal::max($matrix);> C<<$maximum = $matrix->max;>> Returns the maximum of the two numbers "C" and "C" if called with two arguments, or returns the value of the largest element of a matrix if called with one arguemnt or as on object method. =item * C<$minimal_cost_matrix = $cost_matrix-Ekleene();> Copies the matrix "C<$cost_matrix>" (which has to be quadratic!) to a new matrix of the same size (i.e., "clones" the input matrix) and applies Kleene's algorithm to it. See L for more details about this algorithm! The method returns an object reference to the new matrix. Matrix "C<$cost_matrix>" is not changed by this method in any way. =item * C<($norm_matrix,$norm_vector) = $matrix-Enormalize($vector);> This method is used to improve the numerical stability when solving linear equation systems. Suppose you have a matrix "A" and a vector "b" and you want to find out a vector "x" so that C, i.e., the vector "x" which solves the equation system represented by the matrix "A" and the vector "b". Applying this method to the pair (A,b) yields a pair (A',b') where each row has been divided by (the absolute value of) the greatest coefficient appearing in that row. So this coefficient becomes equal to "1" (or "-1") in the new pair (A',b') (all others become smaller than one and greater than minus one). Note that this operation does not change the equation system itself because the same division is carried out on either side of the equation sign! The method requires a quadratic (!) matrix "C<$matrix>" and a vector "C<$vector>" for input (the vector must be a column vector with the same number of rows as the input matrix) and returns a list of two items which are object references to a new matrix and a new vector, in this order. The output matrix and vector are clones of the input matrix and vector to which the operation explained above has been applied. The input matrix and vector are not changed by this in any way. Example of how this method can affect the result of the methods to solve equation systems (explained immediately below following this method): Consider the following little program: #!perl -w use Math::MatrixReal qw(new_from_string); $A = Math::MatrixReal->new_from_string(<<"MATRIX"); [ 1 2 3 ] [ 5 7 11 ] [ 23 19 13 ] MATRIX $b = Math::MatrixReal->new_from_string(<<"MATRIX"); [ 0 ] [ 1 ] [ 29 ] MATRIX $LR = $A->decompose_LR(); if (($dim,$x,$B) = $LR->solve_LR($b)) { $test = $A * $x; print "x = \n$x"; print "A * x = \n$test"; } ($A_,$b_) = $A->normalize($b); $LR = $A_->decompose_LR(); if (($dim,$x,$B) = $LR->solve_LR($b_)) { $test = $A * $x; print "x = \n$x"; print "A * x = \n$test"; } This will print: x = [ 1.000000000000E+00 ] [ 1.000000000000E+00 ] [ -1.000000000000E+00 ] A * x = [ 4.440892098501E-16 ] [ 1.000000000000E+00 ] [ 2.900000000000E+01 ] x = [ 1.000000000000E+00 ] [ 1.000000000000E+00 ] [ -1.000000000000E+00 ] A * x = [ 0.000000000000E+00 ] [ 1.000000000000E+00 ] [ 2.900000000000E+01 ] You can see that in the second example (where "normalize()" has been used), the result is "better", i.e., more accurate! =item * C<$LR_matrix = $matrix-Edecompose_LR();> This method is needed to solve linear equation systems. Suppose you have a matrix "A" and a vector "b" and you want to find out a vector "x" so that C, i.e., the vector "x" which solves the equation system represented by the matrix "A" and the vector "b". You might also have a matrix "A" and a whole bunch of different vectors "b1".."bk" for which you need to find vectors "x1".."xk" so that C, for C. Using Gaussian transformations (multiplying a row or column with a factor, swapping two rows or two columns and adding a multiple of one row or column to another), it is possible to decompose any matrix "A" into two triangular matrices, called "L" and "R" (for "Left" and "Right"). "L" has one's on the main diagonal (the elements (1,1), (2,2), (3,3) and so so), non-zero values to the left and below of the main diagonal and all zero's in the upper right half of the matrix. "R" has non-zero values on the main diagonal as well as to the right and above of the main diagonal and all zero's in the lower left half of the matrix, as follows: [ 1 0 0 0 0 ] [ x x x x x ] [ x 1 0 0 0 ] [ 0 x x x x ] L = [ x x 1 0 0 ] R = [ 0 0 x x x ] [ x x x 1 0 ] [ 0 0 0 x x ] [ x x x x 1 ] [ 0 0 0 0 x ] Note that "C" is equivalent to matrix "A" in the sense that C==E A * x = b> for all vectors "x", leaving out of account permutations of the rows and columns (these are taken care of "magically" by this module!) and numerical errors. Trick: Because we know that "L" has one's on its main diagonal, we can store both matrices together in the same array without information loss! I.e., [ R R R R R ] [ L R R R R ] LR = [ L L R R R ] [ L L L R R ] [ L L L L R ] Beware, though, that "LR" and "C" are not the same!!! Note also that for the same reason, you cannot apply the method "normalize()" to an "LR" decomposition matrix. Trying to do so will yield meaningless rubbish! (You need to apply "normalize()" to each pair (Ai,bi) B decomposing the matrix "Ai'"!) Now what does all this help us in solving linear equation systems? It helps us because a triangular matrix is the next best thing that can happen to us besides a diagonal matrix (a matrix that has non-zero values only on its main diagonal - in which case the solution is trivial, simply divide "C" by "C" to get "C"!). To find the solution to our problem "C", we divide this problem in parts: instead of solving C directly, we first decompose "A" into "L" and "R" and then solve "C" and finally "C" (motto: divide and rule!). From the illustration above it is clear that solving "C" and "C" is straightforward: we immediately know that C. We then deduce swiftly that y[2] = b[2] - L[2,1] * y[1] (and we know "C" by now!), that y[3] = b[3] - L[3,1] * y[1] - L[3,2] * y[2] and so on. Having effortlessly calculated the vector "y", we now proceed to calculate the vector "x" in a similar fashion: we see immediately that C. It follows that x[n-1] = ( y[n-1] - R[n-1,n] * x[n] ) / R[n-1,n-1] and x[n-2] = ( y[n-2] - R[n-2,n-1] * x[n-1] - R[n-2,n] * x[n] ) / R[n-2,n-2] and so on. You can see that - especially when you have many vectors "b1".."bk" for which you are searching solutions to C - this scheme is much more efficient than a straightforward, "brute force" approach. This method requires a quadratic matrix as its input matrix. If you don't have that many equations, fill up with zero's (i.e., do nothing to fill the superfluous rows if it's a "fresh" matrix, i.e., a matrix that has been created with "new()" or "shadow()"). The method returns an object reference to a new matrix containing the matrices "L" and "R". The input matrix is not changed by this method in any way. Note that you can "copy()" or "clone()" the result of this method without losing its "magical" properties (for instance concerning the hidden permutations of its rows and columns). However, as soon as you are applying any method that alters the contents of the matrix, its "magical" properties are stripped off, and the matrix immediately reverts to an "ordinary" matrix (with the values it just happens to contain at that moment, be they meaningful as an ordinary matrix or not!). =item * C<($dimension,$x_vector,$base_matrix) = $LR_matrix>C<-E>C Use this method to actually solve an equation system. Matrix "C<$LR_matrix>" must be a (quadratic) matrix returned by the method "decompose_LR()", the LR decomposition matrix of the matrix "A" of your equation system C. The input vector "C<$b_vector>" is the vector "b" in your equation system C, which must be a column vector and have the same number of rows as the input matrix "C<$LR_matrix>". The method returns a list of three items if a solution exists or an empty list otherwise (!). Therefore, you should always use this method like this: if ( ($dim,$x_vec,$base) = $LR->solve_LR($b_vec) ) { # do something with the solution... } else { # do something with the fact that there is no solution... } The three items returned are: the dimension "C<$dimension>" of the solution space (which is zero if only one solution exists, one if the solution is a straight line, two if the solution is a plane, and so on), the solution vector "C<$x_vector>" (which is the vector "x" of your equation system C) and a matrix "C<$base_matrix>" representing a base of the solution space (a set of vectors which put up the solution space like the spokes of an umbrella). Only the first "C<$dimension>" columns of this base matrix actually contain entries, the remaining columns are all zero. Now what is all this stuff with that "base" good for? The output vector "x" is B a solution of your equation system C. But also any vector "C<$vector>" $vector = $x_vector->clone(); $machine_infinity = 1E+99; # or something like that for ( $i = 1; $i <= $dimension; $i++ ) { $vector += rand($machine_infinity) * $base_matrix->column($i); } is a solution to your problem C, i.e., if "C<$A_matrix>" contains your matrix "A", then print abs( $A_matrix * $vector - $b_vector ), "\n"; should print a number around 1E-16 or so! By the way, note that you can actually calculate those vectors "C<$vector>" a little more efficient as follows: $rand_vector = $x_vector->shadow(); $machine_infinity = 1E+99; # or something like that for ( $i = 1; $i <= $dimension; $i++ ) { $rand_vector->assign($i,1, rand($machine_infinity) ); } $vector = $x_vector + ( $base_matrix * $rand_vector ); Note that the input matrix and vector are not changed by this method in any way. =item * C<$inverse_matrix = $LR_matrix-Einvert_LR();> Use this method to calculate the inverse of a given matrix "C<$LR_matrix>", which must be a (quadratic) matrix returned by the method "decompose_LR()". The method returns an object reference to a new matrix of the same size as the input matrix containing the inverse of the matrix that you initially fed into "decompose_LR()" B, or an empty list otherwise. Therefore, you should always use this method in the following way: if ( $inverse_matrix = $LR->invert_LR() ) { # do something with the inverse matrix... } else { # do something with the fact that there is no inverse matrix... } Note that by definition (disregarding numerical errors), the product of the initial matrix and its inverse (or vice-versa) is always a matrix containing one's on the main diagonal (elements (1,1), (2,2), (3,3) and so on) and zero's elsewhere. The input matrix is not changed by this method in any way. =item * C<$condition = $matrix-Econdition($inverse_matrix);> In fact this method is just a shortcut for abs($matrix) * abs($inverse_matrix) Both input matrices must be quadratic and have the same size, and the result is meaningful only if one of them is the inverse of the other (for instance, as returned by the method "invert_LR()"). The number returned is a measure of the "condition" of the given matrix "C<$matrix>", i.e., a measure of the numerical stability of the matrix. This number is always positive, and the smaller its value, the better the condition of the matrix (the better the stability of all subsequent computations carried out using this matrix). Numerical stability means for example that if abs( $vec_correct - $vec_with_error ) < $epsilon holds, there must be a "C<$delta>" which doesn't depend on the vector "C<$vec_correct>" (nor "C<$vec_with_error>", by the way) so that abs( $matrix * $vec_correct - $matrix * $vec_with_error ) < $delta also holds. =item * C<$determinant = $LR_matrix-Edet_LR();> Calculates the determinant of a matrix, whose LR decomposition matrix "C<$LR_matrix>" must be given (which must be a (quadratic) matrix returned by the method "decompose_LR()"). In fact the determinant is a by-product of the LR decomposition: It is (in principle, that is, except for the sign) simply the product of the elements on the main diagonal (elements (1,1), (2,2), (3,3) and so on) of the LR decomposition matrix. (The sign is taken care of "magically" by this module) =item * C<$order = $LR_matrix-Eorder_LR();> Calculates the order (called "Rang" in German) of a matrix, whose LR decomposition matrix "C<$LR_matrix>" must be given (which must be a (quadratic) matrix returned by the method "decompose_LR()"). This number is a measure of the number of linear independent row and column vectors (= number of linear independent equations in the case of a matrix representing an equation system) of the matrix that was initially fed into "decompose_LR()". If "n" is the number of rows and columns of the (quadratic!) matrix, then "n - order" is the dimension of the solution space of the associated equation system. =item * C<$rank = $LR_matrix-Erank_LR();> This is an alias for the C function. The "order" is usually called the "rank" in the United States. =item * C<$scalar_product = $vector1-Escalar_product($vector2);> Returns the scalar product of vector "C<$vector1>" and vector "C<$vector2>". Both vectors must be column vectors (i.e., a matrix having several rows but only one column). This is a (more efficient!) shortcut for $temp = ~$vector1 * $vector2; $scalar_product = $temp->element(1,1); or the sum C of the products C. Provided none of the two input vectors is the null vector, then the two vectors are orthogonal, i.e., have an angle of 90 degrees between them, exactly when their scalar product is zero, and vice-versa. =item * C<$vector_product = $vector1-Evector_product($vector2);> Returns the vector product of vector "C<$vector1>" and vector "C<$vector2>". Both vectors must be column vectors (i.e., a matrix having several rows but only one column). Currently, the vector product is only defined for 3 dimensions (i.e., vectors with 3 rows); all other vectors trigger an error message. In 3 dimensions, the vector product of two vectors "x" and "y" is defined as | x[1] y[1] e[1] | determinant | x[2] y[2] e[2] | | x[3] y[3] e[3] | where the "C" and "C" are the components of the two vectors "x" and "y", respectively, and the "C" are unity vectors (i.e., vectors with a length equal to one) with a one in row "i" and zero's elsewhere (this means that you have numbers and vectors as elements in this matrix!). This determinant evaluates to the rather simple formula z[1] = x[2] * y[3] - x[3] * y[2] z[2] = x[3] * y[1] - x[1] * y[3] z[3] = x[1] * y[2] - x[2] * y[1] A characteristic property of the vector product is that the resulting vector is orthogonal to both of the input vectors (if neither of both is the null vector, otherwise this is trivial), i.e., the scalar product of each of the input vectors with the resulting vector is always zero. =item * C<$length = $vector-Elength();> This is actually a shortcut for $length = sqrt( $vector->scalar_product($vector) ); and returns the length of a given column or row vector "C<$vector>". Note that the "length" calculated by this method is in fact the "two"-norm (also know as the Euclidean norm) of a vector "C<$vector>"! The general definition for norms of vectors is the following: sub vector_norm { croak "Usage: \$norm = \$vector->vector_norm(\$n);" if (@_ != 2); my($vector,$n) = @_; my($rows,$cols) = ($vector->[1],$vector->[2]); my($k,$comp,$sum); croak "Math::MatrixReal::vector_norm(): vector is not a column vector" unless ($cols == 1); croak "Math::MatrixReal::vector_norm(): norm index must be > 0" unless ($n > 0); croak "Math::MatrixReal::vector_norm(): norm index must be integer" unless ($n == int($n)); $sum = 0; for ( $k = 0; $k < $rows; $k++ ) { $comp = abs( $vector->[0][$k][0] ); $sum += $comp ** $n; } return( $sum ** (1 / $n) ); } Note that the case "n = 1" is the "one"-norm for matrices applied to a vector, the case "n = 2" is the euclidian norm or length of a vector, and if "n" goes to infinity, you have the "infinity"- or "maximum"-norm for matrices applied to a vector! =item * C<$xn_vector = $matrix-E>C =item * C<$xn_vector = $matrix-E>C =item * C<$xn_vector = $matrix-E>C In some cases it might not be practical or desirable to solve an equation system "C" using an analytical algorithm like the "decompose_LR()" and "solve_LR()" method pair. In fact in some cases, due to the numerical properties (the "condition") of the matrix "A", the numerical error of the obtained result can be greater than by using an approximative (iterative) algorithm like one of the three implemented here. All three methods, GSM ("Global Step Method" or "Gesamtschrittverfahren"), SSM ("Single Step Method" or "Einzelschrittverfahren") and RM ("Relaxation Method" or "Relaxationsverfahren"), are fix-point iterations, that is, can be described by an iteration function "C" which has the property: Phi(x) = x <==> A * x = b We can define "C" as follows: Phi(x) := ( En - A ) * x + b where "En" is a matrix of the same size as "A" ("n" rows and columns) with one's on its main diagonal and zero's elsewhere. This function has the required property. Proof: A * x = b <==> -( A * x ) = -b <==> -( A * x ) + x = -b + x <==> -( A * x ) + x + b = x <==> x - ( A * x ) + b = x <==> ( En - A ) * x + b = x This last step is true because x[i] - ( a[i,1] x[1] + ... + a[i,i] x[i] + ... + a[i,n] x[n] ) + b[i] is the same as ( -a[i,1] x[1] + ... + (1 - a[i,i]) x[i] + ... + -a[i,n] x[n] ) + b[i] qed Note that actually solving the equation system "C" means to calculate a[i,1] x[1] + ... + a[i,i] x[i] + ... + a[i,n] x[n] = b[i] <==> a[i,i] x[i] = b[i] - ( a[i,1] x[1] + ... + a[i,i] x[i] + ... + a[i,n] x[n] ) + a[i,i] x[i] <==> x[i] = ( b[i] - ( a[i,1] x[1] + ... + a[i,i] x[i] + ... + a[i,n] x[n] ) + a[i,i] x[i] ) / a[i,i] <==> x[i] = ( b[i] - ( a[i,1] x[1] + ... + a[i,i-1] x[i-1] + a[i,i+1] x[i+1] + ... + a[i,n] x[n] ) ) / a[i,i] There is one major restriction, though: a fix-point iteration is guaranteed to converge only if the first derivative of the iteration function has an absolute value less than one in an area around the point "C" for which "C" is to be true, and if the start vector "C" lies within that area! This is best verified graphically, which unfortunately is impossible to do in this textual documentation! See literature on Numerical Analysis for details! In our case, this restriction translates to the following three conditions: There must exist a norm so that the norm of the matrix of the iteration function, C<( En - A )>, has a value less than one, the matrix "A" may not have any zero value on its main diagonal and the initial vector "C" must be "good enough", i.e., "close enough" to the solution "C". (Remember school math: the first derivative of a straight line given by "C" is "a"!) The three methods expect a (quadratic!) matrix "C<$matrix>" as their first argument, a start vector "C<$x0_vector>", a vector "C<$b_vector>" (which is the vector "b" in your equation system "C"), in the case of the "Relaxation Method" ("RM"), a real number "C<$weight>" best between zero and two, and finally an error limit (real number) "C<$epsilon>". (Note that the weight "C<$weight>" used by the "Relaxation Method" ("RM") is B checked to lie within any reasonable range!) The three methods first test the first two conditions of the three conditions listed above and return an empty list if these conditions are not fulfilled. Therefore, you should always test their return value using some code like: if ( $xn_vector = $A_matrix->solve_GSM($x0_vector,$b_vector,1E-12) ) { # do something with the solution... } else { # do something with the fact that there is no solution... } Otherwise, they iterate until C epsilon>. (Beware that theoretically, infinite loops might result if the starting vector is too far "off" the solution! In practice, this shouldn't be a problem. Anyway, you can always press if you think that the iteration takes too long!) The difference between the three methods is the following: In the "Global Step Method" ("GSM"), the new vector "C" (called "y" here) is calculated from the vector "C" (called "x" here) according to the formula: y[i] = ( b[i] - ( a[i,1] x[1] + ... + a[i,i-1] x[i-1] + a[i,i+1] x[i+1] + ... + a[i,n] x[n] ) ) / a[i,i] In the "Single Step Method" ("SSM"), the components of the vector "C" which have already been calculated are used to calculate the remaining components, i.e. y[i] = ( b[i] - ( a[i,1] y[1] + ... + a[i,i-1] y[i-1] + # note the "y[]"! a[i,i+1] x[i+1] + ... + a[i,n] x[n] ) # note the "x[]"! ) / a[i,i] In the "Relaxation method" ("RM"), the components of the vector "C" are calculated by "mixing" old and new value (like cold and hot water), and the weight "C<$weight>" determines the "aperture" of both the "hot water tap" as well as of the "cold water tap", according to the formula: y[i] = ( b[i] - ( a[i,1] y[1] + ... + a[i,i-1] y[i-1] + # note the "y[]"! a[i,i+1] x[i+1] + ... + a[i,n] x[n] ) # note the "x[]"! ) / a[i,i] y[i] = weight * y[i] + (1 - weight) * x[i] Note that the weight "C<$weight>" should be greater than zero and less than two (!). The three methods are supposed to be of different efficiency. Experiment! Remember that in most cases, it is probably advantageous to first "normalize()" your equation system prior to solving it! =back =head1 OVERLOADED OPERATORS =head2 SYNOPSIS =over 2 =item * Unary operators: "C<->", "C<~>", "C", C, "C", 'C<"">' =item * Binary operators: "C<.>" Binary (arithmetic) operators: "C<+>", "C<->", "C<*>", "C<**>", "C<+=>", "C<-=>", "C<*=>", "C","C<**=>" =item * Binary (relational) operators: "C<==>", "C", "C>", "C=>", "C>", "C=>" "C", "C", "C", "C", "C", "C" Note that the latter ("C", "C", ... ) are just synonyms of the former ("C<==>", "C", ... ), defined for convenience only. =back =head2 DESCRIPTION =over 5 =item '.' Concatenation Returns the two matrices concatenated side by side. Example: $c = $a . $b; For example, if $a=[ 1 2 ] $b=[ 5 6 ] [ 3 4 ] [ 7 8 ] then $c=[ 1 2 5 6 ] [ 3 4 7 8 ] Note that only matrices with the same number of rows may be concatenated. =item '-' Unary minus Returns the negative of the given matrix, i.e., the matrix with all elements multiplied with the factor "-1". Example: $matrix = -$matrix; =item '~' Transposition Returns the transposed of the given matrix. Examples: $temp = ~$vector * $vector; $length = sqrt( $temp->element(1,1) ); if (~$matrix == $matrix) { # matrix is symmetric ... } =item abs Norm Returns the "one"-Norm of the given matrix. Example: $error = abs( $A * $x - $b ); =item test Boolean test Tests wether there is at least one non-zero element in the matrix. Example: if ($xn_vector) { # result of iteration is not zero ... } =item '!' Negated boolean test Tests wether the matrix contains only zero's. Examples: if (! $b_vector) { # heterogenous equation system ... } else { # homogenous equation system ... } unless ($x_vector) { # not the null-vector! } =item '""""' "Stringify" operator Converts the given matrix into a string. Uses scientific representation to keep precision loss to a minimum in case you want to read this string back in again later with "new_from_string()". By default a 13-digit mantissa and a 20-character field for each element is used so that lines will wrap nicely on an 80-column screen. Examples: $matrix = Math::MatrixReal->new_from_string(<<"MATRIX"); [ 1 0 ] [ 0 -1 ] MATRIX print "$matrix"; [ 1.000000000000E+00 0.000000000000E+00 ] [ 0.000000000000E+00 -1.000000000000E+00 ] $string = "$matrix"; $test = Math::MatrixReal->new_from_string($string); if ($test == $matrix) { print ":-)\n"; } else { print ":-(\n"; } =item '+' Addition Returns the sum of the two given matrices. Examples: $matrix_S = $matrix_A + $matrix_B; $matrix_A += $matrix_B; =item '-' Subtraction Returns the difference of the two given matrices. Examples: $matrix_D = $matrix_A - $matrix_B; $matrix_A -= $matrix_B; Note that this is the same as: $matrix_S = $matrix_A + -$matrix_B; $matrix_A += -$matrix_B; (The latter are less efficient, though) =item '*' Multiplication Returns the matrix product of the two given matrices or the product of the given matrix and scalar factor. Examples: $matrix_P = $matrix_A * $matrix_B; $matrix_A *= $matrix_B; $vector_b = $matrix_A * $vector_x; $matrix_B = -1 * $matrix_A; $matrix_B = $matrix_A * -1; $matrix_A *= -1; =item '/' Division Currently a shortcut for doing $a * $b ** -1 is $a / $b, which works for square matrices. One can also use 1/$a . =item '**' Exponentiation Returns the matrix raised to an integer power. If 0 is passed, the identity matrix is returned. If a negative integer is passed, it computes the inverse (if it exists) and then raised the inverse to the absolute value of the integer. The matrix must be quadratic. Examples: $matrix2 = $matrix ** 2; $matrix **= 2; $inv2 = $matrix ** -2; $ident = $matrix ** 0; =item '==' Equality Tests two matrices for equality. Example: if ( $A * $x == $b ) { print "EUREKA!\n"; } Note that in most cases, due to numerical errors (due to the finite precision of computer arithmetics), it is a bad idea to compare two matrices or vectors this way. Better use the norm of the difference of the two matrices you want to compare and compare that norm with a small number, like this: if ( abs( $A * $x - $b ) < 1E-12 ) { print "BINGO!\n"; } =item '!=' Inequality Tests two matrices for inequality. Example: while ($x0_vector != $xn_vector) { # proceed with iteration ... } (Stops when the iteration becomes stationary) Note that (just like with the '==' operator), it is usually a bad idea to compare matrices or vectors this way. Compare the norm of the difference of the two matrices with a small number instead. =item 'E' Less than Examples: if ( $matrix1 < $matrix2 ) { # ... } if ( $vector < $epsilon ) { # ... } if ( 1E-12 < $vector ) { # ... } if ( $A * $x - $b < 1E-12 ) { # ... } These are just shortcuts for saying: if ( abs($matrix1) < abs($matrix2) ) { # ... } if ( abs($vector) < abs($epsilon) ) { # ... } if ( abs(1E-12) < abs($vector) ) { # ... } if ( abs( $A * $x - $b ) < abs(1E-12) ) { # ... } Uses the "one"-norm for matrices and Perl's built-in "abs()" for scalars. =item 'E=' Less than or equal As with the '<' operator, this is just a shortcut for the same expression with "abs()" around all arguments. Example: if ( $A * $x - $b <= 1E-12 ) { # ... } which in fact is the same as: if ( abs( $A * $x - $b ) <= abs(1E-12) ) { # ... } Uses the "one"-norm for matrices and Perl's built-in "abs()" for scalars. =item 'E' Greater than As with the '<' and '<=' operator, this if ( $xn - $x0 > 1E-12 ) { # ... } is just a shortcut for: if ( abs( $xn - $x0 ) > abs(1E-12) ) { # ... } Uses the "one"-norm for matrices and Perl's built-in "abs()" for scalars. =item 'E=' Greater than or equal As with the '<', '<=' and '>' operator, the following if ( $LR >= $A ) { # ... } is simply a shortcut for: if ( abs($LR) >= abs($A) ) { # ... } Uses the "one"-norm for matrices and Perl's built-in "abs()" for scalars. =back =head1 SEE ALSO Math::VectorReal, Math::PARI, Math::MatrixBool, Math::Vec, DFA::Kleene, Math::Kleene, Set::IntegerRange, Set::IntegerFast . =head1 VERSION This man page documents Math::MatrixReal version 2.13 The latest code can be found at https://github.com/leto/math--matrixreal . =head1 AUTHORS Steffen Beyer , Rodolphe Ortalo , Jonathan "Duke" Leto . Currently maintained by Jonathan "Duke" Leto, send all bugs/patches to Github Issues: https://github.com/leto/math--matrixreal/issues =head1 CREDITS Many thanks to Prof. Pahlings for stoking the fire of my enthusiasm for Algebra and Linear Algebra at the university (RWTH Aachen, Germany), and to Prof. Esser and his assistant, Mr. Jarausch, for their fascinating lectures in Numerical Analysis! =head1 COPYRIGHT Copyright (c) 1996-2016 by various authors including the original developer Steffen Beyer, Rodolphe Ortalo, the current maintainer Jonathan "Duke" Leto and all the wonderful people in the AUTHORS file. All rights reserved. =head1 LICENSE AGREEMENT This package is free software; you can redistribute it and/or modify it under the same terms as Perl itself. Fuck yeah. Math-MatrixReal-2.13/t00075556105627002104 012772016550 14753 5ustar00jonathanleto000000000000Math-MatrixReal-2.13/t/.list.t.swo00044456105627002104 3000012772016550 17146 0ustar00jonathanleto000000000000b0VIM 7.3WFjonathanletoloki.local~jonathanleto/git/math--matrixreal/t/list.tutf-8 3210#"! UtpadG N10hNM done_testindone_testing;is_deeply \@list, [1, 2, 3, 3, 4, 5], "list contains all elements from initial rows";is scalar(@list), 6, "list contains 6 elements";@list = $matrix->as_list;$matrix = Math::MatrixReal->new_from_rows([ [1, 2, 3], [3, 4, 5] ]);is_deeply \@list, [1, 2, 3, 4], "list contains all elements from initial rows";is scalar(@list), 4, "list contains 4 elements";my @list = $matrix->as_list;my $matrix = Math::MatrixReal->new_from_rows([ [1, 2], [3, 4] ]);do 'funcs.pl';use Math::MatrixReal;use lib File::Spec->catfile("..","lib");use File::Spec;use Test::More;Math-MatrixReal-2.13/t/00-load.t00044456105627002104 32312772016550 16407 0ustar00jonathanleto000000000000use Test::More tests => 1; use File::Spec::Functions; use strict; use warnings; BEGIN { use_ok('Math::MatrixReal') } diag( 'Testing Math::MatrixReal '. $Math::MatrixReal::VERSION . " on $^O, Perl ($^X) $]" ); Math-MatrixReal-2.13/t/adjoint.t00044456105627002104 127712772016550 16734 0ustar00jonathanleto000000000000use Test::More tests => 2; use File::Spec; use lib File::Spec->catfile("..","lib"); use Math::MatrixReal; my $DEBUG = 0; do 'funcs.pl'; $matrix = Math::MatrixReal->new_diag( [ 1, 2, 3 ] ); $cofactor = Math::MatrixReal->new_from_string(<adjoint(), ~$cofactor, 'adjoint is the transpose of the cofactor'); # the same $matrix = Math::MatrixReal->new_random(6); ok_matrix($matrix->adjoint->inverse,$matrix->inverse->adjoint, 'inverse and adjoint operators are commutative'); Math-MatrixReal-2.13/t/arith.t00044456105627002104 114512772016550 16405 0ustar00jonathanleto000000000000use Test::More tests => 4; use File::Spec; use lib File::Spec->catfile("..","lib"); use Math::MatrixReal; do 'funcs.pl'; $matrix = Math::MatrixReal->new_random(20); $matrix2 = $matrix->shadow(); $matrix2->one(); $matrix3 = $matrix; ok_matrix( $matrix * 2 , $matrix + $matrix, ' twice a = a + a ' ); $matrix3 -= $matrix2; ok_matrix( $matrix3 + $matrix2, $matrix, ' subtraction undoes addition' ); $matrix3 = $matrix; $matrix3 += $matrix2; ok_matrix($matrix3 - $matrix2, $matrix, ' addition undoes subtraction' ); $matrix3 = $matrix; $matrix3 *= 5; ok_matrix( $matrix3, $matrix * 5, 'overloaded *= works' ); Math-MatrixReal-2.13/t/assign.t00044456105627002104 205012772016550 16556 0ustar00jonathanleto000000000000use Test::Simple tests => 5; use File::Spec; use lib File::Spec->catfile("..","lib"); use Math::MatrixReal; do 'funcs.pl'; $matrix = Math::MatrixReal->new_from_string(<new_from_string(<new(1,5); $row = $row->each(sub{(shift)+1}); my $result = $matrix->assign_row(3,$row); ok( ref $result eq 'Math::MatrixReal', 'assign_row returns a the correct object'); ok( abs($matrix-$matrix2) < 1e-8, 'assign_row seems to work' ); } { my $a = Math::MatrixReal->new_from_string(<assign_row(3, $a) }, q{assign_row fails when number of cols don't match} ); } { assert_dies( sub { $matrix->assign_row($a) }, 'assign_row fails when not enough args'); } { assert_dies( sub { $matrix->assign_row($a,3) }, 'assign_row fails when args in wrong order' ); } Math-MatrixReal-2.13/t/basic.t00044456105627002104 1030512772016550 16375 0ustar00jonathanleto000000000000use Test::More tests => 7; use File::Spec; use lib File::Spec->catfile("..","lib"); use Math::MatrixReal; do 'funcs.pl'; my $BENCH = 0; # Some basic benchmarks on operations my $DEBUG2 = 0; my $DEBUG = 0; my $bsize = 200; # For somebenches my $string = "[ 1 2 3 ]\n[ 2 2 -1 ]\n[ 1 1 1 ]\n"; my $matrix33 = Math::MatrixReal->new_from_string($string); print "$matrix33" if $DEBUG; unless ($@){ ok(1, 'new_from_string doesn\'t die'); } else { ok(0, 'new_from_string dies'); } my $matrix77_b = Math::MatrixReal->new_from_string(<<'MATRIX'); [ 1 7 -12 6 -9 0 1 ] [ 0 5 0 0 0 0 0 ] [ 0 0 1 4 0 0 0 ] [ 0 0 0 1 0 0 0 ] [ 12 0 0 0 5 0 4 ] [ 0 3 0 8 0 1 0 ] [ 1 0 0 0 0 0 -5 ] MATRIX print "$matrix77_b" if $DEBUG2; unless ($@){ ok(1, 'new_from_string doesn\'t die'); } else { ok(0, 'new_from_string dies'); } my $c1 = 2 / 3; my $c2 = -2 / 5; my $c3 = 26 / 9; my $matrix33_v = Math::MatrixReal->new_from_string(<<"MATRIX"); [ 3 2 0 ] [ 0 3 2 ] [ $c1 $c2 $c3 ] MATRIX print "$matrix33_v" if $DEBUG2; unless ($@){ ok(1, 'new_from_string doesn\'t die'); } else { ok(0, 'new_from_string dies'); } ## Test Reshape my $matrix43 = Math::MatrixReal->new_from_string(<<"MATRIX"); [ 1 5 9 ] [ 2 6 10 ] [ 3 7 11 ] [ 4 8 12 ] MATRIX print "$matrix43" if $DEBUG2; unless ($@){ ok(1, 'new_from_string doesn\'t die'); } else { ok(0, 'new_from_string dies'); } my $matrix43_r = Math::MatrixReal->reshape(4, 3, [1..12]); print "$matrix43_r" if $DEBUG2; ok($matrix43_r == $matrix43, "Reshape works"); # # test the LR decomposition # my $product33 = $matrix33->multiply($matrix33_v); my $LR_m33 = $product33->decompose_LR(); my $b = Math::MatrixReal->new_from_string(<<"MATRIX"); [ 0 ] [ 1 ] [ 29 ] MATRIX my ($dim,$x,$B, $test); if (($dim, $x, $B) = $LR_m33->solve_LR($b)) { $test = $product33 * $x; if ($DEBUG2) { print "x =\n$x"; print "product33 * x =\n$test"; } } ok_matrix($test, $b, 'LR decomposition seems to work'); my $matrix1 = Math::MatrixReal->new_from_string(<new_diag( [ 1, 2, 3 ] ); ok_matrix($matrix1,$matrix2,'new_from_string agrees with new_diag'); if ($BENCH) { use Benchmark; my $tnew = timeit(20, sub { my $M = Math::MatrixReal->new($bsize,$bsize); }); print "Time to create 20 times an empty ".$bsize."x".$bsize." matrix:\n".timestr($tnew)."\n"; # Some matrices for use... my $random = Math::MatrixReal->new_random($bsize); my $spare = Math::MatrixReal->new($bsize,$bsize); my $Mcopy = $random; my $Mcopy2 = $Mcopy->shadow(); my $tcopy = timeit(20, sub { $Mcopy2->copy($Mcopy); }); print "Time to copy 20 times a ".$bsize."x".$bsize." matrix:\n".timestr($tcopy)."\n"; my $Mzero = $spare; my $tzero = timeit(20, sub { $Mzero->zero(); }); print "Time to zero 20 times a ".$bsize."x".$bsize." matrix:\n".timestr($tzero)."\n"; my $Mone = $spare; my $tone = timeit(20, sub { $Mone->one(); }); print "Time to set 20 times to I a ".$bsize."x".$bsize." matrix:\n".timestr($tone)."\n"; my $Mnorm1 = $random; my $norm1; my $tnorm1 = timeit(10, sub { $norm1 = $Mnorm1->norm_one(); }); print "Time to compute norm_one 10 times for a ".$bsize."x".$bsize." matrix:\n".timestr($tnorm1)."\n"; my $Mnormmax = $random; my $normax; my $tnormmax = timeit(10, sub { $normax = $Mnormmax->norm_max(); }); print "Time to compute norm_max 10 times for a ".$bsize."x".$bsize." matrix:\n".timestr($tnormmax)."\n"; my $Mneg = $random->clone(); my $tneg = timeit(10, sub { $Mneg->negate($Mneg); }); print "Time to negate 10 times a ".$bsize."x".$bsize." matrix:\n".timestr($tneg)."\n"; my $Mtransp = $random->clone(); my $ttransp = timeit(10, sub { $Mtransp->transpose($Mtransp); }); print "Time to transpose 10 times a ".$bsize."x".$bsize." matrix:\n".timestr($ttransp)."\n"; my $Mmul1 = $random->clone(); my $Mmul2 = $random->clone(); my $tmul = timeit(1, sub { $Mmul1->multiply($Mmul2); }); print "Time to multiply 1 times two ".$bsize."x".$bsize." matrices:\n".timestr($tmul)."\n"; } Math-MatrixReal-2.13/t/bench_eigen.t00044456105627002104 1271112772016550 17545 0ustar00jonathanleto000000000000use Test::More tests => 3; use File::Spec; use lib File::Spec->catfile("..","lib"); use Math::MatrixReal; do 'funcs.pl'; ### First, some preparation my $DEBUG2 = 0; # Set this one if you want the REAL benchmarking to be done! my $REALBENCH = 0; my $bigsize = 150; # Size of big matrix for estimation # and REAL tests (be careful: n^3!) use Benchmark; ### We should use the black magic now... # Does estimation times for diagonalization print "Diagonalization estimation...\n" if $DEBUG; my ($bigdiago_time, $oneday_diago); { # Estimates the completion time... my $N1 = 10; my $N2 = 50; my $M1 = Math::MatrixReal->new_random($N1); $M1 = $M1 + ~$M1; my $bench1 = timeit(1, sub { $M1->sym_diagonalize(); }); # HACK: We go into the Benchmark objects !!! my $t1 = $bench1->[1]; print "bench1 (".$N1."x".$N1.") = ".timestr($bench1)."\n" if $DEBUG; my $M2 = Math::MatrixReal->new_random($N2); $M2 = $M2 + ~$M2; my $bench2 = timeit(1, sub { $M2->sym_diagonalize(); }); # HACK: We go into the Benchmark objects !!! my $t2 = $bench2->[1]; print "bench2 (".$N2."x".$N2.")= ".timestr($bench2)."\n" if $DEBUG; my $k3 = ($t1 - (($N1*$N1)/($N2*$N2)) * $t2) / ($N1*$N1*$N1 * (1-($N2/$N1))); my $k2 = ($t2 - (($N2*$N2*$N2)/($N1*$N1*$N1)) * $t1) / ($N2*$N2 * (1-($N2/$N1))); print "t1=$t1 t2=$t2 k3=$k3 k2=$k2\n" if $DEBUG; $bigdiago_time = $k3*($bigsize*$bigsize*$bigsize) + $k2*($bigsize*$bigsize); # Grrr. I am unable to solve k3*N^3 + k2*N^2 = t with pen-and-paper... # (Should go back to school!) Anyway, let's have the machine do it... :-( my $N = 1; my $day = 24 * 60 * 60; # 1 day in seconds # BTW: Furthermore that's a damn stupid solving... while (($k3 * ($N*$N*$N) + $k2 * ($N*$N)) <= $day) { $N++; } $oneday_diago = $N - 1; } # Output estimations... printf STDERR "\n * Estimated diagonalization time for " .$bigsize."x".$bigsize." matrix: %5.2f s\n", $bigdiago_time; printf STDERR " Estimated biggest matrix diagonalisable within 1 day cpu: ".$oneday_diago."x".$oneday_diago."\n"; # # Does estimation times for eigenvalues # print "Eigenvalues computation estimation...\n" if $DEBUG; my ($bigeigen_time, $oneday_eigen); { # Estimates the completion time... my $N1 = 15; my $N2 = 65; my $M1 = Math::MatrixReal->new_random($N1); $M1 = $M1 + ~$M1; my $bench1 = timeit(1, sub { $M1->sym_eigenvalues(); }); # HACK: We go into the Benchmark objects !!! my $t1 = $bench1->[1]; print "bench1 (".$N1."x".$N1.") = ".timestr($bench1)."\n" if $DEBUG; my $M2 = Math::MatrixReal->new_random($N2); $M2 = $M2 + ~$M2; my $bench2 = timeit(1, sub { $M2->sym_eigenvalues(); }); # HACK: We go into the Benchmark objects !!! my $t2 = $bench2->[1]; print "bench2 (".$N2."x".$N2.")= ".timestr($bench2)."\n" if $DEBUG; my $k3 = ($t1 - (($N1*$N1)/($N2*$N2)) * $t2) / ($N1*$N1*$N1 * (1-($N2/$N1))); my $k2 = ($t2 - (($N2*$N2*$N2)/($N1*$N1*$N1)) * $t1) / ($N2*$N2 * (1-($N2/$N1))); print "t1=$t1 t2=$t2 k3=$k3 k2=$k2\n" if $DEBUG; $bigeigen_time = $k3*($bigsize*$bigsize*$bigsize) + $k2*($bigsize*$bigsize); # Grrr. I am unable to solve k3*N^3 + k2*N^2 = t with pen-and-paper... # (Should go back to school!) Anyway, let's have the machine do it... :-( my $N = 1; my $day = 24 * 60 * 60; # 1 day in seconds # BTW: Furthermore that's a damn stupid solving... while (($k3 * ($N*$N*$N) + $k2 * ($N*$N)) <= $day) { $N++; } $oneday_eigen = $N - 1; } # Output estimations... printf STDERR " * Estimated eigenvalues-only computation time for " .$bigsize."x".$bigsize." matrix: %5.2f s\n", $bigeigen_time; printf STDERR " Estimated biggest matrix manageable within 1 day cpu: ".$oneday_eigen."x".$oneday_eigen."\n"; # Tired eh? print STDERR " Btw, do you want to crunch such one now? (no, just kidding...;-)\n"; ok(1 == 1, 'benchmark estimates'); ######################################### # REAL computation test for big matrix. # ######################################### # Test real-world diagonalization if ($REALBENCH) { # Creates a random matrix my $big = Math::MatrixReal->new_random($bigsize); # test on random big matrix print "Matrix ".$bigsize."x$bigsize for eigenvalues & eigenvectors computation:\n" if $DEBUG; # # Benchmark eigenvalues & eigenvectors computation # $big = $big + ~$big; print "Direct diagonalization...\n" if $DEBUG; my ($Lbig_2, $Vbig_2); my $t = timeit(1, sub { ($Lbig_2, $Vbig_2) = $big->sym_diagonalize(); }); print "Timing of ".$bigsize."x".$bigsize." direct diagonalization:\n ".timestr($t)."\n"; print "eigenvalues L:\n$Lbig_2 eigenvectors:\n$Vbig_2" if $DEBUG2; # We check the results anyway (just in case...) ok_eigenvectors($big, $Lbig_2, $Vbig_2, 'eigenvalues of large matrix are correct'); # # Now test the eigenvalues only computations... # print "Recomputing: Eigenvalues only.\n ".$bigsize."x".$bigsize."\n" if $DEBUG; my $altLbig_2; my $tt = timeit(1, sub { $altLbig_2 = $big->sym_eigenvalues(); }); print "Timing of ".$bigsize."x".$bigsize." direct eigenvalues computation:\n ".timestr($tt)."\n"; # We check the results anyway (just in case...) ok_matrix($altLbig_2, $Lbig_2, 'eigenvalues of large matrix are correct'); } else { # Tests are not really done, but we don't bother... # There are other test programs for checking accuracy... not time. ok(1 == 1,'benchmarch fake test' ); ok(1 == 1,'benchmarch fake test' ); } Math-MatrixReal-2.13/t/bench_eigen2.t00044456105627002104 404312772016550 17606 0ustar00jonathanleto000000000000use Test::More tests => 3; use File::Spec; use lib File::Spec->catfile("..","lib"); use Math::MatrixReal; do 'funcs.pl'; my $DEBUG2 = 0; # Set this one if you want the REAL benchmarking to be done! my $REALBENCH = 1; my $bigsize = 25; # Size of big matrix REAL tests (be careful: n^3!) my $howmany = 30; use Benchmark; if ($REALBENCH) { print "Matrix ".$bigsize."x$bigsize for eigenvalues & eigenvectors computation:\n" if $DEBUG; my $big = Math::MatrixReal->new_random($bigsize, { symmetric => 1 } ); # Benchmark eigenvalues & eigenvectors computation print "Householder reduction...\n" if $DEBUG; my ($Tbig, $Qbig); my $t = timeit($howmany, sub { ($Tbig, $Qbig) = $big->householder(); }); print "Timing of ".$bigsize."x".$bigsize." Householder transformation:\n ".timestr($t)."\n" if $DEBUG; print "Is Qbig orthogonal?\n" if $DEBUG; print "Diagonalization of tridiagonal...\n" if $DEBUG; my ($Lbig, $Vbig); my $t2 = timeit($howmany, sub { ($Lbig, $Vbig) = $Tbig->tri_diagonalize($Qbig); }); print "Timing of ".$bigsize."x".$bigsize." QL-implicit diagonalization:\n ".timestr($t2)."\n" if $DEBUG; # We check the results anyway (just in case...:-) ok_eigenvectors( $big, $Lbig, $Vbig); # Now test the eigenvalues only computations... print "Recomputing: Eigenvalues only.\n ".$bigsize."x".$bigsize."\n" if $DEBUG; my $altTbig; my $t3 = timeit($howmany, sub { $altTbig = $big->householder_tridiagonal(); }); print "Timing of ".$bigsize."x".$bigsize." Householder transformation (tridiag. only):\n ".timestr($t3)."\n" if $DEBUG; my $altLbig; my $t4 = timeit($howmany, sub { $altLbig = $altTbig->tri_eigenvalues(); }); print "Timing of ".$bigsize."x".$bigsize." QL-implicit eigenvalues computation:\n ".timestr($t4)."\n" if $DEBUG; # We check the results anyway (just in case...:-) ok_matrix( $altTbig, $Tbig, "$bigsize x $bigsize householder triadiag"); ok_matrix( $altLbig, $Lbig, "$bigsize x $bigsize QL-implicit eigenvalues"); } else { SKIP: { skip "because", 3; }; } Math-MatrixReal-2.13/t/binary.t00044456105627002104 107312772016550 16562 0ustar00jonathanleto000000000000use Test::More tests => 4; use File::Spec; use lib File::Spec->catfile("..","lib"); use Math::MatrixReal; do 'funcs.pl'; $matrix = Math::MatrixReal->new_from_string(<<"MATRIX"); [ 1 0 0 0 1 ] [ 0 2 0 0 2 ] [ 0 0 3 0 0 ] [ 0 0 0 4 0 ] [ 0 0 0 0 5 ] MATRIX ok( ! $matrix->is_binary, 'matrix is not binary' ); $matrix->one(); ok($matrix->is_binary, 'identity matrix is binary' ); $matrix->zero(); ok($matrix->is_binary, 'zero matrix is binary' ); $matrix = Math::MatrixReal->new_from_string(<<"MATRIX"); [ 1 0 0 0 1 ] MATRIX ok($matrix->is_binary, 'vector is binary'); Math-MatrixReal-2.13/t/bool.t00044456105627002104 202012772016550 16222 0ustar00jonathanleto000000000000use Test::More tests => 12; use File::Spec; use lib File::Spec->catfile("..","lib"); use Math::MatrixReal; do 'funcs.pl'; $matrix = Math::MatrixReal->new_from_string(<<"MATRIX"); [ 1 0 0 0 1 ] [ 0 2 0 0 2 ] [ 0 0 3 0 0 ] [ 0 0 0 4 0 ] [ 0 0 0 0 1 ] MATRIX ok(!$matrix->is_positive, 'matrices containing zeros are not considered positive' ); ok(!$matrix->is_negative, 'matrices containing zeros are not considered negative' ); ok($matrix, 'matrix returns true' ); ######################## $matrix = Math::MatrixReal->new_from_string(<<"MATRIX"); [ 1 0 0 0 0 ] [ 0 3 0 0 0 ] [ 0 0 4 0 0 ] [ 1 0 0 1 0 ] [ 1 1 1 1 1 ] MATRIX $matrix = $matrix->each( sub { (shift)+1; } ); ok($matrix->is_positive, 'matrix is positive' ); ok(!$matrix->is_negative, 'matrix is not negative' ); ok($matrix, 'matrix returns true' ); $matrix = $matrix->each( sub { (shift)-11; } ); ok(!$matrix->is_positive ); ok($matrix->is_negative ); ok($matrix, 'matrix returns true' ); $matrix->zero; ok(!$matrix->is_positive ); ok(!$matrix->is_negative ); ok(!$matrix ); Math-MatrixReal-2.13/t/cofactor.t00044456105627002104 140212772016550 17072 0ustar00jonathanleto000000000000use Test::More tests => 2; use File::Spec; use lib File::Spec->catfile("..","lib"); use Math::MatrixReal; do 'funcs.pl'; $matrix = Math::MatrixReal->new_diag( [ 1, 2, 3 ] ); $cofactor = Math::MatrixReal->new_from_string(<cofactor(), $cofactor, 'cofactor works'); # inverse = adjoint(A)/det(A) $matrix = Math::MatrixReal->new_random(5); my $inverse1 = $matrix->inverse; my $inverse2 = ~($matrix->cofactor)->each( sub { (shift)/$matrix->det() } ); ok_matrix($inverse1,$inverse2, 'inverse is same as the adjoint divided by the determinant'); Math-MatrixReal-2.13/t/concat.t00044456105627002104 327212772016550 16550 0ustar00jonathanleto000000000000use Test::Simple tests =>7; use File::Spec; use lib File::Spec->catfile("..","lib"); use Math::MatrixReal; my $eye = Math::MatrixReal->new_diag([ 1,1,1] ); my $full = Math::MatrixReal->new_from_string(<new_from_string(<new_from_string(<dim(); ok( $rows == 3, 'Concatenation preserves number of rows'); ok( $cols == 6, 'Concatenation does the right thing for cols'); my $res = $eyefull - $concat; my $res2= $fulleye - $concat2; ok(abs($res) < $eps ,'Left Concatenation of matrices with the same number of rows works' ); ok(abs($res2) < $eps,'Right Concatenation of matrices with the same number of rows works' ); my $a = Math::MatrixReal->new_diag([1, 2]); my $b = Math::MatrixReal->new_diag([1, 2, 3]); my $c; eval { $c = $a . $b }; if ($@){ ok(1, 'Concatenation of matrices with same number of rows only'); } else { ok(0, 'Concatenation of matrices with same number of rows only'); } $c = Math::MatrixReal->new_from_string(<new_from_string(<new_from_string(< 1; use File::Spec; use lib File::Spec->catfile("..","lib"); use Math::MatrixReal; do 'funcs.pl'; $matrix = new Math::MatrixReal (10,10); $matrix->one(); ok( $matrix->condition($matrix->inverse) - 1 < 1e-6, 'identity has condition number = 1' ); Math-MatrixReal-2.13/t/decompose_LR.t00044456105627002104 67212772016550 17635 0ustar00jonathanleto000000000000use Test::More tests => 2; use File::Spec; use lib File::Spec->catfile("..","lib"); use Math::Complex; use Math::MatrixReal; use Data::Dumper; do 'funcs.pl'; { my $a = Math::MatrixReal->new_from_rows([ [ 2 ] ] ); ok_matrix( $a->decompose_LR->invert_LR, $a->inverse, q{decompose_LR->invert_LR = inverse for 1x1 matrices} ); ok_matrix( $a->new_from_rows( [[ 1/2 ]]) , $a->inverse, q{decompose_LR works for 1x1 matrices} ); } Math-MatrixReal-2.13/t/det.t00044456105627002104 357612772016550 16064 0ustar00jonathanleto000000000000use Test::More tests => 13; use File::Spec; use lib File::Spec->catfile("..","lib"); use Math::MatrixReal; do 'funcs.pl'; my $eps ||= 1e-8; $matrix = Math::MatrixReal->new_from_string(<<"MATRIX"); [ 1 0 0 0 1 ] [ 0 2 0 0 2 ] [ 0 0 3 0 0 ] [ 0 0 0 4 0 ] [ 0 0 0 0 1 ] MATRIX ok( similar( $matrix->det(), 24), 'det works' ); ######################## $matrix = Math::MatrixReal->new_from_string(<<"MATRIX"); [ 1 0 0 0 0 ] [ 0 3 0 0 0 ] [ 0 0 4 0 0 ] [ 1 0 0 1 0 ] [ 1 1 1 1 1 ] MATRIX ok( similar( $matrix->det(), 12) ); ############################### $matrix = Math::MatrixReal->new_from_string(<<"MATRIX"); [ 1 0 0 0 0 ] [ 0 1 0 0 0 ] [ 0 0 4 0 0 ] [ 0 0 0 5 0 ] [ 0 0 0 0 1 ] MATRIX ok( similar( $matrix->det, 20) ); $matrix = Math::MatrixReal->new_from_string(<<"MATRIX"); [ 0 0 0 0 0 ] [ 0 1 0 0 0 ] [ 0 0 4 0 0 ] [ 0 0 0 5 0 ] [ 0 0 0 0 1 ] MATRIX ok($matrix->det() == 0, 'diagonal matrix with 0 on diagonal has det=0'); ################## $eps=1e-6; $matrix = Math::MatrixReal->new_random(5, {bounded_by=>[1,10], integer => 1, symmetric => 1} ) ; my $det1 = (~$matrix)->det; my $det2 = $matrix->det; ok( abs($det1-$det2) < $eps, sprintf("%.12f =? %.12f",$det1,$det2) ); ############ my($r,$c) = $matrix->dim; ok( $r == 5 && $c == 5, 'new_random returns square matrix'); $inverse = $matrix->inverse(); $det = $matrix->det(); $det1=1/$det; $det2=$inverse->det(); ok( abs($det1-$det2) < $eps , sprintf("%.12f =? %.12f",$det1,$det2) ); ############ ## det(A) = product of eigenvalues my $opts = { bounded_by => [-1,1], integer => 1, symmetric => 1 }; my $b = Math::MatrixReal->new_random(5, $opts); ok( $matrix->is_symmetric, 'new_random returns symmetric matrix'); for ( 1 .. 5 ){ $b->new_random(5, $opts); $det1 = $b->det(); my $ev = $b->sym_eigenvalues; $det2=1; $ev->each( sub { $det2*=(shift); } ); ok( similar( $det1, $det2,$eps), 'product of eigenvalues equals the determinant'); } Math-MatrixReal-2.13/t/diag.t00044456105627002104 446212772016550 16207 0ustar00jonathanleto000000000000use Test::More tests => 8; use Math::MatrixReal; use File::Spec; use lib File::Spec->catfile("..","lib"); do 'funcs.pl'; ########################## ## test to see if is_diagonal works my $matrix = Math::MatrixReal->new_from_string(<<'MATRIX'); [ 1 0 0 0 0 0 0 ] [ 0 5 0 0 0 0 0 ] [ 0 0 1 0 0 0 0 ] [ 0 0 0 1 0 0 0 ] [ 0 0 0 0 5 0 0 ] [ 0 0 0 0 0 1 0 ] [ 0 0 0 0 0 0 -5 ] MATRIX ok( $matrix->is_diagonal(), 'is_diagonal works' ); ############################### ## make sure it recognizes a matrix that is not diagonal $matrix = Math::MatrixReal->new_from_string(<<"MATRIX"); [ 3 0 1 ] [ 0 3 0 ] [ 0 0 3 ] MATRIX ok(! $matrix->is_diagonal() ); ############################### ## see if knows that if it ain't square, it ain't diagonal $matrix = Math::MatrixReal->new_from_string(<<"MATRIX"); [ 1 0 ] [ 0 0 ] [ 0 1 ] MATRIX ok( ! $matrix->is_diagonal(), 'nonsquare matrix is not diagonal' ); ############################## ## 1x1 matrix is diagonal by definition $matrix = Math::MatrixReal->new_from_string(<<"MATRIX"); [ 1 ] MATRIX ok( $matrix->is_diagonal() ,'1x1 matrix is diagonal by definition'); ############################## ### see if is_tridiagonal works $matrix = Math::MatrixReal->new_from_string(<<'MATRIX'); [ 4 7 0 0 0 0 0 ] [ 1 5 2 0 0 0 0 ] [ 0 9 1 3 0 0 0 ] [ 0 0 5 1 8 0 0 ] [ 0 0 0 6 5 3 0 ] [ 0 0 0 0 7 1 4 ] [ 0 0 0 0 0 4 -5 ] MATRIX ok($matrix->is_tridiagonal() ); ############################## ### this isn't tridiag $matrix = Math::MatrixReal->new_from_string(<<'MATRIX'); [ 2 4 0 0 0 0 9 ] [ 1 5 2 0 0 0 0 ] [ 0 3 1 3 0 0 0 ] [ 0 0 5 1 8 0 0 ] [ 0 0 0 6 5 3 0 ] [ 0 0 0 0 7 1 4 ] [ 0 0 0 0 0 4 2 ] MATRIX ok( ! $matrix->is_tridiagonal() ); ############################## $matrix = Math::MatrixReal->new_from_string(<<'MATRIX'); [ 1 1 ] [ 1 1 ] MATRIX ok( $matrix->is_tridiagonal(), '2x2 is always tridiag' ); ############################### ### not quadratic => not tridiag $matrix = Math::MatrixReal->new_from_string(<<'MATRIX'); [ 2 4 0 0 0 0 ] [ 1 5 2 0 0 0 ] [ 0 3 1 3 0 0 ] [ 0 0 5 1 8 0 ] [ 0 0 0 6 5 3 ] [ 0 0 0 0 7 1 ] [ 0 0 0 0 0 4 ] MATRIX ok(! $matrix->is_tridiagonal() ); Math-MatrixReal-2.13/t/display_precision.t00044456105627002104 232012772016550 21012 0ustar00jonathanleto000000000000use Test::More tests => 3; use File::Spec; use lib File::Spec->catfile("..","lib"); use Math::MatrixReal; do 'funcs.pl'; my $matrix = Math::MatrixReal->new_diag([1,2,3,4]); $matrix->display_precision(5); my $correct = Math::MatrixReal->new_from_string(<display_precision(5); ok( "$matrix" eq "$correct", 'display_precision(n)' ); $matrix->display_precision(0); $correct = Math::MatrixReal->new_from_string(<display_precision(0); ok( "$matrix" eq "$correct", 'display_precision(0)' ); { assert_dies ( sub { Math::MatrixReal->new(5,5)->display_precision(-42) }, 'display_precision dies on negative arg, matey!' ); } Math-MatrixReal-2.13/t/div.t00044456105627002104 365712772016550 16072 0ustar00jonathanleto000000000000use Test::Simple tests => 7; use Math::MatrixReal; my $div_mat_by_scalar=Math::MatrixReal->new_from_string(<new_from_string(<new_from_string(<new_diag([ 0.51, 0.420, 0.15] ); my $b = Math::MatrixReal->new_diag([ 0.43, 13.4, 1110.5] ); my $c = Math::MatrixReal->new_diag([ 2.3, 554.4, 30.5] ); my $eye = Math::MatrixReal->new_diag([ 1,1,1] ); my $full = Math::MatrixReal->new_from_string(<new_from_string(<new_from_string(< 2; use File::Spec; use lib File::Spec->catfile("..","lib"); use Math::MatrixReal; do 'funcs.pl'; ############################### $matrix = Math::MatrixReal->new_from_string(<<"MATRIX"); [ 1 0 0 0 0 ] [ 0 2 0 0 0 ] [ 0 0 3 0 0 ] [ 0 0 0 4 0 ] [ 0 0 0 0 5 ] MATRIX my $matrix_squared = $matrix->each_diag( sub { (shift)**2 } );; ok_matrix( $matrix * $matrix, $matrix_squared, 'each_diag works' ); ################################ $all_ones = Math::MatrixReal->new_from_string(<<"MATRIX"); [ 1 1 1 1 1 ] [ 1 1 1 1 1 ] [ 1 1 1 1 1 ] [ 1 1 1 1 1 ] [ 1 1 1 1 1 ] MATRIX $matrix->zero(); $matrix = $matrix->each ( sub { (shift) + 1 } ); ok_matrix($matrix, $all_ones, 'each works' ); Math-MatrixReal-2.13/t/eigen_3x3.t00044456105627002104 756012772016550 17071 0ustar00jonathanleto000000000000use Test::More tests => 13; use File::Spec; use lib File::Spec->catfile("..","lib"); use Math::MatrixReal; do 'funcs.pl'; my $DEBUG2 = 0; my $string = "[ 1 2 3 ]\n[ 2 2 -1 ]\n[ 1 1 1 ]\n"; my $matrix33 = Math::MatrixReal->new_from_string($string); print "$matrix33" if $DEBUG; # # Tests eigenvalues & eigenvectors computation # # # First the tridiagonal reduction (Householder) on the 3x3 # my $symm = $matrix33 + ~$matrix33; ok( not($matrix33->is_symmetric())); ok( $symm->is_symmetric(), 'A + ~A is symmetric'); print "Matrix 3x3 for eigenvalues & eigenvectors computation:\n$symm" if $DEBUG; print "Householder reduction...\n" if $DEBUG; my ($T, $Q) = $symm->householder(); print "T=\n$T Q=\n$Q" if $DEBUG2; print "Is Q orthogonal?\n" if $DEBUG; print ($Q * ~$Q) if $DEBUG2; ok_matrix_orthogonal($Q); ok_matrix( $symm, $Q * $T * ~$Q, 'symmetric householder reduction works'); print "Diagonalization of tridiagonal...\n" if $DEBUG; my ($L1, $V1) = $T->tri_diagonalize($Q); print "eigenvalues L:\n$L1 eigenvectors:\n$V1" if $DEBUG2; ok_eigenvectors($symm, $L1, $V1); # Get first eigenvector my $aev1 = $V1->column(1); my $al1 = $L1->element(1,1); my $ap1_1 = $symm * $aev1; # A * x my $ap1_2 = $al1 * $aev1; # lambda *x print "Original computation of A*ev1:\n$ap1_1 Scaled eigenvector:\n$ap1_2" if $DEBUG2; ok_matrix( $ap1_1, $ap1_2, 'eigenvectors match'); print "Direct diagonalization...\n" if $DEBUG; my ($L12, $V12) = $symm->sym_diagonalize(); print "eigenvalues L:\n$L12 eigenvectors:\n$V12" if $DEBUG2; ok_eigenvectors($symm, $L12, $V12); ok_matrix_orthogonal($V12); # Double check the equality ok_matrix( $L12, $L1); ok_matrix( $V12, $V1); # # Now test the eigenvalues only computations... # print "Recomputing: Eigenvalues only.\n 3x3\n" if $DEBUG; my $altT = $symm->householder_tridiagonal(); ok_matrix( $altT, $T,'householder_tridiagonal works'); my $altL1 = $altT->tri_eigenvalues(); ok_matrix( $altL1, $L1,'tri_eigenvalues works'); my $altL12 = $symm->sym_eigenvalues(); ok_matrix( $altL12, $L12, 'sym_eigenvalues works'); __END__ # Attempt: # Obtain the eigenvectors when eigenvalues are known # using inverse iteration. # We solve (M - lambda * I) * b(k+1) = b(k) # with b(0) a random unit vector and b(k) is # normalized at each step. # This should converge towards the eigenvector, # but there are problems: # - for some value, there is not convergence # (the above system is rather singular, so...) # - the solution can oscillate between v and -v (?) # Rodolphe Ortalo, 99/06/14 sub obtain_eigenvector ($$) { my ($M, $eigenvalue) = @_; # Form the linear system A - lamda1 * I my $inv_it = $M->shadow(); $inv_it->one(); $inv_it->multiply_scalar($inv_it, (-1.0 * $eigenvalue)); $inv_it->add($M, $inv_it); print "Linear system matrix:\n $inv_it" if $DEBUG2; # Creates a random vector my ($rows, $cols) = $inv_it->dim(); my $b = Math::MatrixReal->new($rows, 1); for (my $i = 1; $i <= $rows; $i++) { $b->assign($i, 1, rand()); } # Normalize it my $l = $b->length(); $b->multiply_scalar($b, (1.0 / $l)); # Now do LR decomposition for linear system my $inv_it_LR = $inv_it->decompose_LR(); # Check iterations my $iter = 0; my $delta; do { my ($dim, $b_base, $base) = $inv_it_LR->solve_LR($b); # Normalize my $l = $b_base->length(); $b_base->multiply_scalar($b_base, (-1.0 / $l)); # print "b_base=\n$b_base"; $b->subtract($b_base,$b); $delta = $b->norm_one(); print "delta=$delta\n"; $b = $b_base; } while (($delta >= 1e-10) && ($iter++ <= 10)); return $b; } # # Now, try to find one eigenvector again... # (Using Steffen's functions...:-) # my $ev = obtain_eigenvector($symm, $al1); print "Real ev:\n $aev1 Found ev:\n $ev" if $DEBUG; ok_matrix(15, $ev, $aev1); ok_matrix(16, obtain_eigenvector($symm, $L1->element(2,1)), $V1->column(2)); ok_matrix(17, obtain_eigenvector($symm, $L1->element(3,1)), $V1->column(3)); Math-MatrixReal-2.13/t/eigen_7x7.t00044456105627002104 350712772016550 17076 0ustar00jonathanleto000000000000use Test::More tests => 10; use File::Spec; use lib File::Spec->catfile("..","lib"); use Math::MatrixReal; do 'funcs.pl'; my $DEBUG2 = 0; # # Trying some matrixes creation extracted from the pod... # my $matrix77_b = Math::MatrixReal->new_from_string(<<'MATRIX'); [ 1 7 -12 6 -9 0 1 ] [ 0 5 0 0 0 0 0 ] [ 0 0 1 4 0 0 0 ] [ 0 0 0 1 0 0 0 ] [ 12 0 0 0 5 0 4 ] [ 0 3 0 8 0 1 0 ] [ 1 0 0 0 0 0 -5 ] MATRIX print "$matrix77_b" if $DEBUG2; # # Tests eigenvalues & eigenvectors computation # # # Redo things with the 7x7 matrix # my $symm2 = $matrix77_b + ~$matrix77_b; print "Matrix 7x7 for eigenvalues & eigenvectors computation:\n" if $DEBUG; print "$symm2" if $DEBUG2; print "Householder reduction...\n" if $DEBUG; my ($T2, $Q2) = $symm2->householder(); print "T2=\n$T2 Q2=\n$Q2" if $DEBUG2; print "Is Q2 orthogonal?\n" if $DEBUG; ok_matrix_orthogonal($Q2); ok_matrix($symm2, $Q2 * $T2 * ~$Q2, 'householder reduction for 7x7'); print "Diagonalization of tridiagonal...\n" if $DEBUG; my ($L, $V) = $T2->tri_diagonalize($Q2); print "eigenvalues L:\n$L eigenvectors:\n$V" if $DEBUG2; ok_eigenvectors($symm2, $L, $V); print "Direct diagonalization...\n" if $DEBUG; my ($L_2, $V_2) = $symm2->sym_diagonalize(); print "eigenvalues L:\n$L_2 eigenvectors:\n$V_2" if $DEBUG2; ok_eigenvectors($symm2, $L_2, $V_2); ok_matrix_orthogonal( $V_2); # Double check the equality ok_matrix( $L_2, $L); ok_matrix( $V_2, $V); # # Now test the eigenvalues only computations... # print "Recomputing: Eigenvalues only.\n 7x7\n" if $DEBUG; my $altT2 = $symm2->householder_tridiagonal(); ok_matrix( $altT2, $T2, 'householder_tridiagonal for 7x7'); my $altL = $altT2->tri_eigenvalues(); ok_matrix( $altL, $L, 'tri_eigenvalues for 7x7'); my $altL_2 = $symm2->sym_eigenvalues(); ok_matrix( $altL_2, $L_2, 'sym_eigenvalues for 7x7'); Math-MatrixReal-2.13/t/eigen_NxN.t00044456105627002104 500212772016550 17144 0ustar00jonathanleto000000000000use Test::More tests => 15; use File::Spec; use lib File::Spec->catfile("..","lib"); use Math::MatrixReal; do 'funcs.pl'; my $DEBUG2 = 0; my $bigsize = 30; # Size of big matrix tests (be careful: n^3!) # test on random bigger matrix print "Matrix ".$bigsize."x$bigsize for eigenvalues & eigenvectors computation:\n" if $DEBUG; # Creates a random matrix my $big = Math::MatrixReal->new_random($bigsize, { symmetric => 1 }); # Tests eigenvalues & eigenvectors computation print "Householder reduction...\n" if $DEBUG; my ($Tbig, $Qbig) = $big->householder(); print "Is Qbig orthogonal?\n" if $DEBUG; ok_matrix_orthogonal( $Qbig); ok_matrix( $big, $Qbig * $Tbig * ~$Qbig); print "Diagonalization of tridiagonal...\n" if $DEBUG; my ($Lbig, $Vbig) = $Tbig->tri_diagonalize($Qbig); ok_eigenvectors( $big, $Lbig, $Vbig); ok_matrix_orthogonal( $Vbig); print "Direct diagonalization...\n" if $DEBUG; my ($Lbig_2, $Vbig_2) = $big->sym_diagonalize(); print "eigenvalues L:\n$Lbig_2 eigenvectors:\n$Vbig_2" if $DEBUG2; ok_eigenvectors($big, $Lbig_2, $Vbig_2); ok_matrix_orthogonal( $Vbig_2); # Double check the equality ok_matrix( $Lbig_2, $Lbig); ok_matrix( $Vbig_2, $Vbig); # # Now test the eigenvalues only computations... # print "Recomputing: Eigenvalues only.\n ".$bigsize."x".$bigsize."\n" if $DEBUG; my $altTbig = $big->householder_tridiagonal(); ok_matrix( $altTbig, $Tbig); my $altLbig = $altTbig->tri_eigenvalues(); ok_matrix( $altLbig, $Lbig); my $altLbig_2 = $big->sym_eigenvalues(); ok_matrix( $altLbig_2, $Lbig_2); ############## #### lower tri my $eigen = Math::MatrixReal->new_from_string(<new_from_string(<<"MATRIX"); [ 0 0 0 0 0 ] [ 0 3 0 0 0 ] [ 0 0 4 0 0 ] [ 1 0 0 5 0 ] [ 1 1 1 1 1 ] MATRIX ok_matrix( $eigen, $matrix->eigenvalues ); $matrix = $eigen->new_from_rows ( [[1,0,0],[0,2,0],[0,0,3]] ); $eigen = $eigen->new_from_string(<eigenvalues ); #################### ## upper tri $matrix = Math::MatrixReal->new_from_string(<<"MATRIX"); [ 1 0 0 0 1 ] [ 0 2 0 0 2 ] [ 0 0 3 0 0 ] [ 0 0 0 4 0 ] [ 0 0 0 0 5 ] MATRIX $eigen = Math::MatrixReal->new_from_string(<eigenvalues ); ###################### #### diag $matrix = $matrix->new_diag ( [ 10, 20, 30 ] ); $eigen = $matrix->new_from_cols ( [ [ 10, 20, 30 ] ] ); ok_matrix( $eigen, $matrix->eigenvalues ); Math-MatrixReal-2.13/t/equality.t00044456105627002104 215112772016550 17131 0ustar00jonathanleto000000000000use Test::More tests => 12; use File::Spec; use lib File::Spec->catfile("..","lib"); use Math::MatrixReal; do 'funcs.pl'; my $matrix = Math::MatrixReal->new_from_string(<<'MATRIX'); [ 1 7 2 6 9 0 1 1 ] [ 0 5 0 0 0 0 0 0 ] [ 0 0 1 4 0 0 0 0 ] [ 0 0 0 1 0 0 0 0 ] [ 2 0 0 0 5 0 4 0 ] [ 0 3 0 8 0 1 0 0 ] [ 1 0 0 0 0 0 -5 0 ] [ 9 0 0 0 0 0 15 0 ] MATRIX ok( $matrix eq $matrix, 'eq overload works' ); ok( $matrix == $matrix, '== overload works' ); ok( $matrix != 2*$matrix, '!= overload works' ); ok( $matrix ne 2*$matrix, 'ne overload works' ); ok( ($matrix*1) == $matrix, '== overload works' ); ok( $matrix == ($matrix*1), '== overload works' ); ok( $matrix == ($matrix**1), '== overload works' ); ok( $matrix**0 == $matrix**0, '== overload works' ); { no warnings; eval{ $matrix != 1 }; ok( $@ , '!= dies when matrix compared to scalar' ); eval{ $matrix == 1 }; ok( $@ , '== dies when matrix compared to scalar' ); } ok( $matrix->inverse == $matrix->inverse, '== overload works' ); ok( $matrix != $matrix->row(1), 'comparing square matrix to row vector works'); Math-MatrixReal-2.13/t/exponent.t00044456105627002104 162212772016550 17136 0ustar00jonathanleto000000000000use Test::More tests => 6; use File::Spec; use lib File::Spec->catfile("..","lib"); use Math::MatrixReal; do 'funcs.pl'; ############################### ## compute A^2 , compare to A*A $matrix = Math::MatrixReal->new_from_string(<<"MATRIX"); [ 1 0 0 0 0 ] [ 0 2 0 0 0 ] [ 0 0 3 0 0 ] [ 0 0 0 4 0 ] [ 0 0 0 0 5 ] MATRIX my $matrix_squared = $matrix ** 2; ok_matrix( $matrix * $matrix, $matrix_squared ); ################################# $matrix_squared = $matrix->exponent(2); ok_matrix( $matrix * $matrix, $matrix_squared ); ################################# ### A^-2 = (A^-1)^2 ok_matrix( ($matrix ** -1) ** 2, $matrix ** -2 ); ################################# my $one = $matrix->clone(); $one->one(); ok_matrix( $one , $matrix ** 0); ################################# ok_matrix( $one ** 100 , $one, ' identity to any power is still identity'); $matrix **= 2; ok( $matrix == $matrix_squared, '**= works' ); Math-MatrixReal-2.13/t/ext1.t00044456105627002104 1327712772016550 16210 0ustar00jonathanleto000000000000use File::Spec; use lib File::Spec->catfile("..","lib"); use Math::MatrixReal; do 'funcs.pl'; print "1..21\n"; print "ok 1\n"; my $verbose = grep @ARGV, '--verbose'; # below we are basically checking the # various ways that the new_from_* methods # are supposed to work--with strings, array refs, # or Math::MatrixReal vectors. They are also # supposed to work for mixtures of those things, # so we are checking that too. my $matrix2 = Math::MatrixReal->new_from_cols([[11,21], [12,22]]); print &check_matrix($matrix2) ? "ok 2\n" : "not ok 2\n"; my $col1 = $matrix2->column(1); my $col2 = $matrix2->column(2); my $matrix3 = $matrix2->new_from_columns( [$col1, $col2]); print &check_matrix($matrix3) ? "ok 3\n" : "not ok 3\n"; my $string1 = "[ 11 ]\n[ 21 ]\n[ 31 ]\n"; my $string2 = "[ 12 ]\n[ 22 ]\n[ 32 ]\n"; my $string3 = "[ 13 ]\n[ 23 ]\n[ 33 ]\n"; my $matrix4 = Math::MatrixReal->new_from_cols( [$string1, $string2, $string3] ); print &check_matrix($matrix4) ? "ok 4\n" : "not ok 4\n"; my $col52 = $matrix4->column(2); my $matrix5 = Math::MatrixReal->new_from_cols( [$string1, $col52, [13,23,33]]); print &check_matrix($matrix5) ? "ok 5\n" : "not ok 5\n"; my $matrix6 = Math::MatrixReal->new_from_rows( [[11,12,13], [21,22,23], [31,32,33]]); print &check_matrix($matrix6) ? "ok 6\n" : "not ok 6\n"; my $matrix7 = Math::MatrixReal->new_from_rows( ["[ 11 12 13 ]\n", "[ 21 22 23 ]\n", "[ 31 32 33 ]\n"]); print &check_matrix($matrix7) ? "ok 7\n" : "not ok 7\n"; my ($row81, $row82, $row83) = ($matrix4->row(1), $matrix4->row(2), $matrix4->row(3)); my $matrix8 = Math::MatrixReal->new_from_rows( [$row81, $row82, $row83] ); print &check_matrix($matrix8) ? "ok 8\n" : "not ok 8\n"; my $matrix9 = Math::MatrixReal->new_from_rows( ["[ 11 12 13 ]\n", $row82, $matrix8->row(3)] ); print &check_matrix($matrix9) ? "ok 9\n" : "not ok 9\n"; # testing for pre-0.05 problem where if ref( $vec ) # didn't start with Math::MatrixReal # new_from_* wouldn't recognize it package Foo; use base qw/Math::MatrixReal/; package main; my $foo_string = "[ 11 12 13 ]\n"; my $foo_matrix = Foo->new_from_string($foo_string); my $matrix10 = Math::MatrixReal->new_from_rows( [$foo_matrix, $row82, $matrix8->row(3)] ); print &check_matrix($matrix10) ? "ok 10\n" : "not ok 10\n"; # make sure it dies with our error message if you pass in a # hash ref eval{ Math::MatrixReal->new_from_cols( [{ foo=> 'bar'}] ) }; if ($@ =~ /things that inherit from Math::MatrixReal/) { warn $@ if $verbose; print "ok 11\n"; } else { print "not ok 11\n"; } # make sure it dies correctly on passing of a solo hash ref eval{ Math::MatrixReal->new_from_cols( { foo=> 'bar'} ) }; warn $@ if $@ && $verbose; if ($@ =~ /array of columns/) { print "ok 12\n"; } else { print "not ok 12\n"; } # same as above but for *rows version eval{ Math::MatrixReal->new_from_rows( { foo=> 'bar'} ) }; warn $@ if $@ && $verbose; if ($@ =~ /array of rows/) { print "ok 13\n"; } else { print "not ok 13\n"; } # handing *rows a column should die eval { Math::MatrixReal->new_from_rows( [$foo_matrix, $row82, $matrix8->column(3)] ) }; warn $@ if $@ && $verbose; if ($@ =~ /new_from_rows.* don't accept column vectors/) { print "ok 14\n"; } else { print "not ok 14\n"; } # opposite of previous test, making sure error messages # print appropriately eval { Math::MatrixReal->new_from_cols( [$foo_matrix, $row82, ] ) }; warn $@ if $@ && $verbose; if ($@ =~ /new_from_col(umn)?s.* don't accept row vectors/) { print "ok 15\n"; } else { print "not ok 15\n"; } # mixed dimensions are supposed to die eval { Math::MatrixReal->new_from_rows( [$foo_matrix, $row82, [ 1 ]] ) }; warn $@ if $@ && $verbose; if ($@ =~ /all of the rows passed in must have the same dimension/ ) { print "ok 16\n"; } else { print "not ok 16\n"; } # same as above but error message should say 'colunmns' eval { Math::MatrixReal->new_from_columns( [ [ 1, 2, 3], [ 1, 2], ] ) }; warn $@ if $@ && $verbose; if ($@ =~ /all of the columns passed in must have the same dimension/ ) { print "ok 17\n"; } else { print "not ok 17\n"; } # empty array ref passed in generates a weird message from MatrixReal, # I'm putting something less mysterious there eval { Math::MatrixReal->new_from_columns( [ [ 1, 2, 3], [], ] ) }; warn $@ if $@ && $verbose; if ($@ =~ /no elements/ ) { print "ok 18\n"; } else { print "not ok 18\n"; } # making sure we get the MatrixReal error passed through eval { Math::MatrixReal->new_from_columns( [ [ 1, 2, 3], '', ] ) }; warn $@ if $@ && $verbose; if ($@ =~ /empty input string/ ) { print "ok 19\n"; } else { print "not ok 19\n"; } $matrix1 = Math::MatrixReal->new_from_string(<<"MATRIX"); [ 1 2 3 ] [ 4 5 6 ] [ 7 8 9 ] MATRIX $matrix2 = Math::MatrixReal->new_from_rows( [ [ 1, 2, 3 ], [ 4, 5, 6 ], [ 7, 8 ,9 ] ] ); similar($matrix1,$matrix2) ? print "ok 20\n" : print "not ok 20\n"; ################################## $matrix3 = Math::MatrixReal->new_from_cols( [ [ 1, 4, 7], [ 2, 5, 8], [3, 6, 9] ] ); similar($matrix1,$matrix3) ? print "ok 21\n" : print "not ok 21\n"; # ok, the matrix we're making in every case is like # this (or possibly a different-sized/shaped version): # # 11 12 13 # 21 22 23 # 31 32 33 # # so, all we have to do to check them is # to make sure that 10 times the row plus # the column of each given element is equal # to the value of the element (they're # floats, though, so check using tolerance) # sub check_matrix { my $matrix = shift; my ($rows, $cols) = $matrix->dim; my $success = 1; foreach my $row (1..$rows) { foreach my $col (1..$cols) { my $element = $matrix->element($row,$col) ; $success = 0 unless ( abs ( $element - (10*$row + $col) ) < .00001 ) ; } } return $success; } Math-MatrixReal-2.13/t/gramian.t00044456105627002104 161512772016550 16716 0ustar00jonathanleto000000000000use Test::More tests => 6; use File::Spec; use lib File::Spec->catfile("..","lib"); use Math::MatrixReal; do 'funcs.pl'; $matrix = Math::MatrixReal->new_from_string(<<"MATRIX"); [ 1 0 0 0 0 ] [ 0 2 0 0 0 ] [ 0 0 3 0 0 ] [ 0 0 0 4 0 ] [ 0 0 0 0 5 ] MATRIX ok( $matrix->is_gramian() ); ######################## $matrix = Math::MatrixReal->new_from_string(<<"MATRIX"); [ 0 2 0 0 1 ] [ 0 0 3 0 0 ] [ 0 0 0 4 0 ] [ 1 0 0 0 5 ] MATRIX ok( ! $matrix->is_gramian() ); ############################# $matrix = Math::MatrixReal->new_from_string(<is_gramian() ); ################ $matrix = $matrix->new_diag( [ 1, 2, 3, -4 ] ); ok( !$matrix->is_gramian ); ########### $matrix = Math::MatrixReal->new_from_string(<<"MATRIX"); [ 1 0 0 0 1 ] [ 0 2 0 0 0 ] [ 0 0 3 0 0 ] [ 0 0 0 4 0 ] [ -1 0 0 0 5 ] MATRIX ok( !$matrix->is_gramian ); ########## $matrix->zero; ok( $matrix->is_gramian ); Math-MatrixReal-2.13/t/gsm.t00044456105627002104 114212772016550 16061 0ustar00jonathanleto000000000000use Test::More tests => 1; use File::Spec; use lib File::Spec->catfile("..","lib"); use Math::MatrixReal; do 'funcs.pl'; $eps = 1e-6; my $A = Math::MatrixReal->new_from_string(<<"MATRIX"); [ 1 2 3 ] [ 5 7 11 ] [ 23 19 13 ] MATRIX $b = Math::MatrixReal->new_from_cols([[0, 1, 29 ]] ); $x0 = Math::MatrixReal->new_from_cols([[1, 1, -1.1 ]] ); $sol = Math::MatrixReal->new_from_cols([[1, 1, -1 ]] ); SKIP : { skip 'solve_GSM ? ', 1; if ( $xn = $A->solve_GSM($x0,$b,$eps) ) { print $xn; ok( ($xn - $sol) < $eps, 'solve_GSM seems to work'); } else { ok( 0, 'solve_GSM' ); } } Math-MatrixReal-2.13/t/inequality.t00044456105627002104 215112772016550 17460 0ustar00jonathanleto000000000000use Test::More tests => 10; use File::Spec; use lib File::Spec->catfile("..","lib"); use Math::MatrixReal; do 'funcs.pl'; my $matrix = Math::MatrixReal->new_from_string(<<'MATRIX'); [ 1 7 2 6 9 0 1 1 ] [ 0 5 0 0 0 0 0 0 ] [ 0 0 1 4 0 0 0 0 ] [ 0 0 0 1 0 0 0 0 ] [ 2 0 0 0 5 0 4 0 ] [ 0 3 0 8 0 1 0 0 ] [ 1 0 0 0 0 0 -5 0 ] [ 9 0 0 0 0 0 15 0 ] MATRIX ok( $matrix <= $matrix, '<= overload works' ); ok( $matrix >= $matrix, '>= overload works' ); ok( $matrix le $matrix, 'le overload works' ); ok( $matrix ge $matrix, 'ge overload works' ); ok( $matrix->row(2) < $matrix->row(1), '< overloading to norm works for row vector'); ok( $matrix->row(3) > $matrix->row(4), '> overloading to norm works for row vector'); ok( $matrix->row(2) lt $matrix->row(1), 'lt overloading to norm works for row vector'); ok( $matrix->row(3) gt $matrix->row(4), 'gt overloading to norm works for row vector'); ok( $matrix->col(2) > $matrix->col(1), '< overloading to norm works for col vector'); ok( $matrix->col(3) < $matrix->col(4), '> overloading to norm works for col vector'); Math-MatrixReal-2.13/t/inverse.t00044456105627002104 227712772016550 16760 0ustar00jonathanleto000000000000use Test::More tests => 6; use File::Spec; use lib File::Spec->catfile("..","lib"); use Math::MatrixReal; do 'funcs.pl'; { ## compute a 2x2 inverse $matrix = Math::MatrixReal->new_from_string(<<"MATRIX"); [ 3.0 7.0 ] [ 2.0 5.0 ] MATRIX $inverse = Math::MatrixReal->new_from_string(<<"MATRIX"); [ 5.0 -7.0 ] [ -2.0 3.0 ] MATRIX ok_matrix( $matrix ** -1 , $inverse, '** -1 = inverse ' ); } { ## A*A^-1 should = indentity my $matrix = Math::MatrixReal->new_random(10); my $one = $matrix->clone(); $one->one(); ok_matrix($matrix * $matrix ** -1, $one ); } { my $one = Math::MatrixReal->new(5,5); $one->one; ok_matrix( $one, $one ** -1, q{inverse of identity is identity} ); } { my $matrix = Math::MatrixReal->new_random(3); ok_matrix( $matrix->inverse->inverse, $matrix ); } { my $a = Math::MatrixReal->new_random(5); my $b = Math::MatrixReal->new_random(5); ok_matrix( ($a*$b)->inverse, ($b->inverse * $a->inverse) ); } { my $x = 1 + int rand (10); my $a = Math::MatrixReal->new_from_rows ( [[ 1/$x ]] ); my $inv = $a->inverse; ok_matrix( $a * $inv, $a->new_from_rows([[ 1 ]]), "inverting 1x1 matrices works" ); } Math-MatrixReal-2.13/t/is_LR.t00044456105627002104 77512772016550 16276 0ustar00jonathanleto000000000000use Test::More tests => 9; use File::Spec; use lib File::Spec->catfile("..","lib"); use Math::MatrixReal; do 'funcs.pl'; my $matrix = Math::MatrixReal->new_from_string(<decompose_LR; ok($LR->is_LR); my $a = $LR; my $b = $LR; $a+=$matrix; ok( ! $a->is_LR); ok( ! ($LR**2)->is_LR ); ok( ! (~$LR)->is_LR ); ok( ! $LR->inverse->is_LR ); ok( ! $LR->cofactor->is_LR ); ok( ! $LR->adjoint->is_LR ); ok( ! $LR->minor(1,1)->is_LR ); ok( $b->is_LR ); Math-MatrixReal-2.13/t/isrowcol.t00044456105627002104 124512772016550 17140 0ustar00jonathanleto000000000000use Test::More tests => 7; use File::Spec; use lib File::Spec->catfile("..","lib"); use Math::MatrixReal; do 'funcs.pl'; $matrix1 = Math::MatrixReal->new_from_string(<<"MATRIX"); [ 1 0 0 0 ] [ 0 2 0 0 ] [ 0 0 3 0 ] [ 0 0 0 4 ] MATRIX $matrix2 = Math::MatrixReal->new_from_string(<<"MATRIX"); [ 0 0 0 4 ] [ 0 2 0 0 ] [ 0 0 3 0 ] [ 1 0 0 0 ] MATRIX $rowvec = $matrix1->row(1); $colvec = $matrix2->column(2); $s = $rowvec->column(1); ok( ! $matrix1->is_row_vector ); ok( ! $matrix1->is_col_vector ); ok( ! $matrix2->is_row_vector ); ok( ! $matrix2->is_col_vector ); ok( $rowvec->is_row_vector ); ok( $colvec->is_col_vector ); ok( $s->is_row_vector && $s->is_col_vector ); Math-MatrixReal-2.13/t/latex.t00044456105627002104 203312772016550 16410 0ustar00jonathanleto000000000000use Test::Most tests => 2; use strict; use warnings; use File::Spec; use lib File::Spec->catfile("..","lib"); use Math::MatrixReal; do 'funcs.pl'; { my $latex1=<<'LATEX'; $\left( \begin{array}{cc} 1.41e-05&1 \\ 6.82e-06&3 \\ 3.18e-06&4 \end{array} \right) $ LATEX chomp $latex1; # Determine number of digits in exponents beyond the libc 'standard' of two # and pad out the expected result. my $zero = sprintf '%E', 0; my ($pad) = $zero =~ m/E\+00(\d+)$/; $latex1 =~ s/([eE])([+-])(\d\d)/$1$2$pad$3/g if defined $pad; my $a = Math::MatrixReal->new_from_cols([[ 1.41E-05, 6.82E-06, 3.18E-06 ],[1,3,4]]); eq_or_diff( lc $a->as_latex, lc $latex1, 'as_latex seems to work'); } { my $latex2=<<'LATEX'; $A = \left( \begin{array}{ll} 1.23&1.00 \\ 5.68&2.00 \\ 9.10&3.00 \end{array} \right) $ LATEX chomp $latex2; my $b = Math::MatrixReal->new_from_cols([[ 1.234, 5.678, 9.1011],[1,2,3]] ); my $s = $b->as_latex( ( format => "%.2f", align => "l",name => "A" ) ); eq_or_diff(lc $s, lc $latex2,'as_latex format options seem to work'); } Math-MatrixReal-2.13/t/length.t00044456105627002104 67112772016550 16542 0ustar00jonathanleto000000000000use Test::More tests => 2; use File::Spec; use lib File::Spec->catfile("..","lib"); use Math::MatrixReal; do 'funcs.pl'; my $vec = Math::MatrixReal->new_from_rows([ [ 1, 2, 3 ] ]); my $len = (~$vec)->length; ok( similar($len, sqrt(14)), 'length works for row vector, len=' . $len ); $vec = Math::MatrixReal->new_from_cols([ [ 1, 2, 3 ] ]); $len = ($vec)->length; ok( similar($len, sqrt(14)), 'length works for col vector, len=' . $len ); Math-MatrixReal-2.13/t/list.t00044456105627002104 111112772016550 16242 0ustar00jonathanleto000000000000use Test::More; use File::Spec; use lib File::Spec->catfile("..","lib"); use Math::MatrixReal; do 'funcs.pl'; my $matrix = Math::MatrixReal->new_from_rows([ [1, 2], [3, 4] ]); my @list = $matrix->as_list; is scalar(@list), 4, "list contains 4 elements"; is_deeply \@list, [1, 2, 3, 4], "list contains all elements from initial rows"; $matrix = Math::MatrixReal->new_from_rows([ [1, 2, 3], [3, 4, 5] ]); @list = $matrix->as_list; is scalar(@list), 6, "list contains 6 elements"; is_deeply \@list, [1, 2, 3, 3, 4, 5], "list contains all elements from initial rows"; done_testing; Math-MatrixReal-2.13/t/matlab.t00044456105627002104 72512772016550 16521 0ustar00jonathanleto000000000000use Test::More tests => 2; use File::Spec; use lib File::Spec->catfile("..","lib"); use Math::MatrixReal; do 'funcs.pl'; my ($a,$b); $a = Math::MatrixReal->new_from_cols([[ 1.41E-05, 6.82E-06, 3.18E-06 ],[1,3,4]]); like( $a->as_matlab,qr/\[.*;.*;.*\]/s, 'matlab output looks right'); $b = Math::MatrixReal->new_from_cols([[ 1.234, 5.678, 9.1011],[1,2,3]] ); my $s = $b->as_matlab( ( format => "%5.8s", name => "A" ) ); like( $s, qr/A = /, 'name argument respected'); Math-MatrixReal-2.13/t/max_min.t00044456105627002104 320412772016550 16724 0ustar00jonathanleto000000000000use Test::More tests => 16; use File::Spec; use lib File::Spec->catfile("..","lib"); use Math::MatrixReal; do 'funcs.pl'; $matrix = Math::MatrixReal->new_from_string(<new_from_string(<maximum() ), [3, 6, 9], "Max test 1 (scalar context)"); is_deeply( scalar((~$matrix)->maximum()), [7, 8, 9], "Max test 2 (scalar context)"); is_deeply( scalar($vector->maximum() ), 9, "Max test 3 (scalar context)"); is_deeply( scalar((~$vector)->maximum()), 9, "Max test 4 (scalar context)"); is_deeply( scalar($matrix->minimum() ), [1, 4, 7], "Min test 1 (scalar context)"); is_deeply( scalar((~$matrix)->minimum()), [1, 2, 3], "Min test 2 (scalar context)"); is_deeply( scalar($vector->minimum() ), 1, "Min test 3 (scalar context)"); is_deeply( scalar((~$vector)->minimum()), 1, "Min test 4 (scalar context)"); ## list context is_deeply( [ $matrix->maximum() ], [[3, 6, 9], [3, 3, 3]], "Max test 1 (list context)"); is_deeply( [ (~$matrix)->maximum() ], [[7, 8, 9], [3, 3, 3]], "Max test 2 (list context)"); is_deeply( [ $vector->maximum() ], [9, 2], "Max test 3 (list context)"); is_deeply( [ (~$vector)->maximum() ], [9, 2], "Max test 4 (list context)"); is_deeply( [ $matrix->minimum() ], [[1, 4, 7], [1, 1, 1]], "Min test 1 (list context)"); is_deeply( [ (~$matrix)->minimum() ], [[1, 2, 3], [1, 1, 1]], "Min test 2 (list context)"); is_deeply( [ $vector->minimum() ], [1, 1], "Min test 3 (list context)"); is_deeply( [ (~$vector)->minimum() ], [1, 1], "Min test 4 (list context)");Math-MatrixReal-2.13/t/minimax.t00044456105627002104 143212772016550 16737 0ustar00jonathanleto000000000000use Test::More tests => 6; use File::Spec; use lib File::Spec->catfile("..","lib"); use Math::MatrixReal qw/:all/; use strict; use warnings; do 'funcs.pl'; my ($x,$y) = (7,42); ok( min($x ,$x + $y ** 2) == $x, 'min works'); ok( max($y,$x * $y) == $x*$y, 'max works'); my $a = Math::MatrixReal->new_diag( [ 1 .. 10 ] ); my $min = $a->min; ok( similar($min,0), '$a->min works, $min=' . $min); $a = Math::MatrixReal->new_diag( [ 1 .. 10 ] ); my $max = $a->max; ok( similar($max,10) , '$a->max works, $max=' . $max); $a = Math::MatrixReal->new_random( 20, 20, { symmetric => 1 } ); $max = $a->max; $min = $a->min; my $eps = 1e-8; ok( $max <= 10 , 'symmetric random matrix adheres to bounded_by, max=' . $max); ok( $min >= 0 , 'symmetric random matrix adheres to bounded_by, min=' . $min); Math-MatrixReal-2.13/t/minor.t00044456105627002104 75412772016550 16407 0ustar00jonathanleto000000000000use Test::More tests => 3; use File::Spec; use lib File::Spec->catfile("..","lib"); use Math::MatrixReal; do 'funcs.pl'; $matrix = Math::MatrixReal->new_diag( [ 1, 2, 3 ] ); $minor11 = Math::MatrixReal->new_from_rows ( [ [2,0],[0,3] ] ); $minor22 = Math::MatrixReal->new_from_rows ( [ [1,0],[0,3] ] ); $minor13 = Math::MatrixReal->new_from_rows ( [ [0,2],[0,0] ] ); ok_matrix($matrix->minor(1,1),$minor11); ok_matrix($matrix->minor(2,2),$minor22); ok_matrix($matrix->minor(1,3),$minor13); Math-MatrixReal-2.13/t/norm.t00044456105627002104 102012772016550 16241 0ustar00jonathanleto000000000000use Test::More tests => 3; use File::Spec; use lib File::Spec->catfile("..","lib"); use Math::MatrixReal; do 'funcs.pl'; my $eps ||= 1e-8; $matrix = Math::MatrixReal->new_from_string(<<"MATRIX"); [ 1 0 0 0 1 ] [ 0 2 0 0 0 ] [ 0 0 3 0 0 ] [ 0 0 0 4 0 ] [ 1 0 0 0 5 ] MATRIX ok( similar($matrix->norm_one ,$matrix->norm_max), 'norm_one works' ); ok( similar($matrix->norm_sum,17), 'norm_sum works' ); $matrix = $matrix->new_from_rows([[1,2],[3,4]]); ok( similar($matrix->norm_frobenius , sqrt(30)), 'norm_frobenius works' ) ; Math-MatrixReal-2.13/t/normality.t00044456105627002104 50012772016550 17266 0ustar00jonathanleto000000000000use Test::More tests => 2; use File::Spec; use lib File::Spec->catfile("..","lib"); use Math::MatrixReal; do 'funcs.pl'; my $a = Math::MatrixReal->new_from_rows([ [1, 2], [-2, 1] ] ); my $b = Math::MatrixReal->new_from_rows([ [1, 2], [3, 1] ] ); ok( $a->is_normal , 'is_normal'); ok( !$b->is_normal , 'is_normal'); Math-MatrixReal-2.13/t/orthogonal.t00044456105627002104 73212772016550 17433 0ustar00jonathanleto000000000000use Test::More tests => 5; use File::Spec; use lib File::Spec->catfile("..","lib"); use Math::MatrixReal; do 'funcs.pl'; $eps ||= 1e-8; $matrix = Math::MatrixReal->new_from_string(<<"MATRIX"); [ 1 2 2 ] [ 2 1 -2 ] [ -2 2 -1 ] MATRIX $matrix = $matrix->each( sub { (shift)/3; } ); ok( $matrix->is_orthogonal ); ok( ($matrix**2)->is_orthogonal ); ok( (~$matrix)->is_orthogonal ); ok( $matrix->inverse->is_orthogonal ); # det is +-1 ok( abs(abs($matrix->det) - 1) < $eps ); Math-MatrixReal-2.13/t/periodic.t00044456105627002104 77212772016550 17061 0ustar00jonathanleto000000000000use Test::More tests => 7; use File::Spec; use lib File::Spec->catfile("..","lib"); use Math::MatrixReal; do 'funcs.pl'; my $matrix = new Math::MatrixReal (10,10); $matrix->one; ok( $matrix->is_idempotent ); ok( $matrix->is_periodic(1) ); $matrix = new Math::MatrixReal (10,5); ok( !$matrix->is_idempotent ); ok( !$matrix->is_periodic(1) ); $matrix = new Math::MatrixReal (10,10); $matrix->one; ok( $matrix->is_periodic(20) ); $matrix->zero; ok( $matrix->is_periodic(20) ); ok( $matrix->is_idempotent ); Math-MatrixReal-2.13/t/positive.t00044456105627002104 210112772016550 17131 0ustar00jonathanleto000000000000use Test::More tests => 8; use File::Spec; use lib File::Spec->catfile("..","lib"); use Math::MatrixReal qw/:all/; do 'funcs.pl'; my $a = Math::MatrixReal->new_diag( [ 1, 2, -3 ] ); ok( ! $a->is_positive_definite, 'positive_definite' ); $a = Math::MatrixReal->new_diag( [ 1, 2, 3 ] ); ok( $a->is_positive_definite, 'positive_definite' ); $a = Math::MatrixReal->new_diag( [ 1, 2, 0 ] ); ok( ! $a->is_positive_definite, 'positive_definite' ); $a = Math::MatrixReal->new_from_rows( [ [1, 100], [1, 1] ] ); ok( ! $a->is_positive_definite, 'nonsymmetric matrix cannot be positive_definite' ); ### $a = Math::MatrixReal->new_diag( [ 1, 2, -3 ] ); ok( ! $a->is_positive_semidefinite, 'positive_semidefinite' ); $a = Math::MatrixReal->new_diag( [ 1, 2, 3 ] ); ok( $a->is_positive_semidefinite, 'positive_semidefinite' ); $a = Math::MatrixReal->new_diag( [ 1, 2, 0 ] ); ok( $a->is_positive_semidefinite, 'positive_semidefinite' ); $a = Math::MatrixReal->new_from_rows( [ [1, 100], [1, 1] ] ); ok( ! $a->is_positive_semidefinite, 'nonsymmetric matrix cannot be positive_semidefinite' ); Math-MatrixReal-2.13/t/product.t00044456105627002104 75212772016550 16741 0ustar00jonathanleto000000000000use Test::More tests => 2; use File::Spec; use lib File::Spec->catfile("..","lib"); use Math::MatrixReal; do 'funcs.pl'; my $eps = 1e-8; $vec1 = Math::MatrixReal->new_from_string(<new_from_string(<vector_product($vec2); ok( $vec->scalar_product($vec1) < $eps, 'vector product is orthogonal' ); ok( $vec->scalar_product($vec2) < $eps ,'vector product is orthogonal'); Math-MatrixReal-2.13/t/quadratic.t00044456105627002104 124012772016550 17247 0ustar00jonathanleto000000000000use Test::More tests => 3; use File::Spec; use lib File::Spec->catfile("..","lib"); use Math::MatrixReal; do 'funcs.pl'; $matrix = Math::MatrixReal->new_from_string(<<"MATRIX"); [ 1 0 0 0 1 ] [ 0 2 0 0 0 ] [ 0 0 3 0 0 ] [ 0 0 0 4 0 ] [ 1 0 0 0 5 ] MATRIX ok( $matrix->is_quadratic(), 'matrix is quadratic (square)' ); ######################## $matrix = Math::MatrixReal->new_from_string(<<"MATRIX"); [ 0 2 0 0 1 ] [ 0 0 3 0 0 ] [ 0 0 0 4 0 ] [ 1 0 0 0 5 ] MATRIX ok(! $matrix->is_quadratic(), 'matrix is rectangular' ); ############################# $matrix = Math::MatrixReal->new_from_string(<is_square(), '1x1 matrix is square' ); Math-MatrixReal-2.13/t/rand.t00044456105627002104 571712772016550 16233 0ustar00jonathanleto000000000000use Test::More tests => 16; use File::Spec; use lib File::Spec->catfile("..","lib"); use Math::MatrixReal; my ($e,$res) = (0,0); my $eps = 1e-8; do 'funcs.pl'; { my $matrix = Math::MatrixReal->new_random( 10,10, { integer => 1 } ); ok ( ref $matrix eq 'Math::MatrixReal' , 'new_random returns the correct object' ); my ($rows,$cols) = $matrix->dim; ok( $rows == 10 && $cols == 10, 'new_random returns the correct size' ); for my $r ( 1 .. $rows ){ for my $c ( 1 .. $cols ) { $e = $matrix->element($r,$c); $res += abs( $e-int($e) ); } } ok( $res < $eps, 'new_random option type integer works' ); } { $matrix = Math::MatrixReal->new_random( 5 ); ($rows,$cols) = $matrix->dim; ok( $rows == 5 && $cols == 5, 'new_random is square if called with one argument' ); } { ($rows,$cols) = (1+int(rand(10)), 1+int(rand(10)) ); my $matrix = Math::MatrixReal->new_random( $rows,$cols, { bounded_by => [-$rows, $rows] } ); my $min = $matrix->element(1,1); my $max = $min; for my $r ( 1 .. $rows ){ for my $c ( 2 .. $cols ) { $e = $matrix->element($r,$c); $e < $min ? $min = $e : $e > $max ? $max = $e : 0 ; } } ok( $min >= -$rows && $max <= $rows, 'new_random option bounded_by works' ); } { assert_dies( sub { my $matrix = Math::MatrixReal->new_random }, q{new_random fails with no args} ); } { assert_dies( sub { my $matrix = Math::MatrixReal->new_random(0, 17.5) }, q{new_random fails with invalid args} ); } { assert_dies( sub { my $matrix = Math::MatrixReal->new_random(10,20, { bounded_by => [] } ) }, q{new_random fails with invalid bounded_by} ); } { assert_dies( sub { my $matrix = Math::MatrixReal->new_random(10,20, { bounded_by => [1,-1] } ) }, q{new_random fails with invalid bounded_by range} ); } { assert_dies( sub { my $matrix = Math::MatrixReal->new_random(10,20, { symmetric => 1 } ) }, q{new_random fails with rectangular + symmetric} ); } { assert_dies( sub { my $matrix = Math::MatrixReal->new_random(10,20, { tridiag => 1 } ) }, q{new_random fails with nonsquare tridiag} ); } { assert_dies( sub { my $matrix = Math::MatrixReal->new_random(10,20, { diag => 1 } ) }, q{new_random fails with nonsquare diag}, ); } { ok( Math::MatrixReal->new_random(10, { symmetric => 1 } )->is_symmetric, 'new_random can do symmetric'); } { ok( Math::MatrixReal->new_random(5, { tridiag => 1, integer => 1 } )->is_tridiagonal, 'new_random with tridiag works'); } { my $a = Math::MatrixReal->new_random(5, { tridiag => 1, symmetric => 1 } ); ok( $a->is_tridiagonal && $a->is_symmetric, 'new_random with tridiag+symmetric works'); } { ok( Math::MatrixReal->new_random(5, { diag => 1, integer => 1 } )->is_diagonal, 'new_random with diag works'); } Math-MatrixReal-2.13/t/rank.t00044456105627002104 172112772016550 16231 0ustar00jonathanleto000000000000use Test::More tests => 5; use File::Spec; use lib File::Spec->catfile("..","lib"); use Math::MatrixReal; do 'funcs.pl'; $matrix = Math::MatrixReal->new_from_string(<<"MATRIX"); [ 1 0 0 0 1 ] [ 0 2 0 0 2 ] [ 0 0 3 0 0 ] [ 0 0 0 4 0 ] [ 0 0 0 0 1 ] MATRIX ok( $matrix->decompose_LR->rank_LR == 5, 'matrix has rank 5' ); ######################## $matrix = Math::MatrixReal->new_from_string(<<"MATRIX"); [ 1 0 0 0 0 ] [ 0 3 0 0 0 ] [ 0 0 4 0 0 ] [ 1 0 0 1 0 ] [ 1 1 1 1 0 ] MATRIX ok( $matrix->decompose_LR->rank_LR == 4, 'matrix has rank 4' ); $matrix = Math::MatrixReal->new_from_string(<<"MATRIX"); [ 1 ] MATRIX ok($matrix->decompose_LR->rank_LR == 1, 'matrix has rank 1' ); $matrix->zero; ok($matrix->decompose_LR->rank_LR == 0, 'zero matrix has rank 0' ); $matrix = Math::MatrixReal->new_from_string(<<"MATRIX"); [ 1 0 0 0 0e-3 ] [ 0 0 0 0 0.0 ] [ 0 0 0 0 0.0 ] [ 0 0 0 0 0.0 ] [ 0 0 0 0 0.0 ] MATRIX ok($matrix->decompose_LR->rank_LR == 1, 'matrix has rank 1' ); Math-MatrixReal-2.13/t/scinotation.t00044456105627002104 107012772016550 17625 0ustar00jonathanleto000000000000use Test::More tests => 3; use File::Spec; use lib File::Spec->catfile("..","lib"); use Math::MatrixReal; do 'funcs.pl'; my ($a,$b); eval { $a = Math::MatrixReal->new_from_cols([[ 1.41e-05, 6.82E-06, 3.18e-06 ]]) }; if ($@){ ok(0, 'new_from_cols scientific notation fails'); } else { ok(1, 'new_from_cols scientific notation works'); } eval { $b = Math::MatrixReal->new_from_rows([[ 1.41e-05, 6.82E-06, 3.18e-06 ]]) }; if ($@){ ok(0, 'new_from_rows scientific notation fails'); } else { ok(1, 'new_from_rows scientific notation works'); } ok(similar( $a, ~$b) ); Math-MatrixReal-2.13/t/similar.t00044456105627002104 66612772016550 16725 0ustar00jonathanleto000000000000use Test::More tests => 6; use File::Spec; use lib File::Spec->catfile("..","lib"); use Math::MatrixReal qw/:all/; use strict; use warnings; do 'funcs.pl'; my ($x,$y,$z) = (42, 42.0001,42.0000001); ok ( similar($x,$y, 1e-2 ), 'similar' ); ok (! similar($x,$y, 1e-6 ), 'similar' ); ok (! similar($x,$y), 'similar' ); ok ( similar($y,$z, 1e-3 ), 'similar' ); ok (! similar($y,$z, 1e-8 ), 'similar' ); ok (! similar($y,$z), 'similar' ); Math-MatrixReal-2.13/t/spectral.t00044456105627002104 124112772016550 17110 0ustar00jonathanleto000000000000use Test::More tests => 5; use File::Spec; use lib File::Spec->catfile("..","lib"); use Math::MatrixReal; do 'funcs.pl'; $matrix = Math::MatrixReal->new_from_string(<<"MATRIX"); [ 1 0 0 0 1 ] [ 0 2 0 0 2 ] [ 0 0 3 0 0 ] [ 0 0 0 4 0 ] [ 0 0 0 0 5 ] MATRIX ok( $matrix->spectral_radius == 5 ); $matrix->zero(); ok($matrix->spectral_radius == 0, 'zero matrix has spectral radius=0' ); $matrix->one(); ok($matrix->spectral_radius == 1, 'identity has spectral radius=1' ); $matrix = $matrix->new_from_rows( [ [3,-1],[-1,3] ] ); ok( similar($matrix->spectral_radius,4) ); $matrix = $matrix->new_from_rows( [ [1.5,0.5],[.5,1.5] ] ); ok(similar($matrix->spectral_radius,2) ); Math-MatrixReal-2.13/t/stringify.t00044456105627002104 211512772016550 17312 0ustar00jonathanleto000000000000use Test::More tests => 2; use File::Spec; use lib File::Spec->catfile("..","lib"); use Math::MatrixReal; do 'funcs.pl'; # Determine number of digits in exponents beyond the libc 'standard' of two # and pad out the expected result. my $zero = sprintf '%E', 0; my ($pad) = $zero =~ m/E\+00(\d+)$/; my $correct=<new_diag( [ 1, 2, 3] ); my $str = "$matrix"; ok( $str eq $correct, 'stringification'); my $correct2=< 4; use File::Spec; use lib File::Spec->catfile("..","lib"); use Math::MatrixReal; use strict; do 'funcs.pl'; my $eps ||= 1e-8; my $matrix = Math::MatrixReal->new_from_string(<<"MATRIX"); [ 1 2 3 ] [ 4 5 6 ] [ 7 8 9 ] MATRIX my $submatrix1 = $matrix->new_from_rows([ [5,6], [8,9] ]); my $submatrix2 = $matrix->new_from_rows([ [5] ]); ok_matrix($submatrix1, $matrix->submatrix(2,2,3,3) , "submatrix"); ok_matrix($submatrix2, $matrix->submatrix(2,2,2,2) , "submatrix"); #print $matrix->submatrix(3,3,2,2); #ok_matrix($submatrix1, $matrix->submatrix(3,3,2,2) , "submatrix"); { assert_dies ( sub { $matrix->submatrix(0,1,2,3) } , q{indices must be > 0} ); } { assert_dies ( sub { $matrix->submatrix(1,1,2,-3) }, q{indices cannot be negative} ); } Math-MatrixReal-2.13/t/swap.t00044456105627002104 135112772016550 16247 0ustar00jonathanleto000000000000use Test::More tests => 2; use File::Spec; use lib File::Spec->catfile("..","lib"); use Math::MatrixReal; do 'funcs.pl'; $matrix = Math::MatrixReal->new_from_string(<<"MATRIX"); [ 1 0 0 0 ] [ 0 2 0 0 ] [ 0 0 3 0 ] [ 0 0 0 4 ] MATRIX $matrix14 = Math::MatrixReal->new_from_string(<<"MATRIX"); [ 0 0 0 4 ] [ 0 2 0 0 ] [ 0 0 3 0 ] [ 1 0 0 0 ] MATRIX $matrix14_col = Math::MatrixReal->new_from_string(<<"MATRIX"); [ 0 0 0 1 ] [ 0 2 0 0 ] [ 0 0 3 0 ] [ 4 0 0 0 ] MATRIX $matrix->swap_row(1,4); ok_matrix($matrix,$matrix14, 'swap_row works'); # back to orig $matrix = Math::MatrixReal->new_from_string(<<"MATRIX"); [ 1 0 0 0 ] [ 0 2 0 0 ] [ 0 0 3 0 ] [ 0 0 0 4 ] MATRIX $matrix->swap_col(1,4); ok_matrix($matrix,$matrix14_col, 'swap col works'); Math-MatrixReal-2.13/t/symmetric.t00044456105627002104 235012772016550 17311 0ustar00jonathanleto000000000000use Test::More tests => 8; use File::Spec; use lib File::Spec->catfile("..","lib"); use Math::MatrixReal; do 'funcs.pl'; $matrix = Math::MatrixReal->new_from_string(<<"MATRIX"); [ 1 0 0 0 1 ] [ 0 2 0 0 0 ] [ 0 0 3 0 0 ] [ 0 0 0 4 0 ] [ 1 0 0 0 5 ] MATRIX ok( $matrix->is_symmetric() ); ######################## $matrix = Math::MatrixReal->new_from_string(<<"MATRIX"); [ 0 2 0 0 1 ] [ 0 0 3 0 0 ] [ 0 0 0 4 0 ] [ 1 0 0 0 5 ] MATRIX ok(! $matrix->is_symmetric() ); ############################# $matrix = Math::MatrixReal->new_from_string(<is_symmetric(), '1x1 matrix is symmetric' ); ################ $matrix = $matrix->new_diag( [ 1, 2, 3, 4 ] ); ok( $matrix->is_skew_symmetric, 'diagonal matrix is skew symmetric' ); ok( $matrix->is_symmetric, 'diagonal matrix is symmetric' ); ########### $matrix = Math::MatrixReal->new_from_string(<<"MATRIX"); [ 1 0 0 0 1 ] [ 0 2 0 0 0 ] [ 0 0 3 0 0 ] [ 0 0 0 4 0 ] [ -1 0 0 0 5 ] MATRIX ok($matrix->is_skew_symmetric ); ########## $matrix->zero; ok($matrix->is_skew_symmetric, 'zero matrix is skey symmetric'); ############ $matrix = Math::MatrixReal->new_from_string(<<"MATRIX"); [ 0 2 0 0 1 ] [ 0 0 3 0 0 ] [ 0 0 0 4 0 ] [ 1 0 0 0 5 ] MATRIX ok(! $matrix->is_skew_symmetric ); Math-MatrixReal-2.13/t/trace.t00044456105627002104 221712772016550 16375 0ustar00jonathanleto000000000000use Test::More tests => 8; use File::Spec; use lib File::Spec->catfile("..","lib"); use Math::MatrixReal; do 'funcs.pl'; ############################### ## 2x2 inverse $matrix = Math::MatrixReal->new_from_string(<<"MATRIX"); [ 3.0 7.0 ] [ 2.0 5.0 ] MATRIX $inverse = Math::MatrixReal->new_from_string(<<"MATRIX"); [ 5.0 -7.0 ] [ -2.0 3.0 ] MATRIX my $b = Math::MatrixReal->new_random(20); my $c = Math::MatrixReal->new_random(20); my $randint = int(rand(50)); ok( similar( $matrix->trace() , 8), 'trace is correct' ); ok( similar($inverse->trace() , 8), 'trace is correct' ); $matrix->one(); ok( similar( $matrix->trace, 2), 'trace is correct' ); $matrix->zero(); ok( similar( $matrix->trace, 0), 'trace of zero matrix is 0' ); ok( similar( $b->trace, (~$b)->trace) , 'trace is conserved with respect to transpose' ); ok( similar( $randint*$b->trace, ($randint*$b)->trace) , 'trace is conserved with respect to scalar multiplication' ); ok( similar( ($c*$b)->trace, ($b*$c)->trace) , 'trace is conserved with respect to matrix multiplication' ); ok( similar( $c->trace + $b->trace, ($c + $b)->trace) , 'trace is conserved with respect to addition' ); Math-MatrixReal-2.13/t/transpose.t00044456105627002104 106312772016550 17313 0ustar00jonathanleto000000000000use Test::More tests => 4; use File::Spec; use lib File::Spec->catfile("..","lib"); use Math::MatrixReal; do 'funcs.pl'; $matrix = Math::MatrixReal->new_diag( [ 1, 2, 3 ] ); $matrix2 = Math::MatrixReal->new_random(10); ok_matrix(~$matrix, $matrix, 'transpose of a diagonal matrix is itself'); ok_matrix(~(~$matrix2), $matrix2, 'transpose twice = original' ); ok_matrix( ($matrix2 + ~$matrix2), ~($matrix2 + ~$matrix2), 'transpose commutes with addition' ); ok_matrix( ($matrix2 - ~$matrix2), -~($matrix2 - ~$matrix2), 'transpose commutes with subtraction' ); Math-MatrixReal-2.13/t/triang.t00044456105627002104 302212772016550 16556 0ustar00jonathanleto000000000000use Test::More tests => 10; use File::Spec; use lib File::Spec->catfile("..","lib"); use Math::MatrixReal; my $DEBUG = 0; do 'funcs.pl'; $matrix = Math::MatrixReal->new_from_string(<<"MATRIX"); [ 1 0 0 0 1 ] [ 0 2 0 0 2 ] [ 0 0 3 0 0 ] [ 0 0 0 4 0 ] [ 0 0 0 0 5 ] MATRIX ok( $matrix->is_upper_triangular(), 'is_upper_triangular seems to work' ); ######################## $matrix = Math::MatrixReal->new_from_string(<<"MATRIX"); [ 1 0 0 0 0 ] [ 0 3 0 0 0 ] [ 0 0 4 0 0 ] [ 1 0 0 5 0 ] [ 1 1 1 1 1 ] MATRIX ok($matrix->is_lower_triangular(), 'is_lower_triangular seems to work' ); ############################# $matrix = Math::MatrixReal->new_from_string(<is_upper_triangular(), 'row vecs cannot be triangular' ); ok( ! $matrix->is_lower_triangular(), 'row vecs cannot be triangular'); $matrix = Math::MatrixReal->new_from_string(<is_upper_triangular(), 'col vecs cannot be triangular' ); ok( ! $matrix->is_lower_triangular(), 'col vecs cannot be triangular'); $matrix = Math::MatrixReal->new_from_string(<<"MATRIX"); [ 1 0 0 0 1 ] [ 0 3 0 0 0 ] [ 0 0 4 0 0 ] [ 1 0 0 5 0 ] [ 1 1 1 1 1 ] MATRIX ok(! $matrix->is_lower_triangular() ); ok(! $matrix->is_upper_triangular() ); ################################ ## diag matrices are both! $matrix = Math::MatrixReal->new_diag( [ qw(1 2 4 5 5 45 45 5 4) ] ); ok($matrix->is_lower_triangular(), 'diagonal matrices are lower triangular' ); ok($matrix->is_upper_triangular(), 'diagonal matrices are upper triangular' ); Math-MatrixReal-2.13/t/tridiag.t00044456105627002104 261012772016550 16717 0ustar00jonathanleto000000000000use Test::More tests => 5; use File::Spec; use lib File::Spec->catfile("..","lib"); use Math::MatrixReal; use strict; do 'funcs.pl'; my $zero = sprintf '%E', 0; my ($pad) = $zero =~ /E00(\d+)$/; my $b = Math::MatrixReal->new_from_string(<new_tridiag( [1, 2, 3], [1, 2, 3, 4], [1, 2, 3] ); unless ($@){ ok(1, 'new_tridiag exists'); } else { ok(0, 'new_tridiag fails'); } ok( ref $a eq 'Math::MatrixReal', 'new_tridiag returns correct object' ); ok_matrix( $a, $b, 'new_tridiag seems to work' ); my ($r,$c) = $a->dim; ok( $r == 4 && $c == 4, 'new_tridiag returns a matrix of the correct size' ); my $matrix = Math::MatrixReal->new_tridiag( [ 6, 4, 2 ], [1,2,3,4], [1, 8, 9] ); my $correct = <<'MAT'; [ 1.000000000000E+00 1.000000000000E+00 0.000000000000E+00 0.000000000000E+00 ] [ 6.000000000000E+00 2.000000000000E+00 8.000000000000E+00 0.000000000000E+00 ] [ 0.000000000000E+00 4.000000000000E+00 3.000000000000E+00 9.000000000000E+00 ] [ 0.000000000000E+00 0.000000000000E+00 2.000000000000E+00 4.000000000000E+00 ] MAT # Determine number of digits in exponents beyond the libc 'standard' of two # and pad out the expected result. my $zero = sprintf '%E', 0; my ($pad) = $zero =~ m/E\+00(\d+)$/; $correct =~ s/([eE])([+-])(\d\d)/$1$2$pad$3/g if defined $pad; ok( "$matrix" eq $correct, 'new_tridiag' ); Math-MatrixReal-2.13/t/vecnorm.t00044456105627002104 121512772016550 16745 0ustar00jonathanleto000000000000use Test::More tests => 6; use File::Spec; use lib File::Spec->catfile("..","lib"); use Math::MatrixReal; do 'funcs.pl'; my ($a,$b); my $eps = 1e-6; $a = Math::MatrixReal->new_from_cols([[1,2,3]]); eval { @n = map { $a->norm_p($_) } qw(1 2 3 4 Inf); }; if($@) { ok(0,'norm_p doesn\'t seem to work'); } else { ok(1,'norm_p seems to work'); } ok(similar($n[0], 6, $eps),'one norm seems cool'); ok(similar($n[1],sqrt(14) , $eps), 'two norm feeling good' ); ok(similar($n[2], 6**(2/3) , $eps), 'three norm is happy' ); ok(similar($n[3], 2**(1/4)*sqrt(7), $eps), 'four norm is kosher' ); ok(similar($n[4], 3, $eps), 'infinity norm is mighty fine' ); Math-MatrixReal-2.13/t/yacas.t00044456105627002104 145312772016550 16400 0ustar00jonathanleto000000000000use Test::More tests => 2; use File::Spec; use lib File::Spec->catfile("..","lib"); use Math::MatrixReal; use strict; do 'funcs.pl'; my ($a,$b); $a = Math::MatrixReal->new_from_cols([[ 1.41E-05, 6.82E-06, 3.18E-06 ],[1,3,4]]); my $correct = '{{1.41e-05,1},{6.82e-06,3},{3.18e-06,4}}'; # Determine number of digits in exponents beyond the libc 'standard' of two # and pad out the expected result. my $zero = sprintf '%E', 0; my ($pad) = $zero =~ m/E\+00(\d+)$/; $correct =~ s/([eE])([+-])(\d\d)/$1$2$pad$3/g if defined $pad; ok($a->as_yacas eq $correct, 'as_yacas works' ); $b = Math::MatrixReal->new_from_cols([[ 1.234, 5.678, 9.1011],[1,2,3]] ); my $s = $b->as_yacas( ( format => "%.2f", align => "l",name => "A" ) ); ok( $s eq 'A := {{1.23,1.00},{5.68,2.00},{9.10,3.00}}', 'as_yacas formatting works' );