# >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+use warnings;
+no warnings 'recursion';
use strict;
use Data::Dumper;
use Storable qw( dclone );
use Maasha::Common;
+use Maasha::Filesys;
use Maasha::Calc;
use vars qw ( @ISA @EXPORT );
use Exporter;
my ( $dims, $row, $check );
- $dims = &matrix_dims( $matrix );
+ $dims = matrix_dims( $matrix );
$check = $dims->[ COLS ];
my ( $dims, $i, $col, $list, $type, $sort, $uniq, $min, $max, $mean );
- die qq(ERROR: cannot summarize uneven matrix\n) if not &matrix_check( $matrix );
+ die qq(ERROR: cannot summarize uneven matrix\n) if not matrix_check( $matrix );
- $dims = &matrix_dims( $matrix );
+ $dims = matrix_dims( $matrix );
print join( "\t", "TYPE", "LEN", "UNIQ", "SORT", "MIN", "MAX", "MEAN" ), "\n";
for ( $i = 0; $i < $dims->[ COLS ]; $i++ )
{
- $col = &cols_get( $matrix, $i, $i );
- $list = &matrix_flip( $col )->[ 0 ];
+ $col = cols_get( $matrix, $i, $i );
+ $list = matrix_flip( $col )->[ 0 ];
- if ( &list_check_numeric( $list ) ) {
+ if ( list_check_numeric( $list ) ) {
$type = "num";
} else {
$type = "alph";
}
- if ( &list_check_sort( $list, $type ) ) {
+ if ( list_check_sort( $list, $type ) ) {
$sort = "yes";
} else {
$sort = "no";
}
else
{
- ( $min, $max ) = &Maasha::Calc::minmax( $list );
+ ( $min, $max ) = Maasha::Calc::minmax( $list );
}
- $mean = sprintf( "%.2f", &Maasha::Calc::mean( $list ) );
+ $mean = sprintf( "%.2f", Maasha::Calc::mean( $list ) );
}
else
{
$mean = "N/A";
}
- $uniq = &list_uniq( $list );
+ $uniq = list_uniq( $list );
print join( "\t", $type, $dims->[ ROWS ], $uniq, $sort, $min, $max, $mean ), "\n";
}
my ( $i, $c, $dims, $AoA );
- die qq(ERROR: cannot flip uneven matrix\n) if not &matrix_check( $matrix );
+ die qq(ERROR: cannot flip uneven matrix\n) if not matrix_check( $matrix );
- $dims = &matrix_dims( $matrix );
+ $dims = matrix_dims( $matrix );
for ( $i = 0; $i < $dims->[ ROWS ]; $i++ )
{
}
}
- $matrix = $AoA;
+ @{ $matrix } = @{ $AoA };
return wantarray ? @{ $matrix } : $matrix;
}
+sub matrix_deflate_rows
+{
+ # Martin A. Hansen, September 2009.
+
+ # Reduces the number of elements in all rows,
+ # by collectiong elements in buckets that are
+ # averaged.
+
+ my ( $matrix, # AoA data structure
+ $new_size
+ ) = @_;
+
+ # Returns nothing.
+
+ my ( $row );
+
+ foreach $row ( @{ $matrix } ) {
+ list_deflate( $row, $new_size );
+ }
+}
+
+
+sub matrix_deflate_cols
+{
+ # Martin A. Hansen, September 2009.
+
+ # Reduces the number of elements in all columns,
+ # by collectiong elements in buckets that are
+ # averaged.
+
+ my ( $matrix, # AoA data structure
+ $new_size
+ ) = @_;
+
+ # Returns nothing.
+
+ my ( $col );
+
+ matrix_flip( $matrix );
+
+ foreach $col ( @{ $matrix } ) {
+ list_deflate( $col, $new_size );
+ }
+
+ matrix_flip( $matrix );
+}
+
+
sub matrix_rotate_right
{
# Martin A. Hansen, April 2007
$shift ||= 1;
- die qq(ERROR: cannot right rotate uneven matrix\n) if not &matrix_check( $matrix );
+ die qq(ERROR: cannot right rotate uneven matrix\n) if not matrix_check( $matrix );
- $dims = &matrix_dims( $matrix );
+ $dims = matrix_dims( $matrix );
for ( $i = 0; $i < $shift; $i++ )
{
- $col = &cols_get( $matrix, $dims->[ COLS ] - 1, $dims->[ COLS ] - 1 );
- $AoA = &cols_get( $matrix, 0, $dims->[ COLS ] - 2 );
+ $col = cols_get( $matrix, $dims->[ COLS ] - 1, $dims->[ COLS ] - 1 );
+ $AoA = cols_get( $matrix, 0, $dims->[ COLS ] - 2 );
- &cols_unshift( $AoA, $col );
+ cols_unshift( $AoA, $col );
$matrix = $AoA;
}
$shift ||= 1;
- die qq(ERROR: cannot right rotate uneven matrix\n) if not &matrix_check( $matrix );
+ die qq(ERROR: cannot right rotate uneven matrix\n) if not matrix_check( $matrix );
- $dims = &matrix_dims( $matrix );
+ $dims = matrix_dims( $matrix );
for ( $i = 0; $i < $shift; $i++ )
{
- $col = &cols_get( $matrix, 0, 0 );
- $AoA = &cols_get( $matrix, 1, $dims->[ COLS ] - 1 );
+ $col = cols_get( $matrix, 0, 0 );
+ $AoA = cols_get( $matrix, 1, $dims->[ COLS ] - 1 );
- &cols_push( $AoA, $col );
+ cols_push( $AoA, $col );
$matrix = $AoA;
}
$shift ||= 1;
- $dims = &matrix_dims( $matrix );
+ $dims = matrix_dims( $matrix );
for ( $i = 0; $i < $shift; $i++ )
{
- $row = &rows_get( $matrix, 0, 0 );
- $AoA = &rows_get( $matrix, 1, $dims->[ ROWS ] - 1 );
+ $row = rows_get( $matrix, 0, 0 );
+ $AoA = rows_get( $matrix, 1, $dims->[ ROWS ] - 1 );
- &rows_push( $AoA, dclone $row );
+ rows_push( $AoA, dclone $row );
$matrix = $AoA;
}
$shift ||= 1;
- $dims = &matrix_dims( $matrix );
+ $dims = matrix_dims( $matrix );
for ( $i = 0; $i < $shift; $i++ )
{
- $row = &rows_get( $matrix, $dims->[ ROWS ] - 1, $dims->[ ROWS ] - 1 );
- $AoA = &rows_get( $matrix, 0, $dims->[ ROWS ] - 2 );
+ $row = rows_get( $matrix, $dims->[ ROWS ] - 1, $dims->[ ROWS ] - 1 );
+ $AoA = rows_get( $matrix, 0, $dims->[ ROWS ] - 2 );
- &rows_unshift( $AoA, $row );
+ rows_unshift( $AoA, $row );
$matrix = $AoA;
}
my ( $submatrix, $subsubmatrix );
- $submatrix = &rows_get( $matrix, $row_beg, $row_end );
- $subsubmatrix = &cols_get( $submatrix, $col_beg, $col_end );
+ $submatrix = rows_get( $matrix, $row_beg, $row_end );
+ $subsubmatrix = cols_get( $submatrix, $col_beg, $col_end );
return wantarray ? @{ $subsubmatrix } : $subsubmatrix;
}
my ( $dims, $i, @list );
- $dims = &matrix_dims( $matrix );
+ $dims = matrix_dims( $matrix );
- &Maasha::Common::error( qq(Row->$row outside of matrix->$dims->[ ROWS ]) ) if $row > $dims->[ ROWS ];
+ Maasha::Common::error( qq(Row->$row outside of matrix->$dims->[ ROWS ]) ) if $row > $dims->[ ROWS ];
@list = @{ $matrix->[ $row ] };
my ( $dims, $i, @list );
- $dims = &matrix_dims( $matrix );
+ $dims = matrix_dims( $matrix );
- &Maasha::Common::error( qq(Column->$col outside of matrix->$dims->[ COLS ]) ) if $col > $dims->[ COLS ];
+ Maasha::Common::error( qq(Column->$col outside of matrix->$dims->[ COLS ]) ) if $col > $dims->[ COLS ];
for ( $i = 0; $i < $dims->[ ROWS ]; $i++ ) {
push @list, $matrix->[ $i ]->[ $col ];
sub cols_get
{
- # Martin A. Hansen, April 2007
+ # Martin A. Hansen, April 2007.
# returns a range of requested columns from a given matrix
my ( $dims, @cols, $row, @AoA );
- $dims = &matrix_dims( $matrix );
+ $dims = matrix_dims( $matrix );
$col_beg ||= 0;
my ( $list, $sum );
- $list = &cols_get( $matrix, $col, $col );
- $list = &matrix_flip( $list )->[ 0 ];
+ $list = cols_get( $matrix, $col, $col );
+ $list = matrix_flip( $list )->[ 0 ];
die qq(ERROR: cannot sum non-nummerical column\n);
- $sum = &Maasha::Calc::sum( $list );
+ $sum = Maasha::Calc::sum( $list );
return $sum;
}
my ( $dims_matrix, $dims_cols, $i );
- $dims_matrix = &matrix_dims( $matrix );
- $dims_cols = &matrix_dims( $cols );
+ $dims_matrix = matrix_dims( $matrix );
+ $dims_cols = matrix_dims( $cols );
die qq(ERROR: Cannot merge columns with different row count\n) if $dims_matrix->[ ROWS ] != $dims_cols->[ ROWS ];
my ( $dims_matrix, $dims_cols, $i );
- $dims_matrix = &matrix_dims( $matrix );
- $dims_cols = &matrix_dims( $cols );
+ $dims_matrix = matrix_dims( $matrix );
+ $dims_cols = matrix_dims( $cols );
die qq(ERROR: Cannot merge columns with different row count\n) if $dims_matrix->[ ROWS ] != $dims_cols->[ ROWS ];
for ( $i = $beg; $i <= $end; $i++ )
{
- $row = &rows_get( $matrix, $i, $i );
+ $row = rows_get( $matrix, $i, $i );
for ( $c = 0; $c < $shift; $c++ )
{
- $row = &list_rotate_left( @{ $row } );
+ $row = list_rotate_left( @{ $row } );
$matrix->[ $i ] = $row;
}
}
$shift ||= 1;
- $dims = &matrix_dims( $matrix );
+ $dims = matrix_dims( $matrix );
die qq(ERROR: end < beg: $end < $beg\n) if $end < $beg;
die qq(ERROR: row outside matrix\n) if $end >= $dims->[ ROWS ];
for ( $i = $beg; $i <= $end; $i++ )
{
- $row = &rows_get( $matrix, $i, $i );
+ $row = rows_get( $matrix, $i, $i );
for ( $c = 0; $c < $shift; $c++ )
{
- $row = &list_rotate_right( @{ $row } );
+ $row = list_rotate_right( @{ $row } );
$matrix->[ $i ] = $row;
}
}
$shift ||= 1;
- $dims = &matrix_dims( $matrix );
+ $dims = matrix_dims( $matrix );
- $cols_pre = &cols_get( $matrix, 0, $beg - 1 ) if $beg > 0;
- $cols_post = &cols_get( $matrix, $end + 1, $dims->[ COLS ] - 1 ) if $end < $dims->[ COLS ] - 1;
+ $cols_pre = cols_get( $matrix, 0, $beg - 1 ) if $beg > 0;
+ $cols_post = cols_get( $matrix, $end + 1, $dims->[ COLS ] - 1 ) if $end < $dims->[ COLS ] - 1;
for ( $i = $beg; $i <= $end; $i++ )
{
- $col_select = &cols_get( $matrix, $i, $i );
+ $col_select = cols_get( $matrix, $i, $i );
- $list = &matrix_flip( $col_select )->[ 0 ];
+ $list = matrix_flip( $col_select )->[ 0 ];
for ( $c = 0; $c < $shift; $c++ ) {
- $list = &list_rotate_left( $list );
+ $list = list_rotate_left( $list );
}
- $col_select = &matrix_flip( [ $list ] );
+ $col_select = matrix_flip( [ $list ] );
if ( $cols_pre ) {
- &cols_push( $cols_pre, $col_select );
+ cols_push( $cols_pre, $col_select );
} else {
$cols_pre = $col_select;
}
}
- &cols_push( $cols_pre, $cols_post ) if $cols_post;
+ cols_push( $cols_pre, $cols_post ) if $cols_post;
$matrix = $cols_pre;
$shift ||= 1;
- $dims = &matrix_dims( $matrix );
+ $dims = matrix_dims( $matrix );
- $cols_pre = &cols_get( $matrix, 0, $beg - 1 ) if $beg > 0;
- $cols_post = &cols_get( $matrix, $end + 1, $dims->[ COLS ] - 1 ) if $end < $dims->[ COLS ] - 1;
+ $cols_pre = cols_get( $matrix, 0, $beg - 1 ) if $beg > 0;
+ $cols_post = cols_get( $matrix, $end + 1, $dims->[ COLS ] - 1 ) if $end < $dims->[ COLS ] - 1;
for ( $i = $beg; $i <= $end; $i++ )
{
- $col_select = &cols_get( $matrix, $i, $i );
+ $col_select = cols_get( $matrix, $i, $i );
- $list = &matrix_flip( $col_select )->[ 0 ];
+ $list = matrix_flip( $col_select )->[ 0 ];
for ( $c = 0; $c < $shift; $c++ ) {
- $list = &list_rotate_right( $list );
+ $list = list_rotate_right( $list );
}
- $col_select = &matrix_flip( [ $list ] );
+ $col_select = matrix_flip( [ $list ] );
if ( $cols_pre ) {
- &cols_push( $cols_pre, $col_select );
+ cols_push( $cols_pre, $col_select );
} else {
$cols_pre = $col_select;
}
}
- &cols_push( $cols_pre, $cols_post ) if $cols_post;
+ cols_push( $cols_pre, $cols_post ) if $cols_post;
$matrix = $cols_pre;
my ( $elem );
foreach $elem ( @{ $list } ) {
- return 0 if not $elem =~ /^\d+$/; # how about scientific notation ala 123.2312e-03 ?
+ return 0 if not Maasha::Calc::is_a_number( $elem );
}
return 1;
if ( not $type )
{
- if ( &list_check_numeric( $list ) ) {
+ if ( list_check_numeric( $list ) ) {
$type = "n";
} else {
$type = "a";
}
+sub list_deflate
+{
+ # Martin A. Hansen, February 2010.
+
+ # Deflates a list of values to a specified size.
+
+ my ( $list,
+ $new_size,
+ ) = @_;
+
+ # Returns nothing.
+
+ my ( $len, $l_len, $r_len, $diff, $block_size, $space, $i );
+
+ while ( scalar @{ $list } > $new_size )
+ {
+ $len = @{ $list };
+ $diff = $len - $new_size;
+ $block_size = int( $len / $new_size );
+
+ if ( $block_size > 1 )
+ {
+ for ( $i = @{ $list } - $block_size; $i >= 0; $i -= $block_size ) {
+ splice @{ $list }, $i, $block_size, Maasha::Calc::mean( [ @{ $list }[ $i .. $i + $block_size - 1 ] ] );
+ }
+ }
+ else
+ {
+ $space = $len / $diff;
+
+ if ( ( $space % 2 ) == 0 )
+ {
+ splice @{ $list }, $len / 2 - 1, 2, Maasha::Calc::mean( [ @{ $list }[ $len / 2 - 1 .. $len / 2 ] ] );
+ }
+ else
+ {
+ $l_len = $len * ( 1 / 3 );
+ $r_len = $len * ( 2 / 3 );
+
+ splice @{ $list }, $r_len, 2, Maasha::Calc::mean( [ @{ $list }[ $r_len .. $r_len + 1 ] ] );
+ splice @{ $list }, $l_len, 2, Maasha::Calc::mean( [ @{ $list }[ $l_len .. $l_len + 1 ] ] ) if @{ $list } > $new_size;
+ }
+ }
+ }
+}
+
+
+sub list_inflate
+{
+ # Martin A. Hansen, February 2010.
+
+ # Inflates a list of values to a specified size. Newly
+ # introduced elements are interpolated from neighboring elements.
+
+ my ( $list,
+ $new_size,
+ ) = @_;
+
+ # Returns nothing.
+
+ my ( $len, $diff, $block_size, $space, $i );
+
+ while ( $new_size - scalar @{ $list } > 0 )
+ {
+ $len = @{ $list };
+ $diff = $new_size - $len;
+ $block_size = int( $diff / ( $len - 1 ) );
+
+ if ( $block_size > 0 )
+ {
+ for ( $i = 1; $i < @{ $list }; $i += $block_size + 1 ) {
+ splice @{ $list }, $i, 0, interpolate( $list->[ $i - 1 ], $list->[ $i ], $block_size );
+ }
+ }
+ else
+ {
+ $space = $len / $diff;
+
+ if ( ( $space % 2 ) == 0 )
+ {
+ splice @{ $list }, $len / 2, 0, interpolate( $list->[ $len / 2 ], $list->[ $len / 2 + 1 ], 1 );
+ }
+ else
+ {
+ splice @{ $list }, $len * ( 2 / 3 ), 0, interpolate( $list->[ $len * ( 2 / 3 ) ], $list->[ $len * ( 2 / 3 ) + 1 ], 1 );
+ splice @{ $list }, $len * ( 1 / 3 ), 0, interpolate( $list->[ $len * ( 1 / 3 ) ], $list->[ $len * ( 1 / 3 ) + 1 ], 1 ) if @{ $list } < $new_size;
+ }
+ }
+ }
+}
+
+
+sub interpolate
+{
+ # Martin A. Hansen, March 2010
+
+ # Given two values insert a specified number of values evenly
+ # between these NOT encluding the given values.
+
+ my ( $beg, # Begin of interval
+ $end, # End of interval
+ $count, # Number of values to introduce
+ ) = @_;
+
+ # Returns a list
+
+ my ( $diff, $factor, $i, @list );
+
+ $diff = $end - $beg;
+
+ $factor = $diff / ( $count + 1 );
+
+ for ( $i = 1; $i <= $count; $i++ ) {
+ push @list, $beg + $i * $factor;
+ }
+
+ return wantarray ? @list : \@list;
+}
+
+
sub list_uniq
{
# Martin A. Hansen, April 2007.
my ( $dims, $list, $i, $max, $len, %hash, $elem, @list );
- $dims = &matrix_dims( $matrix );
+ $dims = matrix_dims( $matrix );
- $list = &cols_get( $matrix, $col, $col );
- $list = &matrix_flip( $list )->[ 0 ];
+ $list = cols_get( $matrix, $col, $col );
+ $list = matrix_flip( $list )->[ 0 ];
$max = 0;
@list = keys %hash;
- if ( &list_check_numeric( $list ) ) {
+ if ( list_check_numeric( $list ) ) {
@list = sort { $a <=> $b } @list;
} else {
@list = sort { $a cmp $b } @list;
}
+sub merge_tabs
+{
+ # Martin A. Hansen, July 2008.
+
+ # Merge two given tables based on identifiers in a for each table
+ # specified column which should contain a unique identifier.
+ # Initially the tables are sorted and tab2 is merged onto tab1
+ # row-wise.
+
+ my ( $tab1, # table 1 - an AoA.
+ $tab2, # table 2 - an AoA.
+ $col1, # identifier in row1
+ $col2, # identifier in row2
+ $sort_type, # alphabetical or numeric comparison
+ ) = @_;
+
+ # Returns nothing.
+
+ my ( $num, $cmp, $i, $c, @row_cpy, $max );
+
+ $max = 0;
+ $num = 0;
+
+ if ( $sort_type =~ /num/i )
+ {
+ $num = 1;
+
+ @{ $tab1 } = sort { $a->[ $col1 ] <=> $b->[ $col1 ] } @{ $tab1 };
+ @{ $tab2 } = sort { $a->[ $col2 ] <=> $b->[ $col2 ] } @{ $tab2 };
+ }
+ else
+ {
+ @{ $tab1 } = sort { $a->[ $col1 ] cmp $b->[ $col1 ] } @{ $tab1 };
+ @{ $tab2 } = sort { $a->[ $col2 ] cmp $b->[ $col2 ] } @{ $tab2 };
+ }
+
+ $i = 0;
+ $c = 0;
+
+ while ( $i < @{ $tab1 } and $c < @{ $tab2 } )
+ {
+ if ( $num ) {
+ $cmp = $tab1->[ $i ]->[ $col1 ] <=> $tab2->[ $c ]->[ $col2 ];
+ } else {
+ $cmp = $tab1->[ $i ]->[ $col1 ] cmp $tab2->[ $c ]->[ $col2 ];
+ }
+
+ if ( $cmp == 0 )
+ {
+ @row_cpy = @{ $tab2->[ $c ] };
+
+ splice @row_cpy, $col2, 1;
+
+ push @{ $tab1->[ $i ] }, @row_cpy;
+
+ $i++;
+ $c++;
+ }
+ elsif ( $cmp > 0 )
+ {
+ $c++;
+ }
+ else
+ {
+ map { push @{ $tab1->[ $i ] }, "null" } 0 .. ( scalar @{ $tab2->[ $c ] } - 2 );
+
+ $i++;
+ }
+ }
+
+ map { push @{ $tab1->[ -1 ] }, "null" } 0 .. ( scalar @{ $tab1->[ 0 ] } - scalar @{ $tab1->[ -1 ] } + 1 );
+}
+
+
# >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> BINARY SEARCH <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
# print "num->$num low->$low high->$high try->$try int1->$matrix->[ $try ]->[ $col1 ] int2->$matrix->[ $try ]->[ $col2 ]\n";
- if ( $num < $matrix->[ $try ]->[ $col1 ] )
- {
+ if ( $num < $matrix->[ $try ]->[ $col1 ] ) {
$high = $try;
- }
- elsif ( $num > $matrix->[ $try ]->[ $col2 ] )
- {
+ } elsif ( $num > $matrix->[ $try ]->[ $col2 ] ) {
$low = $try + 1;
- }
- else
- {
+ } else {
return $try;
}
}
# print "num->$num low->$low high->$high try->$try int->$list->[ $try ]\n";
- if ( $num < $list->[ $try ] )
- {
+ if ( $num < $list->[ $try ] ) {
$high = $try;
- }
- elsif ( $num > $list->[ $try ] )
- {
+ } elsif ( $num > $list->[ $try ] ) {
$low = $try + 1;
- }
- else
- {
+ } else {
return $try;
}
}
$delimiter ||= "\t";
- $fh = &Maasha::Common::read_open( $path );
+ $fh = Maasha::Filesys::file_read_open( $path );
while ( $line = <$fh> )
{
my ( $fh, $row );
- $fh = &Maasha::Common::write_open( $path ) if $path;
+ $fh = Maasha::Filesys::file_write_open( $path ) if $path;
$delimiter ||= "\t";
$matrix, # data structure
) = @_;
- &Maasha::Common::file_store( $path, $matrix );
+ Maasha::Filesys::file_store( $path, $matrix );
}
my ( $path, # full path to file
) = @_;
- my $matrix = &Maasha::Common::file_retrieve( $path );
+ my $matrix = Maasha::Filesys::file_retrieve( $path );
return wantarray ? @{ $matrix } : $matrix;
}
projects / biopieces.git / blobdiff