# >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+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;
}
}
- $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
sub cols_get
{
- # Martin A. Hansen, April 2007
+ # Martin A. Hansen, April 2007.
# returns a range of requested columns from a given matrix
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;
}
+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.
}
+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