t/AlignIO/AlignIO.t: fix number of tests in plan (fixup c523e6bed866)
[bioperl-live.git] / Bio / Matrix / Generic.pm
blob4debd9ea7636692653c3b85d72012e0a952c41c3
2 # BioPerl module for Bio::Matrix::Generic
4 # Please direct questions and support issues to <bioperl-l@bioperl.org>
6 # Cared for by Jason Stajich <jason-at-bioperl-dot-org>
8 # Copyright Jason Stajich
10 # You may distribute this module under the same terms as perl itself
12 # POD documentation - main docs before the code
14 =head1 NAME
16 Bio::Matrix::Generic - A generic matrix implementation
18 =head1 SYNOPSIS
20 # A matrix has columns and rows
21 my $matrix = Bio::Matrix::Generic->new;
22 $matrix->add_column(1,$column1);
23 $matrix->add_column(2,$column2);
25 my $element = $matrix->entry_by_num(1,2);
26 $matrix->entry_by_num(1,2,$newval);
28 my $entry = $matrix->entry('human', 'mouse');
30 $matrix->entry('human','mouse', $newval);
33 =head1 DESCRIPTION
35 This is a general purpose matrix object for dealing with row+column
36 data which is typical when enumerating all the pairwise combinations
37 and desiring to get slices of the data.
39 Data can be accessed by column and row names or indexes. Matrix
40 indexes start at 0.
42 =head1 FEEDBACK
44 =head2 Mailing Lists
46 User feedback is an integral part of the evolution of this and other
47 Bioperl modules. Send your comments and suggestions preferably to
48 the Bioperl mailing list. Your participation is much appreciated.
50 bioperl-l@bioperl.org - General discussion
51 http://bioperl.org/wiki/Mailing_lists - About the mailing lists
53 =head2 Support
55 Please direct usage questions or support issues to the mailing list:
57 I<bioperl-l@bioperl.org>
59 rather than to the module maintainer directly. Many experienced and
60 reponsive experts will be able look at the problem and quickly
61 address it. Please include a thorough description of the problem
62 with code and data examples if at all possible.
64 =head2 Reporting Bugs
66 Report bugs to the Bioperl bug tracking system to help us keep track
67 of the bugs and their resolution. Bug reports can be submitted via the
68 web:
70 https://github.com/bioperl/bioperl-live/issues
72 =head1 AUTHOR - Jason Stajich
74 Email jason-at-bioperl-dot-org
76 =head1 APPENDIX
78 The rest of the documentation details each of the object methods.
79 Internal methods are usually preceded with a _
81 =cut
83 package Bio::Matrix::Generic;
84 use strict;
87 use base qw(Bio::Root::Root Bio::Matrix::MatrixI);
89 =head2 new
91 Title : new
92 Usage : my $obj = Bio::Matrix::Generic->new();
93 Function: Builds a new Bio::Matrix::Generic object
94 Returns : an instance of Bio::Matrix::Generic
95 Args : -values => arrayref of arrayrefs of data initialization
96 -rownames => arrayref of row names
97 -colnames => arrayref of col names
98 -matrix_id => id of the matrix
99 -matrix_name=> name of the matrix
100 -matrix_init_value => default value to initialize empty cells
102 =cut
104 sub new {
105 my($class,@args) = @_;
107 my $self = $class->SUPER::new(@args);
108 my ($values, $rownames, $colnames,
109 $id,$name,$init_val) =
110 $self->_rearrange([qw(VALUES ROWNAMES COLNAMES
111 MATRIX_ID MATRIX_NAME
112 MATRIX_INIT_VALUE)],@args);
113 $self->matrix_id($id) if defined $id;
114 $self->matrix_name($name) if defined $name;
115 if( defined $rownames && defined $colnames ) {
116 if( ref($rownames) !~ /ARRAY/i ) {
117 $self->throw("need an arrayref for the -rownames option");
119 # insure we copy the values
120 $self->{'_rownames'} = [ @$rownames ];
121 my $count = 0;
122 %{$self->{'_rownamesmap'}} = map { $_ => $count++ } @$rownames;
124 if( ref($colnames) !~ /ARRAY/i ) {
125 $self->throw("need an arrayref for the -colnames option");
127 # insure we copy the values
128 $self->{'_colnames'} = [ @$colnames ];
129 $count = 0;
130 %{$self->{'_colnamesmap'}} = map { $_ => $count++ } @$colnames;
132 $self->{'_values'} = [];
133 if( defined $values ) {
134 if( ref($values) !~ /ARRAY/i ) {
135 $self->throw("Need an arrayref of arrayrefs (matrix) for -values option");
137 for my $v ( @$values ) {
138 if( ref($v) !~ /ARRAY/i ) {
139 $self->throw("Need and array of arrayrefs (matrix) for -values option");
141 push @{$self->{'_values'}}, [@$v];
143 } else {
144 my @fill = ($init_val) x scalar @$colnames; # undef init_val will be default
145 for ( @$rownames ) {
146 push @{$self->{'_values'}}, [@fill];
149 } elsif( ! defined $rownames && ! defined $colnames && ! defined $values ) {
150 $self->{'_values'} = [];
151 $self->{'_rownames'} = [];
152 $self->{'_colnames'} = [];
153 } else {
154 $self->throw("Must have either provided no values/colnames/rownames or provided all three");
157 return $self;
161 =head2 matrix_id
163 Title : matrix_id
164 Usage : my $id = $matrix->matrix_id
165 Function: Get/Set the matrix ID
166 Returns : scalar value
167 Args : [optional] new id value to store
170 =cut
172 sub matrix_id{
173 my $self = shift;
174 return $self->{'_matid'} = shift if @_;
175 return $self->{'_matid'};
180 =head2 matrix_name
182 Title : matrix_name
183 Usage : my $name = $matrix->matrix_name();
184 Function: Get/Set the matrix name
185 Returns : scalar value
186 Args : [optional] new matrix name value
189 =cut
191 sub matrix_name{
192 my $self = shift;
193 return $self->{'_matname'} = shift if @_;
194 return $self->{'_matname'};
198 =head2 entry
200 Title : entry
201 Usage : my $entry = $matrix->entry($row,$col,$value)
202 Function: Get the value for a specific cell as specified
203 by the row and column names
204 Returns : scalar value or undef if row or col does not
205 exist
206 Args : $rowname - name of the row
207 $colname - column name
208 $value - [optional] New value for the entry
210 =cut
212 sub entry{
213 my ($self,$row,$column,$newvalue) = @_;
214 if( ! defined $row || ! defined $column ) {
215 $self->throw("Need at least 2 ids");
218 my ($rownum) = $self->row_num_for_name($row);
219 my ($colnum) = $self->column_num_for_name($column);
220 return $self->entry_by_num($rownum,$colnum,$newvalue);
223 =head2 get_entry
225 Title : get_entry
226 Usage : my $entry = $matrix->get_entry($rowname,$columname,$value)
227 Function: Get the entry for a given row,column pair
228 Returns : scalar
229 Args : $row name
230 $column name
231 $value
234 =cut
236 sub get_entry{ $_[0]->entry($_[1],$_[2]) }
238 =head2 entry_by_num
240 Title : entry_by_num
241 Usage : my $entry = $matrix->entry_by_num($rownum,$colnum)
242 Function: Get an entry by row and column numbers instead of by name
243 (rows and columns start at 0)
244 Returns : scalar value or undef if row or column name does not
245 exist
246 Args : $row - row number
247 $col - column number
248 [optional] $newvalue to store at this cell
250 =cut
252 sub entry_by_num {
253 my ($self,$row,$col,$newvalue) = @_;
254 if( ! defined $row || ! defined $col ||
255 $row !~ /^\d+$/ ||
256 $col !~ /^\d+$/ ) {
257 $self->warn("expected to get 2 number for entry_by_num");
258 return;
261 if( defined $newvalue ) {
262 return $self->_values->[$row][$col] = $newvalue;
263 } else {
264 return $self->_values->[$row][$col];
268 sub get_element {
269 my $self = shift;
270 $self->entry(@_);
274 =head2 column
276 Title : column
277 Usage : my @col = $matrix->column('ALPHA');
279 $matrix->column('ALPHA', \@col);
280 Function: Get/Set a particular column
281 Returns : Array (in array context) or arrayref (in scalar context)
282 of values.
283 For setting will warn if the new column is of a different
284 length from the rest of the columns.
285 Args : name of the column
286 [optional] new column to store here
288 =cut
290 sub column{
291 my ($self,$column,$newcol) = @_;
293 if( ! defined $column ) {
294 $self->warn("Need at least a column id");
295 return;
297 my $colnum = $self->column_num_for_name($column);
298 if( ! defined $colnum ) {
299 $self->warn("could not find column number for $column");
300 return;
302 return $self->column_by_num($colnum,$newcol);
306 =head2 get_column
308 Title : get_column
309 Usage : my @row = $matrix->get_column('ALPHA');
310 Function: Get a particular column
311 Returns : Array (in array context) or arrayref (in scalar context)
312 of values
313 Args : name of the column
316 =cut
318 sub get_column { $_[0]->column($_[1]) }
321 =head2 column_by_num
323 Title : column_by_num
324 Usage : my @col = $matrix->column_by_num(1);
326 $matrix->column_by_num(1,\@newcol);
327 Function: Get/Set a column by its number instead of name
328 (cols/rows start at 0)
329 Returns : Array (in array context) or arrayref (in scalar context)
330 of values
331 Args : name of the column
332 [optional] new value to store for a particular column
334 =cut
336 sub column_by_num{
337 my ($self,$colnum,$newcol) = @_;
338 if( ! defined $colnum ) {
339 $self->warn("need at least a column number");
340 return;
342 my $rowcount = $self->num_rows;
343 my $colcount = $self->num_columns;
344 my $ret;
346 if( defined $newcol ) {
347 if( ref($newcol) !~ /ARRAY/i) {
348 $self->warn("expected a valid arrayref for resetting a column");
349 return;
351 if( scalar @$newcol != $rowcount ) {
352 $self->warn("new column is not the correct length ($rowcount) - call add or remove row to shrink or grow the number of rows first");
353 return;
355 for(my $i=0; $i < $rowcount; $i++) {
356 $self->entry_by_num($i,$colnum,$newcol->[$i]);
358 $ret = $newcol;
359 } else {
360 $ret = [];
361 for(my $i=0; $i < $rowcount; $i++) {
362 push @$ret,$self->entry_by_num($i,$colnum);
365 if( wantarray ) { return @$ret }
366 return $ret;
370 =head2 row
372 Title : row
373 Usage : my @row = $matrix->row($rowname);
375 $matrix->row($rowname,\@rowvalues);
376 Function: Get/Set the row of the matrix
377 Returns : Array (in array context) or arrayref (in scalar context)
378 Args : rowname
379 [optional] new value of row to store
382 =cut
384 sub row {
385 my ($self,$row,$newrow) = @_;
386 if( ! defined $row) {
387 $self->warn("Need at least a row id");
388 return;
390 my $rownum = $self->row_num_for_name($row);
391 return $self->row_by_num($rownum,$newrow);
395 =head2 get_row
397 Title : get_row
398 Usage : my @row = $matrix->get_row('ALPHA');
399 Function: Get a particular row
400 Returns : Array (in array context) or arrayref (in scalar context)
401 of values
402 Args : name of the row
404 =cut
406 sub get_row { $_[0]->row($_[1]) }
408 =head2 row_by_num
410 Title : row_by_num
411 Usage : my @row = $matrix->row_by_num($rownum);
413 $matrix->row($rownum,\@rowvalues);
414 Function: Get/Set the row of the matrix
415 Returns : Array (in array context) or arrayref (in scalar context)
416 Args : rowname
417 [optional] new value of row to store
419 =cut
421 sub row_by_num{
422 my ($self,$rownum,$newrow) = @_;
423 if( ! defined $rownum ) {
424 $self->warn("need at least a row number");
425 return;
427 my $colcount = $self->num_columns;
428 my $ret;
429 if( defined $newrow ) {
430 if( ref($newrow) !~ /ARRAY/i) {
431 $self->warn("expected a valid arrayref for resetting a row");
432 return;
434 if( scalar @$newrow != $colcount ) {
435 $self->warn("new row is not the correct length ($colcount) - call add or remove column to shrink or grow the number of columns first");
436 return;
438 for(my $i=0; $i < $colcount; $i++) {
439 $self->entry_by_num($rownum,$i, $newrow->[$i]);
441 $ret = $newrow;
442 } else {
443 $ret = [];
444 for(my $i=0; $i < $colcount; $i++) {
445 # we're doing this to explicitly
446 # copy the entire row
447 push @$ret, $self->entry_by_num($rownum,$i);
450 if( wantarray ) { return @$ret }
451 return $ret;
457 =head2 diagonal
459 Title : diagonal
460 Usage : my @diagonal = $matrix->get_diagonal()
461 Function: Get the diagonal of a matrix
462 Returns : Array (in array context) or arrayref (in scalar context)
463 of values which lie along the diagonal
464 Args : none
467 =cut
469 sub get_diagonal{
470 my ($self) = @_;
471 my @diag;
472 my $rowcount = $self->num_rows;
473 my $colcount = $self->num_columns;
474 for(my $i = 0; $i < $rowcount; $i++ ) {
475 push @diag, $self->entry_by_num($i,$i);
477 return @diag;
481 =head2 add_row
483 Title : add_row
484 Usage : $matrix->add_row($index,\@newrow);
485 Function: Adds a row at particular location in the matrix.
486 If $index < the rowcount will shift all the rows down
487 by the number of new rows.
488 To add a single empty row, simply call
489 $matrix->add_row($index,undef);
490 Returns : the updated number of total rows in the matrix
491 Args : index to store
492 name of the row (header)
493 newrow to add, if this is undef will add a single
494 row with all values set to undef
496 =cut
498 sub add_row{
499 my ($self,$index,$name,$newrow) = @_;
500 if( !defined $index ||
501 $index !~ /^\d+$/ ) {
502 $self->warn("expected a valid row index in add_row");
503 return;
504 } elsif( ! defined $name) {
505 $self->warn("Need a row name or heading");
506 return;
507 } elsif( defined $self->row_num_for_name($name) ) {
508 $self->warn("Need a unqiue name for the column heading, $name is already used");
509 return;
511 my $colcount = $self->num_columns;
512 my $rowcount = $self->num_rows;
514 if( $index > $rowcount ) {
515 $self->warn("cannot add a row beyond 1+last row at the end ($rowcount) not $index - adding at $rowcount instead");
516 $index = $rowcount;
519 if( ! defined $newrow ) {
520 $newrow = [];
521 $newrow->[$colcount] = undef;
522 } elsif( ref($newrow) !~ /ARRAY/i ) {
523 $self->throw("Expected either undef or a valid arrayref for add_row");
525 # add this row to the matrix by carving out space for it with
526 # splice
527 splice(@{$self->{'_values'}}, $index,0,[]);
528 for( my $i = 0; $i < $colcount; $i++ ) {
529 $self->entry_by_num($index,$i,$newrow->[$i]);
531 splice(@{$self->{'_rownames'}}, $index,0,$name);
532 # Sadly we have to remap these each time (except for the case
533 # when we're adding a new column to the end, but I don't think
534 # the speedup for that case warrants the extra code at this time.
535 my $ct = 0;
536 %{$self->{'_rownamesmap'}} = map { $_ => $ct++} @{$self->{'_rownames'}};
537 return $self->num_rows;
540 =head2 remove_row
542 Title : remove_row
543 Usage : $matrix->remove_row($colnum)
544 Function: remove a row from the matrix shifting all the rows
545 up by one
546 Returns : Updated number of rows in the matrix
547 Args : row index
550 =cut
552 sub remove_row{
553 my ($self,$rowindex) = @_;
554 my $rowcount = $self->num_rows;
556 if( $rowindex > $rowcount ) {
557 $self->warn("rowindex $rowindex is greater than number of rows $rowcount, cannot process");
558 return 0;
559 } else {
560 splice(@{$self->_values},$rowindex,1);
561 delete $self->{'_rownamesmap'}->{$self->{'_rownames'}->[$rowindex]};
562 splice(@{$self->{'_rownames'}},$rowindex,1);
564 my $ct = 0;
565 %{$self->{'_rownamesmap'}} = map { $_ => $ct++} @{$self->{'_rownames'}};
566 return $self->num_rows;
569 =head2 add_column
571 Title : add_column
572 Usage : $matrix->add_column($index,$colname,\@newcol);
573 Function: Adds a column at particular location in the matrix.
574 If $index < the colcount will shift all the columns right
575 by the number of new columns.
576 To add a single empty column, simply call
577 $matrix->add_column($index,undef);
578 Returns : the updated number of total columns in the matrix
579 Args : index to store
580 name of the column (header)
581 newcolumn to add, if this is undef will add a single
582 column with all values set to undef
585 =cut
588 sub add_column{
589 my ($self,$index,$name,$newcol) = @_;
590 if( !defined $index ||
591 $index !~ /^\d+$/ ) {
592 $self->warn("expected a valid col index in add_column");
593 return;
594 } elsif( ! defined $name) {
595 $self->warn("Need a column name or heading");
596 return;
597 } elsif( defined $self->column_num_for_name($name) ) {
598 $self->warn("Need a unqiue name for the column heading, $name is already used");
599 return;
601 my $colcount = $self->num_columns;
602 my $rowcount = $self->num_rows;
603 if( $index > $colcount ) {
604 $self->warn("cannot add a column beyond 1+last column at the end ($colcount) not $index - adding at $colcount instead");
605 $index = $colcount;
608 if( ! defined $newcol ) {
609 $newcol = [];
610 $newcol->[$rowcount] = undef; # make the array '$rowcount' long
611 } elsif( ref($newcol) !~ /ARRAY/i ) {
612 $self->throw("Expected either undef or a valid arrayref for add_row");
614 for( my $i = 0; $i < $rowcount; $i++ ) {
615 # add this column to each row
616 splice(@{$self->_values->[$i]},$index,0,[]);
617 $self->entry_by_num($i,$index,$newcol->[$i]);
619 splice(@{$self->{'_colnames'}}, $index,0,$name);
620 # Sadly we have to remap these each time (except for the case
621 # when we're adding a new column to the end, but I don't think
622 # the speedup for that case warrants the extra code at this time.
623 my $ct = 0;
624 %{$self->{'_colnamesmap'}} = map {$_ => $ct++} @{$self->{'_colnames'}};
625 return $self->num_columns;
628 =head2 remove_column
630 Title : remove_column
631 Usage : $matrix->remove_column($colnum)
632 Function: remove a column from the matrix shifting all the columns
633 to the left by one
634 Returns : Updated number of columns in the matrix
635 Args : column index
637 =cut
639 sub remove_column{
640 my ($self,$colindex) = @_;
642 my $colcount = $self->num_columns;
643 my $rowcount = $self->num_rows;
644 if( $colindex > $colcount ) {
645 $self->warn("colindex $colindex is greater than number of columns ($colcount), cannot process");
646 return 0;
647 } else {
648 for(my $i = 0; $i < $rowcount; $i++ ) {
649 splice(@{$self->_values->[$i]},$colindex,1);
651 delete $self->{'_colnamesmap'}->{$self->{'_colnames'}->[$colindex]};
652 splice(@{$self->{'_colnames'}},$colindex,1);
654 my $ct = 0;
655 %{$self->{'_colnamesmap'}} = map {$_ => $ct++} @{$self->{'_colnames'}};
656 return $self->num_columns;
659 =head2 column_num_for_name
661 Title : column_num_for_name
662 Usage : my $num = $matrix->column_num_for_name($name)
663 Function: Gets the column number for a particular column name
664 Returns : integer
665 Args : string
668 =cut
670 sub column_num_for_name{
671 my ($self,$name) = @_;
673 return $self->{'_colnamesmap'}->{$name};
676 =head2 row_num_for_name
678 Title : row_num_for_name
679 Usage : my $num = $matrix->row_num_for_name
680 Function: Gets the row number for a particular row name
681 Returns : integer
682 Args : string
685 =cut
687 sub row_num_for_name{
688 my ($self,$name) = @_;
689 return $self->{'_rownamesmap'}->{$name}
693 =head2 column_header
695 Title : column_header
696 Usage : my $name = $matrix->column_header(0)
697 Function: Gets the column header for a particular column number
698 Returns : string
699 Args : integer
702 =cut
704 sub column_header{
705 my ($self,$num) = @_;
706 return $self->{'_colnames'}->[$num];
710 =head2 row_header
712 Title : row_header
713 Usage : my $name = $matrix->row_header(0)
714 Function: Gets the row header for a particular row number
715 Returns : string
716 Args : integer
719 =cut
721 sub row_header{
722 my ($self,$num) = @_;
723 return $self->{'_rownames'}->[$num];
726 =head2 num_rows
728 Title : num_rows
729 Usage : my $rowcount = $matrix->num_rows;
730 Function: Get the number of rows
731 Returns : integer
732 Args : none
735 =cut
737 sub num_rows{
738 my ($self) = @_;
739 return scalar @{$self->_values};
743 =head2 num_columns
745 Title : num_columns
746 Usage : my $colcount = $matrix->num_columns
747 Function: Get the number of columns
748 Returns : integer
749 Args : none
752 =cut
754 sub num_columns{
755 my ($self) = @_;
756 return scalar @{$self->_values->[0] || []};
760 =head2 row_names
762 Title : row_names
763 Usage : my @rows = $matrix->row_names
764 Function: The names of all the rows
765 Returns : array in array context, arrayref in scalar context
766 Args : none
769 =cut
771 sub row_names{
772 if( wantarray ) {
773 return @{shift->{'_rownames'}};
774 } else {
775 return shift->{'_rownames'};
780 =head2 column_names
782 Title : column_names
783 Usage : my @columns = $matrix->column_names
784 Function: The names of all the columns
785 Returns : array in array context, arrayref in scalar context
786 Args : none
789 =cut
791 sub column_names{
792 if( wantarray ) {
793 return @{shift->{'_colnames'}};
794 } else {
795 return shift->{'_colnames'};
799 =head2 private methods
801 Private methods for a Generic Matrix
803 =head2 _values
805 Title : _values
806 Usage : $matrix->_values();
807 Function: get/set for array ref of the matrix containing
808 distance values
809 Returns : an array reference
810 Args : an array reference
813 =cut
815 sub _values{
816 my ($self,$val) = @_;
817 if( $val ){
818 $self->{'_values'} = $val;
820 return $self->{'_values'};