File Coverage

blib/lib/Math/PSNR.pm

Criterion	Covered	Total	%
statement	109	111	98.2
branch	28	36	77.7
condition	18	18	100.0
subroutine	20	20	100.0
pod	4	4	100.0
total	179	189	94.7

package Math::PSNR;

use warnings;
use strict;
use utf8;
use Carp;
use Mouse;

our $VERSION = '0.02';

has bpp => (
    is      => 'rw',
    isa     => 'Int',
    default => '8',
    trigger => sub {
        my $self = shift;
        $self->_set_max_power( $self->_calc_max_power );
    },
);

has x => (
    is       => 'rw',
    isa      => 'ArrayRef|HashRef',
    required => '1',
    trigger  => sub {
        my $self = shift;
        $self->_reset_cache;
    },
);

has y => (
    is       => 'rw',
    isa      => 'ArrayRef|HashRef',
    required => '1',
    trigger  => sub {
        my $self = shift;
        $self->_reset_cache;
    },
);

has max_power => (
    is       => 'ro',
    isa      => 'Int',
    writer   => '_set_max_power',
    init_arg => undef,
    lazy     => '1',
    default  => sub {
        my $self = shift;
        return $self->_calc_max_power;
    },
    trigger  => sub {
        my $self = shift;
        $self->_reset_cache;
    },
);

has mse_cache => (
    is       => 'ro',
    isa      => 'Num|Undef',
    writer   => '_set_mse_cache',
    init_arg => undef,
    default  => undef,
);

has psnr_cache => (
    is       => 'ro',
    isa      => 'Num|Undef',
    writer   => '_set_psnr_cache',
    init_arg => undef,
    default  => undef,
);

no Mouse;

sub _reset_cache {
    my $self = shift;
    $self->_set_mse_cache(undef);
    $self->_set_psnr_cache(undef);
}

sub _sqr {
    my $var = shift;
    return $var * $var;
}

sub _log10 {
    my $var = shift;
    return log($var) / log(10);
}

sub _calc_max_power {
    my $self = shift;
    return 2**$self->bpp - 1;
}

sub _limit {
    my ( $self, $var ) = @_;

    if ( $var < 0 ) {
        return 0;
    }
    elsif ( $var > $self->max_power ) {
        return $self->max_power;
    }
    return $var;
}

sub _square_remainder {
    my ( $self, $x, $y ) = @_;

    $x = $self->_limit($x);
    $y = $self->_limit($y);

    return _sqr( $x - $y );
}

sub _calc_psnr {
    my ( $self, $mse ) = @_;
    return 20 * _log10( $self->max_power / sqrt($mse) );
}

sub _check_exist_key {
    my ( $self, $key ) = @_;

    unless ( exists $self->x->{$key} && exists $self->y->{$key} ) {
        croak "Hash of signal must have key of '$key'.";
    }

    unless ( ref $self->x->{$key} eq 'ARRAY'
        && ref $self->y->{$key} eq 'ARRAY' )
    {
        croak "Value of '$key' must be numerical array reference. ";
    }
}

sub _check_exist_rgb_keys {
    my $self = shift;

    $self->_check_exist_key('r');
    $self->_check_exist_key('g');
    $self->_check_exist_key('b');
}

sub _check_signal_length_each {
    my $self = shift;

    my $signal_length_x = $#{ $self->x->{'r'} };
    unless ( $signal_length_x == $#{ $self->x->{'g'} }
        && $signal_length_x == $#{ $self->x->{'b'} } )
    {
        croak
"Each elements of signal must be the same length. Please check out the length of 'r', 'g', and 'b' of signal x.";
    }

    my $signal_length_y = $#{ $self->y->{'r'} };
    unless ( $signal_length_y == $#{ $self->y->{'g'} }
        && $signal_length_y == $#{ $self->y->{'b'} } )
    {
        croak
"Each elements of signal must be the same length. Please check out the length of 'r', 'g', and 'b' of signal y.";
    }

    unless ( $signal_length_x == $signal_length_y ) {
        croak "Signal length are different between 'Signal x' and 'Signal y'.";
    }
}

sub mse {
    my $self = shift;

    return $self->mse_cache if defined( $self->mse_cache );    # Enable Cache

    unless ( ref $self->x eq 'ARRAY' && ref $self->y eq 'ARRAY' ) {
        croak 'Signals must be array reference.';
    }

    my $signal_length = scalar @{ $self->x };
    unless ( $signal_length == scalar @{ $self->y } ) {
        croak 'Signals must be the same length.';
    }

    my ( $x, $y ) = ( $self->x, $self->y );
    my $sum = 0;
    for my $i ( 0 .. $signal_length - 1 ) {
        $sum += $self->_square_remainder( $x->[$i], $y->[$i] );
    }

    my $mse = $sum / $signal_length;

    $self->_set_mse_cache($mse);
    return $mse;
}

sub psnr {
    my $self = shift;

    return $self->psnr_cache if defined( $self->psnr_cache );    # Enable Cache

    my $mse = defined( $self->mse_cache ) ? $self->mse_cache : $self->mse;
    if ( $mse == 0 ) {
        carp 'Given signals are the same.';
        return 'same';
    }

    my $psnr = $self->_calc_psnr($mse);

    $self->_set_psnr_cache($psnr);
    return $psnr;
}

sub mse_rgb {
    my $self = shift;

    return $self->mse_cache if defined( $self->mse_cache );    # Enable Cache

    unless ( ref $self->x eq 'HASH' && ref $self->y eq 'HASH' ) {
        croak 'Signals must be hash reference.';
    }

    $self->_check_exist_rgb_keys;
    $self->_check_signal_length_each;

    my $signal_length = scalar @{ $self->x->{'r'} };

    my ( $x, $y ) = ( $self->x, $self->y );
    my $sum = 0;
    for my $i ( 0 .. $signal_length - 1 ) {
        $sum +=
          $self->_square_remainder( $x->{'r'}->[$i], $y->{'r'}->[$i] ) +
          $self->_square_remainder( $x->{'g'}->[$i], $y->{'g'}->[$i] ) +
          $self->_square_remainder( $x->{'b'}->[$i], $y->{'b'}->[$i] );
    }

    my $mse = $sum / ( 3 * $signal_length );

    $self->_set_mse_cache($mse);
    return $mse;
}

sub psnr_rgb {
    my $self = shift;

    return $self->psnr_cache if defined( $self->psnr_cache );    # Enable Cache

    my $mse = defined( $self->mse_cache ) ? $self->mse_cache : $self->mse_rgb;
    if ( $mse == 0 ) {
        carp 'Given signals are the same.';
        return 'same';
    }

    my $psnr = $self->_calc_psnr($mse);

    $self->_set_psnr_cache($psnr);
    return $psnr;
}

1;
__END__