1# -*- mode: perl; coding: utf-8-unix -*-
2
3package Math::Matrix;
4
5use strict;
6use warnings;
7
8use Carp;
9use Scalar::Util 'blessed';
10
11our $VERSION = '0.94';
12our $eps = 0.00001;
13
14use overload
15
16  '+'  => sub {
17              my ($x, $y, $swap) = @_;
18              $x -> add($y);
19          },
20
21  '-'  => sub {
22              my ($x, $y, $swap) = @_;
23              if ($swap) {
24                  return $x -> neg() if !ref($y) && $y == 0;
25
26                  my $class = ref $x;
27                  return $class -> new($y) -> sub($x);
28              }
29              $x -> sub($y);
30          },
31
32  '*'  => sub {
33              my ($x, $y, $swap) = @_;
34              $x -> mul($y);
35          },
36
37  '**' => sub {
38              my ($x, $y, $swap) = @_;
39              if ($swap) {
40                  my $class = ref $x;
41                  return $class -> new($y) -> pow($x);
42              }
43              $x -> pow($y);
44          },
45
46  '==' => sub {
47              my ($x, $y, $swap) = @_;
48              $x -> meq($y);
49          },
50
51  '!=' => sub {
52              my ($x, $y, $swap) = @_;
53              $x -> mne($y);
54          },
55
56  'int' => sub {
57               my ($x, $y, $swap) = @_;
58               $x -> int();
59           },
60
61  'abs' => sub {
62               my ($x, $y, $swap) = @_;
63               $x -> abs();
64           },
65
66  '~'  => 'transpose',
67  '""' => 'as_string',
68  '='  => 'clone';
69
70=pod
71
72=encoding utf8
73
74=head1 NAME
75
76Math::Matrix - multiply and invert matrices
77
78=head1 SYNOPSIS
79
80    use Math::Matrix;
81
82    # Generate a random 3-by-3 matrix.
83    srand(time);
84    my $A = Math::Matrix -> new([rand, rand, rand],
85                                [rand, rand, rand],
86                                [rand, rand, rand]);
87    $A -> print("A\n");
88
89    # Append a fourth column to $A.
90    my $x = Math::Matrix -> new([rand, rand, rand]);
91    my $E = $A -> concat($x -> transpose);
92    $E -> print("Equation system\n");
93
94    # Compute the solution.
95    my $s = $E -> solve;
96    $s -> print("Solutions s\n");
97
98    # Verify that the solution equals $x.
99    $A -> multiply($s) -> print("A*s\n");
100
101=head1 DESCRIPTION
102
103This module implements various constructors and methods for creating and
104manipulating matrices.
105
106All methods return new objects, so, for example, C<$X-E<gt>add($Y)> does not
107modify C<$X>.
108
109    $X -> add($Y);         # $X not modified; output is lost
110    $X = $X -> add($Y);    # this works
111
112Some operators are overloaded (see L</OVERLOADING>) and allow the operand to be
113modified directly.
114
115    $X = $X + $Y;          # this works
116    $X += $Y;              # so does this
117
118=head1 METHODS
119
120=head2 Constructors
121
122=over 4
123
124=item new()
125
126Creates a new object from the input arguments and returns it.
127
128If a single input argument is given, and that argument is a reference to array
129whose first element is itself a reference to an array, it is assumed that the
130argument contains the whole matrix, like this:
131
132    $x = Math::Matrix->new([[1, 2, 3], [4, 5, 6]]); # 2-by-3 matrix
133    $x = Math::Matrix->new([[1, 2, 3]]);            # 1-by-3 matrix
134    $x = Math::Matrix->new([[1], [2], [3]]);        # 3-by-1 matrix
135
136If a single input argument is given, and that argument is not a reference to an
137array, a 1-by-1 matrix is returned.
138
139    $x = Math::Matrix->new(1);                      # 1-by-1 matrix
140
141Note that all the folling cases result in an empty matrix:
142
143    $x = Math::Matrix->new([[], [], []]);
144    $x = Math::Matrix->new([[]]);
145    $x = Math::Matrix->new([]);
146
147If C<L</new()>> is called as an instance method with no input arguments, a zero
148filled matrix with identical dimensions is returned:
149
150    $b = $a->new();     # $b is a zero matrix with the size of $a
151
152Each row must contain the same number of elements.
153
154=cut
155
156sub new {
157    my $that = shift;
158    my $class = ref($that) || $that;
159    my $self = [];
160
161    # If called as an instance method and no arguments are given, return a
162    # zero matrix of the same size as the invocand.
163
164    if (ref($that) && (@_ == 0)) {
165        @$self = map [ (0) x @$_ ], @$that;
166    }
167
168    # Otherwise return a new matrix based on the input arguments. The object
169    # data is a blessed reference to an array containing the matrix data. This
170    # array contains a list of arrays, one for each row, which in turn contains
171    # a list of elements. An empty matrix has no rows.
172    #
173    #   [[ 1, 2, 3 ], [ 4, 5, 6 ]]  2-by-3 matrix
174    #   [[ 1, 2, 3 ]]               1-by-3 matrix
175    #   [[ 1 ], [ 2 ], [ 3 ]]       3-by-1 matrix
176    #   [[ 1 ]]                     1-by-1 matrix
177    #   []                          empty matrix
178
179    else {
180
181        my $data;
182
183        # If there is a single argument, and that is not a reference,
184        # assume new() has been called as, e.g., $class -> new(3).
185
186        if (@_ == 1 && !ref($_[0])) {
187            $data = [[ $_[0] ]];
188        }
189
190        # If there is a single argument, and that is a reference to an array,
191        # and that array contains at least one element, and that element is
192        # itself a reference to an array, then assume new() has been called
193        # with the matrix as one argument, i.e., a reference to an array of
194        # arrays, e.g., $class -> new([ [1, 2], [3, 4] ]) ...
195
196        elsif (@_ == 1 && ref($_[0]) eq 'ARRAY'
197               && @{$_[0]} > 0 && ref($_[0][0]) eq 'ARRAY')
198        {
199            $data = $_[0];
200        }
201
202        # ... otherwise assume that each argument to new() is a row. Note that
203        # new() called with no arguments results in an empty matrix.
204
205        else {
206            $data = [ @_ ];
207        }
208
209        # Sanity checking.
210
211        if (@$data) {
212            my $nrow = @$data;
213            my $ncol;
214
215            for my $i (0 .. $nrow - 1) {
216                my $row = $data -> [$i];
217
218                # Verify that the row is a reference to an array.
219
220                croak "row with index $i is not a reference to an array"
221                  unless ref($row) eq 'ARRAY';
222
223                # In the first round, get the number of elements, i.e., the
224                # number of columns in the matrix. In the successive
225                # rounds, verify that each row has the same number of
226                # elements.
227
228                if ($i == 0) {
229                    $ncol = @$row;
230                } else {
231                    croak "each row must have the same number of elements"
232                      unless @$row == $ncol;
233                }
234            }
235
236            # Copy the data into $self only if the matrix is non-emtpy.
237
238            @$self = map [ @$_ ], @$data if $ncol;
239        }
240    }
241
242    bless $self, $class;
243}
244
245=pod
246
247=item new_from_sub()
248
249Creates a new matrix object by doing a subroutine call to create each element.
250
251    $sub = sub { ... };
252    $x = Math::Matrix -> new_from_sub($sub);          # 1-by-1
253    $x = Math::Matrix -> new_from_sub($sub, $m);      # $m-by-$m
254    $x = Math::Matrix -> new_from_sub($sub, $m, $n);  # $m-by-$n
255
256The subroutine is called in scalar context with two input arguments, the row and
257column indices of the element to be created. Note that no checks are performed
258on the output of the subroutine.
259
260Example 1, a 4-by-4 identity matrix can be created with
261
262    $sub = sub { $_[0] == $_[1] ? 1 : 0 };
263    $x = Math::Matrix -> new_from_sub($sub, 4);
264
265Example 2, the code
266
267    $x = Math::Matrix -> new_from_sub(sub { 2**$_[1] }, 1, 11);
268
269creates the following 1-by-11 vector with powers of two
270
271    [ 1, 2, 4, 8, 16, 32, 64, 128, 256, 512, 1024 ]
272
273Example 3, the code, using C<$i> and C<$j> for increased readability
274
275    $sub = sub {
276        ($i, $j) = @_;
277        $d = $j - $i;
278        return $d == -1 ? 5
279             : $d ==  0 ? 6
280             : $d ==  1 ? 7
281             : 0;
282    };
283    $x = Math::Matrix -> new_from_sub($sub, 5);
284
285creates the tridiagonal matrix
286
287    [ 6 7 0 0 0 ]
288    [ 5 6 7 0 0 ]
289    [ 0 5 6 7 0 ]
290    [ 0 0 5 6 7 ]
291    [ 0 0 0 5 6 ]
292
293=cut
294
295sub new_from_sub {
296    croak "Not enough arguments for ", (caller(0))[3] if @_ < 2;
297    croak "Too many arguments for ", (caller(0))[3] if @_ > 4;
298    my $class = shift;
299
300    croak +(caller(0))[3], " is a class method, not an instance method"
301      if ref $class;
302
303    my $sub = shift;
304    croak "The first input argument must be a code reference"
305      unless ref($sub) eq 'CODE';
306
307    my ($nrow, $ncol) = @_ == 0 ? (1, 1)
308                      : @_ == 1 ? (@_, @_)
309                      :           (@_);
310
311    my $x = bless [], $class;
312    for my $i (0 .. $nrow - 1) {
313        for my $j (0 .. $ncol - 1) {
314            $x -> [$i][$j] = $sub -> ($i, $j);
315        }
316    }
317
318    return $x;
319}
320
321=pod
322
323=item new_from_rows()
324
325Creates a new matrix by assuming each argument is a row vector.
326
327    $x = Math::Matrix -> new_from_rows($y, $z, ...);
328
329For example
330
331    $x = Math::Matrix -> new_from_rows([1, 2, 3],[4, 5, 6]);
332
333returns the matrix
334
335    [ 1 2 3 ]
336    [ 4 5 6 ]
337
338=cut
339
340sub new_from_rows {
341    croak "Not enough arguments for ", (caller(0))[3] if @_ < 1;
342    my $class = shift;
343
344    croak +(caller(0))[3], " is a class method, not an instance method"
345      if ref $class;
346
347    my @args = ();
348    for (my $i = 0 ; $i <= $#_ ; ++$i) {
349        my $x = $_[$i];
350        $x = $class -> new($x)
351          unless defined(blessed($x)) && $x -> isa($class);
352        if ($x -> is_vector()) {
353            push @args, $x -> to_row();
354        } else {
355            push @args, $x;
356        }
357    }
358
359    $class -> new([]) -> catrow(@args);
360}
361
362=pod
363
364=item new_from_cols()
365
366Creates a matrix by assuming each argument is a column vector.
367
368    $x = Math::Matrix -> new_from_cols($y, $z, ...);
369
370For example,
371
372    $x = Math::Matrix -> new_from_cols([1, 2, 3],[4, 5, 6]);
373
374returns the matrix
375
376    [ 1 4 ]
377    [ 2 5 ]
378    [ 3 6 ]
379
380=cut
381
382sub new_from_cols {
383    croak "Not enough arguments for ", (caller(0))[3] if @_ < 1;
384    my $class = shift;
385
386    croak +(caller(0))[3], " is a class method, not an instance method"
387      if ref $class;
388
389    $class -> new_from_rows(@_) -> swaprc();
390}
391
392=pod
393
394=item id()
395
396Returns a new identity matrix.
397
398    $I = Math::Matrix -> id($n);    # $n-by-$n identity matrix
399    $I = $x -> id($n);              # $n-by-$n identity matrix
400    $I = $x -> id();                # identity matrix with size of $x
401
402=cut
403
404sub id {
405    my $self = shift;
406    my $ref = ref $self;
407    my $class = $ref || $self;
408
409    my $n;
410    if (@_) {
411        $n = shift;
412    } else {
413        if ($ref) {
414            my ($mx, $nx) = $self -> size();
415            croak "When id() is called as an instance method, the invocand",
416              " must be a square matrix" unless $mx == $nx;
417            $n = $mx;
418        } else {
419            croak "When id() is called as a class method, the size must be",
420              " given as an input argument";
421        }
422    }
423
424    bless [ map [ (0) x ($_ - 1), 1, (0) x ($n - $_) ], 1 .. $n ], $class;
425}
426
427=pod
428
429=item new_identity()
430
431This is an alias for C<L</id()>>.
432
433=cut
434
435sub new_identity {
436    id(@_);
437}
438
439=pod
440
441=item eye()
442
443This is an alias for C<L</id()>>.
444
445=cut
446
447sub eye {
448    new_identity(@_);
449}
450
451=pod
452
453=item exchg()
454
455Exchange matrix.
456
457    $x = Math::Matrix -> exchg($n);     # $n-by-$n exchange matrix
458
459=cut
460
461sub exchg {
462    croak "Not enough arguments for ", (caller(0))[3] if @_ < 2;
463    croak "Too many arguments for ", (caller(0))[3] if @_ > 2;
464    my $class = shift;
465
466    my $n = shift;
467    bless [ map [ (0) x ($n - $_), 1, (0) x ($_ - 1) ], 1 .. $n ], $class;
468}
469
470=pod
471
472=item scalar()
473
474Returns a scalar matrix, i.e., a diagonal matrix with all the diagonal elements
475set to the same value.
476
477    # Create an $m-by-$m scalar matrix where each element is $c.
478    $x = Math::Matrix -> scalar($c, $m);
479
480    # Create an $m-by-$n scalar matrix where each element is $c.
481    $x = Math::Matrix -> scalar($c, $m, $n);
482
483Multiplying a matrix A by a scalar matrix B is effectively the same as multiply
484each element in A by the constant on the diagonal of B.
485
486=cut
487
488sub scalar {
489    croak "Not enough arguments for ", (caller(0))[3] if @_ < 2;
490    croak "Too many arguments for ", (caller(0))[3] if @_ > 4;
491    my $class = shift;
492
493    croak +(caller(0))[3], " is a class method, not an instance method"
494      if ref $class;
495
496    my $c = shift;
497    my ($m, $n) = @_ == 0 ? (1, 1)
498                : @_ == 1 ? (@_, @_)
499                :           (@_);
500    croak "The number of rows must be equal to the number of columns"
501      unless $m == $n;
502
503    bless [ map [ (0) x ($_ - 1), $c, (0) x ($n - $_) ], 1 .. $m ], $class;
504}
505
506=pod
507
508=item zeros()
509
510Create a zero matrix.
511
512    # Create an $m-by-$m matrix where each element is 0.
513    $x = Math::Matrix -> zeros($m);
514
515    # Create an $m-by-$n matrix where each element is 0.
516    $x = Math::Matrix -> zeros($m, $n);
517
518=cut
519
520sub zeros {
521    croak "Not enough arguments for ", (caller(0))[3] if @_ < 1;
522    croak "Too many arguments for ", (caller(0))[3] if @_ > 3;
523    my $self = shift;
524    $self -> constant(0, @_);
525};
526
527=pod
528
529=item ones()
530
531Create a matrix of ones.
532
533    # Create an $m-by-$m matrix where each element is 1.
534    $x = Math::Matrix -> ones($m);
535
536    # Create an $m-by-$n matrix where each element is 1.
537    $x = Math::Matrix -> ones($m, $n);
538
539=cut
540
541sub ones {
542    croak "Not enough arguments for ", (caller(0))[3] if @_ < 1;
543    croak "Too many arguments for ", (caller(0))[3] if @_ > 3;
544    my $self = shift;
545    $self -> constant(1, @_);
546};
547
548=pod
549
550=item inf()
551
552Create a matrix of positive infinities.
553
554    # Create an $m-by-$m matrix where each element is Inf.
555    $x = Math::Matrix -> inf($m);
556
557    # Create an $m-by-$n matrix where each element is Inf.
558    $x = Math::Matrix -> inf($m, $n);
559
560=cut
561
562sub inf {
563    croak "Not enough arguments for ", (caller(0))[3] if @_ < 1;
564    croak "Too many arguments for ", (caller(0))[3] if @_ > 3;
565    my $self = shift;
566
567    require Math::Trig;
568    my $inf = Math::Trig::Inf();
569    $self -> constant($inf, @_);
570};
571
572=pod
573
574=item nan()
575
576Create a matrix of NaNs (Not-a-Number).
577
578    # Create an $m-by-$m matrix where each element is NaN.
579    $x = Math::Matrix -> nan($m);
580
581    # Create an $m-by-$n matrix where each element is NaN.
582    $x = Math::Matrix -> nan($m, $n);
583
584=cut
585
586sub nan {
587    croak "Not enough arguments for ", (caller(0))[3] if @_ < 1;
588    croak "Too many arguments for ", (caller(0))[3] if @_ > 3;
589    my $self = shift;
590
591    require Math::Trig;
592    my $inf = Math::Trig::Inf();
593    my $nan = $inf - $inf;
594    $self -> constant($nan, @_);
595};
596
597=pod
598
599=item constant()
600
601Returns a constant matrix, i.e., a matrix whose elements all have the same
602value.
603
604    # Create an $m-by-$m matrix where each element is $c.
605    $x = Math::Matrix -> constant($c, $m);
606
607    # Create an $m-by-$n matrix where each element is $c.
608    $x = Math::Matrix -> constant($c, $m, $n);
609
610=cut
611
612sub constant {
613    croak "Not enough arguments for ", (caller(0))[3] if @_ < 2;
614    croak "Too many arguments for ", (caller(0))[3] if @_ > 4;
615    my $class = shift;
616
617    croak +(caller(0))[3], " is a class method, not an instance method"
618      if ref $class;
619
620    my $c = shift;
621    my ($m, $n) = @_ == 0 ? (1, 1)
622                : @_ == 1 ? (@_, @_)
623                :           (@_);
624
625    bless [ map [ ($c) x $n ], 1 .. $m ], $class;
626}
627
628=pod
629
630=item rand()
631
632Returns a matrix of uniformly distributed random numbers in the range [0,1).
633
634    $x = Math::Matrix -> rand($m);          # $m-by-$m matrix
635    $x = Math::Matrix -> rand($m, $n);      # $m-by-$n matrix
636
637To generate an C<$m>-by-C<$n> matrix of uniformly distributed random numbers in
638the range [0,C<$a>), use
639
640    $x = $a * Math::Matrix -> rand($m, $n);
641
642To generate an C<$m>-by-C<$n> matrix of uniformly distributed random numbers in
643the range [C<$a>,C<$b>), use
644
645    $x = $a + ($b - $a) * Math::Matrix -> rand($m, $n);
646
647See also C<L</randi()>> and C<L</randn()>>.
648
649=cut
650
651sub rand {
652    croak "Not enough arguments for ", (caller(0))[3] if @_ < 1;
653    croak "Too many arguments for ", (caller(0))[3] if @_ > 3;
654    my $class = shift;
655
656    croak +(caller(0))[3], " is a class method, not an instance method"
657      if ref $class;
658
659    my ($nrow, $ncol) = @_ == 0 ? (1, 1)
660                      : @_ == 1 ? (@_, @_)
661                      :           (@_);
662
663    my $x = bless [], $class;
664    for my $i (0 .. $nrow - 1) {
665        for my $j (0 .. $ncol - 1) {
666            $x -> [$i][$j] = CORE::rand;
667        }
668    }
669
670    return $x;
671}
672
673=pod
674
675=item randi()
676
677Returns a matrix of uniformly distributed random integers.
678
679    $x = Math::Matrix -> randi($max);                 # 1-by-1 matrix
680    $x = Math::Matrix -> randi($max, $n);             # $n-by-$n matrix
681    $x = Math::Matrix -> randi($max, $m, $n);         # $m-by-$n matrix
682
683    $x = Math::Matrix -> randi([$min, $max]);         # 1-by-1 matrix
684    $x = Math::Matrix -> randi([$min, $max], $n);     # $n-by-$n matrix
685    $x = Math::Matrix -> randi([$min, $max], $m, $n); # $m-by-$n matrix
686
687See also C<L</rand()>> and C<L</randn()>>.
688
689=cut
690
691sub randi {
692    croak "Not enough arguments for ", (caller(0))[3] if @_ < 2;
693    croak "Too many arguments for ", (caller(0))[3] if @_ > 4;
694    my $class = shift;
695
696    croak +(caller(0))[3], " is a class method, not an instance method"
697      if ref $class;
698
699    my ($min, $max);
700    my $lim = shift;
701    if (ref($lim) eq 'ARRAY') {
702        ($min, $max) = @$lim;
703    } else {
704        $min = 0;
705        $max = $lim;
706    }
707
708    my ($nrow, $ncol) = @_ == 0 ? (1, 1)
709                      : @_ == 1 ? (@_, @_)
710                      :           (@_);
711
712    my $c = $max - $min + 1;
713    my $x = bless [], $class;
714    for my $i (0 .. $nrow - 1) {
715        for my $j (0 .. $ncol - 1) {
716            $x -> [$i][$j] = $min + CORE::int(CORE::rand($c));
717        }
718    }
719
720    return $x;
721}
722
723=pod
724
725=item randn()
726
727Returns a matrix of random numbers from the standard normal distribution.
728
729    $x = Math::Matrix -> randn($m);         # $m-by-$m matrix
730    $x = Math::Matrix -> randn($m, $n);     # $m-by-$n matrix
731
732To generate an C<$m>-by-C<$n> matrix with mean C<$mu> and standard deviation
733C<$sigma>, use
734
735    $x = $mu + $sigma * Math::Matrix -> randn($m, $n);
736
737See also C<L</rand()>> and C<L</randi()>>.
738
739=cut
740
741sub randn {
742    croak "Not enough arguments for ", (caller(0))[3] if @_ < 1;
743    croak "Too many arguments for ", (caller(0))[3] if @_ > 3;
744    my $class = shift;
745
746    croak +(caller(0))[3], " is a class method, not an instance method"
747      if ref $class;
748
749    my ($nrow, $ncol) = @_ == 0 ? (1, 1)
750                      : @_ == 1 ? (@_, @_)
751                      :           (@_);
752
753    my $nelm  = $nrow * $ncol;
754    my $twopi = 2 * atan2 0, -1;
755
756    # The following might generate one value more than we need.
757
758    my $x = [];
759    for (my $k = 0 ; $k < $nelm ; $k += 2) {
760        my $c1 = sqrt(-2 * log(CORE::rand));
761        my $c2 = $twopi * CORE::rand;
762        push @$x, $c1 * cos($c2), $c1 * sin($c2);
763    }
764    pop @$x if @$x > $nelm;
765
766    $x = bless [ $x ], $class;
767    $x -> reshape($nrow, $ncol);
768}
769
770=pod
771
772=item clone()
773
774Clones a matrix and returns the clone.
775
776    $b = $a->clone;
777
778=cut
779
780sub clone {
781    croak "Too many arguments for ", (caller(0))[3] if @_ > 1;
782    my $x = shift;
783    my $class = ref $x;
784
785    croak +(caller(0))[3], " is an instance method, not a class method"
786      unless $class;
787
788    my $y = [ map [ @$_ ], @$x ];
789    bless $y, $class;
790}
791
792=pod
793
794=item diagonal()
795
796A constructor method that creates a diagonal matrix from a single list or array
797of numbers.
798
799    $p = Math::Matrix->diagonal(1, 4, 4, 8);
800    $q = Math::Matrix->diagonal([1, 4, 4, 8]);
801
802The matrix is zero filled except for the diagonal members, which take the
803values of the vector.
804
805The method returns B<undef> in case of error.
806
807=cut
808
809#
810# Either class or object call, create a square matrix with the same
811# dimensions as the passed-in list or array.
812#
813sub diagonal {
814    my $that = shift;
815    my $class = ref($that) || $that;
816    my @diag = @_;
817    my $self = [];
818
819    # diagonal([2,3]) -> diagonal(2,3)
820    @diag = @{$diag[0]} if (ref $diag[0] eq "ARRAY");
821
822    my $len = scalar @diag;
823    return undef if ($len == 0);
824
825    for my $idx (0..$len-1) {
826        my @r = (0) x $len;
827        $r[$idx] = $diag[$idx];
828        push(@{$self}, [@r]);
829    }
830    bless $self, $class;
831}
832
833=pod
834
835=item tridiagonal()
836
837A constructor method that creates a matrix from vectors of numbers.
838
839    $p = Math::Matrix->tridiagonal([1, 4, 4, 8]);
840    $q = Math::Matrix->tridiagonal([1, 4, 4, 8], [9, 12, 15]);
841    $r = Math::Matrix->tridiagonal([1, 4, 4, 8], [9, 12, 15], [4, 3, 2]);
842
843In the first case, the main diagonal takes the values of the vector, while both
844of the upper and lower diagonals's values are all set to one.
845
846In the second case, the main diagonal takes the values of the first vector,
847while the upper and lower diagonals are each set to the values of the second
848vector.
849
850In the third case, the main diagonal takes the values of the first vector,
851while the upper diagonal is set to the values of the second vector, and the
852lower diagonal is set to the values of the third vector.
853
854The method returns B<undef> in case of error.
855
856=cut
857
858#
859# Either class or object call, create a square matrix with the same
860# dimensions as the passed-in list or array.
861#
862sub tridiagonal {
863    my $that = shift;
864    my $class = ref($that) || $that;
865    my(@up_d, @main_d, @low_d);
866    my $self = [];
867
868    #
869    # Handle the different ways the tridiagonal vectors could
870    # be passed in.
871    #
872    if (ref $_[0] eq "ARRAY") {
873        @main_d = @{$_[0]};
874
875        if (ref $_[1] eq "ARRAY") {
876            @up_d = @{$_[1]};
877
878            if (ref $_[2] eq "ARRAY") {
879                @low_d = @{$_[2]};
880            }
881        }
882    } else {
883        @main_d = @_;
884    }
885
886    my $len = scalar @main_d;
887    return undef if ($len == 0);
888
889    #
890    # Default the upper and lower diagonals if no vector
891    # was passed in for them.
892    #
893    @up_d = (1) x ($len -1) if (scalar @up_d == 0);
894    @low_d = @up_d if (scalar @low_d == 0);
895
896    #
897    # First row...
898    #
899    my @arow = (0) x $len;
900    @arow[0..1] = ($main_d[0], $up_d[0]);
901    push (@{$self}, [@arow]);
902
903    #
904    # Bulk of the matrix...
905    #
906    for my $idx (1 .. $#main_d - 1) {
907        my @r = (0) x $len;
908        @r[$idx-1 .. $idx+1] = ($low_d[$idx-1], $main_d[$idx], $up_d[$idx]);
909        push (@{$self}, [@r]);
910    }
911
912    #
913    # Last row.
914    #
915    my @zrow = (0) x $len;
916    @zrow[$len-2..$len-1] = ($low_d[$#main_d -1], $main_d[$#main_d]);
917    push (@{$self}, [@zrow]);
918
919    bless $self, $class;
920}
921
922=pod
923
924=item blkdiag()
925
926Create block diagonal matrix. Returns a block diagonal matrix given a list of
927matrices.
928
929    $z = Math::Matrix -> blkdiag($x, $y, ...);
930
931=cut
932
933sub blkdiag {
934    croak "Not enough arguments for ", (caller(0))[3] if @_ < 1;
935    #croak "Too many arguments for ", (caller(0))[3] if @_ > 1;
936    my $class = shift;
937
938    my $y = [];
939    my $nrowy = 0;
940    my $ncoly = 0;
941
942    for my $i (0 .. $#_) {
943        my $x = $_[$i];
944
945        $x = $class -> new($x)
946          unless defined(blessed($x)) && $x -> isa($class);
947
948        my ($nrowx, $ncolx) = $x -> size();
949
950        # Upper right submatrix.
951
952        for my $i (0 .. $nrowy - 1) {
953            for my $j (0 .. $ncolx - 1) {
954                $y -> [$i][$ncoly + $j] = 0;
955            }
956        }
957
958        # Lower left submatrix.
959
960        for my $i (0 .. $nrowx - 1) {
961            for my $j (0 .. $ncoly - 1) {
962                $y -> [$nrowy + $i][$j] = 0;
963            }
964        }
965
966        # Lower right submatrix.
967
968        for my $i (0 .. $nrowx - 1) {
969            for my $j (0 .. $ncolx - 1) {
970                $y -> [$nrowy + $i][$ncoly + $j] = $x -> [$i][$j];
971            }
972        }
973
974        $nrowy += $nrowx;
975        $ncoly += $ncolx;
976    }
977
978    bless $y, $class;
979}
980
981=pod
982
983=back
984
985=head2 Identify matrices
986
987=over 4
988
989=item is_empty()
990
991Returns 1 is the invocand is empty, i.e., it has no elements.
992
993    $bool = $x -> is_empty();
994
995=cut
996
997sub is_empty {
998    croak "Not enough arguments for ", (caller(0))[3] if @_ < 1;
999    croak "Too many arguments for ", (caller(0))[3] if @_ > 1;
1000    my $x = shift;
1001    return $x -> nelm() == 0;
1002}
1003
1004=pod
1005
1006=item is_scalar()
1007
1008Returns 1 is the invocand is a scalar, i.e., it has one element.
1009
1010    $bool = $x -> is_scalar();
1011
1012=cut
1013
1014sub is_scalar {
1015    croak "Not enough arguments for ", (caller(0))[3] if @_ < 1;
1016    croak "Too many arguments for ", (caller(0))[3] if @_ > 1;
1017    my $x = shift;
1018    return $x -> nelm() == 1 ? 1 : 0;
1019}
1020
1021=pod
1022
1023=item is_vector()
1024
1025Returns 1 is the invocand is a vector, i.e., a row vector or a column vector.
1026
1027    $bool = $x -> is_vector();
1028
1029=cut
1030
1031sub is_vector {
1032    croak "Not enough arguments for ", (caller(0))[3] if @_ < 1;
1033    croak "Too many arguments for ", (caller(0))[3] if @_ > 1;
1034    my $x = shift;
1035    return $x -> is_col() || $x -> is_row() ? 1 : 0;
1036}
1037
1038=pod
1039
1040=item is_row()
1041
1042Returns 1 if the invocand has exactly one row, and 0 otherwise.
1043
1044    $bool = $x -> is_row();
1045
1046=cut
1047
1048sub is_row {
1049    croak "Not enough arguments for ", (caller(0))[3] if @_ < 1;
1050    croak "Too many arguments for ", (caller(0))[3] if @_ > 1;
1051    my $x = shift;
1052    return $x -> nrow() == 1 ? 1 : 0;
1053}
1054
1055=pod
1056
1057=item is_col()
1058
1059Returns 1 if the invocand has exactly one column, and 0 otherwise.
1060
1061    $bool = $x -> is_col();
1062
1063=cut
1064
1065sub is_col {
1066    croak "Not enough arguments for ", (caller(0))[3] if @_ < 1;
1067    croak "Too many arguments for ", (caller(0))[3] if @_ > 1;
1068    my $x = shift;
1069    return $x -> ncol() == 1 ? 1 : 0;
1070}
1071
1072=pod
1073
1074=item is_square()
1075
1076Returns 1 is the invocand is square, and 0 otherwise.
1077
1078    $bool = $x -> is_square();
1079
1080=cut
1081
1082sub is_square {
1083    croak "Not enough arguments for ", (caller(0))[3] if @_ < 1;
1084    croak "Too many arguments for ", (caller(0))[3] if @_ > 1;
1085    my $x = shift;
1086    my ($nrow, $ncol) = $x -> size();
1087    return $nrow == $ncol ? 1 : 0;
1088}
1089
1090=pod
1091
1092=item is_symmetric()
1093
1094Returns 1 is the invocand is symmetric, and 0 otherwise.
1095
1096    $bool = $x -> is_symmetric();
1097
1098An symmetric matrix satisfies x(i,j) = x(j,i) for all i and j, for example
1099
1100    [  1  2 -3 ]
1101    [  2 -4  5 ]
1102    [ -3  5  6 ]
1103
1104=cut
1105
1106sub is_symmetric {
1107    croak "Not enough arguments for ", (caller(0))[3] if @_ < 1;
1108    croak "Too many arguments for ", (caller(0))[3] if @_ > 1;
1109    my $x = shift;
1110
1111    my ($nrow, $ncol) = $x -> size();
1112    return 0 unless $nrow == $ncol;
1113
1114    for my $i (1 .. $nrow - 1) {
1115        for my $j (0 .. $i - 1) {
1116            return 0 unless $x -> [$i][$j] == $x -> [$j][$i];
1117        }
1118    }
1119
1120    return 1;
1121}
1122
1123=pod
1124
1125=item is_antisymmetric()
1126
1127Returns 1 is the invocand is antisymmetric a.k.a. skew-symmetric, and 0
1128otherwise.
1129
1130    $bool = $x -> is_antisymmetric();
1131
1132An antisymmetric matrix satisfies x(i,j) = -x(j,i) for all i and j, for
1133example
1134
1135    [  0  2 -3 ]
1136    [ -2  0  4 ]
1137    [  3 -4  0 ]
1138
1139=cut
1140
1141sub is_antisymmetric {
1142    croak "Not enough arguments for ", (caller(0))[3] if @_ < 1;
1143    croak "Too many arguments for ", (caller(0))[3] if @_ > 1;
1144    my $x = shift;
1145
1146    my ($nrow, $ncol) = $x -> size();
1147    return 0 unless $nrow == $ncol;
1148
1149    # Check the diagonal.
1150
1151    for my $i (0 .. $nrow - 1) {
1152        return 0 unless $x -> [$i][$i] == 0;
1153    }
1154
1155    # Check the off-diagonal.
1156
1157    for my $i (1 .. $nrow - 1) {
1158        for my $j (0 .. $i - 1) {
1159            return 0 unless $x -> [$i][$j] == -$x -> [$j][$i];
1160        }
1161    }
1162
1163    return 1;
1164}
1165
1166=pod
1167
1168=item is_persymmetric()
1169
1170Returns 1 is the invocand is persymmetric, and 0 otherwise.
1171
1172    $bool = $x -> is_persymmetric();
1173
1174A persymmetric matrix is a square matrix which is symmetric with respect to the
1175anti-diagonal, e.g.:
1176
1177    [ f  h  j  k ]
1178    [ c  g  i  j ]
1179    [ b  d  g  h ]
1180    [ a  b  c  f ]
1181
1182=cut
1183
1184sub is_persymmetric {
1185    croak "Not enough arguments for ", (caller(0))[3] if @_ < 1;
1186    croak "Too many arguments for ", (caller(0))[3] if @_ > 1;
1187    my $x = shift;
1188
1189    $x -> fliplr() -> is_symmetric();
1190}
1191
1192=pod
1193
1194=item is_hankel()
1195
1196Returns 1 is the invocand is a Hankel matric a.k.a. a catalecticant matrix, and
11970 otherwise.
1198
1199    $bool = $x -> is_hankel();
1200
1201A Hankel matrix is a square matrix in which each ascending skew-diagonal from
1202left to right is constant, e.g.:
1203
1204    [ e f g h i ]
1205    [ d e f g h ]
1206    [ c d e f g ]
1207    [ b c d e f ]
1208    [ a b c d e ]
1209
1210=cut
1211
1212sub is_hankel {
1213    croak "Not enough arguments for ", (caller(0))[3] if @_ < 1;
1214    croak "Too many arguments for ", (caller(0))[3] if @_ > 1;
1215    my $x = shift;
1216
1217    my ($nrow, $ncol) = $x -> size();
1218    return 0 unless $nrow == $ncol;
1219
1220    # Check the lower triangular part.
1221
1222    for my $i (0 .. $nrow - 2) {
1223        my $first = $x -> [$i][0];
1224        for my $k (1 .. $nrow - $i - 1) {
1225            return 0 unless $x -> [$i + $k][$k] == $first;
1226        }
1227    }
1228
1229    # Check the strictly upper triangular part.
1230
1231    for my $j (1 .. $ncol - 2) {
1232        my $first = $x -> [0][$j];
1233        for my $k (1 .. $nrow - $j - 1) {
1234            return 0 unless $x -> [$k][$j + $k] == $first;
1235        }
1236    }
1237
1238    return 1;
1239}
1240
1241=pod
1242
1243=item is_zero()
1244
1245Returns 1 is the invocand is a zero matrix, and 0 otherwise. A zero matrix
1246contains no element whose value is different from zero.
1247
1248    $bool = $x -> is_zero();
1249
1250=cut
1251
1252sub is_zero {
1253    croak "Not enough arguments for ", (caller(0))[3] if @_ < 1;
1254    croak "Too many arguments for ", (caller(0))[3] if @_ > 1;
1255    my $x = shift;
1256    return $x -> is_constant(0);
1257}
1258
1259=pod
1260
1261=item is_one()
1262
1263Returns 1 is the invocand is a matrix of ones, and 0 otherwise. A matrix of
1264ones contains no element whose value is different from one.
1265
1266    $bool = $x -> is_one();
1267
1268=cut
1269
1270sub is_one {
1271    croak "Not enough arguments for ", (caller(0))[3] if @_ < 1;
1272    croak "Too many arguments for ", (caller(0))[3] if @_ > 1;
1273    my $x = shift;
1274    return $x -> is_constant(1);
1275}
1276
1277=pod
1278
1279=item is_constant()
1280
1281Returns 1 is the invocand is a constant matrix, and 0 otherwise. A constant
1282matrix is a matrix where no two elements have different values.
1283
1284    $bool = $x -> is_constant();
1285
1286=cut
1287
1288sub is_constant {
1289    croak "Not enough arguments for ", (caller(0))[3] if @_ < 1;
1290    croak "Too many arguments for ", (caller(0))[3] if @_ > 2;
1291    my $x = shift;
1292
1293    my ($nrow, $ncol) = $x -> size();
1294
1295    # An empty matrix contains no elements that are different from $c.
1296
1297    return 1 if $nrow * $ncol == 0;
1298
1299    my $c = @_ ? shift() : $x -> [0][0];
1300    for my $i (0 .. $nrow - 1) {
1301        for my $j (0 .. $ncol - 1) {
1302            return 0 if $x -> [$i][$j] != $c;
1303        }
1304    }
1305
1306    return 1;
1307}
1308
1309=pod
1310
1311=item is_identity()
1312
1313Returns 1 is the invocand is an identity matrix, and 0 otherwise. An
1314identity matrix contains ones on the main diagonal and zeros elsewhere.
1315
1316    $bool = $x -> is_identity();
1317
1318=cut
1319
1320sub is_identity {
1321    croak "Not enough arguments for ", (caller(0))[3] if @_ < 1;
1322    croak "Too many arguments for ", (caller(0))[3] if @_ > 1;
1323    my $x = shift;
1324
1325    my ($nrow, $ncol) = $x -> size();
1326    return 0 unless $nrow == $ncol;
1327
1328    for my $i (0 .. $nrow - 1) {
1329        for my $j (0 .. $ncol - 1) {
1330            return 0 if $x -> [$i][$j] != ($i == $j ? 1 : 0);
1331        }
1332    }
1333
1334    return 1;
1335}
1336
1337=pod
1338
1339=item is_exchg()
1340
1341Returns 1 is the invocand is an exchange matrix, and 0 otherwise.
1342
1343    $bool = $x -> is_exchg();
1344
1345An exchange matrix contains ones on the main anti-diagonal and zeros elsewhere,
1346for example
1347
1348    [ 0 0 1 ]
1349    [ 0 1 0 ]
1350    [ 1 0 0 ]
1351
1352=cut
1353
1354sub is_exchg {
1355    croak "Not enough arguments for ", (caller(0))[3] if @_ < 1;
1356    croak "Too many arguments for ", (caller(0))[3] if @_ > 1;
1357    my $x = shift;
1358
1359    my ($nrow, $ncol) = $x -> size();
1360    return 0 unless $nrow == $ncol;
1361
1362    my $imax = $nrow - 1;
1363    for my $i (0 .. $nrow - 1) {
1364        for my $j (0 .. $ncol - 1) {
1365            return 0 if $x -> [$i][$j] != ($i + $j == $imax ? 1 : 0);
1366        }
1367    }
1368
1369    return 1;
1370}
1371
1372=pod
1373
1374=item is_bool()
1375
1376Returns 1 is the invocand is a boolean matrix, and 0 otherwise.
1377
1378    $bool = $x -> is_bool();
1379
1380A boolean matrix is a matrix is a matrix whose entries are either 0 or 1, for
1381example
1382
1383    [ 0 1 1 ]
1384    [ 1 0 0 ]
1385    [ 0 1 0 ]
1386
1387=cut
1388
1389sub is_bool {
1390    croak "Not enough arguments for ", (caller(0))[3] if @_ < 1;
1391    croak "Too many arguments for ", (caller(0))[3] if @_ > 1;
1392    my $x = shift;
1393
1394    my ($nrow, $ncol) = $x -> size();
1395
1396    for my $i (0 .. $nrow - 1) {
1397        for my $j (0 .. $ncol - 1) {
1398            my $val = $x -> [$i][$j];
1399            return 0 if $val != 0 && $val != 1;
1400        }
1401    }
1402
1403    return 1;
1404}
1405
1406=pod
1407
1408=item is_perm()
1409
1410Returns 1 is the invocand is an permutation matrix, and 0 otherwise.
1411
1412    $bool = $x -> is_perm();
1413
1414A permutation matrix is a square matrix with exactly one 1 in each row and
1415column, and all other elements 0, for example
1416
1417    [ 0 1 0 ]
1418    [ 1 0 0 ]
1419    [ 0 0 1 ]
1420
1421=cut
1422
1423sub is_perm {
1424    croak "Not enough arguments for ", (caller(0))[3] if @_ < 1;
1425    croak "Too many arguments for ", (caller(0))[3] if @_ > 1;
1426    my $x = shift;
1427
1428    my ($nrow, $ncol) = $x -> size();
1429    return 0 unless $nrow == $ncol;
1430
1431    my $rowsum = [ (0) x $nrow ];
1432    my $colsum = [ (0) x $ncol ];
1433
1434    for my $i (0 .. $nrow - 1) {
1435        for my $j (0 .. $ncol - 1) {
1436            my $val = $x -> [$i][$j];
1437            return 0 if $val != 0 && $val != 1;
1438            if ($val == 1) {
1439                return 0 if ++$rowsum -> [$i] > 1;
1440                return 0 if ++$colsum -> [$j] > 1;
1441            }
1442        }
1443    }
1444
1445    for my $i (0 .. $nrow - 1) {
1446        return 0 if $rowsum -> [$i] != 1;
1447        return 0 if $colsum -> [$i] != 1;
1448    }
1449
1450    return 1;
1451}
1452
1453=pod
1454
1455=item is_int()
1456
1457Returns 1 is the invocand is an integer matrix, i.e., a matrix of integers, and
14580 otherwise.
1459
1460    $bool = $x -> is_int();
1461
1462=cut
1463
1464sub is_int {
1465    croak "Not enough arguments for ", (caller(0))[3] if @_ < 1;
1466    croak "Too many arguments for ", (caller(0))[3] if @_ > 1;
1467    my $x = shift;
1468
1469    my ($nrow, $ncol) = $x -> size();
1470
1471    for my $i (0 .. $nrow - 1) {
1472        for my $j (0 .. $ncol - 1) {
1473            return 0 unless $x -> [$i][$j] == int $x -> [$i][$j];
1474        }
1475    }
1476
1477    return 1;
1478}
1479
1480=pod
1481
1482=item is_diag()
1483
1484Returns 1 is the invocand is diagonal, and 0 otherwise.
1485
1486    $bool = $x -> is_diag();
1487
1488A diagonal matrix is a square matrix where all non-zero elements, if any, are on
1489the main diagonal. It has the following pattern, where only the elements marked
1490as C<x> can be non-zero,
1491
1492    [ x 0 0 0 0 ]
1493    [ 0 x 0 0 0 ]
1494    [ 0 0 x 0 0 ]
1495    [ 0 0 0 x 0 ]
1496    [ 0 0 0 0 x ]
1497
1498=cut
1499
1500sub is_diag {
1501    croak "Not enough arguments for ", (caller(0))[3] if @_ < 1;
1502    croak "Too many arguments for ", (caller(0))[3] if @_ > 1;
1503    my $x = shift;
1504    $x -> is_band(0);
1505}
1506
1507=pod
1508
1509=item is_adiag()
1510
1511Returns 1 is the invocand is anti-diagonal, and 0 otherwise.
1512
1513    $bool = $x -> is_adiag();
1514
1515A diagonal matrix is a square matrix where all non-zero elements, if any, are on
1516the main antidiagonal. It has the following pattern, where only the elements
1517marked as C<x> can be non-zero,
1518
1519    [ 0 0 0 0 x ]
1520    [ 0 0 0 x 0 ]
1521    [ 0 0 x 0 0 ]
1522    [ 0 x 0 0 0 ]
1523    [ x 0 0 0 0 ]
1524
1525=cut
1526
1527sub is_adiag {
1528    croak "Not enough arguments for ", (caller(0))[3] if @_ < 1;
1529    croak "Too many arguments for ", (caller(0))[3] if @_ > 1;
1530    my $x = shift;
1531    $x -> is_aband(0);
1532}
1533
1534=pod
1535
1536=item is_tridiag()
1537
1538Returns 1 is the invocand is tridiagonal, and 0 otherwise.
1539
1540    $bool = $x -> is_tridiag();
1541
1542A tridiagonal matrix is a square matrix with nonzero elements only on the
1543diagonal and slots horizontally or vertically adjacent the diagonal (i.e., along
1544the subdiagonal and superdiagonal). It has the following pattern, where only the
1545elements marked as C<x> can be non-zero,
1546
1547    [ x x 0 0 0 ]
1548    [ x x x 0 0 ]
1549    [ 0 x x x 0 ]
1550    [ 0 0 x x x ]
1551    [ 0 0 0 x x ]
1552
1553=cut
1554
1555sub is_tridiag {
1556    croak "Not enough arguments for ", (caller(0))[3] if @_ < 1;
1557    croak "Too many arguments for ", (caller(0))[3] if @_ > 1;
1558    my $x = shift;
1559    $x -> is_band(1);
1560}
1561
1562=pod
1563
1564=item is_atridiag()
1565
1566Returns 1 is the invocand is anti-tridiagonal, and 0 otherwise.
1567
1568    $bool = $x -> is_tridiag();
1569
1570A anti-tridiagonal matrix is a square matrix with nonzero elements only on the
1571anti-diagonal and slots horizontally or vertically adjacent the diagonal (i.e.,
1572along the anti-subdiagonal and anti-superdiagonal). It has the following
1573pattern, where only the elements marked as C<x> can be non-zero,
1574
1575    [ 0 0 0 x x ]
1576    [ 0 0 x x x ]
1577    [ 0 x x x 0 ]
1578    [ x x x 0 0 ]
1579    [ x x 0 0 0 ]
1580
1581=cut
1582
1583sub is_atridiag {
1584    croak "Not enough arguments for ", (caller(0))[3] if @_ < 1;
1585    croak "Too many arguments for ", (caller(0))[3] if @_ > 1;
1586    my $x = shift;
1587    $x -> is_aband(1);
1588}
1589
1590=pod
1591
1592=item is_pentadiag()
1593
1594Returns 1 is the invocand is pentadiagonal, and 0 otherwise.
1595
1596    $bool = $x -> is_pentadiag();
1597
1598A pentadiagonal matrix is a square matrix with nonzero elements only on the
1599diagonal and the two diagonals above and below the main diagonal. It has the
1600following pattern, where only the elements marked as C<x> can be non-zero,
1601
1602    [ x x x 0 0 0 ]
1603    [ x x x x 0 0 ]
1604    [ x x x x x 0 ]
1605    [ 0 x x x x x ]
1606    [ 0 0 x x x x ]
1607    [ 0 0 0 x x x ]
1608
1609=cut
1610
1611sub is_pentadiag {
1612    croak "Not enough arguments for ", (caller(0))[3] if @_ < 1;
1613    croak "Too many arguments for ", (caller(0))[3] if @_ > 1;
1614    my $x = shift;
1615    $x -> is_band(2);
1616}
1617
1618=pod
1619
1620=item is_apentadiag()
1621
1622Returns 1 is the invocand is anti-pentadiagonal, and 0 otherwise.
1623
1624    $bool = $x -> is_pentadiag();
1625
1626A anti-pentadiagonal matrix is a square matrix with nonzero elements only on the
1627anti-diagonal and two anti-diagonals above and below the main anti-diagonal. It
1628has the following pattern, where only the elements marked as C<x> can be
1629non-zero,
1630
1631    [ 0 0 0 x x x ]
1632    [ 0 0 x x x x ]
1633    [ 0 x x x x x ]
1634    [ x x x x x 0 ]
1635    [ x x x x 0 0 ]
1636    [ x x x 0 0 0 ]
1637
1638=cut
1639
1640sub is_apentadiag {
1641    croak "Not enough arguments for ", (caller(0))[3] if @_ < 1;
1642    croak "Too many arguments for ", (caller(0))[3] if @_ > 1;
1643    my $x = shift;
1644    $x -> is_aband(2);
1645}
1646
1647=pod
1648
1649=item is_heptadiag()
1650
1651Returns 1 is the invocand is heptadiagonal, and 0 otherwise.
1652
1653    $bool = $x -> is_heptadiag();
1654
1655A heptadiagonal matrix is a square matrix with nonzero elements only on the
1656diagonal and the two diagonals above and below the main diagonal. It has the
1657following pattern, where only the elements marked as C<x> can be non-zero,
1658
1659    [ x x x x 0 0 ]
1660    [ x x x x x 0 ]
1661    [ x x x x x x ]
1662    [ x x x x x x ]
1663    [ 0 x x x x x ]
1664    [ 0 0 x x x x ]
1665
1666=cut
1667
1668sub is_heptadiag {
1669    croak "Not enough arguments for ", (caller(0))[3] if @_ < 1;
1670    croak "Too many arguments for ", (caller(0))[3] if @_ > 1;
1671    my $x = shift;
1672    $x -> is_band(3);
1673}
1674
1675=pod
1676
1677=item is_aheptadiag()
1678
1679Returns 1 is the invocand is anti-heptadiagonal, and 0 otherwise.
1680
1681    $bool = $x -> is_heptadiag();
1682
1683A anti-heptadiagonal matrix is a square matrix with nonzero elements only on the
1684anti-diagonal and two anti-diagonals above and below the main anti-diagonal. It
1685has the following pattern, where only the elements marked as C<x> can be
1686non-zero,
1687
1688    [ 0 0 x x x x ]
1689    [ 0 x x x x x ]
1690    [ x x x x x x ]
1691    [ x x x x x x ]
1692    [ x x x x x 0 ]
1693    [ x x x x 0 0 ]
1694
1695=cut
1696
1697sub is_aheptadiag {
1698    croak "Not enough arguments for ", (caller(0))[3] if @_ < 1;
1699    croak "Too many arguments for ", (caller(0))[3] if @_ > 1;
1700    my $x = shift;
1701    $x -> is_aband(3);
1702}
1703
1704=pod
1705
1706=item is_band()
1707
1708Returns 1 is the invocand is a band matrix with a specified bandwidth, and 0
1709otherwise.
1710
1711    $bool = $x -> is_band($k);
1712
1713A band matrix is a square matrix with nonzero elements only on the diagonal and
1714on the C<$k> diagonals above and below the main diagonal. The bandwidth C<$k>
1715must be non-negative.
1716
1717    $bool = $x -> is_band(0);   # is $x diagonal?
1718    $bool = $x -> is_band(1);   # is $x tridiagonal?
1719    $bool = $x -> is_band(2);   # is $x pentadiagonal?
1720    $bool = $x -> is_band(3);   # is $x heptadiagonal?
1721
1722See also C<L</is_aband()>> and C<L</bandwidth()>>.
1723
1724=cut
1725
1726sub is_band {
1727    croak "Not enough arguments for ", (caller(0))[3] if @_ < 2;
1728    croak "Too many arguments for ", (caller(0))[3] if @_ > 2;
1729    my $x = shift;
1730    my $class = ref $x;
1731
1732    my ($nrow, $ncol) = $x -> size();
1733    return 0 unless $nrow == $ncol;     # must be square
1734
1735    my $k = shift;                      # bandwidth
1736    croak "Bandwidth can not be undefined" unless defined $k;
1737    if (ref $k) {
1738        $k = $class -> new($k)
1739          unless defined(blessed($k)) && $k -> isa($class);
1740        croak "Bandwidth must be a scalar" unless $k -> is_scalar();
1741        $k = $k -> [0][0];
1742    }
1743
1744    return 0 if $nrow <= $k;            # if the band doesn't fit inside
1745    return 1 if $nrow == $k + 1;        # if the whole band fits exactly
1746
1747    for my $i (0 .. $nrow - $k - 2) {
1748        for my $j ($k + 1 + $i .. $ncol - 1) {
1749            return 0 if ($x -> [$i][$j] != 0 ||
1750                         $x -> [$j][$i] != 0);
1751        }
1752    }
1753
1754    return 1;
1755}
1756
1757=pod
1758
1759=item is_aband()
1760
1761Returns 1 is the invocand is "anti-banded" with a specified bandwidth, and 0
1762otherwise.
1763
1764    $bool = $x -> is_aband($k);
1765
1766Some examples
1767
1768    $bool = $x -> is_aband(0);  # is $x anti-diagonal?
1769    $bool = $x -> is_aband(1);  # is $x anti-tridiagonal?
1770    $bool = $x -> is_aband(2);  # is $x anti-pentadiagonal?
1771    $bool = $x -> is_aband(3);  # is $x anti-heptadiagonal?
1772
1773A band matrix is a square matrix with nonzero elements only on the diagonal and
1774on the C<$k> diagonals above and below the main diagonal. The bandwidth C<$k>
1775must be non-negative.
1776
1777A "anti-banded" matrix is a square matrix with nonzero elements only on the
1778anti-diagonal and C<$k> anti-diagonals above and below the main anti-diagonal.
1779
1780See also C<L</is_band()>> and C<L</bandwidth()>>.
1781
1782=cut
1783
1784sub is_aband {
1785    croak "Not enough arguments for ", (caller(0))[3] if @_ < 2;
1786    croak "Too many arguments for ", (caller(0))[3] if @_ > 2;
1787    my $x = shift;
1788    my $class = ref $x;
1789
1790    my ($nrow, $ncol) = $x -> size();
1791    return 0 unless $nrow == $ncol;     # must be square
1792
1793    my $k = shift;                      # bandwidth
1794    croak "Bandwidth can not be undefined" unless defined $k;
1795    if (ref $k) {
1796        $k = $class -> new($k)
1797          unless defined(blessed($k)) && $k -> isa($class);
1798        croak "Bandwidth must be a scalar" unless $k -> is_scalar();
1799        $k = $k -> [0][0];
1800    }
1801
1802    return 0 if $nrow <= $k;            # if the band doesn't fit inside
1803    return 1 if $nrow == $k + 1;        # if the whole band fits exactly
1804
1805    # Check upper part.
1806
1807    for my $i (0 .. $nrow - $k - 2) {
1808        for my $j (0 .. $nrow - $k - 2 - $i) {
1809            return 0 if $x -> [$i][$j] != 0;
1810        }
1811    }
1812
1813    # Check lower part.
1814
1815    for my $i ($k + 1 .. $nrow - 1) {
1816        for my $j ($nrow - $i + $k .. $nrow - 1) {
1817            return 0 if $x -> [$i][$j] != 0;
1818        }
1819    }
1820
1821    return 1;
1822}
1823
1824=pod
1825
1826=item is_triu()
1827
1828Returns 1 is the invocand is upper triangular, and 0 otherwise.
1829
1830    $bool = $x -> is_triu();
1831
1832An upper triangular matrix is a square matrix where all non-zero elements are on
1833or above the main diagonal. It has the following pattern, where only the
1834elements marked as C<x> can be non-zero. It has the following pattern, where
1835only the elements marked as C<x> can be non-zero,
1836
1837    [ x x x x ]
1838    [ 0 x x x ]
1839    [ 0 0 x x ]
1840    [ 0 0 0 x ]
1841
1842=cut
1843
1844sub is_triu {
1845    croak "Not enough arguments for ", (caller(0))[3] if @_ < 1;
1846    croak "Too many arguments for ", (caller(0))[3] if @_ > 1;
1847    my $x = shift;
1848
1849    my $nrow = $x -> nrow();
1850    my $ncol = $x -> ncol();
1851
1852    return 0 unless $nrow == $ncol;
1853
1854    for my $i (1 .. $nrow - 1) {
1855        for my $j (0 .. $i - 1) {
1856            return 0 unless $x -> [$i][$j] == 0;
1857        }
1858    }
1859
1860    return 1;
1861}
1862
1863=pod
1864
1865=item is_striu()
1866
1867Returns 1 is the invocand is strictly upper triangular, and 0 otherwise.
1868
1869    $bool = $x -> is_striu();
1870
1871A strictly upper triangular matrix is a square matrix where all non-zero
1872elements are strictly above the main diagonal. It has the following pattern,
1873where only the elements marked as C<x> can be non-zero,
1874
1875    [ 0 x x x ]
1876    [ 0 0 x x ]
1877    [ 0 0 0 x ]
1878    [ 0 0 0 0 ]
1879
1880=cut
1881
1882sub is_striu {
1883    croak "Not enough arguments for ", (caller(0))[3] if @_ < 1;
1884    croak "Too many arguments for ", (caller(0))[3] if @_ > 1;
1885    my $x = shift;
1886
1887    my $nrow = $x -> nrow();
1888    my $ncol = $x -> ncol();
1889
1890    return 0 unless $nrow == $ncol;
1891
1892    for my $i (0 .. $nrow - 1) {
1893        for my $j (0 .. $i) {
1894            return 0 unless $x -> [$i][$j] == 0;
1895        }
1896    }
1897
1898    return 1;
1899}
1900
1901=pod
1902
1903=item is_tril()
1904
1905Returns 1 is the invocand is lower triangular, and 0 otherwise.
1906
1907    $bool = $x -> is_tril();
1908
1909A lower triangular matrix is a square matrix where all non-zero elements are on
1910or below the main diagonal. It has the following pattern, where only the
1911elements marked as C<x> can be non-zero,
1912
1913    [ x 0 0 0 ]
1914    [ x x 0 0 ]
1915    [ x x x 0 ]
1916    [ x x x x ]
1917
1918=cut
1919
1920sub is_tril {
1921    croak "Not enough arguments for ", (caller(0))[3] if @_ < 1;
1922    croak "Too many arguments for ", (caller(0))[3] if @_ > 1;
1923    my $x = shift;
1924
1925    my $nrow = $x -> nrow();
1926    my $ncol = $x -> ncol();
1927
1928    return 0 unless $nrow == $ncol;
1929
1930    for my $i (0 .. $nrow - 1) {
1931        for my $j ($i + 1 .. $ncol - 1) {
1932            return 0 unless $x -> [$i][$j] == 0;
1933        }
1934    }
1935
1936    return 1;
1937}
1938
1939=pod
1940
1941=item is_stril()
1942
1943Returns 1 is the invocand is strictly lower triangular, and 0 otherwise.
1944
1945    $bool = $x -> is_stril();
1946
1947A strictly lower triangular matrix is a square matrix where all non-zero
1948elements are strictly below the main diagonal. It has the following pattern,
1949where only the elements marked as C<x> can be non-zero,
1950
1951    [ 0 0 0 0 ]
1952    [ x 0 0 0 ]
1953    [ x x 0 0 ]
1954    [ x x x 0 ]
1955
1956=cut
1957
1958sub is_stril {
1959    croak "Not enough arguments for ", (caller(0))[3] if @_ < 1;
1960    croak "Too many arguments for ", (caller(0))[3] if @_ > 1;
1961    my $x = shift;
1962
1963    my $nrow = $x -> nrow();
1964    my $ncol = $x -> ncol();
1965
1966    return 0 unless $nrow == $ncol;
1967
1968    for my $i (0 .. $nrow - 1) {
1969        for my $j ($i .. $ncol - 1) {
1970            return 0 unless $x -> [$i][$j] == 0;
1971        }
1972    }
1973
1974    return 1;
1975}
1976
1977=pod
1978
1979=item is_atriu()
1980
1981Returns 1 is the invocand is upper anti-triangular, and 0 otherwise.
1982
1983    $bool = $x -> is_atriu();
1984
1985An upper anti-triangular matrix is a square matrix where all non-zero elements
1986are on or above the main anti-diagonal. It has the following pattern, where only
1987the elements marked as C<x> can be non-zero,
1988
1989    [ x x x x ]
1990    [ x x x 0 ]
1991    [ x x 0 0 ]
1992    [ x 0 0 0 ]
1993
1994=cut
1995
1996sub is_atriu {
1997    croak "Not enough arguments for ", (caller(0))[3] if @_ < 1;
1998    croak "Too many arguments for ", (caller(0))[3] if @_ > 1;
1999    my $x = shift;
2000
2001    my $nrow = $x -> nrow();
2002    my $ncol = $x -> ncol();
2003
2004    return 0 unless $nrow == $ncol;
2005
2006    for my $i (1 .. $nrow - 1) {
2007        for my $j ($ncol - $i .. $ncol - 1) {
2008            return 0 unless $x -> [$i][$j] == 0;
2009        }
2010    }
2011
2012    return 1;
2013}
2014
2015=pod
2016
2017=item is_satriu()
2018
2019Returns 1 is the invocand is strictly upper anti-triangular, and 0 otherwise.
2020
2021    $bool = $x -> is_satriu();
2022
2023A strictly anti-triangular matrix is a square matrix where all non-zero elements
2024are strictly above the main diagonal. It has the following pattern, where only
2025the elements marked as C<x> can be non-zero,
2026
2027    [ x x x 0 ]
2028    [ x x 0 0 ]
2029    [ x 0 0 0 ]
2030    [ 0 0 0 0 ]
2031
2032=cut
2033
2034sub is_satriu {
2035    croak "Not enough arguments for ", (caller(0))[3] if @_ < 1;
2036    croak "Too many arguments for ", (caller(0))[3] if @_ > 1;
2037    my $x = shift;
2038
2039    my $nrow = $x -> nrow();
2040    my $ncol = $x -> ncol();
2041
2042    return 0 unless $nrow == $ncol;
2043
2044    for my $i (0 .. $nrow - 1) {
2045        for my $j ($ncol - $i - 1 .. $ncol - 1) {
2046            return 0 unless $x -> [$i][$j] == 0;
2047        }
2048    }
2049
2050    return 1;
2051}
2052
2053=pod
2054
2055=item is_atril()
2056
2057Returns 1 is the invocand is lower anti-triangular, and 0 otherwise.
2058
2059    $bool = $x -> is_atril();
2060
2061A lower anti-triangular matrix is a square matrix where all non-zero elements
2062are on or below the main anti-diagonal. It has the following pattern, where only
2063the elements marked as C<x> can be non-zero,
2064
2065    [ 0 0 0 x ]
2066    [ 0 0 x x ]
2067    [ 0 x x x ]
2068    [ x x x x ]
2069
2070=cut
2071
2072sub is_atril {
2073    croak "Not enough arguments for ", (caller(0))[3] if @_ < 1;
2074    croak "Too many arguments for ", (caller(0))[3] if @_ > 1;
2075    my $x = shift;
2076
2077    my $nrow = $x -> nrow();
2078    my $ncol = $x -> ncol();
2079
2080    return 0 unless $nrow == $ncol;
2081
2082    for my $i (0 .. $nrow - 1) {
2083        for my $j (0 .. $ncol - $i - 2) {
2084            return 0 unless $x -> [$i][$j] == 0;
2085        }
2086    }
2087
2088    return 1;
2089}
2090
2091=pod
2092
2093=item is_satril()
2094
2095Returns 1 is the invocand is strictly lower anti-triangular, and 0 otherwise.
2096
2097    $bool = $x -> is_satril();
2098
2099A strictly lower anti-triangular matrix is a square matrix where all non-zero
2100elements are strictly below the main anti-diagonal. It has the following
2101pattern, where only the elements marked as C<x> can be non-zero,
2102
2103    [ 0 0 0 0 ]
2104    [ 0 0 0 x ]
2105    [ 0 0 x x ]
2106    [ 0 x x x ]
2107
2108=cut
2109
2110sub is_satril {
2111    croak "Not enough arguments for ", (caller(0))[3] if @_ < 1;
2112    croak "Too many arguments for ", (caller(0))[3] if @_ > 1;
2113    my $x = shift;
2114
2115    my $nrow = $x -> nrow();
2116    my $ncol = $x -> ncol();
2117
2118    return 0 unless $nrow == $ncol;
2119
2120    for my $i (0 .. $nrow - 1) {
2121        for my $j (0 .. $ncol - $i - 1) {
2122            return 0 unless $x -> [$i][$j] == 0;
2123        }
2124    }
2125
2126    return 1;
2127}
2128
2129=pod
2130
2131=back
2132
2133=head2 Identify elements
2134
2135This section contains methods for identifying and locating elements within an
2136array. See also C<L</Scalar comparison>>.
2137
2138=over 4
2139
2140=item find()
2141
2142Returns the location of each non-zero element.
2143
2144    $K = $x -> find();          # linear index
2145    ($I, $J) = $x -> find();    # subscripts
2146
2147For example, to find the linear index of each element that is greater than or
2148equal to 1, use
2149
2150    $K = $x -> sge(1) -> find();
2151
2152=cut
2153
2154sub find {
2155    croak "Not enough arguments for ", (caller(0))[3] if @_ < 1;
2156    croak "Too many arguments for ", (caller(0))[3] if @_ > 1;
2157    my $x = shift;
2158
2159    my ($m, $n) = $x -> size();
2160
2161    my $I = [];
2162    my $J = [];
2163    for my $j (0 .. $n - 1) {
2164        for my $i (0 .. $m - 1) {
2165            next unless $x->[$i][$j];
2166            push @$I, $i;
2167            push @$J, $j;
2168        }
2169    }
2170
2171    return $I, $J if wantarray;
2172
2173    my $K = [ map { $m * $J -> [$_] + $I -> [$_] } 0 .. $#$I ];
2174    return $K;
2175}
2176
2177=pod
2178
2179=item is_finite()
2180
2181Returns a matrix of ones and zeros. The element is one if the corresponding
2182element in the invocand matrix is finite, and zero otherwise.
2183
2184    $y = $x -> is_finite();
2185
2186=cut
2187
2188sub is_finite {
2189    croak "Not enough arguments for ", (caller(0))[3] if @_ < 1;
2190    croak "Too many arguments for ", (caller(0))[3] if @_ > 1;
2191    my $x = shift;
2192
2193    require Math::Trig;
2194    my $pinf = Math::Trig::Inf();       # positiv infinity
2195    my $ninf = -$pinf;                  # negative infinity
2196
2197    bless [ map { [
2198                   map {
2199                       $ninf < $_ && $_ < $pinf ? 1 : 0
2200                   } @$_
2201                  ] } @$x ], ref $x;
2202}
2203
2204=pod
2205
2206=item is_inf()
2207
2208Returns a matrix of ones and zeros. The element is one if the corresponding
2209element in the invocand matrix is positive or negative infinity, and zero
2210otherwise.
2211
2212    $y = $x -> is_inf();
2213
2214=cut
2215
2216sub is_inf {
2217    croak "Not enough arguments for ", (caller(0))[3] if @_ < 1;
2218    croak "Too many arguments for ", (caller(0))[3] if @_ > 1;
2219    my $x = shift;
2220
2221    require Math::Trig;
2222    my $pinf = Math::Trig::Inf();       # positiv infinity
2223    my $ninf = -$pinf;                  # negative infinity
2224
2225    bless [ map { [
2226                   map {
2227                       $_ == $pinf || $_ == $ninf ? 1 : 0;
2228                   } @$_
2229                  ] } @$x ], ref $x;
2230}
2231
2232=pod
2233
2234=item is_nan()
2235
2236Returns a matrix of ones and zeros. The element is one if the corresponding
2237element in the invocand matrix is a NaN (Not-a-Number), and zero otherwise.
2238
2239    $y = $x -> is_nan();
2240
2241=cut
2242
2243sub is_nan {
2244    croak "Not enough arguments for ", (caller(0))[3] if @_ < 1;
2245    croak "Too many arguments for ", (caller(0))[3] if @_ > 1;
2246    my $x = shift;
2247
2248    bless [ map [ map { $_ != $_ ? 1 : 0 } @$_ ], @$x ], ref $x;
2249}
2250
2251=pod
2252
2253=item all()
2254
2255Tests whether all of the elements along various dimensions of a matrix are
2256non-zero. If the dimension argument is not given, the first non-singleton
2257dimension is used.
2258
2259    $y = $x -> all($dim);
2260    $y = $x -> all();
2261
2262=cut
2263
2264sub all {
2265    croak "Not enough arguments for ", (caller(0))[3] if @_ < 1;
2266    croak "Too many arguments for ", (caller(0))[3] if @_ > 2;
2267    my $x = shift;
2268    $x -> apply(\&_all, @_);
2269}
2270
2271=pod
2272
2273=item any()
2274
2275Tests whether any of the elements along various dimensions of a matrix are
2276non-zero. If the dimension argument is not given, the first non-singleton
2277dimension is used.
2278
2279    $y = $x -> any($dim);
2280    $y = $x -> any();
2281
2282=cut
2283
2284sub any {
2285    croak "Not enough arguments for ", (caller(0))[3] if @_ < 1;
2286    croak "Too many arguments for ", (caller(0))[3] if @_ > 2;
2287    my $x = shift;
2288    $x -> apply(\&_any, @_);
2289}
2290
2291=pod
2292
2293=item cumall()
2294
2295A cumulative variant of C<L</all()>>. If the dimension argument is not given,
2296the first non-singleton dimension is used.
2297
2298    $y = $x -> cumall($dim);
2299    $y = $x -> cumall();
2300
2301=cut
2302
2303sub cumall {
2304    croak "Not enough arguments for ", (caller(0))[3] if @_ < 1;
2305    croak "Too many arguments for ", (caller(0))[3] if @_ > 2;
2306    my $x = shift;
2307    $x -> apply(\&_cumall, @_);
2308}
2309
2310=pod
2311
2312=item cumany()
2313
2314A cumulative variant of C<L</all()>>. If the dimension argument is not given,
2315the first non-singleton dimension is used.
2316
2317    $y = $x -> cumany($dim);
2318    $y = $x -> cumany();
2319
2320=cut
2321
2322sub cumany {
2323    croak "Not enough arguments for ", (caller(0))[3] if @_ < 1;
2324    croak "Too many arguments for ", (caller(0))[3] if @_ > 2;
2325    my $x = shift;
2326    $x -> apply(\&_cumany, @_);
2327}
2328
2329=pod
2330
2331=back
2332
2333=head2 Basic properties
2334
2335=over 4
2336
2337=item size()
2338
2339You can determine the dimensions of a matrix by calling:
2340
2341    ($m, $n) = $a -> size;
2342
2343=cut
2344
2345sub size {
2346    my $self = shift;
2347    my $m = @{$self};
2348    my $n = $m ? @{$self->[0]} : 0;
2349    ($m, $n);
2350}
2351
2352=pod
2353
2354=item nelm()
2355
2356Returns the number of elements in the matrix.
2357
2358    $n = $x -> nelm();
2359
2360=cut
2361
2362sub nelm {
2363    croak "Not enough arguments for ", (caller(0))[3] if @_ < 1;
2364    croak "Too many arguments for ", (caller(0))[3] if @_ > 1;
2365    my $x = shift;
2366    return @$x ? @$x * @{$x->[0]} : 0;
2367}
2368
2369=pod
2370
2371=item nrow()
2372
2373Returns the number of rows.
2374
2375    $m = $x -> nrow();
2376
2377=cut
2378
2379sub nrow {
2380    croak "Not enough arguments for ", (caller(0))[3] if @_ < 1;
2381    croak "Too many arguments for ", (caller(0))[3] if @_ > 1;
2382    my $x = shift;
2383    return scalar @$x;
2384}
2385
2386=pod
2387
2388=item ncol()
2389
2390Returns the number of columns.
2391
2392    $n = $x -> ncol();
2393
2394=cut
2395
2396sub ncol {
2397    croak "Not enough arguments for ", (caller(0))[3] if @_ < 1;
2398    croak "Too many arguments for ", (caller(0))[3] if @_ > 1;
2399    my $x = shift;
2400    return @$x ? scalar(@{$x->[0]}) : 0;
2401}
2402
2403=pod
2404
2405=item npag()
2406
2407Returns the number of pages. A non-matrix has one page.
2408
2409    $n = $x -> pag();
2410
2411=cut
2412
2413sub npag {
2414    croak "Not enough arguments for ", (caller(0))[3] if @_ < 1;
2415    croak "Too many arguments for ", (caller(0))[3] if @_ > 1;
2416    my $x = shift;
2417    return @$x ? 1 : 0;
2418}
2419
2420=pod
2421
2422=item ndim()
2423
2424Returns the number of dimensions. This is the number of dimensions along which
2425the length is different from one.
2426
2427    $n = $x -> ndim();
2428
2429=cut
2430
2431sub ndim {
2432    croak "Not enough arguments for ", (caller(0))[3] if @_ < 1;
2433    croak "Too many arguments for ", (caller(0))[3] if @_ > 1;
2434    my $x = shift;
2435    my ($nrow, $ncol) = $x -> size();
2436    my $ndim = 0;
2437    ++$ndim if $nrow != 1;
2438    ++$ndim if $ncol != 1;
2439    return $ndim;
2440}
2441
2442=pod
2443
2444=item bandwidth()
2445
2446Returns the bandwidth of a matrix. In scalar context, returns the number of the
2447non-zero diagonal furthest away from the main diagonal. In list context,
2448separate values are returned for the lower and upper bandwidth.
2449
2450    $n = $x -> bandwidth();
2451    ($l, $u) = $x -> bandwidth();
2452
2453The bandwidth is a non-negative integer. If the bandwidth is 0, the matrix is
2454diagonal or zero. If the bandwidth is 1, the matrix is tridiagonal. If the
2455bandwidth is 2, the matrix is pentadiagonal etc.
2456
2457A matrix with the following pattern, where C<x> denotes a non-zero value, would
2458return 2 in scalar context, and (1,2) in list context.
2459
2460    [ x x x 0 0 0 ]
2461    [ x x x x 0 0 ]
2462    [ 0 x x x x 0 ]
2463    [ 0 0 x x x x ]
2464    [ 0 0 0 x x x ]
2465    [ 0 0 0 0 x x ]
2466
2467See also C<L</is_band()>> and C<L</is_aband()>>.
2468
2469=cut
2470
2471sub bandwidth {
2472    croak "Not enough arguments for ", (caller(0))[3] if @_ < 1;
2473    croak "Too many arguments for ", (caller(0))[3] if @_ > 1;
2474    my $x = shift;
2475
2476    my ($nrow, $ncol) = $x -> size();
2477
2478    my $upper = 0;
2479    my $lower = 0;
2480
2481    for my $i (0 .. $nrow - 1) {
2482        for my $j (0 .. $ncol - 1) {
2483            next if $x -> [$i][$j] == 0;
2484            my $dist = $j - $i;
2485            if ($dist > 0) {
2486                $upper = $dist if $dist > $upper;
2487            } else {
2488                $lower = $dist if $dist < $lower;
2489            }
2490        }
2491    }
2492
2493    $lower = -$lower;
2494    return $lower, $upper if wantarray;
2495    return $lower > $upper ? $lower : $upper;
2496}
2497
2498=pod
2499
2500=back
2501
2502=head2 Manipulate matrices
2503
2504These methods are for combining matrices, splitting matrices, extracing parts of
2505a matrix, inserting new parts into a matrix, deleting parts of a matrix etc.
2506There are also methods for shuffling elements around (relocating elements)
2507inside a matrix.
2508
2509These methods are not concerned with the values of the elements.
2510
2511=over 4
2512
2513=item catrow()
2514
2515Concatenate rows, i.e., concatenate matrices vertically. Any number of arguments
2516is allowed. All non-empty matrices must have the same number or columns. The
2517result is a new matrix.
2518
2519    $x = Math::Matrix -> new([1, 2], [4, 5]);   # 2-by-2 matrix
2520    $y = Math::Matrix -> new([3, 6]);           # 1-by-2 matrix
2521    $z = $x -> catrow($y);                      # 3-by-2 matrix
2522
2523=cut
2524
2525sub catrow {
2526    my $x = shift;
2527    my $class = ref $x;
2528
2529    my $ncol;
2530    my $z = bless [], $class;           # initialize output
2531
2532    for my $y ($x, @_) {
2533        my $ncoly = $y -> ncol();
2534        next if $ncoly == 0;            # ignore empty $y
2535
2536        if (defined $ncol) {
2537            croak "All operands must have the same number of columns in ",
2538              (caller(0))[3] unless $ncoly == $ncol;
2539        } else {
2540            $ncol = $ncoly;
2541        }
2542
2543        push @$z, map [ @$_ ], @$y;
2544    }
2545
2546    return $z;
2547}
2548
2549=pod
2550
2551=item catcol()
2552
2553Concatenate columns, i.e., matrices horizontally. Any number of arguments is
2554allowed. All non-empty matrices must have the same number or rows. The result is
2555a new matrix.
2556
2557    $x = Math::Matrix -> new([1, 2], [4, 5]);   # 2-by-2 matrix
2558    $y = Math::Matrix -> new([3], [6]);         # 2-by-1 matrix
2559    $z = $x -> catcol($y);                      # 2-by-3 matrix
2560
2561=cut
2562
2563sub catcol {
2564    my $x = shift;
2565    my $class = ref $x;
2566
2567    my $nrow;
2568    my $z = bless [], $class;           # initialize output
2569
2570    for my $y ($x, @_) {
2571        my $nrowy = $y -> nrow();
2572        next if $nrowy == 0;            # ignore empty $y
2573
2574        if (defined $nrow) {
2575            croak "All operands must have the same number of rows in ",
2576              (caller(0))[3] unless $nrowy == $nrow;
2577        } else {
2578            $nrow = $nrowy;
2579        }
2580
2581        for my $i (0 .. $nrow - 1) {
2582            push @{ $z -> [$i] }, @{ $y -> [$i] };
2583        }
2584    }
2585
2586    return $z;
2587}
2588
2589=pod
2590
2591=item getrow()
2592
2593Get the specified row(s). Returns a new matrix with the specified rows. The
2594number of rows in the output is identical to the number of elements in the
2595input.
2596
2597    $y = $x -> getrow($i);                  # get one
2598    $y = $x -> getrow([$i0, $i1, $i2]);     # get multiple
2599
2600=cut
2601
2602sub getrow {
2603    croak "Not enough arguments for ", (caller(0))[3] if @_ < 2;
2604    croak "Too many arguments for ", (caller(0))[3] if @_ > 2;
2605    my $x = shift;
2606    my $class = ref $x;
2607
2608    my $idx = shift;
2609    croak "Row index can not be undefined" unless defined $idx;
2610    if (ref $idx) {
2611        $idx = __PACKAGE__ -> new($idx)
2612          unless defined(blessed($idx)) && $idx -> isa($class);
2613        $idx = $idx -> to_row();
2614        $idx = $idx -> [0];
2615    } else {
2616        $idx = [ $idx ];
2617    }
2618
2619    my ($nrowx, $ncolx) = $x -> size();
2620
2621    my $y = [];
2622    for my $iy (0 .. $#$idx) {
2623        my $ix = $idx -> [$iy];
2624        croak "Row index value $ix too large for $nrowx-by-$ncolx matrix in ",
2625          (caller(0))[3] if $ix >= $nrowx;
2626        $y -> [$iy] = [ @{ $x -> [$ix] } ];
2627    }
2628
2629    bless $y, $class;
2630}
2631
2632=pod
2633
2634=item getcol()
2635
2636Get the specified column(s). Returns a new matrix with the specified columns.
2637The number of columns in the output is identical to the number of elements in
2638the input.
2639
2640    $y = $x -> getcol($j);                  # get one
2641    $y = $x -> getcol([$j0, $j1, $j2]);     # get multiple
2642
2643=cut
2644
2645sub getcol {
2646    croak "Not enough arguments for ", (caller(0))[3] if @_ < 2;
2647    croak "Too many arguments for ", (caller(0))[3] if @_ > 2;
2648    my $x = shift;
2649    my $class = ref $x;
2650
2651    my $idx = shift;
2652    croak "Column index can not be undefined" unless defined $idx;
2653    if (ref $idx) {
2654        $idx = __PACKAGE__ -> new($idx)
2655          unless defined(blessed($idx)) && $idx -> isa($class);
2656        $idx = $idx -> to_row();
2657        $idx = $idx -> [0];
2658    } else {
2659        $idx = [ $idx ];
2660    }
2661
2662    my ($nrowx, $ncolx) = $x -> size();
2663
2664    my $y = [];
2665    for my $jy (0 .. $#$idx) {
2666        my $jx = $idx -> [$jy];
2667        croak "Column index value $jx too large for $nrowx-by-$ncolx matrix in ",
2668          (caller(0))[3] if $jx >= $ncolx;
2669        for my $i (0 .. $nrowx - 1) {
2670            $y -> [$i][$jy] = $x -> [$i][$jx];
2671        }
2672    }
2673
2674    bless $y, $class;
2675}
2676
2677=pod
2678
2679=item delrow()
2680
2681Delete row(s). Returns a new matrix identical to the invocand but with the
2682specified row(s) deleted.
2683
2684    $y = $x -> delrow($i);                  # delete one
2685    $y = $x -> delrow([$i0, $i1, $i2]);     # delete multiple
2686
2687=cut
2688
2689sub delrow {
2690    croak "Not enough arguments for ", (caller(0))[3] if @_ < 2;
2691    croak "Too many arguments for ", (caller(0))[3] if @_ > 2;
2692    my $x = shift;
2693    my $class = ref $x;
2694
2695    my $idxdel = shift;
2696    croak "Row index can not be undefined" unless defined $idxdel;
2697    if (ref $idxdel) {
2698        $idxdel = __PACKAGE__ -> new($idxdel)
2699          unless defined(blessed($idxdel)) && $idxdel -> isa($class);
2700        $idxdel = $idxdel -> to_row();
2701        $idxdel = $idxdel -> [0];
2702    } else {
2703        $idxdel = [ $idxdel ];
2704    }
2705
2706    my $nrowx = $x -> nrow();
2707
2708    # This should be made faster.
2709
2710    my $idxget = [];
2711    for my $i (0 .. $nrowx - 1) {
2712        my $seen = 0;
2713        for my $idx (@$idxdel) {
2714            if ($i == int $idx) {
2715                $seen = 1;
2716                last;
2717            }
2718        }
2719        push @$idxget, $i unless $seen;
2720    }
2721
2722    my $y = [];
2723    @$y = map [ @$_ ], @$x[ @$idxget ];
2724    bless $y, $class;
2725}
2726
2727=pod
2728
2729=item delcol()
2730
2731Delete column(s). Returns a new matrix identical to the invocand but with the
2732specified column(s) deleted.
2733
2734    $y = $x -> delcol($j);                  # delete one
2735    $y = $x -> delcol([$j0, $j1, $j2]);     # delete multiple
2736
2737=cut
2738
2739sub delcol {
2740    croak "Not enough arguments for ", (caller(0))[3] if @_ < 2;
2741    croak "Too many arguments for ", (caller(0))[3] if @_ > 2;
2742    my $x = shift;
2743    my $class = ref $x;
2744
2745    my $idxdel = shift;
2746    croak "Column index can not be undefined" unless defined $idxdel;
2747    if (ref $idxdel) {
2748        $idxdel = __PACKAGE__ -> new($idxdel)
2749          unless defined(blessed($idxdel)) && $idxdel -> isa($class);
2750        $idxdel = $idxdel -> to_row();
2751        $idxdel = $idxdel -> [0];
2752    } else {
2753        $idxdel = [ $idxdel ];
2754    }
2755
2756    my ($nrowx, $ncolx) = $x -> size();
2757
2758    # This should be made faster.
2759
2760    my $idxget = [];
2761    for my $j (0 .. $ncolx - 1) {
2762        my $seen = 0;
2763        for my $idx (@$idxdel) {
2764            if ($j == int $idx) {
2765                $seen = 1;
2766                last;
2767            }
2768        }
2769        push @$idxget, $j unless $seen;
2770    }
2771
2772    my $y = [];
2773    if (@$idxget) {
2774        for my $row (@$x) {
2775            push @$y, [ @{$row}[ @$idxget ] ];
2776        }
2777    }
2778    bless $y, $class;
2779}
2780
2781=pod
2782
2783=item concat()
2784
2785Concatenate two matrices horizontally. The matrices must have the same number of
2786rows. The result is a new matrix or B<undef> in case of error.
2787
2788    $x = Math::Matrix -> new([1, 2], [4, 5]);   # 2-by-2 matrix
2789    $y = Math::Matrix -> new([3], [6]);         # 2-by-1 matrix
2790    $z = $x -> concat($y);                      # 2-by-3 matrix
2791
2792=cut
2793
2794sub concat {
2795    my $self   = shift;
2796    my $other  = shift;
2797    my $result =  $self->clone();
2798
2799    return undef if scalar(@{$self}) != scalar(@{$other});
2800    for my $i (0 .. $#{$self}) {
2801        push @{$result->[$i]}, @{$other->[$i]};
2802    }
2803    $result;
2804}
2805
2806=pod
2807
2808=item splicerow()
2809
2810Row splicing. This is like Perl's built-in splice() function, except that it
2811works on the rows of a matrix.
2812
2813    $y = $x -> splicerow($offset);
2814    $y = $x -> splicerow($offset, $length);
2815    $y = $x -> splicerow($offset, $length, $a, $b, ...);
2816
2817The built-in splice() function modifies the first argument and returns the
2818removed elements, if any. However, since splicerow() does not modify the
2819invocand, it returns the modified version as the first output argument and the
2820removed part as a (possibly empty) second output argument.
2821
2822    $x = Math::Matrix -> new([[ 1,  2],
2823                              [ 3,  4],
2824                              [ 5,  6],
2825                              [ 7,  8]]);
2826    $a = Math::Matrix -> new([[11, 12],
2827                              [13, 14]]);
2828    ($y, $z) = $x -> splicerow(1, 2, $a);
2829
2830Gives C<$y>
2831
2832    [  1  2 ]
2833    [ 11 12 ]
2834    [ 13 14 ]
2835    [  7  8 ]
2836
2837and C<$z>
2838
2839    [  3  4 ]
2840    [  5  6 ]
2841
2842=cut
2843
2844sub splicerow {
2845    croak "Not enough input arguments" if @_ < 1;
2846    my $x = shift;
2847    my $class = ref $x;
2848
2849    my $offs = 0;
2850    my $len  = $x -> nrow();
2851    my $repl = $class -> new([]);
2852
2853    if (@_) {
2854        $offs = shift;
2855        croak "Offset can not be undefined" unless defined $offs;
2856        if (ref $offs) {
2857            $offs = $class -> new($offs)
2858              unless defined(blessed($offs)) && $offs -> isa($class);
2859            croak "Offset must be a scalar" unless $offs -> is_scalar();
2860            $offs = $offs -> [0][0];
2861        }
2862
2863        if (@_) {
2864            $len = shift;
2865            croak "Length can not be undefined" unless defined $len;
2866            if (ref $len) {
2867                $len = $class -> new($len)
2868                  unless defined(blessed($len)) && $len -> isa($class);
2869                croak "length must be a scalar" unless $len -> is_scalar();
2870                $len = $len -> [0][0];
2871            }
2872
2873            if (@_) {
2874                $repl = $repl -> catrow(@_);
2875            }
2876        }
2877    }
2878
2879    my $y = $x -> clone();
2880    my $z = $class -> new([]);
2881
2882    @$z = splice @$y, $offs, $len, @$repl;
2883    return wantarray ? ($y, $z) : $y;
2884}
2885
2886=pod
2887
2888=item splicecol()
2889
2890Column splicing. This is like Perl's built-in splice() function, except that it
2891works on the columns of a matrix.
2892
2893    $y = $x -> splicecol($offset);
2894    $y = $x -> splicecol($offset, $length);
2895    $y = $x -> splicecol($offset, $length, $a, $b, ...);
2896
2897The built-in splice() function modifies the first argument and returns the
2898removed elements, if any. However, since splicecol() does not modify the
2899invocand, it returns the modified version as the first output argument and the
2900removed part as a (possibly empty) second output argument.
2901
2902    $x = Math::Matrix -> new([[ 1, 3, 5, 7 ],
2903                              [ 2, 4, 6, 8 ]]);
2904    $a = Math::Matrix -> new([[11, 13],
2905                              [12, 14]]);
2906    ($y, $z) = $x -> splicerow(1, 2, $a);
2907
2908Gives C<$y>
2909
2910    [ 1  11  13  7 ]
2911    [ 2  12  14  8 ]
2912
2913and C<$z>
2914
2915    [ 3  5 ]
2916    [ 4  6 ]
2917
2918=cut
2919
2920sub splicecol {
2921    croak "Not enough input arguments" if @_ < 1;
2922    my $x = shift;
2923    my $class = ref $x;
2924
2925    my ($nrowx, $ncolx) = $x -> size();
2926
2927    my $offs = 0;
2928    my $len  = $ncolx;
2929    my $repl = $class -> new([]);
2930
2931    if (@_) {
2932        $offs = shift;
2933        croak "Offset can not be undefined" unless defined $offs;
2934        if (ref $offs) {
2935            $offs = $class -> new($offs)
2936              unless defined(blessed($offs)) && $offs -> isa($class);
2937            croak "Offset must be a scalar" unless $offs -> is_scalar();
2938            $offs = $offs -> [0][0];
2939        }
2940
2941        if (@_) {
2942            $len = shift;
2943            croak "Length can not be undefined" unless defined $len;
2944            if (ref $len) {
2945                $len = $class -> new($len)
2946                  unless defined(blessed($len)) && $len -> isa($class);
2947                croak "length must be a scalar" unless $len -> is_scalar();
2948                $len = $len -> [0][0];
2949            }
2950
2951            if (@_) {
2952                $repl = $repl -> catcol(@_);
2953            }
2954        }
2955    }
2956
2957    my $y = $x -> clone();
2958    my $z = $class -> new([]);
2959
2960    if ($offs > $len) {
2961        carp "splicecol() offset past end of array";
2962        $offs = $len;
2963    }
2964
2965    # The case when we are not removing anything from the invocand matrix: If
2966    # the offset is identical to the number of columns in the invocand matrix,
2967    # just appending the replacement matrix to the invocand matrix.
2968
2969    if ($offs == $len) {
2970        unless ($repl -> is_empty()) {
2971            for my $i (0 .. $nrowx - 1) {
2972                push @{ $y -> [$i] }, @{ $repl -> [$i] };
2973            }
2974        }
2975    }
2976
2977    # The case when we are removing everything from the invocand matrix: If the
2978    # offset is zero, and the length is identical to the number of columns in
2979    # the invocand matrix, replace the whole invocand matrix with the
2980    # replacement matrix.
2981
2982    elsif ($offs == 0 && $len == $ncolx) {
2983        @$z = @$y;
2984        @$y = @$repl;
2985    }
2986
2987    # The case when we are removing parts of the invocand matrix.
2988
2989    else {
2990        if ($repl -> is_empty()) {
2991            for my $i (0 .. $nrowx - 1) {
2992                @{ $z -> [$i] } = splice @{ $y -> [$i] }, $offs, $len;
2993            }
2994        } else {
2995            for my $i (0 .. $nrowx - 1) {
2996                @{ $z -> [$i] } = splice @{ $y -> [$i] }, $offs, $len, @{ $repl -> [$i] };
2997            }
2998        }
2999    }
3000
3001    return wantarray ? ($y, $z) : $y;
3002}
3003
3004=pod
3005
3006=item swaprc()
3007
3008Swap rows and columns. This method does nothing but shuffle elements around. For
3009real numbers, swaprc() is identical to the transpose() method.
3010
3011A subclass implementing a matrix of complex numbers should provide a transpose()
3012method that also takes the complex conjugate of each elements. The swaprc()
3013method, on the other hand, should only shuffle elements around.
3014
3015=cut
3016
3017sub swaprc {
3018    my $x = shift;
3019    my $class = ref $x;
3020
3021    my $y = bless [], $class;
3022    my $ncolx = $x -> ncol();
3023    return $y if $ncolx == 0;
3024
3025    for my $j (0 .. $ncolx - 1) {
3026        push @$y, [ map $_->[$j], @$x ];
3027    }
3028    return $y;
3029}
3030
3031=pod
3032
3033=item flipud()
3034
3035Flip upside-down, i.e., flip along dimension 1.
3036
3037    $y = $x -> flipud();
3038
3039=cut
3040
3041sub flipud {
3042    croak "Not enough arguments for ", (caller(0))[3] if @_ < 1;
3043    croak "Too many arguments for ", (caller(0))[3] if @_ > 1;
3044    my $x = shift;
3045    my $class = ref $x;
3046
3047    my $y = [ reverse map [ @$_ ], @$x ];
3048    bless $y, $class;;
3049}
3050
3051=pod
3052
3053=item fliplr()
3054
3055Flip left-to-right, i.e., flip along dimension 2.
3056
3057    $y = $x -> fliplr();
3058
3059=cut
3060
3061sub fliplr {
3062    croak "Not enough arguments for ", (caller(0))[3] if @_ < 1;
3063    croak "Too many arguments for ", (caller(0))[3] if @_ > 1;
3064    my $x = shift;
3065    my $class = ref $x;
3066
3067    my $y = [ map [ reverse @$_ ], @$x ];
3068    bless $y, $class;
3069}
3070
3071=pod
3072
3073=item flip()
3074
3075Flip along various dimensions of a matrix. If the dimension argument is not
3076given, the first non-singleton dimension is used.
3077
3078    $y = $x -> flip($dim);
3079    $y = $x -> flip();
3080
3081See also C<L</flipud()>> and C<L</fliplr()>>.
3082
3083=cut
3084
3085sub flip {
3086    croak "Not enough arguments for ", (caller(0))[3] if @_ < 1;
3087    croak "Too many arguments for ", (caller(0))[3] if @_ > 2;
3088    my $x = shift;
3089    $x -> apply(sub { reverse @_ }, @_);
3090}
3091
3092=pod
3093
3094=item rot90()
3095
3096Rotate 90 degrees counterclockwise.
3097
3098    $y = $x -> rot90();     # rotate 90 degrees counterclockwise
3099    $y = $x -> rot90($n);   # rotate 90*$n degrees counterclockwise
3100
3101=cut
3102
3103sub rot90 {
3104    croak "Not enough arguments for ", (caller(0))[3] if @_ < 1;
3105    croak "Too many arguments for ", (caller(0))[3] if @_ > 2;
3106    my $x = shift;
3107    my $class = ref $x;
3108
3109    my $n = 1;
3110    if (@_) {
3111        $n = shift;
3112        if (ref $n) {
3113            $n = $class -> new($n)
3114              unless defined(blessed($n)) && $n -> isa($class);
3115            croak "Argument must be a scalar" unless $n -> is_scalar();
3116            $n = $n -> [0][0];
3117        }
3118        croak "Argument must be an integer" unless $n == int $n;
3119    }
3120
3121    my $y = [];
3122
3123    # Rotate 0 degrees, i.e., clone.
3124
3125    $n %= 4;
3126    if ($n == 0) {
3127        $y = [ map [ @$_ ], @$x ];
3128    }
3129
3130    # Rotate 90 degrees.
3131
3132    elsif ($n == 1) {
3133        my ($nrowx, $ncolx) = $x -> size();
3134        my $jmax = $ncolx - 1;
3135        for my $i (0 .. $nrowx - 1) {
3136            for my $j (0 .. $ncolx - 1) {
3137                $y -> [$jmax - $j][$i] = $x -> [$i][$j];
3138            }
3139        }
3140    }
3141
3142    # Rotate 180 degrees.
3143
3144    elsif ($n == 2) {
3145        $y = [ map [ reverse @$_ ], reverse @$x ];
3146    }
3147
3148    # Rotate 270 degrees.
3149
3150    elsif ($n == 3) {
3151        my ($nrowx, $ncolx) = $x -> size();
3152        my $imax = $nrowx - 1;
3153        for my $i (0 .. $nrowx - 1) {
3154            for my $j (0 .. $ncolx - 1) {
3155                $y -> [$j][$imax - $i] = $x -> [$i][$j];
3156            }
3157        }
3158    }
3159
3160    bless $y, $class;
3161}
3162
3163=pod
3164
3165=item rot180()
3166
3167Rotate 180 degrees.
3168
3169    $y = $x -> rot180();
3170
3171=cut
3172
3173sub rot180 {
3174    croak "Not enough arguments for ", (caller(0))[3] if @_ < 1;
3175    croak "Too many arguments for ", (caller(0))[3] if @_ > 1;
3176    my $x = shift;
3177    $x -> rot90(2);
3178}
3179
3180=pod
3181
3182=item rot270()
3183
3184Rotate 270 degrees counterclockwise, i.e., 90 degrees clockwise.
3185
3186    $y = $x -> rot270();
3187
3188=cut
3189
3190sub rot270 {
3191    croak "Not enough arguments for ", (caller(0))[3] if @_ < 1;
3192    croak "Too many arguments for ", (caller(0))[3] if @_ > 1;
3193    my $x = shift;
3194    $x -> rot90(3);
3195}
3196
3197=pod
3198
3199=item repelm()
3200
3201Repeat elements.
3202
3203    $x -> repelm($y);
3204
3205Repeats each element in $x the number of times specified in $y.
3206
3207If $x is the matrix
3208
3209    [ 4 5 6 ]
3210    [ 7 8 9 ]
3211
3212and $y is
3213
3214    [ 3 2 ]
3215
3216the returned matrix is
3217
3218    [ 4 4 5 5 6 6 ]
3219    [ 4 4 5 5 6 6 ]
3220    [ 4 4 5 5 6 6 ]
3221    [ 7 7 8 8 9 9 ]
3222    [ 7 7 8 8 9 9 ]
3223    [ 7 7 8 8 9 9 ]
3224
3225=cut
3226
3227sub repelm {
3228    croak "Not enough arguments for ", (caller(0))[3] if @_ < 2;
3229    croak "Too many arguments for ", (caller(0))[3] if @_ > 2;
3230    my $x = shift;
3231    my $class = ref $x;
3232
3233    my $y = shift;
3234    $y = __PACKAGE__ -> new($y)
3235      unless defined(blessed($y)) && $y -> isa(__PACKAGE__);
3236    croak "Input argument must contain two elements"
3237      unless $y -> nelm() == 2;
3238
3239    my ($nrowx, $ncolx) = $x -> size();
3240
3241    $y = $y -> to_col();
3242    my $nrowrep = $y -> [0][0];
3243    my $ncolrep = $y -> [1][0];
3244
3245    my $z = [];
3246    for my $ix (0 .. $nrowx - 1) {
3247        for my $jx (0 .. $ncolx - 1) {
3248            for my $iy (0 .. $nrowrep - 1) {
3249                for my $jy (0 .. $ncolrep - 1) {
3250                    my $iz = $ix * $nrowrep + $iy;
3251                    my $jz = $jx * $ncolrep + $jy;
3252                    $z -> [$iz][$jz] = $x -> [$ix][$jx];
3253                }
3254            }
3255        }
3256    }
3257
3258    bless $z, $class;
3259}
3260
3261=pod
3262
3263=item repmat()
3264
3265Repeat elements.
3266
3267    $x -> repmat($y);
3268
3269Repeats the matrix $x the number of times specified in $y.
3270
3271If $x is the matrix
3272
3273    [ 4 5 6 ]
3274    [ 7 8 9 ]
3275
3276and $y is
3277
3278    [ 3 2 ]
3279
3280the returned matrix is
3281
3282    [ 4 5 6 4 5 6 ]
3283    [ 7 8 9 7 8 9 ]
3284    [ 4 5 6 4 5 6 ]
3285    [ 7 8 9 7 8 9 ]
3286    [ 4 5 6 4 5 6 ]
3287    [ 7 8 9 7 8 9 ]
3288
3289=cut
3290
3291sub repmat {
3292    croak "Not enough arguments for ", (caller(0))[3] if @_ < 2;
3293    croak "Too many arguments for ", (caller(0))[3] if @_ > 2;
3294    my $x = shift;
3295    my $class = ref $x;
3296
3297    my $y = shift;
3298    $y = __PACKAGE__ -> new($y)
3299      unless defined(blessed($y)) && $y -> isa(__PACKAGE__);
3300    croak "Input argument must contain two elements"
3301      unless $y -> nelm() == 2;
3302
3303    my ($nrowx, $ncolx) = $x -> size();
3304
3305    $y = $y -> to_col();
3306    my $nrowrep = $y -> [0][0];
3307    my $ncolrep = $y -> [1][0];
3308
3309    my $z = [];
3310    for my $ix (0 .. $nrowx - 1) {
3311        for my $jx (0 .. $ncolx - 1) {
3312            for my $iy (0 .. $nrowrep - 1) {
3313                for my $jy (0 .. $ncolrep - 1) {
3314                    my $iz = $iy * $nrowx + $ix;
3315                    my $jz = $jy * $ncolx + $jx;
3316                    $z -> [$iz][$jz] = $x -> [$ix][$jx];
3317                }
3318            }
3319        }
3320    }
3321
3322    bless $z, $class;
3323}
3324
3325=pod
3326
3327=item reshape()
3328
3329Returns a reshaped copy of a matrix. The reshaping is done by creating a new
3330matrix and looping over the elements in column major order. The new matrix must
3331have the same number of elements as the invocand matrix. The following returns
3332an C<$m>-by-C<$n> matrix,
3333
3334    $y = $x -> reshape($m, $n);
3335
3336The code
3337
3338    $x = Math::Matrix -> new([[1, 3, 5, 7], [2, 4, 6, 8]]);
3339    $y = $x -> reshape(4, 2);
3340
3341creates the matrix $x
3342
3343    [ 1  3  5  7 ]
3344    [ 2  4  6  8 ]
3345
3346and returns a reshaped copy $y
3347
3348    [ 1  5 ]
3349    [ 2  6 ]
3350    [ 3  7 ]
3351    [ 4  8 ]
3352
3353=cut
3354
3355sub reshape {
3356    croak "Not enough arguments for ", (caller(0))[3] if @_ < 3;
3357    croak "Too many arguments for ", (caller(0))[3] if @_ > 3;
3358    my $x = shift;
3359    my $class = ref $x;
3360
3361    my ($nrowx, $ncolx) = $x -> size();
3362    my $nelmx = $nrowx * $ncolx;
3363
3364    my ($nrowy, $ncoly) = @_;
3365    my $nelmy = $nrowy * $ncoly;
3366
3367    croak "when reshaping, the number of elements can not change in ",
3368      (caller(0))[3] unless $nelmx == $nelmy;
3369
3370    my $y = [];
3371
3372    # No reshaping; just clone.
3373
3374    if ($nrowx == $nrowy && $ncolx == $ncoly) {
3375        $y = [ map [ @$_ ], @$x ];
3376    }
3377
3378    elsif ($nrowx == 1) {
3379
3380        # Reshape from a row vector to a column vector.
3381
3382        if ($ncoly == 1) {
3383            $y = [ map [ $_ ], @{ $x -> [0] } ];
3384        }
3385
3386        # Reshape from a row vector to a matrix.
3387
3388        else {
3389            my $k = 0;
3390            for my $j (0 .. $ncoly - 1) {
3391                for my $i (0 .. $nrowy - 1) {
3392                    $y -> [$i][$j] = $x -> [0][$k++];
3393                }
3394            }
3395        }
3396    }
3397
3398    elsif ($ncolx == 1) {
3399
3400        # Reshape from a column vector to a row vector.
3401
3402        if ($nrowy == 1) {
3403            $y = [[ map { @$_ } @$x ]];
3404        }
3405
3406        # Reshape from a column vector to a matrix.
3407
3408        else {
3409            my $k = 0;
3410            for my $j (0 .. $ncoly - 1) {
3411                for my $i (0 .. $nrowy - 1) {
3412                    $y -> [$i][$j] = $x -> [$k++][0];
3413                }
3414            }
3415        }
3416    }
3417
3418    # The invocand is a matrix. This code works in all cases, but is somewhat
3419    # slower than the specialized code above.
3420
3421    else {
3422        for my $k (0 .. $nelmx - 1) {
3423            my $ix = $k % $nrowx;
3424            my $jx = ($k - $ix) / $nrowx;
3425            my $iy = $k % $nrowy;
3426            my $jy = ($k - $iy) / $nrowy;
3427            $y -> [$iy][$jy] = $x -> [$ix][$jx];
3428        }
3429    }
3430
3431    bless $y, $class;
3432}
3433
3434=pod
3435
3436=item to_row()
3437
3438Reshape to a row.
3439
3440    $x -> to_row();
3441
3442This method reshapes the matrix into a single row. It is essentially the same
3443as, but faster than,
3444
3445    $x -> reshape(1, $x -> nelm());
3446
3447=cut
3448
3449sub to_row {
3450    croak "Not enough arguments for ", (caller(0))[3] if @_ < 1;
3451    croak "Too many arguments for ", (caller(0))[3] if @_ > 1;
3452    my $x = shift;
3453    my $class = ref $x;
3454
3455    my $y = bless [], $class;
3456
3457    my $ncolx = $x -> ncol();
3458    return $y if $ncolx == 0;
3459
3460    for my $j (0 .. $ncolx - 1) {
3461        push @{ $y -> [0] }, map $_->[$j], @$x;
3462    }
3463    return $y;
3464}
3465
3466=pod
3467
3468=item to_col()
3469
3470Reshape to a column.
3471
3472    $y = $x -> to_col();
3473
3474This method reshapes the matrix into a single column. It is essentially the same
3475as, but faster than,
3476
3477    $x -> reshape($x -> nelm(), 1);
3478
3479=cut
3480
3481sub to_col {
3482    croak "Not enough arguments for ", (caller(0))[3] if @_ < 1;
3483    croak "Too many arguments for ", (caller(0))[3] if @_ > 1;
3484    my $x = shift;
3485
3486    my $class = ref $x;
3487
3488    my $y = bless [], $class;
3489
3490    my $ncolx = $x -> ncol();
3491    return $y if $ncolx == 0;
3492
3493    for my $j (0 .. $ncolx - 1) {
3494        push @$y, map [ $_->[$j] ], @$x;
3495    }
3496    return $y;
3497}
3498
3499=pod
3500
3501=item to_permmat()
3502
3503Permutation vector to permutation matrix. Converts a vector of zero-based
3504permutation indices to a permutation matrix.
3505
3506    $P = $v -> to_permmat();
3507
3508For example
3509
3510    $v = Math::Matrix -> new([[0, 3, 1, 4, 2]]);
3511    $m = $v -> to_permmat();
3512
3513gives the permutation matrix C<$m>
3514
3515    [ 1 0 0 0 0 ]
3516    [ 0 0 0 1 0 ]
3517    [ 0 1 0 0 0 ]
3518    [ 0 0 0 0 1 ]
3519    [ 0 0 1 0 0 ]
3520
3521=cut
3522
3523sub to_permmat {
3524    croak "Not enough arguments for ", (caller(0))[3] if @_ < 1;
3525    croak "Too many arguments for ", (caller(0))[3] if @_ > 1;
3526    my $v = shift;
3527    my $class = ref $v;
3528
3529    my $n = $v -> nelm();
3530    my $P = $class -> zeros($n, $n);    # initialize output
3531    return $P if $n == 0;               # if emtpy $v
3532
3533    croak "Invocand must be a vector" unless $v -> is_vector();
3534    $v = $v -> to_col();
3535
3536    for my $i (0 .. $n - 1) {
3537        my $j = $v -> [$i][0];
3538        croak "index out of range" unless 0 <= $j && $j < $n;
3539        $P -> [$i][$j] = 1;
3540    }
3541
3542    return $P;
3543}
3544
3545=pod
3546
3547=item to_permvec()
3548
3549Permutation matrix to permutation vector. Converts a permutation matrix to a
3550vector of zero-based permutation indices.
3551
3552    $v = $P -> to_permvec();
3553
3554    $v = Math::Matrix -> new([[0, 3, 1, 4, 2]]);
3555    $m = $v -> to_permmat();
3556
3557Gives the permutation matrix C<$m>
3558
3559    [ 1 0 0 0 0 ]
3560    [ 0 0 0 1 0 ]
3561    [ 0 1 0 0 0 ]
3562    [ 0 0 0 0 1 ]
3563    [ 0 0 1 0 0 ]
3564
3565See also C<L</to_permmat()>>.
3566
3567=cut
3568
3569sub to_permvec {
3570    croak "Not enough arguments for ", (caller(0))[3] if @_ < 1;
3571    croak "Too many arguments for ", (caller(0))[3] if @_ > 1;
3572    my $P = shift;
3573    my $class = ref $P;
3574
3575    croak "Invocand matrix must be square" unless $P -> is_square();
3576    my $n = $P -> nrow();
3577
3578    my $v = $class -> zeros($n, 1);     # initialize output
3579
3580    my $seen = [ (0) x $n ];            # keep track of the ones
3581
3582    for my $i (0 .. $n - 1) {
3583        my $k;
3584        for my $j (0 .. $n - 1) {
3585            next if $P -> [$i][$j] == 0;
3586            if ($P -> [$i][$j] == 1) {
3587                croak "invalid permutation matrix; more than one row has",
3588                  " an element with value 1 in column $j" if $seen->[$j]++;
3589                $k = $j;
3590                next;
3591            }
3592            croak "invalid permutation matrix; element ($i,$j)",
3593              " is neither 0 nor 1";
3594        }
3595        croak "invalid permutation matrix; row $i has no element with value 1"
3596          unless defined $k;
3597        $v->[$i][0] = $k;
3598    }
3599
3600    return $v;
3601}
3602
3603=pod
3604
3605=item triu()
3606
3607Upper triangular part. Extract the upper triangular part of a matrix and set all
3608other elements to zero.
3609
3610    $y = $x -> triu();
3611    $y = $x -> triu($n);
3612
3613The optional second argument specifies how many diagonals above or below the
3614main diagonal should also be set to zero. The default value of C<$n> is zero
3615which includes the main diagonal.
3616
3617=cut
3618
3619sub triu {
3620    croak "Not enough arguments for ", (caller(0))[3] if @_ < 1;
3621    croak "Too many arguments for ", (caller(0))[3] if @_ > 2;
3622    my $x = shift;
3623    my $class = ref $x;
3624
3625    my $n = 0;
3626    if (@_) {
3627        $n = shift;
3628        if (ref $n) {
3629            $n = $class -> new($n)
3630              unless defined(blessed($n)) && $n -> isa($class);
3631            croak "Argument must be a scalar" unless $n -> is_scalar();
3632            $n = $n -> [0][0];
3633        }
3634        croak "Argument must be an integer" unless $n == int $n;
3635    }
3636
3637    my ($nrowx, $ncolx) = $x -> size();
3638
3639    my $y = [];
3640    for my $i (0 .. $nrowx - 1) {
3641        for my $j (0 .. $ncolx - 1) {
3642            $y -> [$i][$j] = $j - $i >= $n ? $x -> [$i][$j] : 0;
3643        }
3644    }
3645
3646    bless $y, $class;
3647}
3648
3649=pod
3650
3651=item tril()
3652
3653Lower triangular part. Extract the lower triangular part of a matrix and set all
3654other elements to zero.
3655
3656    $y = $x -> tril();
3657    $y = $x -> tril($n);
3658
3659The optional second argument specifies how many diagonals above or below the
3660main diagonal should also be set to zero. The default value of C<$n> is zero
3661which includes the main diagonal.
3662
3663=cut
3664
3665sub tril {
3666    croak "Not enough arguments for ", (caller(0))[3] if @_ < 1;
3667    croak "Too many arguments for ", (caller(0))[3] if @_ > 2;
3668    my $x = shift;
3669    my $class = ref $x;
3670
3671    my $n = 0;
3672    if (@_) {
3673        $n = shift;
3674        if (ref $n) {
3675            $n = $class -> new($n)
3676              unless defined(blessed($n)) && $n -> isa($class);
3677            croak "Argument must be a scalar" unless $n -> is_scalar();
3678            $n = $n -> [0][0];
3679        }
3680        croak "Argument must be an integer" unless $n == int $n;
3681    }
3682
3683    my ($nrowx, $ncolx) = $x -> size();
3684
3685    my $y = [];
3686    for my $i (0 .. $nrowx - 1) {
3687        for my $j (0 .. $ncolx - 1) {
3688            $y -> [$i][$j] = $j - $i <= $n ? $x -> [$i][$j] : 0;
3689        }
3690    }
3691
3692    bless $y, $class;
3693}
3694
3695=pod
3696
3697=item slice()
3698
3699Extract columns:
3700
3701    a->slice(1,3,5);
3702
3703=cut
3704
3705sub slice {
3706    my $self = shift;
3707    my $class = ref($self);
3708    my $result = [];
3709
3710    for my $i (0 .. $#$self) {
3711        push @$result, [ @{$self->[$i]}[@_] ];
3712    }
3713
3714    bless $result, $class;
3715}
3716
3717=pod
3718
3719=item diagonal_vector()
3720
3721Extract the diagonal as an array:
3722
3723    $diag = $a->diagonal_vector;
3724
3725=cut
3726
3727sub diagonal_vector {
3728    my $self = shift;
3729    my @diag;
3730    my $idx = 0;
3731    my($m, $n) = $self->size();
3732
3733    croak "Not a square matrix" if $m != $n;
3734
3735    foreach my $r (@{$self}) {
3736        push @diag, $r->[$idx++];
3737    }
3738    return \@diag;
3739}
3740
3741=pod
3742
3743=item tridiagonal_vector()
3744
3745Extract the diagonals that make up a tridiagonal matrix:
3746
3747    ($main_d, $upper_d, $lower_d) = $a->tridiagonal_vector;
3748
3749=cut
3750
3751sub tridiagonal_vector {
3752    my $self = shift;
3753    my(@main_d, @up_d, @low_d);
3754    my($m, $n) = $self->size();
3755    my $idx = 0;
3756
3757    croak "Not a square matrix" if $m != $n;
3758
3759    foreach my $r (@{$self}) {
3760        push @low_d, $r->[$idx - 1] if ($idx > 0);
3761        push @main_d, $r->[$idx++];
3762        push @up_d, $r->[$idx] if ($idx < $m);
3763    }
3764    return ([@main_d],[@up_d],[@low_d]);
3765}
3766
3767=pod
3768
3769=back
3770
3771=head2 Mathematical functions
3772
3773=head3 Addition
3774
3775=over 4
3776
3777=item add()
3778
3779Addition. If one operands is a scalar, it is treated like a constant matrix with
3780the same size as the other operand. Otherwise ordinary matrix addition is
3781performed.
3782
3783    $z = $x -> add($y);
3784
3785See also C<L</madd()>> and C<L</sadd()>>.
3786
3787=cut
3788
3789sub add {
3790    croak "Not enough arguments for ", (caller(0))[3] if @_ < 2;
3791    croak "Too many arguments for ", (caller(0))[3] if @_ > 2;
3792    my $x = shift;
3793    my $class = ref $x;
3794
3795    my $y = shift;
3796    $y = $class -> new($y) unless defined(blessed($y)) && $y -> isa($class);
3797
3798    $x -> is_scalar() || $y -> is_scalar() ? $x -> sadd($y) : $x -> madd($y);
3799}
3800
3801=pod
3802
3803=item madd()
3804
3805Matrix addition. Add two matrices of the same dimensions. An error is thrown if
3806the matrices don't have the same size.
3807
3808    $z = $x -> madd($y);
3809
3810See also C<L</add()>> and C<L</sadd()>>.
3811
3812=cut
3813
3814sub madd {
3815    croak "Not enough arguments for ", (caller(0))[3] if @_ < 2;
3816    croak "Too many arguments for ", (caller(0))[3] if @_ > 2;
3817    my $x = shift;
3818    my $class = ref $x;
3819
3820    my $y = shift;
3821    $y = $class -> new($y) unless defined(blessed($y)) && $y -> isa($class);
3822
3823    my ($nrowx, $ncolx) = $x -> size();
3824    my ($nrowy, $ncoly) = $y -> size();
3825
3826    croak "Can't add $nrowx-by-$ncolx matrix to $nrowy-by-$ncoly matrix"
3827      unless $nrowx == $nrowy && $ncolx == $ncoly;
3828
3829    my $z = [];
3830    for my $i (0 .. $nrowx - 1) {
3831        for my $j (0 .. $ncolx - 1) {
3832            $z->[$i][$j] = $x->[$i][$j] + $y->[$i][$j];
3833        }
3834    }
3835
3836    bless $z, $class;
3837}
3838
3839=pod
3840
3841=item sadd()
3842
3843Scalar (element by element) addition with scalar expansion. This method places
3844no requirements on the size of the input matrices.
3845
3846    $z = $x -> sadd($y);
3847
3848See also C<L</add()>> and C<L</madd()>>.
3849
3850=cut
3851
3852sub sadd {
3853    croak "Not enough arguments for ", (caller(0))[3] if @_ < 2;
3854    croak "Too many arguments for ", (caller(0))[3] if @_ > 2;
3855    my $x = shift;
3856
3857    my $sub = sub { $_[0] + $_[1] };
3858    $x -> sapply($sub, @_);
3859}
3860
3861=pod
3862
3863=back
3864
3865=head3 Subtraction
3866
3867=over 4
3868
3869=item sub()
3870
3871Subtraction. If one operands is a scalar, it is treated as a constant matrix
3872with the same size as the other operand. Otherwise, ordinarly matrix subtraction
3873is performed.
3874
3875    $z = $x -> sub($y);
3876
3877See also C<L</msub()>> and C<L</ssub()>>.
3878
3879=cut
3880
3881sub sub {
3882    croak "Not enough arguments for ", (caller(0))[3] if @_ < 2;
3883    croak "Too many arguments for ", (caller(0))[3] if @_ > 2;
3884    my $x = shift;
3885    my $class = ref $x;
3886
3887    my $y = shift;
3888    $y = $class -> new($y) unless defined(blessed($y)) && $y -> isa($class);
3889
3890    $x -> is_scalar() || $y -> is_scalar() ? $x -> ssub($y) : $x -> msub($y);
3891}
3892
3893=pod
3894
3895=item msub()
3896
3897Matrix subtraction. Subtract two matrices of the same size. An error is thrown
3898if the matrices don't have the same size.
3899
3900    $z = $x -> msub($y);
3901
3902See also C<L</sub()>> and C<L</ssub()>>.
3903
3904=cut
3905
3906sub msub {
3907    croak "Not enough arguments for ", (caller(0))[3] if @_ < 2;
3908    croak "Too many arguments for ", (caller(0))[3] if @_ > 2;
3909    my $x = shift;
3910    my $class = ref $x;
3911
3912    my $y = shift;
3913    $y = $class -> new($y) unless defined(blessed($y)) && $y -> isa($class);
3914
3915    my ($nrowx, $ncolx) = $x -> size();
3916    my ($nrowy, $ncoly) = $y -> size();
3917
3918    croak "Can't subtract $nrowy-by-$ncoly matrix from $nrowx-by-$ncolx matrix"
3919      unless $nrowx == $nrowy && $ncolx == $ncoly;
3920
3921    my $z = [];
3922    for my $i (0 .. $nrowx - 1) {
3923        for my $j (0 .. $ncolx - 1) {
3924            $z->[$i][$j] = $x->[$i][$j] - $y->[$i][$j];
3925        }
3926    }
3927
3928    bless $z, $class;
3929}
3930
3931=pod
3932
3933=item ssub()
3934
3935Scalar (element by element) subtraction with scalar expansion. This method
3936places no requirements on the size of the input matrices.
3937
3938    $z = $x -> ssub($y);
3939
3940See also C<L</sub()>> and C<L</msub()>>.
3941
3942=cut
3943
3944sub ssub {
3945    croak "Not enough arguments for ", (caller(0))[3] if @_ < 2;
3946    croak "Too many arguments for ", (caller(0))[3] if @_ > 2;
3947    my $x = shift;
3948
3949    my $sub = sub { $_[0] - $_[1] };
3950    $x -> sapply($sub, @_);
3951}
3952
3953=pod
3954
3955=item subtract()
3956
3957This is an alias for C<L</msub()>>.
3958
3959=cut
3960
3961sub subtract {
3962    my $x = shift;
3963    $x -> sub(@_);
3964}
3965
3966=pod
3967
3968=back
3969
3970=head3 Negation
3971
3972=over 4
3973
3974=item neg()
3975
3976Negation. Negate a matrix.
3977
3978    $y = $x -> neg();
3979
3980It is effectively equivalent to
3981
3982    $y = $x -> map(sub { -$_ });
3983
3984=cut
3985
3986sub neg {
3987    croak "Not enough arguments for ", (caller(0))[3] if @_ < 1;
3988    croak "Too many arguments for ", (caller(0))[3] if @_ > 1;
3989    my $x = shift;
3990    bless [ map [ map -$_, @$_ ], @$x ], ref $x;
3991}
3992
3993=pod
3994
3995=item negative()
3996
3997This is an alias for C<L</neg()>>.
3998
3999=cut
4000
4001sub negative {
4002    my $x = shift;
4003    $x -> neg(@_);
4004}
4005
4006=pod
4007
4008=back
4009
4010=head3 Multiplication
4011
4012=over 4
4013
4014=item mul()
4015
4016Multiplication. If one operands is a scalar, it is treated as a constant matrix
4017with the same size as the other operand. Otherwise, ordinary matrix
4018multiplication is performed.
4019
4020    $z = $x -> mul($y);
4021
4022=cut
4023
4024sub mul {
4025    croak "Not enough arguments for ", (caller(0))[3] if @_ < 2;
4026    croak "Too many arguments for ", (caller(0))[3] if @_ > 2;
4027    my $x = shift;
4028    my $class = ref $x;
4029
4030    my $y = shift;
4031    $y = $class -> new($y) unless defined(blessed($y)) && $y -> isa($class);
4032
4033    $x -> is_scalar() || $y -> is_scalar() ? $x -> smul($y) : $x -> mmul($y);
4034}
4035
4036=pod
4037
4038=item mmul()
4039
4040Matrix multiplication. An error is thrown if the sizes don't match; the number
4041of columns in the first operand must be equal to the number of rows in the
4042second operand.
4043
4044    $z = $x -> mmul($y);
4045
4046=cut
4047
4048sub mmul {
4049    croak "Not enough arguments for ", (caller(0))[3] if @_ < 2;
4050    croak "Too many arguments for ", (caller(0))[3] if @_ > 2;
4051    my $x = shift;
4052    my $class = ref $x;
4053
4054    my $y = shift;
4055    $y = $class -> new($y) unless defined(blessed($y)) && $y -> isa($class);
4056
4057    my $mx = $x -> nrow();
4058    my $nx = $x -> ncol();
4059
4060    my $my = $y -> nrow();
4061    my $ny = $y -> ncol();
4062
4063    croak "Can't multiply $mx-by-$nx matrix with $my-by-$ny matrix"
4064      unless $nx == $my;
4065
4066    my $z = [];
4067    my $l = $nx - 1;            # "inner length"
4068    for my $i (0 .. $mx - 1) {
4069        for my $j (0 .. $ny - 1) {
4070            $z -> [$i][$j] = _sum(map $x -> [$i][$_] * $y -> [$_][$j], 0 .. $l);
4071        }
4072    }
4073
4074    bless $z, $class;
4075}
4076
4077=pod
4078
4079=item smul()
4080
4081Scalar (element by element) multiplication with scalar expansion. This method
4082places no requirements on the size of the input matrices.
4083
4084    $z = $x -> smul($y);
4085
4086=cut
4087
4088sub smul {
4089    croak "Not enough arguments for ", (caller(0))[3] if @_ < 2;
4090    croak "Too many arguments for ", (caller(0))[3] if @_ > 2;
4091    my $x = shift;
4092
4093    my $sub = sub { $_[0] * $_[1] };
4094    $x -> sapply($sub, @_);
4095}
4096
4097=pod
4098
4099=item mmuladd()
4100
4101Matrix fused multiply and add. If C<$x> is a C<$p>-by-C<$q> matrix, then C<$y>
4102must be a C<$q>-by-C<$r> matrix and C<$z> must be a C<$p>-by-C<$r> matrix. An
4103error is thrown if the sizes don't match.
4104
4105    $w = $x -> mmuladd($y, $z);
4106
4107The fused multiply and add is equivalent to, but computed with higher accuracy
4108than
4109
4110    $w = $x -> mmul($y) -> madd($z);
4111
4112This method can be used to improve the solution of linear systems.
4113
4114=cut
4115
4116sub mmuladd {
4117    croak "Not enough arguments for ", (caller(0))[3] if @_ < 3;
4118    croak "Too many arguments for ", (caller(0))[3] if @_ > 3;
4119    my $x = shift;
4120    my $class = ref $x;
4121
4122    my ($mx, $nx) = $x -> size();
4123
4124    my $y = shift;
4125    $y = $class -> new($y) unless defined(blessed($y)) && $y -> isa($class);
4126    my ($my, $ny) = $y -> size();
4127
4128    croak "Can't multiply $mx-by-$nx matrix with $my-by-$ny matrix"
4129      unless $nx == $my;
4130
4131    my $z = shift;
4132    $z = $class -> new($z) unless defined(blessed($z)) && $z -> isa($class);
4133    my ($mz, $nz) = $z -> size();
4134
4135    croak "Can't add $mz-by-$nz matrix to $mx-by-$ny matrix"
4136      unless $mz == $mx && $nz == $ny;
4137
4138    my $w = [];
4139    my $l = $nx - 1;            # "inner length"
4140    for my $i (0 .. $mx - 1) {
4141        for my $j (0 .. $ny - 1) {
4142            $w -> [$i][$j]
4143              = _sum(map($x -> [$i][$_] * $y -> [$_][$j], 0 .. $l),
4144                     $z -> [$i][$j]);
4145        }
4146    }
4147
4148    bless $w, $class;
4149}
4150
4151=pod
4152
4153=item kron()
4154
4155Kronecker tensor product.
4156
4157    $A -> kronprod($B);
4158
4159If C<$A> is an C<$m>-by-C<$n> matrix and C<$B> is a C<$p>-by-C<$q> matrix, then
4160C<< $A -> kron($B) >> is an C<$m>*C<$p>-by-C<$n>*C<$q> matrix formed by taking
4161all possible products between the elements of C<$A> and the elements of C<$B>.
4162
4163=cut
4164
4165sub kron {
4166    croak "Not enough arguments for ", (caller(0))[3] if @_ < 2;
4167    croak "Too many arguments for ", (caller(0))[3] if @_ > 2;
4168    my $x = shift;
4169    my $class = ref $x;
4170
4171    my $y = shift;
4172    $y = $class -> new($y) unless defined(blessed($y)) && $y -> isa($class);
4173
4174    my ($nrowx, $ncolx) = $x -> size();
4175    my ($nrowy, $ncoly) = $y -> size();
4176
4177    my $z = bless [], $class;
4178
4179    for my $ix (0 .. $nrowx - 1) {
4180        for my $jx (0 .. $ncolx - 1) {
4181            for my $iy (0 .. $nrowy - 1) {
4182                for my $jy (0 .. $ncoly - 1) {
4183                    my $iz = $ix * $nrowx + $iy;
4184                    my $jz = $jx * $ncolx + $jy;
4185                    $z -> [$iz][$jz] = $x -> [$ix][$jx] * $y -> [$iy][$jy];
4186                }
4187            }
4188        }
4189    }
4190
4191    return $z;
4192}
4193
4194=pod
4195
4196=item multiply()
4197
4198This is an alias for C<L</mmul()>>.
4199
4200=cut
4201
4202sub multiply {
4203    my $x = shift;
4204    $x -> mmul(@_);
4205}
4206
4207=pod
4208
4209=item multiply_scalar()
4210
4211Multiplies a matrix and a scalar resulting in a matrix of the same dimensions
4212with each element scaled with the scalar.
4213
4214    $a->multiply_scalar(2);  scale matrix by factor 2
4215
4216=cut
4217
4218sub multiply_scalar {
4219    my $self = shift;
4220    my $factor = shift;
4221    my $result = $self->new();
4222
4223    my $last = $#{$self->[0]};
4224    for my $i (0 .. $#{$self}) {
4225        for my $j (0 .. $last) {
4226            $result->[$i][$j] = $factor * $self->[$i][$j];
4227        }
4228    }
4229    $result;
4230}
4231
4232=pod
4233
4234=back
4235
4236=head3 Powers
4237
4238=over 4
4239
4240=item pow()
4241
4242Power function.
4243
4244This is an alias for C<L</mpow()>>.
4245
4246See also C<L</spow()>>.
4247
4248=cut
4249
4250sub pow {
4251    my $x = shift;
4252    $x -> mpow(@_);
4253}
4254
4255=pod
4256
4257=item mpow()
4258
4259Matrix power. The second operand must be a non-negative integer.
4260
4261    $y = $x -> mpow($n);
4262
4263The following example
4264
4265    $x = Math::Matrix -> new([[0, -2],[1, 4]]);
4266    $y = 4;
4267    $z = $x -> pow($y);
4268
4269returns the matrix
4270
4271    [ -28  -96 ]
4272    [  48  164 ]
4273
4274See also C<L</spow()>>.
4275
4276=cut
4277
4278sub mpow {
4279    croak "Not enough arguments for ", (caller(0))[3] if @_ < 2;
4280    croak "Too many arguments for ", (caller(0))[3] if @_ > 2;
4281    my $x = shift;
4282    my $class = ref $x;
4283
4284    croak "Invocand matrix must be square in ", (caller(0))[3]
4285      unless $x -> is_square();
4286
4287    my $n = shift;
4288    croak "Exponent can not be undefined" unless defined $n;
4289    if (ref $n) {
4290        $n = $class -> new($n) unless defined(blessed($n)) && $n -> isa($class);
4291        croak "Exponent must be a scalar in ", (caller(0))[3]
4292          unless $n -> is_scalar();
4293        $n = $n -> [0][0];
4294    }
4295    croak "Exponent must be an integer" unless $n == int $n;
4296
4297    return $class -> new([]) if $x -> is_empty();
4298
4299    my ($nrowx, $ncolx) = $x -> size();
4300    return $class -> id($nrowx, $ncolx) if $n == 0;
4301    return $x -> clone()                if $n == 1;
4302
4303    my $neg = $n < 0;
4304    $n = -$n if $neg;
4305
4306    my $y = $class -> id($nrowx, $ncolx);
4307    my $tmp = $x;
4308    while (1) {
4309        my $rem = $n % 2;
4310        $y *= $tmp if $rem;
4311        $n = ($n - $rem) / 2;
4312        last if $n == 0;
4313        $tmp = $tmp * $tmp;
4314    }
4315
4316    $y = $y -> minv() if $neg;
4317
4318    return $y;
4319}
4320
4321=pod
4322
4323=item spow()
4324
4325Scalar (element by element) power function. This method doesn't require the
4326matrices to have the same size.
4327
4328    $z = $x -> spow($y);
4329
4330See also C<L</mpow()>>.
4331
4332=cut
4333
4334sub spow {
4335    croak "Not enough arguments for ", (caller(0))[3] if @_ < 2;
4336    croak "Too many arguments for ", (caller(0))[3] if @_ > 2;
4337    my $x = shift;
4338
4339    my $sub = sub { $_[0] ** $_[1] };
4340    $x -> sapply($sub, @_);
4341}
4342
4343=pod
4344
4345=back
4346
4347=head3 Inversion
4348
4349=over 4
4350
4351=item inv()
4352
4353This is an alias for C<L</minv()>>.
4354
4355=cut
4356
4357sub inv {
4358    my $x = shift;
4359    $x -> minv();
4360}
4361
4362=pod
4363
4364=item invert()
4365
4366Invert a Matrix using C<solve>.
4367
4368=cut
4369
4370sub invert {
4371    my $M = shift;
4372    my ($m, $n) = $M->size;
4373    croak "Can't invert $m-by-$n matrix; matrix must be square"
4374      if $m != $n;
4375    my $I = $M->new_identity($n);
4376    ($M->concat($I))->solve;
4377}
4378
4379=pod
4380
4381=item minv()
4382
4383Matrix inverse. Invert a matrix.
4384
4385    $y = $x -> inv();
4386
4387See the section L</IMPROVING THE SOLUTION OF LINEAR SYSTEMS> for a list of
4388additional parameters that can be used for trying to obtain a better solution
4389through iteration.
4390
4391=cut
4392
4393sub minv {
4394    croak "Not enough arguments for ", (caller(0))[3] if @_ < 1;
4395    #croak "Too many arguments for ", (caller(0))[3] if @_ > 1;
4396    my $x = shift;
4397    my $class = ref $x;
4398
4399    my $n = $x -> nrow();
4400    return $class -> id($n) -> mldiv($x, @_);
4401}
4402
4403=pod
4404
4405=item sinv()
4406
4407Scalar (element by element) inverse. Invert each element in a matrix.
4408
4409    $y = $x -> sinv();
4410
4411=cut
4412
4413sub sinv {
4414    croak "Not enough arguments for ", (caller(0))[3] if @_ < 1;
4415    croak "Too many arguments for ", (caller(0))[3] if @_ > 1;
4416    my $x = shift;
4417
4418    bless [ map [ map 1/$_, @$_ ], @$x ], ref $x;
4419}
4420
4421=pod
4422
4423=item mldiv()
4424
4425Matrix left division. Returns the solution x of the linear system of equations
4426A*x = y, by computing A^(-1)*y.
4427
4428    $x = $y -> mldiv($A);
4429
4430This method also handles overdetermined and underdetermined systems. There are
4431three cases
4432
4433=over 4
4434
4435=item *
4436
4437If A is a square matrix, then
4438
4439    x = A\y = inv(A)*y
4440
4441so that A*x = y to within round-off accuracy.
4442
4443=item *
4444
4445If A is an M-by-N matrix where M > N, then A\y is computed as
4446
4447    A\y = (A'*A)\(A'*y) = inv(A'*A)*(A'*y)
4448
4449where A' denotes the transpose of A. The returned matrix is the least squares
4450solution to the linear system of equations A*x = y, if it exists. The matrix
4451A'*A must be non-singular.
4452
4453=item *
4454
4455If A is an where M < N, then A\y is computed as
4456
4457    A\y = A'*((A*A')\y)
4458
4459This solution is not unique. The matrix A*A' must be non-singular.
4460
4461=back
4462
4463See the section L</IMPROVING THE SOLUTION OF LINEAR SYSTEMS> for a list of
4464additional parameters that can be used for trying to obtain a better solution
4465through iteration.
4466
4467=cut
4468
4469sub mldiv {
4470    croak "Not enough arguments for ", (caller(0))[3] if @_ < 2;
4471    #croak "Too many arguments for ", (caller(0))[3] if @_ > 2;
4472    my $y = shift;
4473    my $class = ref $y;
4474
4475    my $A = shift;
4476    $A = $class -> new($A) unless defined(blessed($A)) && $A -> isa($class);
4477
4478    my ($m, $n) = $A -> size();
4479
4480    if ($m > $n) {
4481
4482        # If A is an M-by-N matrix where M > N, i.e., an overdetermined system,
4483        # compute (A'*A)\(A'*y) by doing a one level deep recursion.
4484
4485        my $At = $A -> transpose();
4486        return $At -> mmul($y) -> mldiv($At -> mmul($A), @_);
4487
4488    } elsif ($m < $n) {
4489
4490        # If A is an M-by-N matrix where M < N, i.e., and underdetermined
4491        # system, compute A'*((A*A')\y) by doing a one level deep recursion.
4492        # This solution is not unique.
4493
4494        my $At = $A -> transpose();
4495        return $At -> mldiv($At -> mmul($A), @_);
4496    }
4497
4498    # If extra arguments are given ...
4499
4500    if (@_) {
4501
4502        require Config;
4503        my $max_iter = 20;
4504        my $rel_tol  = ($Config::Config{uselongdouble} ||
4505                        $Config::Config{usequadmath}) ? 1e-19 : 1e-9;
4506        my $abs_tol  = 0;
4507        my $debug;
4508
4509        while (@_) {
4510            my $param = shift;
4511            croak "parameter name can not be undefined" unless defined $param;
4512
4513            croak "missing value for parameter '$param'" unless @_;
4514            my $value = shift;
4515
4516            if ($param eq 'MaxIter') {
4517                croak "value for parameter 'MaxIter' can not be undefined"
4518                  unless defined $value;
4519                croak "value for parameter 'MaxIter' must be a positive integer"
4520                  unless $value > 0 && $value == int $value;
4521                $max_iter = $value;
4522                next;
4523            }
4524
4525            if ($param eq 'RelTol') {
4526                croak "value for parameter 'RelTol' can not be undefined"
4527                  unless defined $value;
4528                croak "value for parameter 'RelTol' must be non-negative"
4529                  unless $value >= 0;
4530                $rel_tol = $value;
4531                next;
4532            }
4533
4534            if ($param eq 'AbsTol') {
4535                croak "value for parameter 'AbsTol' can not be undefined"
4536                  unless defined $value;
4537                croak "value for parameter 'AbsTol' must be non-negative"
4538                  unless $value >= 0;
4539                $abs_tol = $value;
4540                next;
4541            }
4542
4543            if ($param eq 'Debug') {
4544                $debug = $value;
4545                next;
4546            }
4547
4548            croak "unknown parameter '$param'";
4549        }
4550
4551        if ($debug) {
4552            printf "\n";
4553            printf "max_iter = %24d\n", $max_iter;
4554            printf "rel_tol  = %24.15e\n", $rel_tol;
4555            printf "abs_tol  = %24.15e\n", $abs_tol;
4556        }
4557
4558        my $y_norm = _hypot(map { @$_ } @$y);
4559
4560        my $x = $y -> mldiv($A);
4561
4562        my $x_best;
4563        my $iter_best;
4564        my $abs_err_best;
4565        my $rel_err_best;
4566
4567        for (my $iter = 1 ; ; $iter++) {
4568
4569            # Compute the residuals.
4570
4571            my $r = $A -> mmuladd($x, -$y);
4572
4573            # Compute the errors.
4574
4575            my $r_norm  = _hypot(map @$_, @$r);
4576            my $abs_err = $r_norm;
4577            my $rel_err = $y_norm == 0 ? $r_norm : $r_norm / $y_norm;
4578
4579            if ($debug) {
4580                printf "\n";
4581                printf "iter     = %24d\n", $iter;
4582                printf "r_norm   = %24.15e\n", $r_norm;
4583                printf "y_norm   = %24.15e\n", $y_norm;
4584                printf "abs_err  = %24.15e\n", $abs_err;
4585                printf "rel_err  = %24.15e\n", $rel_err;
4586            }
4587
4588            # See if this is the first round or we have an new all-time best.
4589
4590            if ($iter == 1 ||
4591                $abs_err < $abs_err_best ||
4592                $rel_err < $rel_err_best)
4593            {
4594                $x_best       = $x;
4595                $iter_best    = $iter;
4596                $abs_err_best = $abs_err;
4597                $rel_err_best = $rel_err;
4598            }
4599
4600            if ($abs_err_best <= $abs_tol || $rel_err_best <= $rel_tol) {
4601                last;
4602            } else {
4603
4604                # If we still haven't got the desired result, but have reached
4605                # the maximum number of iterations, display a warning.
4606
4607                if ($iter == $max_iter) {
4608                    carp "mldiv() stopped because the maximum number of",
4609                      " iterations (max. iter = $max_iter) was reached without",
4610                      " converging to any of the desired tolerances (",
4611                      "rel_tol = ", $rel_tol, ", ",
4612                      "abs_tol = ", $abs_tol, ").",
4613                      " The best iterate (iter. = ", $iter_best, ") has",
4614                      " a relative residual of ", $rel_err_best, " and",
4615                      " an absolute residual of ", $abs_err_best, ".";
4616                    last;
4617                }
4618            }
4619
4620            # Compute delta $x.
4621
4622            my $d = $r -> mldiv($A);
4623
4624            # Compute the improved solution $x.
4625
4626            $x -= $d;
4627        }
4628
4629        return $x_best, $rel_err_best, $abs_err_best, $iter_best if wantarray;
4630        return $x_best;
4631    }
4632
4633    # If A is an M-by-M, compute A\y directly.
4634
4635    croak "mldiv(): sizes don't match" unless $y -> nrow() == $n;
4636
4637    # Create the augmented matrix.
4638
4639    my $x = $A -> catcol($y);
4640
4641    # Perform forward elimination.
4642
4643    my ($rowperm, $colperm);
4644    eval { ($x, $rowperm, $colperm) = $x -> felim_fp() };
4645    croak "mldiv(): matrix is singular or close to singular" if $@;
4646
4647    # Perform backward substitution.
4648
4649    eval { $x = $x -> bsubs() };
4650    croak "mldiv(): matrix is singular or close to singular" if $@;
4651
4652    # Remove left half to keep only the augmented matrix.
4653
4654    $x = $x -> splicecol(0, $n);
4655
4656    # Reordering the rows is only necessary when full (complete) pivoting is
4657    # used above. If partial pivoting is used, this reordeing could be skipped,
4658    # but it executes so fast that it causes no harm to do it anyway.
4659
4660    @$x[ @$colperm ] = @$x;
4661
4662    return $x;
4663}
4664
4665=pod
4666
4667=item sldiv()
4668
4669Scalar (left) division.
4670
4671    $x -> sldiv($y);
4672
4673For scalars, there is no difference between left and right division, so this is
4674just an alias for C<L</sdiv()>>.
4675
4676=cut
4677
4678sub sldiv {
4679    my $x = shift;
4680    $x -> sdiv(@_)
4681}
4682
4683=pod
4684
4685=item mrdiv()
4686
4687Matrix right division. Returns the solution x of the linear system of equations
4688x*A = y, by computing x = y/A = y*inv(A) = (A'\y')', where A' and y' denote the
4689transpose of A and y, respectively, and \ is matrix left division (see
4690C<L</mldiv()>>).
4691
4692    $x = $y -> mrdiv($A);
4693
4694See the section L</IMPROVING THE SOLUTION OF LINEAR SYSTEMS> for a list of
4695additional parameters that can be used for trying to obtain a better solution
4696through iteration.
4697
4698=cut
4699
4700sub mrdiv {
4701    croak "Not enough arguments for ", (caller(0))[3] if @_ < 2;
4702    #croak "Too many arguments for ", (caller(0))[3] if @_ > 2;
4703    my $y = shift;
4704    my $class = ref $y;
4705
4706    my $A = shift;
4707    $A = $class -> new($A) unless defined(blessed($A)) && $A -> isa($class);
4708
4709    $y -> transpose() -> mldiv($A -> transpose(), @_) -> transpose();
4710}
4711
4712=pod
4713
4714=item srdiv()
4715
4716Scalar (right) division.
4717
4718    $x -> srdiv($y);
4719
4720For scalars, there is no difference between left and right division, so this is
4721just an alias for C<L</sdiv()>>.
4722
4723=cut
4724
4725sub srdiv {
4726    my $x = shift;
4727    $x -> sdiv(@_)
4728}
4729
4730=pod
4731
4732=item sdiv()
4733
4734Scalar division. Performs scalar (element by element) division.
4735
4736    $x -> sdiv($y);
4737
4738=cut
4739
4740sub sdiv {
4741    croak "Not enough arguments for ", (caller(0))[3] if @_ < 2;
4742    croak "Too many arguments for ", (caller(0))[3] if @_ > 2;
4743    my $x = shift;
4744
4745    my $sub = sub { $_[0] / $_[1] };
4746    $x -> sapply($sub, @_);
4747}
4748
4749=pod
4750
4751=item mpinv()
4752
4753Matrix pseudo-inverse, C<(A'*A)^(-1)*A'>, where "C<'>" is the transpose
4754operator.
4755
4756See the section L</IMPROVING THE SOLUTION OF LINEAR SYSTEMS> for a list of
4757additional parameters that can be used for trying to obtain a better solution
4758through iteration.
4759
4760=cut
4761
4762sub mpinv {
4763    my $A = shift;
4764
4765    my $At = $A -> transpose();
4766    return $At -> mldiv($At -> mmul($A), @_);
4767}
4768
4769=pod
4770
4771=item pinv()
4772
4773This is an alias for C<L</mpinv()>>.
4774
4775=cut
4776
4777sub pinv {
4778    my $x = shift;
4779    $x -> mpinv();
4780}
4781
4782=pod
4783
4784=item pinvert()
4785
4786This is an alias for C<L</mpinv()>>.
4787
4788=cut
4789
4790sub pinvert {
4791    my $x = shift;
4792    $x -> mpinv();
4793}
4794
4795=pod
4796
4797=item solve()
4798
4799Solves a equation system given by the matrix. The number of colums must be
4800greater than the number of rows. If variables are dependent from each other,
4801the second and all further of the dependent coefficients are 0. This means the
4802method can handle such systems. The method returns a matrix containing the
4803solutions in its columns or B<undef> in case of error.
4804
4805=cut
4806
4807sub solve {
4808    my $self  = shift;
4809    my $class = ref($self);
4810
4811    my $m    = $self->clone();
4812    my $mr   = $#{$m};
4813    my $mc   = $#{$m->[0]};
4814    my $f;
4815    my $try;
4816
4817    return undef if $mc <= $mr;
4818  ROW: for(my $i = 0; $i <= $mr; $i++) {
4819        $try=$i;
4820        # make diagonal element nonzero if possible
4821        while (abs($m->[$i]->[$i]) < $eps) {
4822            last ROW if $try++ > $mr;
4823            my $row = splice(@{$m},$i,1);
4824            push(@{$m}, $row);
4825        }
4826
4827        # normalize row
4828        $f = $m->[$i]->[$i];
4829        for (my $k = 0; $k <= $mc; $k++) {
4830            $m->[$i]->[$k] /= $f;
4831        }
4832        # subtract multiple of designated row from other rows
4833        for (my $j = 0; $j <= $mr; $j++) {
4834            next if $i == $j;
4835            $f = $m->[$j]->[$i];
4836            for (my $k = 0; $k <= $mc; $k++) {
4837                $m->[$j]->[$k] -= $m->[$i]->[$k] * $f;
4838            }
4839        }
4840    }
4841
4842    # Answer is in augmented column
4843    $class -> new([ @{ $m -> transpose }[$mr+1 .. $mc] ]) -> transpose;
4844}
4845
4846=pod
4847
4848=back
4849
4850=head3 Factorisation
4851
4852=over 4
4853
4854=item chol()
4855
4856Cholesky decomposition.
4857
4858    $L = $A -> chol();
4859
4860Every symmetric, positive definite matrix A can be decomposed into a product of
4861a unique lower triangular matrix L and its transpose, so that A = L*L', where L'
4862denotes the transpose of L. L is called the Cholesky factor of A.
4863
4864=cut
4865
4866sub chol {
4867    my $x = shift;
4868    my $class = ref $x;
4869
4870    croak "Input matrix must be a symmetric" unless $x -> is_symmetric();
4871
4872    my $y = [ map [ (0) x @$x ], @$x ];         # matrix of zeros
4873    for my $i (0 .. $#$x) {
4874        for my $j (0 .. $i) {
4875            my $z = $x->[$i][$j];
4876            $z -= $y->[$i][$_] * $y->[$j][$_] for 0 .. $j;
4877            if ($i == $j) {
4878                croak "Matrix is not positive definite" if $z < 0;
4879                $y->[$i][$j] = sqrt($z);
4880            } else {
4881                croak "Matrix is not positive definite" if $y->[$j][$j] == 0;
4882                $y->[$i][$j] = $z / $y->[$j][$j];
4883            }
4884        }
4885    }
4886    bless $y, $class;
4887}
4888
4889=pod
4890
4891=back
4892
4893=head3 Miscellaneous matrix functions
4894
4895=over 4
4896
4897=item transpose()
4898
4899Returns the transposed matrix. This is the matrix where colums and rows of the
4900argument matrix are swapped.
4901
4902A subclass implementing matrices of complex numbers should provide a
4903C<L</transpose()>> method that takes the complex conjugate of each element.
4904
4905=cut
4906
4907sub transpose {
4908    my $x = shift;
4909    my $class = ref $x;
4910
4911    my $y = bless [], $class;
4912    my $ncolx = $x -> ncol();
4913    return $y if $ncolx == 0;
4914
4915    for my $j (0 .. $ncolx - 1) {
4916        push @$y, [ map $_->[$j], @$x ];
4917    }
4918    return $y;
4919}
4920
4921=pod
4922
4923=item minormatrix()
4924
4925Minor matrix. The (i,j) minor matrix of a matrix is identical to the original
4926matrix except that row i and column j has been removed.
4927
4928    $y = $x -> minormatrix($i, $j);
4929
4930See also C<L</minor()>>.
4931
4932=cut
4933
4934sub minormatrix {
4935    croak "Not enough arguments for ", (caller(0))[3] if @_ < 3;
4936    croak "Too many arguments for ", (caller(0))[3] if @_ > 3;
4937    my $x = shift;
4938    my $class = ref $x;
4939
4940    my ($m, $n) = $x -> size();
4941
4942    my $i = shift;
4943    croak "Row index value $i outside of $m-by-$n matrix"
4944      unless 0 <= $i && $i < $m;
4945
4946    my $j = shift;
4947    croak "Column index value $j outside of $m-by-$n matrix"
4948      unless 0 <= $j && $j < $n;
4949
4950    # We could just use the following, which is simpler, but also slower:
4951    #
4952    #     $x -> delrow($i) -> delcol($j);
4953
4954    my @rowidx = 0 .. $m - 1;
4955    splice @rowidx, $i, 1;
4956
4957    my @colidx = 0 .. $n - 1;
4958    splice @colidx, $j, 1;
4959
4960    bless [ map [ @{$_}[@colidx] ], @{$x}[@rowidx] ], $class;
4961}
4962
4963=pod
4964
4965=item minor()
4966
4967Minor. The (i,j) minor of a matrix is the determinant of the (i,j) minor matrix.
4968
4969    $y = $x -> minor($i, $j);
4970
4971See also C<L</minormatrix()>>.
4972
4973=cut
4974
4975sub minor {
4976    croak "Not enough arguments for ", (caller(0))[3] if @_ < 3;
4977    croak "Too many arguments for ", (caller(0))[3] if @_ > 3;
4978    my $x = shift;
4979
4980    croak "Matrix must be square" unless $x -> is_square();
4981
4982    $x -> minormatrix(@_) -> determinant();
4983}
4984
4985=pod
4986
4987=item cofactormatrix()
4988
4989Cofactor matrix. Element (i,j) in the cofactor matrix is the (i,j) cofactor,
4990which is (-1)^(i+j) multiplied by the determinant of the (i,j) minor matrix.
4991
4992    $y = $x -> cofactormatrix();
4993
4994=cut
4995
4996sub cofactormatrix {
4997    croak "Not enough arguments for ", (caller(0))[3] if @_ < 1;
4998    croak "Too many arguments for ", (caller(0))[3] if @_ > 1;
4999    my $x = shift;
5000
5001    my ($m, $n) = $x -> size();
5002    croak "matrix must be square" unless $m == $n;
5003
5004    my $y = [];
5005    for my $i (0 .. $m - 1) {
5006        for my $j (0 .. $n - 1) {
5007            $y -> [$i][$j] = (-1) ** ($i + $j) * $x -> minor($i, $j);
5008        }
5009    }
5010
5011    bless $y;
5012}
5013
5014=pod
5015
5016=item cofactor()
5017
5018Cofactor. The (i,j) cofactor of a matrix is (-1)**(i+j) times the (i,j) minor of
5019the matrix.
5020
5021    $y = $x -> cofactor($i, $j);
5022
5023=cut
5024
5025sub cofactor {
5026    croak "Not enough arguments for ", (caller(0))[3] if @_ < 3;
5027    croak "Too many arguments for ", (caller(0))[3] if @_ > 3;
5028    my $x = shift;
5029
5030    my ($m, $n) = $x -> size();
5031    croak "matrix must be square" unless $m == $n;
5032
5033    my ($i, $j) = @_;
5034    (-1) ** ($i + $j) * $x -> minor($i, $j);
5035}
5036
5037=pod
5038
5039=item adjugate()
5040
5041Adjugate of a matrix. The adjugate, also called classical adjoint or adjunct, of
5042a square matrix is the transpose of the cofactor matrix.
5043
5044    $y = $x -> adjugate();
5045
5046=cut
5047
5048sub adjugate {
5049    croak "Not enough arguments for ", (caller(0))[3] if @_ < 1;
5050    croak "Too many arguments for ", (caller(0))[3] if @_ > 1;
5051    my $x = shift;
5052
5053    $x -> cofactormatrix() -> transpose();
5054}
5055
5056=pod
5057
5058=item det()
5059
5060Determinant. Returns the determinant of a matrix. The matrix must be square.
5061
5062    $y = $x -> det();
5063
5064The matrix is computed by forward elimination, which might cause round-off
5065errors. So for example, the determinant might be a non-integer even for an
5066integer matrix.
5067
5068=cut
5069
5070sub det {
5071    croak "Not enough arguments for ", (caller(0))[3] if @_ < 1;
5072    croak "Too many arguments for ", (caller(0))[3] if @_ > 1;
5073    my $x = shift;
5074    my $class = ref $x;
5075
5076    my ($nrowx, $ncolx) = $x -> size();
5077    croak "matrix must be square" unless $nrowx == $ncolx;
5078
5079    # Create the augmented matrix.
5080
5081    $x = $x -> catcol($class -> id($nrowx));
5082
5083    # Perform forward elimination.
5084
5085    my ($iperm, $jperm, $iswap, $jswap);
5086    eval { ($x, $iperm, $jperm, $iswap, $jswap) = $x -> felim_fp() };
5087
5088    # Compute the product of the elements on the diagonal.
5089
5090    my $det = 1;
5091    for (my $i = 0 ; $i < $nrowx ; ++$i) {
5092        last if ($det *= $x -> [$i][$i]) == 0;
5093    }
5094
5095    # Adjust the sign according to the number of inversions.
5096
5097    $det = ($iswap + $jswap) % 2 ? -$det : $det;
5098
5099    return $det;
5100}
5101
5102=pod
5103
5104=item determinant()
5105
5106This is an alias for C<L</det()>>.
5107
5108=cut
5109
5110sub determinant {
5111    my $x = shift;
5112    $x -> det(@_);
5113}
5114
5115=pod
5116
5117=item detr()
5118
5119Determinant. Returns the determinant of a matrix. The matrix must be square.
5120
5121    $y = $x -> determinant();
5122
5123The determinant is computed by recursion, so it is generally much slower than
5124C<L</det()>>.
5125
5126=cut
5127
5128sub detr {
5129    my $x = shift;
5130    my $class = ref($x);
5131    my $imax = $#$x;
5132    my $jmax = $#{$x->[0]};
5133
5134    return undef unless $imax == $jmax;     # input must be a square matrix
5135
5136    # Matrix is 3 × 3
5137
5138    return
5139        $x -> [0][0] * ($x -> [1][1] * $x -> [2][2] - $x -> [1][2] * $x -> [2][1])
5140      - $x -> [0][1] * ($x -> [1][0] * $x -> [2][2] - $x -> [1][2] * $x -> [2][0])
5141      + $x -> [0][2] * ($x -> [1][0] * $x -> [2][1] - $x -> [1][1] * $x -> [2][0])
5142      if $imax == 2;
5143
5144    # Matrix is 2 × 2
5145
5146    return $x -> [0][0] * $x -> [1][1] - $x -> [1][0] * $x -> [0][1]
5147      if $imax == 1;
5148
5149    # Matrix is 1 × 1
5150
5151    return $x -> [0][0] if $imax == 0;
5152
5153    # Matrix is N × N for N > 3.
5154
5155    my $det = 0;
5156
5157    # Create a matrix with column 0 removed. We only need to do this once.
5158    my $x0 = bless [ map [ @{$_}[1 .. $jmax] ], @$x ], $class;
5159
5160    for my $i (0 .. $imax) {
5161
5162        # Create a matrix with row $i and column 0 removed.
5163        my $x1 = bless [ map [ @$_ ], @{$x0}[ 0 .. $i-1, $i+1 .. $imax ] ], $class;
5164
5165        my $term = $x1 -> determinant();
5166        $term *= $i % 2 ? -$x->[$i][0] : $x->[$i][0];
5167
5168        $det += $term;
5169    }
5170
5171    return $det;
5172}
5173
5174=pod
5175
5176=back
5177
5178=head3 Elementwise mathematical functions
5179
5180These method work on each element of a matrix.
5181
5182=over 4
5183
5184=item int()
5185
5186Truncate to integer. Truncates each element to an integer.
5187
5188    $y = $x -> int();
5189
5190This function is effectivly the same as
5191
5192    $y = $x -> map(sub { int });
5193
5194=cut
5195
5196sub int {
5197    croak "Not enough arguments for ", (caller(0))[3] if @_ < 1;
5198    croak "Too many arguments for ", (caller(0))[3] if @_ > 1;
5199    my $x = shift;
5200
5201    bless [ map [ map int($_), @$_ ], @$x ], ref $x;
5202}
5203
5204=pod
5205
5206=item floor()
5207
5208Round to negative infinity. Rounds each element to negative infinity.
5209
5210    $y = $x -> floor();
5211
5212=cut
5213
5214sub floor {
5215    croak "Not enough arguments for ", (caller(0))[3] if @_ < 1;
5216    croak "Too many arguments for ", (caller(0))[3] if @_ > 1;
5217    my $x = shift;
5218
5219    bless [ map { [
5220                   map {
5221                       my $ix = CORE::int($_);
5222                       ($ix <= $_) ? $ix : $ix - 1;
5223                   } @$_
5224                  ] } @$x ], ref $x;
5225}
5226
5227=pod
5228
5229=item ceil()
5230
5231Round to positive infinity. Rounds each element to positive infinity.
5232
5233    $y = $x -> int();
5234
5235=cut
5236
5237sub ceil {
5238    croak "Not enough arguments for ", (caller(0))[3] if @_ < 1;
5239    croak "Too many arguments for ", (caller(0))[3] if @_ > 1;
5240    my $x = shift;
5241
5242    bless [ map { [
5243                   map {
5244                       my $ix = CORE::int($_);
5245                     ($ix >= $_) ? $ix : $ix + 1;
5246                   } @$_
5247                  ] } @$x ], ref $x;
5248}
5249
5250=pod
5251
5252=item abs()
5253
5254Absolute value. The absolute value of each element.
5255
5256    $y = $x -> abs();
5257
5258This is effectivly the same as
5259
5260    $y = $x -> map(sub { abs });
5261
5262=cut
5263
5264sub abs {
5265    croak "Not enough arguments for ", (caller(0))[3] if @_ < 1;
5266    croak "Too many arguments for ", (caller(0))[3] if @_ > 1;
5267    my $x = shift;
5268
5269    bless [ map [ map abs($_), @$_ ], @$x ], ref $x;
5270}
5271
5272=pod
5273
5274=item sign()
5275
5276Sign function. Apply the sign function to each element.
5277
5278    $y = $x -> sign();
5279
5280This is effectivly the same as
5281
5282    $y = $x -> map(sub { $_ <=> 0 });
5283
5284=cut
5285
5286sub sign {
5287    croak "Not enough arguments for ", (caller(0))[3] if @_ < 1;
5288    croak "Too many arguments for ", (caller(0))[3] if @_ > 1;
5289    my $x = shift;
5290
5291    bless [ map [ map { $_ <=> 0 } @$_ ], @$x ], ref $x;
5292}
5293
5294=pod
5295
5296=back
5297
5298=head3 Columnwise or rowwise mathematical functions
5299
5300These method work along each column or row of a matrix. Some of these methods
5301return a matrix with the same size as the invocand matrix. Other methods
5302collapse the dimension, so that, e.g., if the method is applied to the first
5303dimension a I<p>-by-I<q> matrix becomes a 1-by-I<q> matrix, and if applied to
5304the second dimension, it becomes a I<p>-by-1 matrix. Others, like C<L</diff()>>,
5305reduces the length along the dimension by one, so a I<p>-by-I<q> matrix becomes
5306a (I<p>-1)-by-I<q> or a I<p>-by-(I<q>-1) matrix.
5307
5308=over 4
5309
5310=item sum()
5311
5312Sum of elements along various dimensions of a matrix. If the dimension argument
5313is not given, the first non-singleton dimension is used.
5314
5315    $y = $x -> sum($dim);
5316    $y = $x -> sum();
5317
5318=cut
5319
5320sub sum {
5321    croak "Not enough arguments for ", (caller(0))[3] if @_ < 1;
5322    croak "Too many arguments for ", (caller(0))[3] if @_ > 2;
5323    my $x = shift;
5324    $x -> apply(\&_sum, @_);
5325}
5326
5327=pod
5328
5329=item prod()
5330
5331Product of elements along various dimensions of a matrix. If the dimension
5332argument is not given, the first non-singleton dimension is used.
5333
5334    $y = $x -> prod($dim);
5335    $y = $x -> prod();
5336
5337=cut
5338
5339sub prod {
5340    croak "Not enough arguments for ", (caller(0))[3] if @_ < 1;
5341    croak "Too many arguments for ", (caller(0))[3] if @_ > 2;
5342    my $x = shift;
5343    $x -> apply(\&_prod, @_);
5344}
5345
5346=pod
5347
5348=item mean()
5349
5350Mean of elements along various dimensions of a matrix. If the dimension argument
5351is not given, the first non-singleton dimension is used.
5352
5353    $y = $x -> mean($dim);
5354    $y = $x -> mean();
5355
5356=cut
5357
5358sub mean {
5359    croak "Not enough arguments for ", (caller(0))[3] if @_ < 1;
5360    croak "Too many arguments for ", (caller(0))[3] if @_ > 2;
5361    my $x = shift;
5362    $x -> apply(\&_mean, @_);
5363}
5364
5365=pod
5366
5367=item hypot()
5368
5369Hypotenuse. Computes the square root of the sum of the square of each element
5370along various dimensions of a matrix. If the dimension argument is not given,
5371the first non-singleton dimension is used.
5372
5373    $y = $x -> hypot($dim);
5374    $y = $x -> hypot();
5375
5376For example,
5377
5378    $x = Math::Matrix -> new([[3,  4],
5379                              [5, 12]]);
5380    $y = $x -> hypot(2);
5381
5382returns the 2-by-1 matrix
5383
5384    [  5 ]
5385    [ 13 ]
5386
5387=cut
5388
5389sub hypot {
5390    croak "Not enough arguments for ", (caller(0))[3] if @_ < 1;
5391    croak "Too many arguments for ", (caller(0))[3] if @_ > 2;
5392    my $x = shift;
5393    $x -> apply(\&_hypot, @_);
5394}
5395
5396=pod
5397
5398=item min()
5399
5400Minimum of elements along various dimensions of a matrix. If the dimension
5401argument is not given, the first non-singleton dimension is used.
5402
5403    $y = $x -> min($dim);
5404    $y = $x -> min();
5405
5406=cut
5407
5408sub min {
5409    croak "Not enough arguments for ", (caller(0))[3] if @_ < 1;
5410    croak "Too many arguments for ", (caller(0))[3] if @_ > 2;
5411    my $x = shift;
5412    $x -> apply(\&_min, @_);
5413}
5414
5415=pod
5416
5417=item max()
5418
5419Maximum of elements along various dimensions of a matrix. If the dimension
5420argument is not given, the first non-singleton dimension is used.
5421
5422    $y = $x -> max($dim);
5423    $y = $x -> max();
5424
5425=cut
5426
5427sub max {
5428    croak "Not enough arguments for ", (caller(0))[3] if @_ < 1;
5429    croak "Too many arguments for ", (caller(0))[3] if @_ > 2;
5430    my $x = shift;
5431    $x -> apply(\&_max, @_);
5432}
5433
5434=pod
5435
5436=item median()
5437
5438Median of elements along various dimensions of a matrix. If the dimension
5439argument is not given, the first non-singleton dimension is used.
5440
5441    $y = $x -> median($dim);
5442    $y = $x -> median();
5443
5444=cut
5445
5446sub median {
5447    croak "Not enough arguments for ", (caller(0))[3] if @_ < 1;
5448    croak "Too many arguments for ", (caller(0))[3] if @_ > 2;
5449    my $x = shift;
5450    $x -> apply(\&_median, @_);
5451}
5452
5453=pod
5454
5455=item cumsum()
5456
5457Returns the cumulative sum along various dimensions of a matrix. If the
5458dimension argument is not given, the first non-singleton dimension is used.
5459
5460    $y = $x -> cumsum($dim);
5461    $y = $x -> cumsum();
5462
5463=cut
5464
5465sub cumsum {
5466    croak "Not enough arguments for ", (caller(0))[3] if @_ < 1;
5467    croak "Too many arguments for ", (caller(0))[3] if @_ > 2;
5468    my $x = shift;
5469    $x -> apply(\&_cumsum, @_);
5470}
5471
5472=pod
5473
5474=item cumprod()
5475
5476Returns the cumulative product along various dimensions of a matrix. If the
5477dimension argument is not given, the first non-singleton dimension is used.
5478
5479    $y = $x -> cumprod($dim);
5480    $y = $x -> cumprod();
5481
5482=cut
5483
5484sub cumprod {
5485    croak "Not enough arguments for ", (caller(0))[3] if @_ < 1;
5486    croak "Too many arguments for ", (caller(0))[3] if @_ > 2;
5487    my $x = shift;
5488    $x -> apply(\&_cumprod, @_);
5489}
5490
5491=pod
5492
5493=item cummean()
5494
5495Returns the cumulative mean along various dimensions of a matrix. If the
5496dimension argument is not given, the first non-singleton dimension is used.
5497
5498    $y = $x -> cummean($dim);
5499    $y = $x -> cummean();
5500
5501=cut
5502
5503sub cummean {
5504    croak "Not enough arguments for ", (caller(0))[3] if @_ < 1;
5505    croak "Too many arguments for ", (caller(0))[3] if @_ > 2;
5506    my $x = shift;
5507    $x -> apply(\&_cummean, @_);
5508}
5509
5510=pod
5511
5512=item diff()
5513
5514Returns the differences between adjacent elements. If the dimension argument is
5515not given, the first non-singleton dimension is used.
5516
5517    $y = $x -> diff($dim);
5518    $y = $x -> diff();
5519
5520=cut
5521
5522sub diff {
5523    croak "Not enough arguments for ", (caller(0))[3] if @_ < 1;
5524    croak "Too many arguments for ", (caller(0))[3] if @_ > 2;
5525    my $x = shift;
5526    $x -> apply(\&_diff, @_);
5527}
5528
5529=pod
5530
5531=item vecnorm()
5532
5533Return the C<$p>-norm of the elements of C<$x>. If the dimension argument is not
5534given, the first non-singleton dimension is used.
5535
5536    $y = $x -> vecnorm($p, $dim);
5537    $y = $x -> vecnorm($p);
5538    $y = $x -> vecnorm();
5539
5540The C<$p>-norm of a vector is defined as the C<$p>th root of the sum of the
5541absolute values fo the elements raised to the C<$p>th power.
5542
5543=cut
5544
5545sub vecnorm {
5546    croak "Not enough arguments for ", (caller(0))[3] if @_ < 1;
5547    croak "Too many arguments for ", (caller(0))[3] if @_ > 3;
5548    my $x = shift;
5549    my $class = ref $x;
5550
5551    my $p = 2;
5552    if (@_) {
5553        $p = shift;
5554        croak 'When the \$p argument is given, it can not be undefined'
5555          unless defined $p;
5556        if (ref $p) {
5557            $p = $class -> new($p)
5558              unless defined(blessed($p)) && $p -> isa($class);
5559            croak 'The $p argument must be a scalar' unless $p -> is_scalar();
5560            $p = $p -> [0][0];
5561        }
5562    }
5563
5564    my $sub = sub { _vecnorm($p, @_) };
5565    $x -> apply($sub, @_);
5566}
5567
5568=pod
5569
5570=item apply()
5571
5572Applies a subroutine to each row or column of a matrix. If the dimension
5573argument is not given, the first non-singleton dimension is used.
5574
5575    $y = $x -> apply($sub, $dim);
5576    $y = $x -> apply($sub);
5577
5578The subroutine is passed a list with all elements in a single column or row.
5579
5580=cut
5581
5582sub apply {
5583    my $x = shift;
5584    my $class = ref $x;
5585
5586    my $sub = shift;
5587
5588    # Get the size of the input $x.
5589
5590    my ($nrowx, $ncolx) = $x -> size();
5591
5592    # Get the dimension along which to apply the subroutine.
5593
5594    my $dim;
5595    if (@_) {
5596        $dim = shift;
5597        croak "Dimension can not be undefined" unless defined $dim;
5598        if (ref $dim) {
5599            $dim = $class -> new($dim)
5600              unless defined(blessed($dim)) && $dim -> isa($class);
5601            croak "Dimension must be a scalar" unless $dim -> is_scalar();
5602            $dim = $dim -> [0][0];
5603            croak "Dimension must be a positive integer"
5604              unless $dim > 0 && $dim == CORE::int($dim);
5605        }
5606        croak "Dimension must be 1 or 2" unless $dim == 1 || $dim == 2;
5607    } else {
5608        $dim = $nrowx > 1 ? 1 : 2;
5609    }
5610
5611    # Initialise output.
5612
5613    my $y = [];
5614
5615    # Work along the first dimension, i.e., each column.
5616
5617    my ($nrowy, $ncoly);
5618    if ($dim == 1) {
5619        $nrowy = 0;
5620        for my $j (0 .. $ncolx - 1) {
5621            my @col = $sub -> (map $_ -> [$j], @$x);
5622            if ($j == 0) {
5623                $nrowy = @col;
5624            } else {
5625                croak "The number of elements in each column must be the same"
5626                  unless $nrowy == @col;
5627            }
5628            $y -> [$_][$j] = $col[$_] for 0 .. $#col;
5629        }
5630        $y = [] if $nrowy == 0;
5631    }
5632
5633    # Work along the second dimension, i.e., each row.
5634
5635    elsif ($dim == 2) {
5636        $ncoly = 0;
5637        for my $i (0 .. $nrowx - 1) {
5638            my @row = $sub -> (@{ $x -> [$i] });
5639            if ($i == 0) {
5640                $ncoly = @row;
5641            } else {
5642                croak "The number of elements in each row must be the same"
5643                  unless $ncoly == @row;
5644            }
5645            $y -> [$i] = [ @row ];
5646        }
5647        $y = [] if $ncoly == 0;
5648    }
5649
5650    bless $y, $class;
5651}
5652
5653=pod
5654
5655=back
5656
5657=head2 Comparison
5658
5659=head3 Matrix comparison
5660
5661Methods matrix comparison. These methods return a scalar value.
5662
5663=over 4
5664
5665=item meq()
5666
5667Matrix equal to. Returns 1 if two matrices are identical and 0 otherwise.
5668
5669    $bool = $x -> meq($y);
5670
5671=cut
5672
5673sub meq {
5674    croak "Not enough arguments for ", (caller(0))[3] if @_ < 2;
5675    croak "Too many arguments for ", (caller(0))[3] if @_ > 2;
5676    my $x = shift;
5677    my $class = ref $x;
5678
5679    my $y = shift;
5680    $y = $class -> new($y)
5681      unless defined(blessed($y)) && $y -> isa($class);
5682
5683    my ($nrowx, $ncolx) = $x -> size();
5684    my ($nrowy, $ncoly) = $y -> size();
5685
5686    # Quick exit if the sizes don't match.
5687
5688    return 0 unless $nrowx == $nrowy && $ncolx == $ncoly;
5689
5690    # Compare the elements.
5691
5692    for my $i (0 .. $nrowx - 1) {
5693        for my $j (0 .. $ncolx - 1) {
5694            return 0 if $x->[$i][$j] != $y->[$i][$j];
5695        }
5696    }
5697    return 1;
5698}
5699
5700=pod
5701
5702=item mne()
5703
5704Matrix not equal to. Returns 1 if two matrices are different and 0 otherwise.
5705
5706    $bool = $x -> mne($y);
5707
5708=cut
5709
5710sub mne {
5711    croak "Not enough arguments for ", (caller(0))[3] if @_ < 2;
5712    croak "Too many arguments for ", (caller(0))[3] if @_ > 2;
5713    my $x = shift;
5714    my $class = ref $x;
5715
5716    my $y = shift;
5717    $y = $class -> new($y)
5718      unless defined(blessed($y)) && $y -> isa($class);
5719
5720    my ($nrowx, $ncolx) = $x -> size();
5721    my ($nrowy, $ncoly) = $y -> size();
5722
5723    # Quick exit if the sizes don't match.
5724
5725    return 1 unless $nrowx == $nrowy && $ncolx == $ncoly;
5726
5727    # Compare the elements.
5728
5729    for my $i (0 .. $nrowx - 1) {
5730        for my $j (0 .. $ncolx - 1) {
5731            return 1 if $x->[$i][$j] != $y->[$i][$j];
5732        }
5733    }
5734    return 0;
5735}
5736
5737=pod
5738
5739=item equal()
5740
5741Decide if two matrices are equal. The criterion is, that each pair of elements
5742differs less than $Math::Matrix::eps.
5743
5744    $bool = $x -> equal($y);
5745
5746=cut
5747
5748sub equal {
5749    my $A = shift;
5750    my $B = shift;
5751
5752    my $jmax = $#{$A->[0]};
5753    for my $i (0 .. $#{$A}) {
5754        for my $j (0 .. $jmax) {
5755            return 0 if CORE::abs($A->[$i][$j] - $B->[$i][$j]) >= $eps;
5756        }
5757    }
5758    return 1;
5759}
5760
5761=pod
5762
5763=back
5764
5765=head3 Scalar comparison
5766
5767Each of these methods performs scalar (element by element) comparison and
5768returns a matrix of ones and zeros. Scalar expansion is performed if necessary.
5769
5770=over 4
5771
5772=item seq()
5773
5774Scalar equality. Performs scalar (element by element) comparison of two
5775matrices.
5776
5777    $bool = $x -> seq($y);
5778
5779=cut
5780
5781sub seq {
5782    croak "Not enough arguments for ", (caller(0))[3] if @_ < 2;
5783    croak "Too many arguments for ", (caller(0))[3] if @_ > 2;
5784    my $x = shift;
5785    my $class = ref $x;
5786
5787    my $y = shift;
5788    $y = $class -> new($y)
5789      unless defined(blessed($y)) && $y -> isa($class);
5790
5791    $x -> sapply(sub { $_[0] == $_[1] ? 1 : 0 }, $y);
5792}
5793
5794=pod
5795
5796=item sne()
5797
5798Scalar (element by element) not equal to. Performs scalar (element by element)
5799comparison of two matrices.
5800
5801    $bool = $x -> sne($y);
5802
5803=cut
5804
5805sub sne {
5806    croak "Not enough arguments for ", (caller(0))[3] if @_ < 2;
5807    croak "Too many arguments for ", (caller(0))[3] if @_ > 2;
5808    my $x = shift;
5809    my $class = ref $x;
5810
5811    my $y = shift;
5812    $y = $class -> new($y)
5813      unless defined(blessed($y)) && $y -> isa($class);
5814
5815    $x -> sapply(sub { $_[0] != $_[1] ? 1 : 0 }, $y);
5816}
5817
5818=pod
5819
5820=item slt()
5821
5822Scalar (element by element) less than. Performs scalar (element by element)
5823comparison of two matrices.
5824
5825    $bool = $x -> slt($y);
5826
5827=cut
5828
5829sub slt {
5830    croak "Not enough arguments for ", (caller(0))[3] if @_ < 2;
5831    croak "Too many arguments for ", (caller(0))[3] if @_ > 2;
5832    my $x = shift;
5833    my $class = ref $x;
5834
5835    my $y = shift;
5836    $y = $class -> new($y)
5837      unless defined(blessed($y)) && $y -> isa($class);
5838
5839    $x -> sapply(sub { $_[0] < $_[1] ? 1 : 0 }, $y);
5840}
5841
5842=pod
5843
5844=item sle()
5845
5846Scalar (element by element) less than or equal to. Performs scalar
5847(element by element) comparison of two matrices.
5848
5849    $bool = $x -> sle($y);
5850
5851=cut
5852
5853sub sle {
5854    croak "Not enough arguments for ", (caller(0))[3] if @_ < 2;
5855    croak "Too many arguments for ", (caller(0))[3] if @_ > 2;
5856    my $x = shift;
5857    my $class = ref $x;
5858
5859    my $y = shift;
5860    $y = $class -> new($y)
5861      unless defined(blessed($y)) && $y -> isa($class);
5862
5863    $x -> sapply(sub { $_[0] <= $_[1] ? 1 : 0 }, $y);
5864}
5865
5866=pod
5867
5868=item sgt()
5869
5870Scalar (element by element) greater than. Performs scalar (element by element)
5871comparison of two matrices.
5872
5873    $bool = $x -> sgt($y);
5874
5875=cut
5876
5877sub sgt {
5878    croak "Not enough arguments for ", (caller(0))[3] if @_ < 2;
5879    croak "Too many arguments for ", (caller(0))[3] if @_ > 2;
5880    my $x = shift;
5881    my $class = ref $x;
5882
5883    my $y = shift;
5884    $y = $class -> new($y)
5885      unless defined(blessed($y)) && $y -> isa($class);
5886
5887    $x -> sapply(sub { $_[0] > $_[1] ? 1 : 0 }, $y);
5888}
5889
5890=pod
5891
5892=item sge()
5893
5894Scalar (element by element) greater than or equal to. Performs scalar
5895(element by element) comparison of two matrices.
5896
5897    $bool = $x -> sge($y);
5898
5899=cut
5900
5901sub sge {
5902    croak "Not enough arguments for ", (caller(0))[3] if @_ < 2;
5903    croak "Too many arguments for ", (caller(0))[3] if @_ > 2;
5904    my $x = shift;
5905    my $class = ref $x;
5906
5907    my $y = shift;
5908    $y = $class -> new($y)
5909      unless defined(blessed($y)) && $y -> isa($class);
5910
5911    $x -> sapply(sub { $_[0] >= $_[1] ? 1 : 0 }, $y);
5912}
5913
5914=pod
5915
5916=item scmp()
5917
5918Scalar (element by element) comparison. Performs scalar (element by element)
5919comparison of two matrices. Each element in the output matrix is either -1, 0,
5920or 1 depending on whether the elements are less than, equal to, or greater than
5921each other.
5922
5923    $bool = $x -> scmp($y);
5924
5925=cut
5926
5927sub scmp {
5928    croak "Not enough arguments for ", (caller(0))[3] if @_ < 2;
5929    croak "Too many arguments for ", (caller(0))[3] if @_ > 2;
5930    my $x = shift;
5931    my $class = ref $x;
5932
5933    my $y = shift;
5934    $y = $class -> new($y)
5935      unless defined(blessed($y)) && $y -> isa($class);
5936
5937    $x -> sapply(sub { $_[0] <=> $_[1] }, $y);
5938}
5939
5940=pod
5941
5942=back
5943
5944=head2 Vector functions
5945
5946=over 4
5947
5948=item dot_product()
5949
5950Compute the dot product of two vectors. The second operand does not have to be
5951an object.
5952
5953    # $x and $y are both objects
5954    $x = Math::Matrix -> new([1, 2, 3]);
5955    $y = Math::Matrix -> new([4, 5, 6]);
5956    $p = $x -> dot_product($y);             # $p = 32
5957
5958    # Only $x is an object.
5959    $p = $x -> dot_product([4, 5, 6]);      # $p = 32
5960
5961=cut
5962
5963sub dot_product {
5964    my $x = shift;
5965    my $class = ref $x;
5966
5967    my $y = shift;
5968    $y = $class -> new($y)
5969      unless defined(blessed($y)) && $y -> isa($class);
5970
5971    croak "First argument must be a vector"  unless $x -> is_vector();
5972    $x = $x -> to_row() unless $x -> is_row();
5973
5974    croak "Second argument must be a vector" unless $x -> is_vector();
5975    $y = $y -> to_col() unless $x -> is_col();
5976
5977    croak "The two vectors must have the same length"
5978      unless $x -> nelm() == $y -> nelm();
5979
5980    $x -> multiply($y) -> [0][0];
5981}
5982
5983=pod
5984
5985=item outer_product()
5986
5987Compute the outer product of two vectors. The second operand does not have to be
5988an object.
5989
5990    # $x and $y are both objects
5991    $x = Math::Matrix -> new([1, 2, 3]);
5992    $y = Math::Matrix -> new([4, 5, 6, 7]);
5993    $p = $x -> outer_product($y);
5994
5995    # Only $x is an object.
5996    $p = $x -> outer_product([4, 5, 6, y]);
5997
5998=cut
5999
6000sub outer_product {
6001    my $x = shift;
6002    my $class = ref $x;
6003
6004    my $y = shift;
6005    $y = $class -> new($y)
6006      unless defined(blessed($y)) && $y -> isa($class);
6007
6008    croak "First argument must be a vector"  unless $x -> is_vector();
6009    $x = $x -> to_col() unless $x -> is_col();
6010
6011    croak "Second argument must be a vector" unless $x -> is_vector();
6012    $y = $y -> to_row() unless $x -> is_row();
6013
6014    $x -> multiply($y);
6015}
6016
6017=pod
6018
6019=item absolute()
6020
6021Compute the absolute value (i.e., length) of a vector.
6022
6023    $v = Math::Matrix -> new([3, 4]);
6024    $a = $v -> absolute();                  # $v = 5
6025
6026=cut
6027
6028sub absolute {
6029    my $x = shift;
6030    croak "Argument must be a vector"  unless $x -> is_vector();
6031
6032    _hypot(@{ $x -> to_row() -> [0] });
6033}
6034
6035=pod
6036
6037=item normalize()
6038
6039Normalize a vector, i.e., scale a vector so its length becomes 1.
6040
6041    $v = Math::Matrix -> new([3, 4]);
6042    $u = $v -> normalize();                 # $u = [ 0.6, 0.8 ]
6043
6044=cut
6045
6046sub normalize {
6047    my $vector = shift;
6048    my $length = $vector->absolute();
6049    return undef
6050      unless $length;
6051    $vector->multiply_scalar(1 / $length);
6052}
6053
6054=pod
6055
6056=item cross_product()
6057
6058Compute the cross-product of vectors.
6059
6060    $x = Math::Matrix -> new([1,3,2],
6061                             [5,4,2]);
6062    $p = $x -> cross_product();             # $p = [ -2, 8, -11 ]
6063
6064=cut
6065
6066sub cross_product {
6067    my $vectors = shift;
6068    my $class = ref($vectors);
6069
6070    my $dimensions = @{$vectors->[0]};
6071    return undef
6072      unless $dimensions == @$vectors + 1;
6073
6074    my @axis;
6075    foreach my $column (0..$dimensions-1) {
6076        my $tmp = $vectors->slice(0..$column-1,
6077                                  $column+1..$dimensions-1);
6078        my $scalar = $tmp->determinant;
6079        $scalar *= ($column % 2) ? -1 : 1;
6080        push @axis, $scalar;
6081    }
6082    my $axis = $class->new(\@axis);
6083    $axis = $axis->multiply_scalar(($dimensions % 2) ? 1 : -1);
6084}
6085
6086=pod
6087
6088=back
6089
6090=head2 Conversion
6091
6092=over 4
6093
6094=item as_string()
6095
6096Creates a string representation of the matrix and returns it.
6097
6098    $x = Math::Matrix -> new([1, 2], [3, 4]);
6099    $s = $x -> as_string();
6100
6101=cut
6102
6103sub as_string {
6104    my $self = shift;
6105    my $out = "";
6106    for my $row (@{$self}) {
6107        for my $col (@{$row}) {
6108            $out = $out . sprintf "%10.5f ", $col;
6109        }
6110        $out = $out . sprintf "\n";
6111    }
6112    $out;
6113}
6114
6115=pod
6116
6117=item as_array()
6118
6119Returns the matrix as an unblessed Perl array, i.e., and ordinary, unblessed
6120reference.
6121
6122    $y = $x -> as_array();      # ref($y) returns 'ARRAY'
6123
6124=cut
6125
6126sub as_array {
6127    my $x = shift;
6128    [ map [ @$_ ], @$x ];
6129}
6130
6131=pod
6132
6133=back
6134
6135=head2 Matrix utilities
6136
6137=head3 Apply a subroutine to each element
6138
6139=over 4
6140
6141=item map()
6142
6143Call a subroutine for every element of a matrix, locally setting C<$_> to each
6144element and passing the matrix row and column indices as input arguments.
6145
6146    # square each element
6147    $y = $x -> map(sub { $_ ** 2 });
6148
6149    # set strictly lower triangular part to zero
6150    $y = $x -> map(sub { $_[0] > $_[1] ? 0 : $_ })'
6151
6152=cut
6153
6154sub map {
6155    my $x = shift;
6156    my $class = ref $x;
6157
6158    my $sub = shift;
6159    croak "The first input argument must be a code reference"
6160      unless ref($sub) eq 'CODE';
6161
6162    my $y = [];
6163    my ($nrow, $ncol) = $x -> size();
6164    for my $i (0 .. $nrow - 1) {
6165        for my $j (0 .. $ncol - 1) {
6166            local $_ = $x -> [$i][$j];
6167            $y -> [$i][$j] = $sub -> ($i, $j);
6168        }
6169    }
6170
6171    bless $y, $class;
6172}
6173
6174=pod
6175
6176=item sapply()
6177
6178Applies a subroutine to each element of a matrix, or each set of corresponding
6179elements if multiple matrices are given, and returns the result. The first
6180argument is the subroutine to apply. The following arguments, if any, are
6181additional matrices on which to apply the subroutine.
6182
6183    $w = $x -> sapply($sub);            # single operand
6184    $w = $x -> sapply($sub, $y);        # two operands
6185    $w = $x -> sapply($sub, $y, $z);    # three operands
6186
6187Each matrix element, or corresponding set of elements, are passed to the
6188subroutine as input arguments.
6189
6190When used with a single operand, this method is similar to the C<L</map()>>
6191method, the syntax is different, since C<L</sapply()>> supports multiple
6192operands.
6193
6194See also C<L</map()>>.
6195
6196=over 4
6197
6198=item *
6199
6200The subroutine is run in scalar context.
6201
6202=item *
6203
6204No checks are done on the return value of the subroutine.
6205
6206=item *
6207
6208The number of rows in the output matrix equals the number of rows in the operand
6209with the largest number of rows. Ditto for columns. So if C<$x> is 5-by-2
6210matrix, and C<$y> is a 3-by-4 matrix, the result is a 5-by-4 matrix.
6211
6212=item *
6213
6214For each operand that has a number of rows smaller than the maximum value, the
6215rows are recyled. Ditto for columns.
6216
6217=item *
6218
6219Don't modify the variables $_[0], $_[1] etc. inside the subroutine. Otherwise,
6220there is a risk of modifying the operand matrices.
6221
6222=item *
6223
6224If the matrix elements are objects that are not cloned when the "=" (assignment)
6225operator is used, you might have to explicitly clone the objects used inside the
6226subroutine. Otherwise, the elements in the output matrix might be references to
6227objects in the operand matrices, rather than references to new objects.
6228
6229=back
6230
6231Some examples
6232
6233=over 4
6234
6235=item One operand
6236
6237With one operand, i.e., the invocand matrix, the subroutine is applied to each
6238element of the invocand matrix. The returned matrix has the same size as the
6239invocand. For example, multiplying the matrix C<$x> with the scalar C<$c>
6240
6241    $sub = sub { $c * $_[0] };      # subroutine to multiply by $c
6242    $z = $x -> sapply($sub);        # multiply each element by $c
6243
6244=item Two operands
6245
6246When two operands are specfied, the subroutine is applied to each pair of
6247corresponding elements in the two operands. For example, adding two matrices can
6248be implemented as
6249
6250    $sub = sub { $_[0] * $_[1] };
6251    $z = $x -> sapply($sub, $y);
6252
6253Note that if the matrices have different sizes, the rows and/or columns of the
6254smaller are recycled to match the size of the larger. If C<$x> is a
6255C<$p>-by-C<$q> matrix and C<$y> is a C<$r>-by-C<$s> matrix, then C<$z> is a
6256max(C<$p>,C<$r>)-by-max(C<$q>,C<$s>) matrix, and
6257
6258    $z -> [$i][$j] = $sub -> ($x -> [$i % $p][$j % $q],
6259                              $y -> [$i % $r][$j % $s]);
6260
6261Because of this recycling, multiplying the matrix C<$x> with the scalar C<$c>
6262(see above) can also be implemented as
6263
6264    $sub = sub { $_[0] * $_[1] };
6265    $z = $x -> sapply($sub, $c);
6266
6267Generating a matrix with all combinations of C<$x**$y> for C<$x> being 4, 5, and
62686 and C<$y> being 1, 2, 3, and 4 can be done with
6269
6270    $c = Math::Matrix -> new([[4], [5], [6]]);      # 3-by-1 column
6271    $r = Math::Matrix -> new([[1, 2, 3, 4]]);       # 1-by-4 row
6272    $x = $c -> sapply(sub { $_[0] ** $_[1] }, $r);  # 3-by-4 matrix
6273
6274=item Multiple operands
6275
6276In general, the sapply() method can have any number of arguments. For example,
6277to compute the sum of the four matrices C<$x>, C<$y>, C<$z>, and C<$w>,
6278
6279    $sub = sub {
6280               $sum = 0;
6281               for $val (@_) {
6282                   $sum += $val;
6283               };
6284               return $sum;
6285           };
6286    $sum = $x -> sapply($sub, $y, $z, $w);
6287
6288=back
6289
6290=cut
6291
6292sub sapply {
6293    croak "Not enough arguments for ", (caller(0))[3] if @_ < 2;
6294    my $x = shift;
6295    my $class = ref $x;
6296
6297    # Get the subroutine to apply on all the elements.
6298
6299    my $sub = shift;
6300    croak "input argument must be a reference to a subroutine"
6301      unless ref($sub) eq 'CODE';
6302
6303    my $y = bless [], $class;
6304
6305    # For speed, treat a single matrix operand as a special case.
6306
6307    if (@_ == 0) {
6308        my ($nrowx, $ncolx) = $x -> size();
6309        return $y if $nrowx * $ncolx == 0;      # quick exit if $x is empty
6310
6311        for my $i (0 .. $nrowx - 1) {
6312            for my $j (0 .. $ncolx - 1) {
6313                $y -> [$i][$j] = $sub -> ($x -> [$i][$j]);
6314            }
6315        }
6316
6317        return $y;
6318    }
6319
6320    # Create some auxiliary arrays.
6321
6322    my @args = ($x, @_);    # all matrices
6323    my @size = ();          # size of each matrix
6324    my @nelm = ();          # number of elements in each matrix
6325
6326    # Loop over the input arguments to perform some checks and get their
6327    # properties. Also get the size (number of rows and columns) of the output
6328    # matrix.
6329
6330    my $nrowy = 0;
6331    my $ncoly = 0;
6332
6333    for my $k (0 .. $#args) {
6334
6335        # Make sure the k'th argument is a matrix object.
6336
6337        $args[$k] = $class -> new($args[$k])
6338          unless defined(blessed($args[$k])) && $args[$k] -> isa($class);
6339
6340        # Get the number of rows, columns, and elements in the k'th argument,
6341        # and save this information for later.
6342
6343        my ($nrowk, $ncolk) = $args[$k] -> size();
6344        $size[$k] = [ $nrowk, $ncolk ];
6345        $nelm[$k] = $nrowk * $ncolk;
6346
6347        # Update the size of the output matrix.
6348
6349        $nrowy = $nrowk if $nrowk > $nrowy;
6350        $ncoly = $ncolk if $ncolk > $ncoly;
6351    }
6352
6353    # We only accept empty matrices if all matrices are empty.
6354
6355    my $n_empty = grep { $_ == 0 } @nelm;
6356    return $y if $n_empty == @args;     # quick exit if all are empty
6357
6358    # At ths point, we know that not all matrices are empty, but some might be
6359    # empty. We only continue if none are empty.
6360
6361    croak "Either all or none of the matrices must be empty in ", (caller(0))[3]
6362      unless $n_empty == 0;
6363
6364    # Loop over the subscripts into the output matrix.
6365
6366    for my $i (0 .. $nrowy - 1) {
6367        for my $j (0 .. $ncoly - 1) {
6368
6369            # Initialize the argument list for the subroutine call that will
6370            # give the value for element ($i,$j) in the output matrix.
6371
6372            my @elms = ();
6373
6374            # Loop over the matrices.
6375
6376            for my $k (0 .. $#args) {
6377
6378                # Get the number of rows and columns in the k'th matrix.
6379
6380                my $nrowk = $size[$k][0];
6381                my $ncolk = $size[$k][1];
6382
6383                # Compute the subscripts of the element to use in the k'th
6384                # matrix.
6385
6386                my $ik = $i % $nrowk;
6387                my $jk = $j % $ncolk;
6388
6389                # Get the element from the k'th matrix to use in this call.
6390
6391                $elms[$k] = $args[$k][$ik][$jk];
6392            }
6393
6394            # Now we have the argument list for the subroutine call.
6395
6396            $y -> [$i][$j] = $sub -> (@elms);
6397        }
6398    }
6399
6400    return $y;
6401}
6402
6403=pod
6404
6405=back
6406
6407=head3 Forward elimination
6408
6409These methods take a matrix as input, performs forward elimination, and returns
6410a matrix where all elements below the main diagonal are zero. In list context,
6411four additional arguments are returned: an array with the row permutations, an
6412array with the column permutations, an integer with the number of row swaps and
6413an integer with the number of column swaps performed during elimination.
6414
6415The permutation vectors can be converted to permutation matrices with
6416C<L</to_permmat()>>.
6417
6418=over
6419
6420=item felim_np()
6421
6422Perform forward elimination with no pivoting.
6423
6424    $y = $x -> felim_np();
6425
6426Forward elimination without pivoting may fail even when the matrix is
6427non-singular.
6428
6429This method is provided mostly for illustration purposes.
6430
6431=cut
6432
6433sub felim_np {
6434    croak "Not enough arguments for ", (caller(0))[3] if @_ < 1;
6435    croak "Too many arguments for ", (caller(0))[3] if @_ > 1;
6436    my $x = shift;
6437
6438    $x = $x -> clone();
6439    my $nrow = $x -> nrow();
6440    my $ncol = $x -> ncol();
6441
6442    my $imax = $nrow - 1;
6443    my $jmax = $ncol - 1;
6444
6445    my $iperm = [ 0 .. $imax ];         # row permutation vector
6446    my $jperm = [ 0 .. $imax ];         # column permutation vector
6447    my $iswap = 0;                      # number of row swaps
6448    my $jswap = 0;                      # number of column swaps
6449
6450    my $debug = 0;
6451
6452    printf "\nfelim_np(): before 0:\n\n%s\n", $x if $debug;
6453
6454    for (my $i = 0 ; $i <= $imax && $i <= $jmax ; ++$i) {
6455
6456        # The so far remaining unreduced submatrix starts at element ($i,$i).
6457
6458        # Skip this round, if all elements below (i,i) are zero.
6459
6460        my $saw_non_zero = 0;
6461        for (my $u = $i + 1 ; $u <= $imax ; ++$u) {
6462            if ($x->[$u][$i] != 0) {
6463                $saw_non_zero = 1;
6464                last;
6465            }
6466        }
6467        next unless $saw_non_zero;
6468
6469        # Since we don't use pivoting, element ($i,$i) must be non-zero.
6470
6471        if ($x->[$i][$i] == 0) {
6472            croak "No pivot element found for row $i";
6473        }
6474
6475        # Subtract row $i from each row $u below $i.
6476
6477        for (my $u = $i + 1 ; $u <= $imax ; ++$u) {
6478            for (my $j = $jmax ; $j >= $i ; --$j) {
6479                $x->[$u][$j] -= ($x->[$i][$j] * $x->[$u][$i]) / $x->[$i][$i];
6480            }
6481
6482            # In case of round-off errors.
6483
6484            $x->[$u][$i] *= 0;
6485        }
6486
6487        printf "\nfelim_np(): after %u:\n\n%s\n\n", $i, $x if $debug;
6488    }
6489
6490    return $x, $iperm, $jperm, $iswap, $jswap if wantarray;
6491    return $x;
6492}
6493
6494=pod
6495
6496=item felim_tp()
6497
6498Perform forward elimination with trivial pivoting, a variant of partial
6499pivoting.
6500
6501    $y = $x -> felim_tp();
6502
6503If A is a p-by-q matrix, and the so far remaining unreduced submatrix starts at
6504element (i,i), the pivot element is the first element in column i that is
6505non-zero.
6506
6507This method is provided mostly for illustration purposes.
6508
6509=cut
6510
6511sub felim_tp {
6512    croak "Not enough arguments for ", (caller(0))[3] if @_ < 1;
6513    croak "Too many arguments for ", (caller(0))[3] if @_ > 1;
6514    my $x = shift;
6515
6516    croak "felim_tp(): too many input arguments" if @_ > 0;
6517
6518    $x = $x -> clone();
6519    my $nrow = $x -> nrow();
6520    my $ncol = $x -> ncol();
6521
6522    my $imax = $nrow - 1;
6523    my $jmax = $ncol - 1;
6524
6525    my $iperm = [ 0 .. $imax ];         # row permutation vector
6526    my $jperm = [ 0 .. $imax ];         # column permutation vector
6527    my $iswap = 0;                      # number of row swaps
6528    my $jswap = 0;                      # number of column swaps
6529
6530    my $debug = 0;
6531
6532    printf "\nfelim_tp(): before 0:\n\n%s\n", $x if $debug;
6533
6534    for (my $i = 0 ; $i <= $imax && $i <= $jmax ; ++$i) {
6535
6536        # The so far remaining unreduced submatrix starts at element ($i,$i).
6537
6538        # Skip this round, if all elements below (i,i) are zero.
6539
6540        my $saw_non_zero = 0;
6541        for (my $u = $i + 1 ; $u <= $imax ; ++$u) {
6542            if ($x->[$u][$i] != 0) {
6543                $saw_non_zero = 1;
6544                last;
6545            }
6546        }
6547        next unless $saw_non_zero;
6548
6549        # The pivot element is the first element in column $i (in the unreduced
6550        # submatrix) that is non-zero.
6551
6552        my $p;          # index of pivot row
6553
6554        for (my $u = $i ; $u <= $imax ; ++$u) {
6555            if ($x->[$u][$i] != 0) {
6556                $p = $u;
6557                last;
6558            }
6559        }
6560
6561        printf "\nfelim_tp(): pivot element is (%u,%u)\n", $p, $i if $debug;
6562
6563        # Swap rows $i and $p.
6564
6565        if ($p != $i) {
6566            ($x->[$i], $x->[$p]) = ($x->[$p], $x->[$i]);
6567            ($iperm->[$i], $iperm->[$p]) = ($iperm->[$p], $iperm->[$i]);
6568            $iswap++;
6569        }
6570
6571        # Subtract row $i from all following rows.
6572
6573        for (my $u = $i + 1 ; $u <= $imax ; ++$u) {
6574
6575            for (my $j = $jmax ; $j >= $i ; --$j) {
6576                $x->[$u][$j] -= ($x->[$i][$j] * $x->[$u][$i]) / $x->[$i][$i];
6577            }
6578
6579            # In case of round-off errors.
6580
6581            $x->[$u][$i] *= 0;
6582        }
6583
6584        printf "\nfelim_tp(): after %u:\n\n%s\n\n", $i, $x if $debug;
6585    }
6586
6587    return $x, $iperm, $jperm, $iswap, $jswap if wantarray;
6588    return $x;
6589}
6590
6591=pod
6592
6593=item felim_pp()
6594
6595Perform forward elimination with (unscaled) partial pivoting.
6596
6597    $y = $x -> felim_pp();
6598
6599If A is a p-by-q matrix, and the so far remaining unreduced submatrix starts at
6600element (i,i), the pivot element is the element in column i that has the largest
6601absolute value.
6602
6603This method is provided mostly for illustration purposes.
6604
6605=cut
6606
6607sub felim_pp {
6608    croak "Not enough arguments for ", (caller(0))[3] if @_ < 1;
6609    croak "Too many arguments for ", (caller(0))[3] if @_ > 1;
6610    my $x = shift;
6611
6612    croak "felim_pp(): too many input arguments" if @_ > 0;
6613
6614    $x = $x -> clone();
6615    my $nrow = $x -> nrow();
6616    my $ncol = $x -> ncol();
6617
6618    my $imax = $nrow - 1;
6619    my $jmax = $ncol - 1;
6620
6621    my $iperm = [ 0 .. $imax ];         # row permutation vector
6622    my $jperm = [ 0 .. $imax ];         # column permutation vector
6623    my $iswap = 0;                      # number of row swaps
6624    my $jswap = 0;                      # number of column swaps
6625
6626    my $debug = 0;
6627
6628    printf "\nfelim_pp(): before 0:\n\n%s\n", $x if $debug;
6629
6630    for (my $i = 0 ; $i <= $imax && $i <= $jmax ; ++$i) {
6631
6632        # The so far remaining unreduced submatrix starts at element ($i,$i).
6633
6634        # Skip this round, if all elements below (i,i) are zero.
6635
6636        my $saw_non_zero = 0;
6637        for (my $u = $i + 1 ; $u <= $imax ; ++$u) {
6638            if ($x->[$u][$i] != 0) {
6639                $saw_non_zero = 1;
6640                last;
6641            }
6642        }
6643        next unless $saw_non_zero;
6644
6645        # The pivot element is the element in column $i (in the unreduced
6646        # submatrix) that has the largest absolute value.
6647
6648        my $p;                  # index of pivot row
6649        my $max_abs_val = 0;
6650
6651        for (my $u = $i ; $u <= $imax ; ++$u) {
6652            my $abs_val = CORE::abs($x->[$u][$i]);
6653            if ($abs_val > $max_abs_val) {
6654                $max_abs_val = $abs_val;
6655                $p = $u;
6656            }
6657        }
6658
6659        printf "\nfelim_pp(): pivot element is (%u,%u)\n", $p, $i if $debug;
6660
6661        # Swap rows $i and $p.
6662
6663        if ($p != $i) {
6664            ($x->[$p], $x->[$i]) = ($x->[$i], $x->[$p]);
6665            ($iperm->[$p], $iperm->[$i]) = ($iperm->[$i], $iperm->[$p]);
6666            $iswap++;
6667        }
6668
6669        # Subtract row $i from all following rows.
6670
6671        for (my $u = $i + 1 ; $u <= $imax ; ++$u) {
6672
6673            for (my $j = $jmax ; $j >= $i ; --$j) {
6674                $x->[$u][$j] -= ($x->[$i][$j] * $x->[$u][$i]) / $x->[$i][$i];
6675            }
6676
6677            # In case of round-off errors.
6678
6679            $x->[$u][$i] *= 0;
6680        }
6681
6682        printf "\nfelim_pp(): after %u:\n\n%s\n\n", $i, $x if $debug;
6683    }
6684
6685    return $x, $iperm, $jperm, $iswap, $jswap if wantarray;
6686    return $x;
6687}
6688
6689=pod
6690
6691=item felim_sp()
6692
6693Perform forward elimination with scaled pivoting, a variant of partial pivoting.
6694
6695    $y = $x -> felim_sp();
6696
6697If A is a p-by-q matrix, and the so far remaining unreduced submatrix starts at
6698element (i,i), the pivot element is the element in column i that has the largest
6699absolute value relative to the other elements on the same row.
6700
6701=cut
6702
6703sub felim_sp {
6704    croak "Not enough arguments for ", (caller(0))[3] if @_ < 1;
6705    croak "Too many arguments for ", (caller(0))[3] if @_ > 1;
6706    my $x = shift;
6707
6708    croak "felim_sp(): too many input arguments" if @_ > 0;
6709
6710    $x = $x -> clone();
6711    my $nrow = $x -> nrow();
6712    my $ncol = $x -> ncol();
6713
6714    my $imax = $nrow - 1;
6715    my $jmax = $ncol - 1;
6716
6717    my $iperm = [ 0 .. $imax ];         # row permutation vector
6718    my $jperm = [ 0 .. $imax ];         # column permutation vector
6719    my $iswap = 0;                      # number of row swaps
6720    my $jswap = 0;                      # number of column swaps
6721
6722    my $debug = 0;
6723
6724    printf "\nfelim_sp(): before 0:\n\n%s\n", $x if $debug;
6725
6726    for (my $i = 0 ; $i <= $imax && $i <= $jmax ; ++$i) {
6727
6728        # The so far remaining unreduced submatrix starts at element ($i,$i).
6729
6730        # Skip this round, if all elements below (i,i) are zero.
6731
6732        my $saw_non_zero = 0;
6733        for (my $u = $i + 1 ; $u <= $imax ; ++$u) {
6734            if ($x->[$u][$i] != 0) {
6735                $saw_non_zero = 1;
6736                last;
6737            }
6738        }
6739        next unless $saw_non_zero;
6740
6741        # The pivot element is the element in column $i (in the unreduced
6742        # submatrix) that has the largest absolute value relative to the other
6743        # elements on the same row.
6744
6745        my $p;
6746        my $max_abs_ratio = 0;
6747
6748        for (my $u = $i ; $u <= $imax ; ++$u) {
6749
6750            # Find the element with the largest absolute value in row $u.
6751
6752            my $max_abs_val = 0;
6753            for (my $v = $i ; $v <= $jmax ; ++$v) {
6754                my $abs_val = CORE::abs($x->[$u][$v]);
6755                $max_abs_val = $abs_val if $abs_val > $max_abs_val;
6756            }
6757
6758            next if $max_abs_val == 0;
6759
6760            # Find the ratio for this row and see if it the best so far.
6761
6762            my $abs_ratio = CORE::abs($x->[$u][$i]) / $max_abs_val;
6763            #croak "column ", $i + 1, " has only zeros"
6764            #  if $ratio == 0;
6765
6766            if ($abs_ratio > $max_abs_ratio) {
6767                $max_abs_ratio = $abs_ratio;
6768                $p = $u;
6769            }
6770
6771        }
6772
6773        printf "\nfelim_sp(): pivot element is (%u,%u)\n", $p, $i if $debug;
6774
6775        # Swap rows $i and $p.
6776
6777        if ($p != $i) {
6778            ($x->[$p], $x->[$i]) = ($x->[$i], $x->[$p]);
6779            ($iperm->[$p], $iperm->[$i]) = ($iperm->[$i], $iperm->[$p]);
6780            $iswap++;
6781        }
6782
6783        # Subtract row $i from all following rows.
6784
6785        for (my $u = $i + 1 ; $u <= $imax ; ++$u) {
6786
6787            for (my $j = $jmax ; $j >= $i ; --$j) {
6788                $x->[$u][$j] -= ($x->[$i][$j] * $x->[$u][$i]) / $x->[$i][$i];
6789            }
6790
6791            # In case of round-off errors.
6792
6793            $x->[$u][$i] *= 0;
6794        }
6795
6796        printf "\nfelim_sp(): after %u:\n\n%s\n\n", $i, $x if $debug;
6797    }
6798
6799    return $x, $iperm, $jperm, $iswap, $jswap if wantarray;
6800    return $x;
6801}
6802
6803=pod
6804
6805=item felim_fp()
6806
6807Performs forward elimination with full pivoting.
6808
6809    $y = $x -> felim_fp();
6810
6811The elimination is done with full pivoting, also called complete pivoting or
6812total pivoting. If A is a p-by-q matrix, and the so far remaining unreduced
6813submatrix starts at element (i,i), the pivot element is the element in the whole
6814submatrix that has the largest absolute value. With full pivoting, both rows and
6815columns might be swapped.
6816
6817=cut
6818
6819sub felim_fp {
6820    croak "Not enough arguments for ", (caller(0))[3] if @_ < 1;
6821    croak "Too many arguments for ", (caller(0))[3] if @_ > 1;
6822    my $x = shift;
6823
6824    croak "felim_fp(): too many input arguments" if @_ > 0;
6825
6826    $x = $x -> clone();
6827    my $nrow = $x -> nrow();
6828    my $ncol = $x -> ncol();
6829
6830    my $imax = $nrow - 1;
6831    my $jmax = $ncol - 1;
6832
6833    my $iperm = [ 0 .. $imax ];         # row permutation vector
6834    my $jperm = [ 0 .. $imax ];         # column permutation vector
6835    my $iswap = 0;                      # number of row swaps
6836    my $jswap = 0;                      # number of column swaps
6837
6838    my $debug = 0;
6839
6840    printf "\nfelim_fp(): before 0:\n\n%s\n", $x if $debug;
6841
6842    for (my $i = 0 ; $i <= $imax && $i <= $jmax ; ++$i) {
6843
6844        # The so far remaining unreduced submatrix starts at element ($i,$i).
6845        # The pivot element is the element in the whole submatrix that has the
6846        # largest absolute value.
6847
6848        my $p;                  # index of pivot row
6849        my $q;                  # index of pivot column
6850
6851        # Loop over each row and column in the submatrix to find the element
6852        # with the largest absolute value.
6853
6854        my $max_abs_val = 0;
6855        for (my $u = $i ; $u <= $imax ; ++$u) {
6856            for (my $v = $i ; $v <= $imax && $v <= $jmax ; ++$v) {
6857                my $abs_val = CORE::abs($x->[$u][$v]);
6858                if ($abs_val > $max_abs_val) {
6859                    $max_abs_val = $abs_val;
6860                    $p = $u;
6861                    $q = $v;
6862                }
6863            }
6864        }
6865
6866        # If we didn't find a pivot element, it means that the so far unreduced
6867        # submatrix contains zeros only, in which case we're done.
6868
6869        last unless defined $p;
6870
6871        printf "\nfelim_fp(): pivot element is (%u,%u)\n", $p, $q if $debug;
6872
6873        # Swap rows $i and $p.
6874
6875        if ($p != $i) {
6876            printf "\nfelim_fp(): swapping rows %u and %u\n", $p, $i if $debug;
6877            printf "\nfrom this:\n\n%s\n", $x if $debug;
6878            ($x->[$p], $x->[$i]) = ($x->[$i], $x->[$p]);
6879            printf "\nto this:\n\n%s\n", $x if $debug;
6880            ($iperm->[$p], $iperm->[$i]) = ($iperm->[$i], $iperm->[$p]);
6881            $iswap++;
6882        }
6883
6884        # Swap columns $i and $q.
6885
6886        if ($q != $i) {
6887            printf "\nfelim_fp(): swapping columns %u and %u\n", $q, $i if $debug;
6888            printf "\nfrom this:\n\n%s\n", $x if $debug;
6889            for (my $u = 0 ; $u <= $imax ; ++$u) {
6890                ($x->[$u][$q], $x->[$u][$i]) = ($x->[$u][$i], $x->[$u][$q]);
6891            }
6892            printf "\nto this:\n\n%s\n", $x if $debug;
6893            ($jperm->[$q], $jperm->[$i]) = ($jperm->[$i], $jperm->[$q]);
6894            $jswap++;
6895        }
6896
6897        # Subtract row $i from all following rows.
6898
6899        for (my $u = $i + 1 ; $u <= $imax ; ++$u) {
6900
6901            for (my $j = $jmax ; $j >= $i ; --$j) {
6902                $x->[$u][$j] -= ($x->[$i][$j] * $x->[$u][$i]) / $x->[$i][$i];
6903            }
6904
6905            # In case of round-off errors.
6906
6907            $x->[$u][$i] *= 0;
6908        }
6909
6910        printf "\nfelim_fp(): after %u:\n\n%s\n\n", $i, $x if $debug;
6911    }
6912
6913    return $x, $iperm, $jperm, $iswap, $jswap if wantarray;
6914    return $x;
6915}
6916
6917=pod
6918
6919=back
6920
6921=head3 Back-substitution
6922
6923=over 4
6924
6925=item bsubs()
6926
6927Performs back-substitution.
6928
6929    $y = $x -> bsubs();
6930
6931The leftmost square portion of the matrix must be upper triangular.
6932
6933=cut
6934
6935sub bsubs {
6936    croak "Not enough arguments for ", (caller(0))[3] if @_ < 1;
6937    croak "Too many arguments for ", (caller(0))[3] if @_ > 1;
6938    my $x = shift;
6939
6940    croak "bsubs(): too many input arguments" if @_ > 0;
6941
6942    my $nrow = $x -> nrow();
6943    my $ncol = $x -> ncol();
6944
6945    my $imax = $nrow - 1;
6946    my $jmax = $ncol - 1;
6947
6948    my $debug = 0;
6949
6950    printf "\nbsubs(): before 0:\n\n%s\n", $x if $debug;
6951
6952    for (my $i = 0 ; $i <= $imax ; ++$i) {
6953
6954        # Check the elements below ($i,$i). They should all be zero.
6955
6956        for (my $k = $i + 1 ; $k <= $imax ; ++$k) {
6957            croak "matrix is not upper triangular; element ($i,$i) is non-zero"
6958              unless $x->[$k][$i] == 0;
6959        }
6960
6961        # There is no rows above the first row to perform back-substitution on.
6962
6963        next if $i == 0;
6964
6965        # If the element on the diagonal is zero, we can't use it to perform
6966        # back-substitution. However, this is not a problem if all the elements
6967        # above ($i,$i) are zero.
6968
6969        if ($x->[$i][$i] == 0) {
6970            my $non_zero = 0;
6971            my $k;
6972            for ($k = 0 ; $k < $i ; ++$k) {
6973                if ($x->[$k][$i] != 0) {
6974                    $non_zero++;
6975                    last;
6976                }
6977            }
6978            if ($non_zero) {
6979                croak "bsubs(): back substitution failed; diagonal element",
6980                  " ($i,$i) is zero, but ($k,$i) isn't";
6981                next;
6982            }
6983        }
6984
6985        # Subtract row $i from each row $u above row $i.
6986
6987        for (my $u = $i - 1 ; $u >= 0 ; --$u) {
6988
6989            # From row $u subtract $c times of row $i.
6990
6991            my $c = $x->[$u][$i] / $x->[$i][$i];
6992
6993            for (my $j = $jmax ; $j >= $i ; --$j) {
6994                $x->[$u][$j] -= $c * $x->[$i][$j];
6995            }
6996
6997            # In case of round-off errors.  (Will they ever happen?)
6998
6999            $x->[$u][$i] *= 0;
7000        }
7001
7002        printf "\nbsubs(): after %u:\n\n%s\n\n", $i, $x if $debug;
7003    }
7004
7005    # Normalise.
7006
7007    for (my $i = 0 ; $i <= $imax ; ++$i) {
7008        next if $x->[$i][$i] == 1;      # row is already normalized
7009        next if $x->[$i][$i] == 0;      # row can't be normalized
7010        for (my $j = $imax + 1 ; $j <= $jmax ; ++$j) {
7011            $x->[$i][$j] /= $x->[$i][$i];
7012        }
7013        $x->[$i][$i] = 1;
7014    }
7015
7016    printf "\nbsubs(): after normalisation:\n\n%s\n\n", $x if $debug;
7017
7018    return $x;
7019}
7020
7021=pod
7022
7023=back
7024
7025=head2 Miscellaneous methods
7026
7027=over 4
7028
7029=item print()
7030
7031Prints the matrix on STDOUT. If the method has additional parameters, these are
7032printed before the matrix is printed.
7033
7034=cut
7035
7036sub print {
7037    my $self = shift;
7038
7039    print @_ if scalar(@_);
7040    print $self->as_string;
7041}
7042
7043=pod
7044
7045=item version()
7046
7047Returns a string contining the package name and version number.
7048
7049=cut
7050
7051sub version {
7052    return "Math::Matrix $VERSION";
7053}
7054
7055# Internal utility methods.
7056
7057# Compute the sum of all elements using Neumaier's algorithm, an improvement
7058# over Kahan's algorithm.
7059#
7060# See
7061# https://en.wikipedia.org/wiki/Kahan_summation_algorithm#Further_enhancements
7062
7063sub _sum {
7064    my $sum = 0;
7065    my $c = 0;
7066
7067    for (@_) {
7068        my $t = $sum + $_;
7069        if (CORE::abs($sum) >= CORE::abs($_)) {
7070            $c += ($sum - $t) + $_;
7071        } else {
7072            $c += ($_ - $t) + $sum;
7073        }
7074        $sum = $t;
7075    }
7076
7077    return $sum + $c;
7078}
7079
7080# _prod LIST
7081#
7082
7083sub _prod {
7084    my $prod = 1;
7085    $prod *= $_ for @_;
7086    return $prod;
7087}
7088
7089# _mean LIST
7090#
7091# Method for finding the mean.
7092
7093sub _mean {
7094    return 0 unless @_;
7095    _sum(@_) / @_;
7096}
7097
7098# Method used to calculate the length of the hypotenuse of a right-angle
7099# triangle. It is designed to avoid errors arising due to limited-precision
7100# calculations performed on computers. E.g., with double-precision arithmetic:
7101#
7102#     sqrt(3e200**2 + 4e200**2)    # = Inf, due to overflow
7103#     _hypot(3e200, 4e200)         # = 5e200, which is correct
7104#
7105#     sqrt(3e-200**2 + 4e-200**2)  # = 0, due to underflow
7106#     _hypot(3e-200, 4e-200)       # = 5e-200, which is correct
7107#
7108# See https://en.wikipedia.org/wiki/Hypot
7109
7110sub _hypot {
7111    my @x = map { CORE::abs($_) } @_;
7112
7113    # Compute the maximum value.
7114
7115    my $max = _max(@x);
7116    return 0 if $max == 0;
7117
7118    # Scale and square the values.
7119
7120    for (@x) {
7121        $_ /= $max;
7122        $_ *= $_;
7123    }
7124
7125    $max * sqrt(_sum(@x))
7126}
7127
7128# _sumsq LIST
7129#
7130# Sum of squared absolute values.
7131
7132sub _sumsq {
7133    _sum(map { $_ * $_ } map { CORE::abs($_) } @_);
7134}
7135
7136# _vecnorm P, LIST
7137#
7138# Vector P-norm. If the input is $x[0], $x[1], ..., then the output is
7139#
7140#   (abs($x[0])**$p + abs($x[1])**$p + ...)**(1/$p)
7141
7142sub _vecnorm {
7143    my $p = shift;
7144    my @x = map { CORE::abs($_) } @_;
7145
7146    return _sum(@x) if $p == 1;
7147
7148    require Math::Trig;
7149    my $inf = Math::Trig::Inf();
7150
7151    return _max(@x) if $p == $inf;
7152
7153    # Compute the maximum value.
7154
7155    my $max = 0;
7156    for (@x) {
7157        $max = $_ if $_ > $max;
7158    }
7159
7160    # Scale and apply power function.
7161
7162    for (@x) {
7163        $_ /= $max;
7164        $_ **= $p;
7165    }
7166
7167    $max * _sum(@x) ** (1/$p);
7168}
7169
7170# _min LIST
7171#
7172# Minimum value.
7173
7174sub _min {
7175    my $min = shift;
7176    for (@_) {
7177        $min = $_ if $_ < $min;
7178    }
7179
7180    return $min;
7181}
7182
7183# _max LIST
7184#
7185# Maximum value.
7186
7187sub _max {
7188    my $max = shift;
7189    for (@_) {
7190        $max = $_ if $_ > $max;
7191    }
7192
7193    return $max;
7194}
7195
7196# _median LIST
7197#
7198# Method for finding the median.
7199
7200sub _median {
7201    my @x = sort { $a <=> $b } @_;
7202    if (@x % 2) {
7203         $x[$#x / 2];
7204    } else {
7205        ($x[@x / 2] + $x[@x / 2 - 1]) / 2;
7206    }
7207}
7208
7209# _any LIST
7210#
7211# Method that returns 1 if at least one value in LIST is non-zero and 0
7212# otherwise.
7213
7214sub _any {
7215    for (@_) {
7216        return 1 if $_ != 0;
7217    }
7218    return 0;
7219}
7220
7221# _all LIST
7222#
7223# Method that returns 1 if all values in LIST are non-zero and 0 otherwise.
7224
7225sub _all {
7226    for (@_) {
7227        return 0 if $_ == 0;
7228    }
7229    return 1;
7230}
7231
7232# _cumsum LIST
7233#
7234# Cumulative sum. If the input is $x[0], $x[1], ..., then output element $y[$i]
7235# is the sum of the elements $x[0], $x[1], ..., $x[$i].
7236
7237sub _cumsum {
7238    my @sum = ();
7239
7240    my $sum = 0;
7241    my $c = 0;
7242
7243    for (@_) {
7244        my $t = $sum + $_;
7245        if (CORE::abs($sum) >= CORE::abs($_)) {
7246            $c += ($sum - $t) + $_;
7247        } else {
7248            $c += ($_ - $t) + $sum;
7249        }
7250        $sum = $t;
7251        push @sum, $sum + $c;
7252    }
7253
7254    return @sum;
7255}
7256
7257# _cumprod LIST
7258#
7259# Cumulative product. If the input is $x[0], $x[1], ..., then output element
7260# $y[$i] is the product of the elements $x[0], $x[1], ..., $x[$i].
7261
7262sub _cumprod {
7263    my @prod = shift;
7264    push @prod, $prod[-1] * $_ for @_;
7265    return @prod;
7266}
7267
7268# _cummean LIST
7269#
7270# Cumulative mean. If the input is $x[0], $x[1], ..., then output element $y[$i]
7271# is the mean of the elements $x[0], $x[1], ..., $x[$i].
7272
7273sub _cummean {
7274    my @mean = ();
7275    my $sum = 0;
7276    for my $i (0 .. $#_) {
7277        $sum += $_[$i];
7278        push @mean, $sum / ($i + 1);
7279    }
7280    return @mean;
7281}
7282
7283# _cummean LIST
7284#
7285# Cumulative minimum. If the input is $x[0], $x[1], ..., then output element
7286# $y[$i] is the minimum of the elements $x[0], $x[1], ..., $x[$i].
7287
7288sub _cummin {
7289    my @min = shift;
7290    for (@_) {
7291        push @min, $min[-1] < $_ ? $min[-1] : $_;
7292    }
7293    return @min;
7294}
7295
7296# _cummax LIST
7297#
7298# Cumulative maximum. If the input is $x[0], $x[1], ..., then output element
7299# $y[$i] is the maximum of the elements $x[0], $x[1], ..., $x[$i].
7300
7301sub _cummax {
7302    my @max = shift;
7303    for (@_) {
7304        push @max, $max[-1] > $_ ? $max[-1] : $_;
7305    }
7306    return @max;
7307}
7308
7309# _cumany LIST
7310#
7311# Cumulative any. If the input is $x[0], $x[1], ..., then output element $y[$i]
7312# is 1 if at least one of the elements $x[0], $x[1], ..., $x[$i] is non-zero,
7313# and 0 otherwise.
7314
7315sub _cumany {
7316    my @any = ();
7317    for (@_) {
7318        if ($_ != 0) {
7319            push @any, (1) x (@_ - @any);
7320            last;
7321        }
7322        push @any, 0;
7323    }
7324    return @any;
7325}
7326
7327# _cumall LIST
7328#
7329# Cumulative all. If the input is $x[0], $x[1], ..., then output element $y[$i]
7330# is 1 if all of the elements $x[0], $x[1], ..., $x[$i] are non-zero, and 0
7331# otherwise.
7332
7333sub _cumall {
7334    my @all = ();
7335    for (@_) {
7336        if ($_ == 0) {
7337            push @all, (0) x (@_ - @all);
7338            last;
7339        }
7340        push @all, 1;
7341    }
7342    return @all;
7343}
7344
7345# _diff LIST
7346#
7347# Difference. If the input is $x[0], $x[1], ..., then output element $y[$i] =
7348# $x[$i+1] - $x[$i].
7349
7350sub _diff {
7351    my @diff = ();
7352    for my $i (1 .. $#_) {
7353        push @diff, $_[$i] - $_[$i - 1];
7354    }
7355    return @diff;
7356}
7357
7358=pod
7359
7360=back
7361
7362=head1 OVERLOADING
7363
7364The following operators are overloaded.
7365
7366=over 4
7367
7368=item C<+> and C<+=>
7369
7370Matrix or scalar addition. Unless one or both of the operands is a scalar, both
7371operands must have the same size.
7372
7373    $C  = $A + $B;      # assign $A + $B to $C
7374    $A += $B;           # assign $A + $B to $A
7375
7376Note that
7377
7378=item C<-> and C<-=>
7379
7380Matrix or scalar subtraction. Unless one or both of the operands is a scalar,
7381both operands must have the same size.
7382
7383    $C  = $A + $B;      # assign $A - $B to $C
7384    $A += $B;           # assign $A - $B to $A
7385
7386=item C<*> and C<*=>
7387
7388Matrix or scalar multiplication. Unless one or both of the operands is a scalar,
7389the number of columns in the first operand must be equal to the number of rows
7390in the second operand.
7391
7392    $C  = $A * $B;      # assign $A * $B to $C
7393    $A *= $B;           # assign $A * $B to $A
7394
7395=item C<**> and C<**=>
7396
7397Matrix power. The second operand must be a scalar.
7398
7399    $C  = $A * $B;      # assign $A ** $B to $C
7400    $A *= $B;           # assign $A ** $B to $A
7401
7402=item C<==>
7403
7404Equal to.
7405
7406    $A == $B;           # is $A equal to $B?
7407
7408=item C<!=>
7409
7410Not equal to.
7411
7412    $A != $B;           # is $A not equal to $B?
7413
7414=item C<neg>
7415
7416Negation.
7417
7418    $B = -$A;           # $B is the negative of $A
7419
7420=item C<~>
7421
7422Transpose.
7423
7424    $B = ~$A;           # $B is the transpose of $A
7425
7426=item C<abs>
7427
7428Absolute value.
7429
7430    $B = abs $A;        # $B contains absolute values of $A
7431
7432=item C<int>
7433
7434Truncate to integer.
7435
7436    $B = int $A;        # $B contains only integers
7437
7438=back
7439
7440=head1 IMPROVING THE SOLUTION OF LINEAR SYSTEMS
7441
7442The methods that do an explicit or implicit matrix left division accept some
7443additional parameters. If these parameters are specified, the matrix left
7444division is done repeatedly in an iterative way, which often gives a better
7445solution.
7446
7447=head2 Background
7448
7449The linear system of equations
7450
7451    $A * $x = $y
7452
7453can be solved for C<$x> with
7454
7455    $x = $y -> mldiv($A);
7456
7457Ideally C<$A * $x> should equal C<$y>, but due to numerical errors, this is not
7458always the case. The following illustrates how to improve the solution C<$x>
7459computed above:
7460
7461    $r = $A -> mmuladd($x, -$y);    # compute the residual $A*$x-$y
7462    $d = $r -> mldiv($A);           # compute the delta for $x
7463    $x -= $d;                       # improve the solution $x
7464
7465This procedure is repeated, and at each step, the absolute error
7466
7467    ||$A*$x - $y|| = ||$r||
7468
7469and the relative error
7470
7471    ||$A*$x - $y|| / ||$y|| = ||$r|| / ||$y||
7472
7473are computed and compared to the tolerances. Once one of the stopping criteria
7474is satisfied, the algorithm terminates.
7475
7476=head2 Stopping criteria
7477
7478The algorithm stops when at least one of the errors are within the specified
7479tolerances or the maximum number of iterations is reached. If the maximum number
7480of iterations is reached, but noen of the errors are within the tolerances, a
7481warning is displayed and the best solution so far is returned.
7482
7483=head2 Parameters
7484
7485=over 4
7486
7487=item MaxIter
7488
7489The maximum number of iterations to perform. The value must be a positive
7490integer. The default is 20.
7491
7492=item RelTol
7493
7494The limit for the relative error. The value must be a non-negative. The default
7495value is 1e-19 when perl is compiled with long doubles or quadruple precision,
7496and 1e-9 otherwise.
7497
7498=item AbsTol
7499
7500The limit for the absolute error. The value must be a non-negative. The default
7501value is 0.
7502
7503=item Debug
7504
7505If this parameter does not affect when the algorithm terminates, but when set to
7506non-zero, some information is displayed at each step.
7507
7508=back
7509
7510=head2 Example
7511
7512If
7513
7514    $A = [[  8, -8, -5,  6, -1,  3 ],
7515          [ -7, -1,  5, -9,  5,  6 ],
7516          [ -7,  8,  9, -2, -4,  3 ],
7517          [  3, -4,  5,  5,  3,  3 ],
7518          [  9,  8, -3, -4,  1,  6 ],
7519          [ -8,  9, -1,  3,  5,  2 ]];
7520
7521    $y = [[  80, -13 ],
7522          [  -2, 104 ],
7523          [ -57, -27 ],
7524          [  47, -28 ],
7525          [   5,  77 ],
7526          [  91, 133 ]];
7527
7528the result of C<< $x = $y -> mldiv($A); >>, using double precision arithmetic,
7529is the approximate solution
7530
7531    $x = [[ -2.999999999999998, -5.000000000000000 ],
7532          [ -1.000000000000000,  3.000000000000001 ],
7533          [ -5.999999999999997, -8.999999999999996 ],
7534          [  8.000000000000000, -2.000000000000003 ],
7535          [  6.000000000000003,  9.000000000000002 ],
7536          [  7.999999999999997,  8.999999999999995 ]];
7537
7538The residual C<< $res = $A -> mmuladd($x, -$y); >> is
7539
7540    $res = [[  1.24344978758018e-14,  1.77635683940025e-15 ],
7541            [  8.88178419700125e-15, -5.32907051820075e-15 ],
7542            [ -1.24344978758018e-14,  1.77635683940025e-15 ],
7543            [ -7.10542735760100e-15, -4.08562073062058e-14 ],
7544            [ -1.77635683940025e-14, -3.81916720471054e-14 ],
7545            [  1.24344978758018e-14,  8.43769498715119e-15 ]];
7546
7547and the delta C<< $dx = $res -> mldiv($A); >> is
7548
7549    $dx = [[   -8.592098303124e-16, -2.86724066474914e-15 ],
7550           [ -7.92220125658508e-16, -2.99693950082398e-15 ],
7551           [ -2.22533360993874e-16,  3.03465504177947e-16 ],
7552           [  6.47376093198353e-17, -1.12378127899388e-15 ],
7553           [  6.35204502123966e-16,  2.40938179521241e-15 ],
7554           [  1.55166908001001e-15,  2.08339859425849e-15 ]];
7555
7556giving the improved, and in this case exact, solution C<< $x -= $dx; >>,
7557
7558    $x = [[ -3, -5 ],
7559          [ -1,  3 ],
7560          [ -6, -9 ],
7561          [  8, -2 ],
7562          [  6,  9 ],
7563          [  8,  9 ]];
7564
7565=head1 SUBCLASSING
7566
7567The methods should work fine with any kind of numerical objects, provided that
7568the assignment operator C<=> is overloaded, so that Perl knows how to create a
7569copy.
7570
7571You can check the behaviour of the assignment operator by assigning a value to a
7572new variable, modify the new variable, and check whether this also modifies the
7573original value. Here is an example:
7574
7575    $x = Some::Class -> new(0);           # create object $x
7576    $y = $x;                              # create new variable $y
7577    $y++;                                 # modify $y
7578    print "it's a clone\n" if $x != $y;   # is $x modified?
7579
7580The subclass might need to implement some methods of its own. For instance, if
7581each element is a complex number, a transpose() method needs to be implemented
7582to take the complex conjugate of each value. An as_string() method might also be
7583useful for displaying the matrix in a format more suitable for the subclass.
7584
7585Here is an example showing Math::Matrix::Complex, a fully-working subclass of
7586Math::Matrix, where each element is a Math::Complex object.
7587
7588    use strict;
7589    use warnings;
7590
7591    package Math::Matrix::Complex;
7592
7593    use Math::Matrix;
7594    use Scalar::Util 'blessed';
7595    use Math::Complex 1.57;     # "=" didn't clone before 1.57
7596
7597    our @ISA = ('Math::Matrix');
7598
7599    # We need a new() method to make sure every element is an object.
7600
7601    sub new {
7602        my $self = shift;
7603        my $x = $self -> SUPER::new(@_);
7604
7605        my $sub = sub {
7606            defined(blessed($_[0])) && $_[0] -> isa('Math::Complex')
7607              ? $_[0]
7608              : Math::Complex -> new($_[0]);
7609        };
7610
7611        return $x -> sapply($sub);
7612    }
7613
7614    # We need a transpose() method, since the transpose of a matrix
7615    # with complex numbers also takes the conjugate of all elements.
7616
7617    sub transpose {
7618        my $x = shift;
7619        my $y = $x -> SUPER::transpose(@_);
7620
7621        return $y -> sapply(sub { ~$_[0] });
7622    }
7623
7624    # We need an as_string() method, since our parent's methods
7625    # doesn't format complex numbers correctly.
7626
7627    sub as_string {
7628        my $self = shift;
7629        my $out = "";
7630        for my $row (@$self) {
7631            for my $elm (@$row) {
7632                $out = $out . sprintf "%10s ", $elm;
7633            }
7634            $out = $out . sprintf "\n";
7635        }
7636        $out;
7637    }
7638
7639    1;
7640
7641=head1 BUGS
7642
7643Please report any bugs or feature requests via
7644L<https://github.com/pjacklam/p5-Math-Matrix/issues>.
7645
7646Old bug reports and feature requests can be found at
7647L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=Math-Matrix>.
7648
7649=head1 SUPPORT
7650
7651You can find documentation for this module with the perldoc command.
7652
7653    perldoc Math::Matrix
7654
7655You can also look for information at:
7656
7657=over 4
7658
7659=item * GitHub Source Repository
7660
7661L<https://github.com/pjacklam/p5-Math-Matrix>
7662
7663=item * MetaCPAN
7664
7665L<https://metacpan.org/release/Math-Matrix>
7666
7667=item * CPAN Ratings
7668
7669L<http://cpanratings.perl.org/d/Math-Matrix>
7670
7671=item * CPAN Testers PASS Matrix
7672
7673L<http://pass.cpantesters.org/distro/A/Math-Matrix.html>
7674
7675=item * CPAN Testers Reports
7676
7677L<http://www.cpantesters.org/distro/A/Math-Matrix.html>
7678
7679=item * CPAN Testers Matrix
7680
7681L<http://matrix.cpantesters.org/?dist=Math-Matrix>
7682
7683=back
7684
7685=head1 LICENSE AND COPYRIGHT
7686
7687Copyright (c) 2020-2021, Peter John Acklam
7688
7689Copyright (C) 2013, John M. Gamble <jgamble@ripco.com>, all rights reserved.
7690
7691Copyright (C) 2009, oshalla
7692https://rt.cpan.org/Public/Bug/Display.html?id=42919
7693
7694Copyright (C) 2002, Bill Denney <gte273i@prism.gatech.edu>, all rights
7695reserved.
7696
7697Copyright (C) 2001, Brian J. Watson <bjbrew@power.net>, all rights reserved.
7698
7699Copyright (C) 2001, Ulrich Pfeifer <pfeifer@wait.de>, all rights reserved.
7700Copyright (C) 1995, Universität Dortmund, all rights reserved.
7701
7702Copyright (C) 2001, Matthew Brett <matthew.brett@mrc-cbu.cam.ac.uk>
7703
7704This program is free software; you may redistribute it and/or modify it under
7705the same terms as Perl itself.
7706
7707=head1 AUTHORS
7708
7709Peter John Acklam E<lt>pjacklam@gmail.comE<gt> (2020-2021)
7710
7711Ulrich Pfeifer E<lt>pfeifer@ls6.informatik.uni-dortmund.deE<gt> (1995-2013)
7712
7713Brian J. Watson E<lt>bjbrew@power.netE<gt>
7714
7715Matthew Brett E<lt>matthew.brett@mrc-cbu.cam.ac.ukE<gt>
7716
7717=cut
7718
77191;
7720