1 package Maasha::Matrix;
3 # Copyright (C) 2007 Martin A. Hansen.
5 # This program is free software; you can redistribute it and/or
6 # modify it under the terms of the GNU General Public License
7 # as published by the Free Software Foundation; either version 2
8 # of the License, or (at your option) any later version.
10 # This program is distributed in the hope that it will be useful,
11 # but WITHOUT ANY WARRANTY; without even the implied warranty of
12 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
13 # GNU General Public License for more details.
15 # You should have received a copy of the GNU General Public License
16 # along with this program; if not, write to the Free Software
17 # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
19 # http://www.gnu.org/copyleft/gpl.html
22 # >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> DESCRIPTION <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
25 # This modules contains subroutines for simple matrix manipulations.
28 # >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
32 no warnings 'recursion';
35 use Storable qw( dclone );
39 use vars qw ( @ISA @EXPORT );
42 @ISA = qw( Exporter );
50 # >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> SUBROUTINES <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
55 # Martin A. Hansen, April 2007
57 # returns the dimensions of a matrix: rows x cols
59 my ( $matrix, # AoA data structure
66 $rows = scalar @{ $matrix };
67 $cols = scalar @{ $matrix->[ 0 ] };
69 return wantarray ? ( $rows, $cols ) : [ $rows, $cols ];
75 # Martin A. Hansen, April 2007.
77 # Checks that the matrix of even columns.
78 # return 1 if ok else 0.
80 my ( $matrix, # AoA data structure
85 my ( $dims, $row, $check );
87 $dims = matrix_dims( $matrix );
89 $check = $dims->[ COLS ];
91 foreach $row ( @{ $matrix } ) {
92 return 0 if scalar @{ $row } != $check;
101 # Martin A. Hansen, April 2007.
103 # For each column in a given matrix print:
105 my ( $matrix, # AoA data structure
108 my ( $dims, $i, $col, $list, $type, $sort, $uniq, $min, $max, $mean );
110 die qq(ERROR: cannot summarize uneven matrix\n) if not matrix_check( $matrix );
112 $dims = matrix_dims( $matrix );
114 print join( "\t", "TYPE", "LEN", "UNIQ", "SORT", "MIN", "MAX", "MEAN" ), "\n";
116 for ( $i = 0; $i < $dims->[ COLS ]; $i++ )
118 $col = cols_get( $matrix, $i, $i );
119 $list = matrix_flip( $col )->[ 0 ];
121 if ( list_check_numeric( $list ) ) {
127 if ( list_check_sort( $list, $type ) ) {
133 if ( $type eq "num" )
135 if ( $sort eq "yes" )
138 $max = $list->[ -1 ];
142 ( $min, $max ) = Maasha::Calc::minmax( $list );
145 $mean = sprintf( "%.2f", Maasha::Calc::mean( $list ) );
154 $uniq = list_uniq( $list );
156 print join( "\t", $type, $dims->[ ROWS ], $uniq, $sort, $min, $max, $mean ), "\n";
163 # Martin A. Hansen, April 2007
165 # flips a matrix making rows to columns and visa versa.
167 my ( $matrix, # AoA data structure
172 my ( $i, $c, $dims, $AoA );
174 die qq(ERROR: cannot flip uneven matrix\n) if not matrix_check( $matrix );
176 $dims = matrix_dims( $matrix );
178 for ( $i = 0; $i < $dims->[ ROWS ]; $i++ )
180 for ( $c = 0; $c < $dims->[ COLS ]; $c++ ) {
181 $AoA->[ $c ]->[ $i ] = $matrix->[ $i ]->[ $c ];
185 @{ $matrix } = @{ $AoA };
187 return wantarray ? @{ $matrix } : $matrix;
191 sub matrix_deflate_rows
193 # Martin A. Hansen, September 2009.
195 # Reduces the number of elements in all rows,
196 # by collectiong elements in buckets that are
199 my ( $matrix, # AoA data structure
207 foreach $row ( @{ $matrix } ) {
208 list_deflate( $row, $new_size );
213 sub matrix_deflate_cols
215 # Martin A. Hansen, September 2009.
217 # Reduces the number of elements in all columns,
218 # by collectiong elements in buckets that are
221 my ( $matrix, # AoA data structure
229 matrix_flip( $matrix );
231 foreach $col ( @{ $matrix } ) {
232 list_deflate( $col, $new_size );
235 matrix_flip( $matrix );
239 sub matrix_rotate_right
241 # Martin A. Hansen, April 2007
243 # Rotates elements in a given matrix a given
244 # number of positions to the right by popping columns,
245 # from the right matrix edge and prefixed to the left edge.
247 my ( $matrix, # AoA data structure
248 $shift, # number of shifts - DEFAULT=1
253 my ( $i, $dims, $col, $AoA );
257 die qq(ERROR: cannot right rotate uneven matrix\n) if not matrix_check( $matrix );
259 $dims = matrix_dims( $matrix );
261 for ( $i = 0; $i < $shift; $i++ )
263 $col = cols_get( $matrix, $dims->[ COLS ] - 1, $dims->[ COLS ] - 1 );
264 $AoA = cols_get( $matrix, 0, $dims->[ COLS ] - 2 );
266 cols_unshift( $AoA, $col );
271 return wantarray ? @{ $matrix } : $matrix;
275 sub matrix_rotate_left
277 # Martin A. Hansen, April 2007
279 # Rotates elements in a given matrix a given
280 # number of positions to the left while columns
281 # are shifted from the left matrix edge and appended,
284 my ( $matrix, # AoA data structure
285 $shift, # number of shifts - DEFAULT=1
290 my ( $i, $dims, $col, $AoA );
294 die qq(ERROR: cannot right rotate uneven matrix\n) if not matrix_check( $matrix );
296 $dims = matrix_dims( $matrix );
298 for ( $i = 0; $i < $shift; $i++ )
300 $col = cols_get( $matrix, 0, 0 );
301 $AoA = cols_get( $matrix, 1, $dims->[ COLS ] - 1 );
303 cols_push( $AoA, $col );
308 return wantarray ? @{ $matrix } : $matrix;
314 # Martin A. Hansen, April 2007
316 # Rotates elements in a given matrix a given
317 # number of positions up while rows are shifted
318 # from the top of the matrix to the bottom.
320 my ( $matrix, # AoA data structure
321 $shift, # number of shifts - DEFAULT=1
326 my ( $dims, $i, $row, $AoA );
330 $dims = matrix_dims( $matrix );
332 for ( $i = 0; $i < $shift; $i++ )
334 $row = rows_get( $matrix, 0, 0 );
335 $AoA = rows_get( $matrix, 1, $dims->[ ROWS ] - 1 );
337 rows_push( $AoA, dclone $row );
342 return wantarray ? @{ $matrix } : $matrix;
346 sub matrix_rotate_down
348 # Martin A. Hansen, April 2007
350 # Rotates elements in a given matrix a given
351 # number of positions down while rows are shifted
352 # from the bottom matrix edge to the top edge.
354 my ( $matrix, # AoA data structure
355 $shift, # number of shifts - DEFAULT=1
360 my ( $dims, $i, $row, $AoA );
364 $dims = matrix_dims( $matrix );
366 for ( $i = 0; $i < $shift; $i++ )
368 $row = rows_get( $matrix, $dims->[ ROWS ] - 1, $dims->[ ROWS ] - 1 );
369 $AoA = rows_get( $matrix, 0, $dims->[ ROWS ] - 2 );
371 rows_unshift( $AoA, $row );
376 return wantarray ? @{ $matrix } : $matrix;
382 # Martin A. Hansen, April 2007
384 # returns a submatrix sliced from a given matrix
386 my ( $matrix, # AoA data structure
387 $row_beg, # first row - OPTIONAL (default 0)
388 $row_end, # last row - OPTIONAL (default last row)
389 $col_beg, # first col - OPTIONAL (default 0)
390 $col_end, # last col - OPTIONAL (default last col)
395 my ( $submatrix, $subsubmatrix );
397 $submatrix = rows_get( $matrix, $row_beg, $row_end );
398 $subsubmatrix = cols_get( $submatrix, $col_beg, $col_end );
400 return wantarray ? @{ $subsubmatrix } : $subsubmatrix;
406 # Martin A. Hansen, April 2008.
408 # Returns a single row from a given matrix.
410 my ( $matrix, # AoA data structure
416 my ( $dims, $i, @list );
418 $dims = matrix_dims( $matrix );
420 Maasha::Common::error( qq(Row->$row outside of matrix->$dims->[ ROWS ]) ) if $row > $dims->[ ROWS ];
422 @list = @{ $matrix->[ $row ] };
424 return wantarray ? @list : \@list;
430 # Martin A. Hansen, April 2007
432 # returns a range of requested rows from a given matrix.
434 my ( $matrix, # AoA data structure
435 $row_beg, # first row - OPTIONAL (default 0)
436 $row_end, # last row - OPTIONAL (default last row)
445 if ( not defined $row_end ) {
446 $row_end = scalar @{ $matrix };
449 if ( $row_end >= scalar @{ $matrix } )
451 warn qq(WARNING: row end larger than matrix\n);
452 $row_end = scalar( @{ $matrix } ) - 1;
455 die qq(ERROR: row begin "$row_beg" larger than row end "$row_end"\n) if $row_end < $row_beg;
457 if ( $row_beg == 0 and $row_end == scalar( @{ $matrix } ) - 1 ) {
458 @rows = @{ $matrix };
460 @rows = @{ $matrix }[ $row_beg .. $row_end ];
463 return wantarray ? @rows : \@rows;
469 # Martin A. Hansen, April 2008.
471 # Returns a single column from a given matrix.
473 my ( $matrix, # AoA data structure
474 $col, # column to get
479 my ( $dims, $i, @list );
481 $dims = matrix_dims( $matrix );
483 Maasha::Common::error( qq(Column->$col outside of matrix->$dims->[ COLS ]) ) if $col > $dims->[ COLS ];
485 for ( $i = 0; $i < $dims->[ ROWS ]; $i++ ) {
486 push @list, $matrix->[ $i ]->[ $col ];
489 return wantarray ? @list : \@list;
495 # Martin A. Hansen, April 2007.
497 # returns a range of requested columns from a given matrix
499 my ( $matrix, # AoA data structure
500 $col_beg, # first column - OPTIONAL (default 0)
501 $col_end, # last column - OPTIONAL (default last column)
506 my ( $dims, @cols, $row, @AoA );
508 $dims = matrix_dims( $matrix );
512 if ( not defined $col_end ) {
513 $col_end = $dims->[ COLS ] - 1;
516 if ( $col_end > $dims->[ COLS ] - 1 )
518 warn qq(WARNING: column end larger than matrix\n);
519 $col_end = $dims->[ COLS ] - 1;
522 die qq(ERROR: column begin "$col_beg" larger than column end "$col_end"\n) if $col_end < $col_beg;
524 if ( $col_beg == 0 and $col_end == $dims->[ COLS ] - 1 )
530 foreach $row ( @{ $matrix } )
532 @cols = @{ $row }[ $col_beg .. $col_end ];
534 push @AoA, [ @cols ];
538 return wantarray ? @AoA : \@AoA;
550 $list = cols_get( $matrix, $col, $col );
551 $list = matrix_flip( $list )->[ 0 ];
553 die qq(ERROR: cannot sum non-nummerical column\n);
555 $sum = Maasha::Calc::sum( $list );
563 # Martin A. Hansen, April 2007.
565 # Appends one or more rows to a matrix.
567 my ( $matrix, # AoA data structure
568 $rows, # list of rows
573 push @{ $matrix }, @{ $rows };
575 return wantarray ? @{ $matrix } : $matrix;
581 # Martin A. Hansen, April 2007.
583 # Prefixes one or more rows to a matrix.
585 my ( $matrix, # AoA data structure
586 $rows, # list of rows
591 unshift @{ $matrix }, @{ $rows };
593 return wantarray ? @{ $matrix } : $matrix;
599 # Martin A. Hansen, April 2007.
601 # Appends one or more lists as columns to a matrix.
603 my ( $matrix, # AoA data structure
604 $cols, # list of columns
609 my ( $dims_matrix, $dims_cols, $i );
611 $dims_matrix = matrix_dims( $matrix );
612 $dims_cols = matrix_dims( $cols );
614 die qq(ERROR: Cannot merge columns with different row count\n) if $dims_matrix->[ ROWS ] != $dims_cols->[ ROWS ];
616 for ( $i = 0; $i < $dims_matrix->[ ROWS ]; $i++ )
618 push @{ $matrix->[ $i ] }, @{ $cols->[ $i ] };
621 return wantarray ? @{ $matrix } : $matrix;
627 # Martin A. Hansen, April 2007.
629 # Prefixes one or more lists as columns to a matrix.
631 my ( $matrix, # AoA data structure
632 $cols, # list of columns
637 my ( $dims_matrix, $dims_cols, $i );
639 $dims_matrix = matrix_dims( $matrix );
640 $dims_cols = matrix_dims( $cols );
642 die qq(ERROR: Cannot merge columns with different row count\n) if $dims_matrix->[ ROWS ] != $dims_cols->[ ROWS ];
644 for ( $i = 0; $i < $dims_matrix->[ ROWS ]; $i++ ) {
645 unshift @{ $matrix->[ $i ] }, @{ $cols->[ $i ] };
648 return wantarray ? @{ $matrix } : $matrix;
654 # Martin A. Hansen, April 2007.
656 # Given a matrix and a range of rows, rotates these rows
657 # left by shifting a given number of elements from
658 # the first position to the last.
660 my ( $matrix, # AoA data structure
661 $beg, # first row to shift
662 $end, # last row to shit
663 $shift, # number of shifts - DEFAULT=1
672 for ( $i = $beg; $i <= $end; $i++ )
674 $row = rows_get( $matrix, $i, $i );
676 for ( $c = 0; $c < $shift; $c++ )
678 $row = list_rotate_left( @{ $row } );
679 $matrix->[ $i ] = $row;
683 return wantarray ? @{ $matrix } : $matrix;
687 sub rows_rotate_right
689 # Martin A. Hansen, April 2007.
691 # Given a matrix and a range of rows, rotates these rows
692 # right by shifting a given number of elements from the
693 # last position to the first.
695 my ( $matrix, # AoA data structure
696 $beg, # first row to shift
697 $end, # last row to shit
698 $shift, # number of shifts - DEFAULT=1
703 my ( $dims, $i, $c, $row );
707 $dims = matrix_dims( $matrix );
709 die qq(ERROR: end < beg: $end < $beg\n) if $end < $beg;
710 die qq(ERROR: row outside matrix\n) if $end >= $dims->[ ROWS ];
712 for ( $i = $beg; $i <= $end; $i++ )
714 $row = rows_get( $matrix, $i, $i );
716 for ( $c = 0; $c < $shift; $c++ )
718 $row = list_rotate_right( @{ $row } );
719 $matrix->[ $i ] = $row;
723 return wantarray ? @{ $matrix } : $matrix;
729 # Martin A. Hansen, April 2007.
731 # Given a matrix and a range of columns, rotates these columns
732 # ups by shifting the the first cell of each row from the
733 # first position to the last.
735 my ( $matrix, # AoA data structure
736 $beg, # first row to shift
737 $end, # last row to shit
738 $shift, # number of shifts - DEFAULT=1
743 my ( $dims, $i, $c, $cols_pre, $col_select, $cols_post, $list );
747 $dims = matrix_dims( $matrix );
749 $cols_pre = cols_get( $matrix, 0, $beg - 1 ) if $beg > 0;
750 $cols_post = cols_get( $matrix, $end + 1, $dims->[ COLS ] - 1 ) if $end < $dims->[ COLS ] - 1;
752 for ( $i = $beg; $i <= $end; $i++ )
754 $col_select = cols_get( $matrix, $i, $i );
756 $list = matrix_flip( $col_select )->[ 0 ];
758 for ( $c = 0; $c < $shift; $c++ ) {
759 $list = list_rotate_left( $list );
762 $col_select = matrix_flip( [ $list ] );
765 cols_push( $cols_pre, $col_select );
767 $cols_pre = $col_select;
771 cols_push( $cols_pre, $cols_post ) if $cols_post;
775 return wantarray ? @{ $matrix } : $matrix;
781 # Martin A. Hansen, April 2007.
783 # Given a matrix and a range of columns, rotates these columns
784 # ups by shifting the the first cell of each row from the
785 # first position to the last.
787 my ( $matrix, # AoA data structure
788 $beg, # first row to shift
789 $end, # last row to shit
790 $shift, # number of shifts - DEFAULT=1
795 my ( $dims, $i, $c, $cols_pre, $col_select, $cols_post, $list );
799 $dims = matrix_dims( $matrix );
801 $cols_pre = cols_get( $matrix, 0, $beg - 1 ) if $beg > 0;
802 $cols_post = cols_get( $matrix, $end + 1, $dims->[ COLS ] - 1 ) if $end < $dims->[ COLS ] - 1;
804 for ( $i = $beg; $i <= $end; $i++ )
806 $col_select = cols_get( $matrix, $i, $i );
808 $list = matrix_flip( $col_select )->[ 0 ];
810 for ( $c = 0; $c < $shift; $c++ ) {
811 $list = list_rotate_right( $list );
814 $col_select = matrix_flip( [ $list ] );
817 cols_push( $cols_pre, $col_select );
819 $cols_pre = $col_select;
823 cols_push( $cols_pre, $cols_post ) if $cols_post;
827 return wantarray ? @{ $matrix } : $matrix;
833 # Martin A. Hansen, April 2007.
835 # given a list, shifts off the first element,
836 # and appends to the list, which is returned.
838 my ( $list, # list to rotate
841 my ( @new_list, $elem );
843 @new_list = @{ $list };
845 $elem = shift @new_list;
847 push @new_list, $elem;
849 return wantarray ? @new_list : \@new_list;
853 sub list_rotate_right
855 # Martin A. Hansen, April 2007.
857 # given a list, pops off the last element,
858 # and prefixes to the list, which is returned.
860 my ( $list, # list to rotate
863 my ( @new_list, $elem );
865 @new_list = @{ $list };
867 $elem = pop @new_list;
869 unshift @new_list, $elem;
871 return wantarray ? @new_list : \@new_list;
875 sub list_check_numeric
877 # Martin A. Hansen, April 2007.
879 # Checks if a given list only contains
880 # numerical elements. return 1 if numerical,
883 my ( $list, # list to check
890 foreach $elem ( @{ $list } ) {
891 return 0 if not Maasha::Calc::is_a_number( $elem );
900 # Martin A. Hansen, April 2007.
902 # Checks if a given list is sorted.
903 # If the sort type is not specified, we
904 # are going to check the type and make a guess.
905 # Returns 1 if sorted else 0.
907 my ( $list, # list to check
908 $type, # numerical of alphabetical
917 if ( list_check_numeric( $list ) ) {
925 if ( $type =~ /^a.*/i ) {
932 if ( @{ $list } > 1 )
936 for ( $i = 1; $i < @{ $list }; $i++ )
938 $cmp = $list->[ $i - 1 ] <=> $list->[ $i ];
940 return 0 if $cmp > 0;
945 for ( $i = 1; $i < @{ $list }; $i++ )
947 $cmp = $list->[ $i - 1 ] cmp $list->[ $i ];
949 return 0 if $cmp > 0;
960 # Martin A. Hansen, February 2010.
962 # Deflates a list of values to a specified size.
970 my ( $len, $l_len, $r_len, $diff, $block_size, $space, $i );
972 while ( scalar @{ $list } > $new_size )
975 $diff = $len - $new_size;
976 $block_size = int( $len / $new_size );
978 if ( $block_size > 1 )
980 for ( $i = @{ $list } - $block_size; $i >= 0; $i -= $block_size ) {
981 splice @{ $list }, $i, $block_size, Maasha::Calc::mean( [ @{ $list }[ $i .. $i + $block_size - 1 ] ] );
986 $space = $len / $diff;
988 if ( ( $space % 2 ) == 0 )
990 splice @{ $list }, $len / 2 - 1, 2, Maasha::Calc::mean( [ @{ $list }[ $len / 2 - 1 .. $len / 2 ] ] );
994 $l_len = $len * ( 1 / 3 );
995 $r_len = $len * ( 2 / 3 );
997 splice @{ $list }, $r_len, 2, Maasha::Calc::mean( [ @{ $list }[ $r_len .. $r_len + 1 ] ] );
998 splice @{ $list }, $l_len, 2, Maasha::Calc::mean( [ @{ $list }[ $l_len .. $l_len + 1 ] ] ) if @{ $list } > $new_size;
1007 # Martin A. Hansen, February 2010.
1009 # Inflates a list of values to a specified size. Newly
1010 # introduced elements are interpolated from neighboring elements.
1018 my ( $len, $diff, $block_size, $space, $i );
1020 while ( $new_size - scalar @{ $list } > 0 )
1023 $diff = $new_size - $len;
1024 $block_size = int( $diff / ( $len - 1 ) );
1026 if ( $block_size > 0 )
1028 for ( $i = 1; $i < @{ $list }; $i += $block_size + 1 ) {
1029 splice @{ $list }, $i, 0, interpolate( $list->[ $i - 1 ], $list->[ $i ], $block_size );
1034 $space = $len / $diff;
1036 if ( ( $space % 2 ) == 0 )
1038 splice @{ $list }, $len / 2, 0, interpolate( $list->[ $len / 2 ], $list->[ $len / 2 + 1 ], 1 );
1042 splice @{ $list }, $len * ( 2 / 3 ), 0, interpolate( $list->[ $len * ( 2 / 3 ) ], $list->[ $len * ( 2 / 3 ) + 1 ], 1 );
1043 splice @{ $list }, $len * ( 1 / 3 ), 0, interpolate( $list->[ $len * ( 1 / 3 ) ], $list->[ $len * ( 1 / 3 ) + 1 ], 1 ) if @{ $list } < $new_size;
1052 # Martin A. Hansen, March 2010
1054 # Given two values insert a specified number of values evenly
1055 # between these NOT encluding the given values.
1057 my ( $beg, # Begin of interval
1058 $end, # End of interval
1059 $count, # Number of values to introduce
1064 my ( $diff, $factor, $i, @list );
1066 $diff = $end - $beg;
1068 $factor = $diff / ( $count + 1 );
1070 for ( $i = 1; $i <= $count; $i++ ) {
1071 push @list, $beg + $i * $factor;
1074 return wantarray ? @list : \@list;
1080 # Martin A. Hansen, April 2007.
1082 # returns the number of unique elements in a
1090 my ( %hash, $count );
1092 map { $hash{ $_ } = 1 } @{ $list };
1094 $count = scalar keys %hash;
1102 # Martin A. Hansen, April 2007.
1104 my ( $matrix, # AoA data structure
1108 my ( $dims, $list, $i, $max, $len, %hash, $elem, @list );
1110 $dims = matrix_dims( $matrix );
1112 $list = cols_get( $matrix, $col, $col );
1113 $list = matrix_flip( $list )->[ 0 ];
1117 for ( $i = 0; $i < @{ $list }; $i++ )
1119 $hash{ $list->[ $i ] }++;
1121 $len = length $list->[ $i ];
1123 $max = $len if $len > $max;
1128 if ( list_check_numeric( $list ) ) {
1129 @list = sort { $a <=> $b } @list;
1131 @list = sort { $a cmp $b } @list;
1134 foreach $elem ( @list )
1136 print $elem, " " x ( $max - length( $elem ) ),
1137 sprintf( " %6s ", $hash{ $elem } ),
1138 sprintf( "%.2f\n", ( $hash{ $elem } / $dims->[ ROWS ] ) * 100 );
1145 # Martin A. Hansen, July 2008.
1147 # Merge two given tables based on identifiers in a for each table
1148 # specified column which should contain a unique identifier.
1149 # Initially the tables are sorted and tab2 is merged onto tab1
1152 my ( $tab1, # table 1 - an AoA.
1153 $tab2, # table 2 - an AoA.
1154 $col1, # identifier in row1
1155 $col2, # identifier in row2
1156 $sort_type, # alphabetical or numeric comparison
1161 my ( $num, $cmp, $i, $c, @row_cpy, $max );
1166 if ( $sort_type =~ /num/i )
1170 @{ $tab1 } = sort { $a->[ $col1 ] <=> $b->[ $col1 ] } @{ $tab1 };
1171 @{ $tab2 } = sort { $a->[ $col2 ] <=> $b->[ $col2 ] } @{ $tab2 };
1175 @{ $tab1 } = sort { $a->[ $col1 ] cmp $b->[ $col1 ] } @{ $tab1 };
1176 @{ $tab2 } = sort { $a->[ $col2 ] cmp $b->[ $col2 ] } @{ $tab2 };
1182 while ( $i < @{ $tab1 } and $c < @{ $tab2 } )
1185 $cmp = $tab1->[ $i ]->[ $col1 ] <=> $tab2->[ $c ]->[ $col2 ];
1187 $cmp = $tab1->[ $i ]->[ $col1 ] cmp $tab2->[ $c ]->[ $col2 ];
1192 @row_cpy = @{ $tab2->[ $c ] };
1194 splice @row_cpy, $col2, 1;
1196 push @{ $tab1->[ $i ] }, @row_cpy;
1207 map { push @{ $tab1->[ $i ] }, "null" } 0 .. ( scalar @{ $tab2->[ $c ] } - 2 );
1213 map { push @{ $tab1->[ -1 ] }, "null" } 0 .. ( scalar @{ $tab1->[ 0 ] } - scalar @{ $tab1->[ -1 ] } + 1 );
1217 # >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> BINARY SEARCH <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
1222 # Martin A. Hansen, February 2008.
1224 # Uses binary search to locate the interval containing a
1225 # given number. The intervals are defined by begin and end
1226 # positions in seperate columns in a matrix. If a interval is
1227 # found then the index of that matrix row is returned, otherwise
1230 my ( $matrix, # data structure
1231 $col1, # column with interval begins
1232 $col2, # column with interval ends
1233 $num, # number to search for
1236 # Returns an integer.
1238 my ( $high, $low, $try );
1241 $high = @{ $matrix };
1243 while ( $low < $high )
1245 $try = int( ( $high + $low ) / 2 );
1247 # print "num->$num low->$low high->$high try->$try int1->$matrix->[ $try ]->[ $col1 ] int2->$matrix->[ $try ]->[ $col2 ]\n";
1249 if ( $num < $matrix->[ $try ]->[ $col1 ] ) {
1251 } elsif ( $num > $matrix->[ $try ]->[ $col2 ] ) {
1264 # Martin A. Hansen, February 2008.
1266 # Uses binary search to locate a number in a list of numbers.
1267 # If the number is found, then the index (the position of the number
1268 # in the list) is returned, otherwise -1 is returned.
1270 my ( $list, # list of numbers
1271 $num, # number to search for
1274 # Returns an integer.
1276 my ( $high, $low, $try );
1281 while ( $low < $high )
1283 $try = int( ( $high + $low ) / 2 );
1285 # print "num->$num low->$low high->$high try->$try int->$list->[ $try ]\n";
1287 if ( $num < $list->[ $try ] ) {
1289 } elsif ( $num > $list->[ $try ] ) {
1300 # >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> DISK SUBROUTINES <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
1305 # Martin A. Hansen, April 2007
1307 # Reads tabular data from file into a matrix
1308 # AoA data structure.
1310 my ( $path, # full path to file with data
1311 $delimiter, # column delimiter - OPTIONAL (default tab)
1312 $comments, # regex for comment lines to skip - OPTIONAL
1313 $fields_ok, # list of fields to accept - OPTIONAL
1318 my ( $fh, $line, @fields, @AoA );
1320 $delimiter ||= "\t";
1322 $fh = Maasha::Filesys::file_read_open( $path );
1324 while ( $line = <$fh> )
1328 next if $comments and $line =~ /^$comments/;
1330 @fields = split /$delimiter/, $line;
1332 map { splice( @fields, $_, 1 ) } @{ $fields_ok } if $fields_ok;
1334 push @AoA, [ @fields ];
1339 return wantarray ? @AoA : \@AoA;
1345 # Martin A. Hansen, April 2007
1347 # Writes a tabular data structure to STDOUT or file.
1349 my ( $matrix, # AoA data structure
1350 $path, # full path to output file - OPTIONAL (default STDOUT)
1351 $delimiter, # column delimiter - OPTIONAL (default tab)
1356 $fh = Maasha::Filesys::file_write_open( $path ) if $path;
1358 $delimiter ||= "\t";
1360 foreach $row ( @{ $matrix } )
1363 print $fh join( $delimiter, @{ $row } ), "\n";
1365 print join( $delimiter, @{ $row } ), "\n";
1375 # Martin A. Hansen, April 2007.
1377 # stores a matrix to a binary file.
1379 my ( $path, # full path to file
1380 $matrix, # data structure
1383 Maasha::Filesys::file_store( $path, $matrix );
1389 # Martin A. Hansen, April 2007.
1391 # retrieves a matrix from a binary file
1393 my ( $path, # full path to file
1396 my $matrix = Maasha::Filesys::file_retrieve( $path );
1398 return wantarray ? @{ $matrix } : $matrix;
1402 # >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<