use warnings;
+no warnings 'recursion';
use strict;
use Data::Dumper;
use Storable qw( dclone );
}
}
- $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
}
-sub list_shrink
+sub list_deflate
{
- # Martin A. Hansen, September 2009.
+ # Martin A. Hansen, February 2010.
+
+ # Deflates a list of values to a specified size.
+
+ my ( $list,
+ $new_size,
+ ) = @_;
+
+ # Returns nothing.
- # Shrinks a list of values to a specified size
- # and at the same time average the values.
+ 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 ( $old_size, $bucket_size, $i, @new_list );
+ my ( $len, $diff, $block_size, $space, $i );
- $old_size = scalar @{ $list };
+ while ( $new_size - scalar @{ $list } > 0 )
+ {
+ $len = @{ $list };
+ $diff = $new_size - $len;
+ $block_size = int( $diff / ( $len - 1 ) );
- Maasha::Common::error( qq(can't shrink to a bigger list: $old_size < $new_size ) ) if $old_size < $new_size;
+ 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;
+ }
+ }
+ }
+}
- $bucket_size = int( $old_size / $new_size );
- for ( $i = 0; $i < $old_size - $bucket_size + 1; $i += $bucket_size ) {
- push @new_list, Maasha::Calc::mean( [ splice @{ $list }, $i, $bucket_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;
}
- $list = \@new_list;
+ return wantarray ? @list : \@list;
}