]> git.donarmstrong.com Git - biopieces.git/blobdiff - code_perl/Maasha/Matrix.pm
fixed seq qual length check
[biopieces.git] / code_perl / Maasha / Matrix.pm
index 641a9c231eb28486a58004a098595bf32fdafe83..4706faa2af44d001a49e56be659120a26f5ad58e 100644 (file)
@@ -29,10 +29,12 @@ package Maasha::Matrix;
 
 
 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;
@@ -180,12 +182,60 @@ sub matrix_flip
         }
     }
 
-    $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
@@ -442,7 +492,7 @@ sub col_get
 
 sub cols_get
 {
-    # Martin A. Hansen, April 2007
+    # Martin A. Hansen, April 2007.
 
     # returns a range of requested columns from a given matrix
 
@@ -838,7 +888,7 @@ sub list_check_numeric
     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;
@@ -905,6 +955,126 @@ sub list_check_sort
 }
 
 
+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.
@@ -1076,16 +1246,11 @@ sub interval_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;
         }
     }
@@ -1119,16 +1284,11 @@ sub list_search
     
         # 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;
         }
     }
@@ -1159,7 +1319,7 @@ sub matrix_read
 
     $delimiter ||= "\t";
 
-    $fh = Maasha::Common::read_open( $path );
+    $fh = Maasha::Filesys::file_read_open( $path );
 
     while ( $line = <$fh> )
     {
@@ -1193,7 +1353,7 @@ sub matrix_write
 
     my ( $fh, $row );
 
-    $fh = Maasha::Common::write_open( $path ) if $path;
+    $fh = Maasha::Filesys::file_write_open( $path ) if $path;
 
     $delimiter ||= "\t";
 
@@ -1220,7 +1380,7 @@ sub matrix_store
          $matrix,    # data structure
        ) = @_;
 
-    Maasha::Common::file_store( $path, $matrix );
+    Maasha::Filesys::file_store( $path, $matrix );
 }
 
 
@@ -1233,7 +1393,7 @@ sub matrix_retrive
     my ( $path,   # full path to file
        ) = @_;
 
-    my $matrix = Maasha::Common::file_retrieve( $path );
+    my $matrix = Maasha::Filesys::file_retrieve( $path );
 
     return wantarray ? @{ $matrix } : $matrix;
 }