reworked list_inflate/deflate

git-svn-id: http://biopieces.googlecode.com/svn/trunk@892 74ccb610-7750-0410-82ae-013aeee3265d

diff --git a/code_perl/Maasha/Matrix.pm b/code_perl/Maasha/Matrix.pm
index 62f532e26e8e64b11bce7757d325fa900cd6bd59..4706faa2af44d001a49e56be659120a26f5ad58e 100644 (file)
--- a/code_perl/Maasha/Matrix.pm
+++ b/code_perl/Maasha/Matrix.pm
@@ -957,41 +957,57 @@ sub list_check_sort
 
 sub list_deflate
 {
-    # Martin A. Hansen, September 2009.
-
-    # Deflates a list of values to a specified size 
-    # and at the same time average the values.
-
-    my ( $list,       # list to deflate
-         $new_size,   # new number of elements in list
+    # Martin A. Hansen, February 2010.
+    
+    # Deflates a list of values to a specified size. 
+    
+    my ( $list,
+         $new_size,
        ) = @_;
 
     # Returns nothing.
 
-    my ( $bin_size, $i, @new_list );
-
-    Maasha::Common::error( qq(new_size->$new_size must be a positive integer) ) if $new_size < 1;
-    Maasha::Common::error( qq(new_size->$new_size larger than list) )           if $new_size > scalar @{ $list };
+    my ( $len, $l_len, $r_len, $diff, $block_size, $space, $i );
 
-    $bin_size = int( scalar @{ $list } / $new_size );
+    while ( scalar @{ $list } > $new_size )
+    {
+        $len        = @{ $list };
+        $diff       = $len - $new_size;
+        $block_size = int( $len / $new_size );
 
-    for ( $i = 0; $i < @{ $list } - $bin_size; $i += $bin_size ) {
-        push @new_list, Maasha::Calc::mean( [ @{ $list }[ $i .. $i + $bin_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;
+             }
+        }
     }
-
-    # Maasha::Common::error( sprintf( "List size != new size: %d != %d" ), scalar @new_list, $new_size ) if scalar @new_list != $new_size; # FIXME - I want this check!
-
-    @{ $list } = @new_list;
 }
 
 
 sub list_inflate
 {
     # Martin A. Hansen, February 2010.
-
-    # Inflates a list of values to a specified size recursively.
-    # Newly introduced elements are means of neighboring elements.
-    # This routine is a rough and not very precise.
+    
+    # Inflates a list of values to a specified size. Newly
+    # introduced elements are interpolated from neighboring elements.
     
     my ( $list,
          $new_size,
@@ -999,27 +1015,63 @@ sub list_inflate
 
     # Returns nothing.
 
-    my ( $len, $diff, $space );
-
-    $len  = @{ $list };
-    $diff = $new_size - $len;
+    my ( $len, $diff, $block_size, $space, $i );
 
-    if ( $diff > 0 )
+    while ( $new_size - scalar @{ $list } > 0 )
     {
-        $space = $len / $diff;
+        $len        = @{ $list };
+        $diff       = $new_size - $len;
+        $block_size = int( $diff / ( $len - 1 ) );
 
-        if ( ( $space % 2 ) == 0 )
+        if ( $block_size > 0 )
         {
-            splice @{ $list }, $len / 2, 0, Maasha::Calc::mean( [ $list->[ $len / 2 ], $list->[ $len / 2 + 1 ] ] );
+            for ( $i = 1; $i < @{ $list }; $i += $block_size + 1 ) {
+                splice @{ $list }, $i, 0, interpolate( $list->[ $i - 1 ], $list->[ $i ], $block_size );
+            }
         }
         else
         {
-            splice @{ $list }, $len * ( 2 / 3 ), 0, Maasha::Calc::mean( [ $list->[ $len * ( 2 / 3 ) ], $list->[ $len * ( 2 / 3 ) + 1 ] ] );
-            splice @{ $list }, $len * ( 1 / 3 ), 0, Maasha::Calc::mean( [ $list->[ $len * ( 1 / 3 ) ], $list->[ $len * ( 1 / 3 ) + 1 ] ] ) if @{ $list } < $new_size;
+            $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;
+            }
         }
+    }
+}
 
-        list_inflate( $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;
 }