File Coverage

blib/lib/Math/Wavelet/Haar.pm

Criterion	Covered	Total	%
statement	77	77	100.0
branch	9	16	56.2
condition			n/a
subroutine	9	9	100.0
pod	4	5	80.0
total	99	107	92.5

package Math::Wavelet::Haar;

use 5.005005;
use strict;
use warnings;

use Storable qw(dclone);

require Exporter;

our @ISA = qw(Exporter);

# Items to export into callers namespace by default. Note: do not export
# names by default without a very good reason. Use EXPORT_OK instead.
# Do not simply export all your public functions/methods/constants.

# This allows declaration	use Wavelet::Haar ':all';
# If you do not need this, moving things directly into @EXPORT or @EXPORT_OK
# will save memory.
our %EXPORT_TAGS = ( 'all' => [ qw(
        transform1D
        transform2D
        detransform1D
        detransform2D
) ] );

our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );

our @EXPORT = qw(
);

our $VERSION = '0.06';

# Preloaded methods go here.

sub transform1D
{
    my @input=@_;
    return if (!is_power2(scalar(@input)));
    my @output=(0)x@_;

   my $length=@input>>1;

    for (; ; $length >>= 1) {
        #length=2^n, WITH DECREASING n

        for my $i (0..$length-1)
        {
            my $sum = $input[$i*2]+$input[$i*2+1];
            my $difference = $input[$i*2]-$input[$i*2+1];
            $output[$i] = $sum;
            $output[$length+$i] = $difference;
        }
        return @output if ($length == 1) ;

        #//Swap arrays to do next iteration
        @input[0..$length*2]=@output[0..$length*2];
    }
}

sub is_power2
{
  $_[0] && ($_[0]-1&$_[0] ) == 0
}

sub transform2D
{
  my @input = @{dclone(\@_)};

  my $length = @_;

  my $width = @{$input[0]};
  return if (!is_power2($width));
  for (1..$length-1)
  {
    return if (@{$input[$_]} != $width);
  }

  #do the X direction
  for (0..$length-1)
  {
    @{$input[$_]} = transform1D(@{$input[$_]});
  }

  for my $i (0..$width-1)
  {
    my @col = map { $_->[$i] } @input;

    @col = transform1D(@col);

    for my $l (0..$#col)
    {
      $input[$l]->[$i] = $col[$l];
    }
  }

  return @input;
}

sub detransform1D
{
    my @input=@_;
    return if (!is_power2(scalar(@input)));
    my @output=@input;

   my $length=1;

    for (; $length<=@input>>1; $length <<= 1)
    {
      for my $i (0..$length-1)
      {
        my $x = ($input[$i] + $input[$i+$length])/2;
        my $y = ($input[$i] - $input[$i+$length])/2;
        $output[$i*2] = $x;
        $output[$i*2+1] = $y;
      }
      #//Swap arrays to do next iteration
      @input = @output;
    }

    return @input;
}

sub detransform2D
{
  my @input = @{dclone(\@_)};
  my $length = @_;

  my $width = @{$input[0]};
  return if (!is_power2($width));
  for (1..$length-1)
  {
    return if (@{$input[$_]} != $width);
  }

  #do the X direction
  for (0..$length-1)
  {
    @{$input[$_]} = detransform1D(@{$input[$_]});
  }

  for my $i (0..$width-1)
  {
    my @col = map { $_->[$i] } @input;

    @col = detransform1D(@col);

    for my $l (0..$#col)
    {
      $input[$l]->[$i] = $col[$l];
    }
  }

  return @input;
}

# Autoload methods go after =cut, and are processed by the autosplit program.

1;
__END__