view release on metacpan or  search on metacpan

lib/Math/InterpolationCompiler.pm  view on Meta::CPAN

package Math::InterpolationCompiler;
use 5.006001;
use Moo 2;
use Types::Standard 1;
use Carp;
use Exporter 'import';

our @EXPORT_OK= qw( linear_clamp_fn linear_extrapolate_fn );

our $VERSION= '0.002000';

# ABSTRACT: Compile interpolations into perl coderefs


has domain        => ( is => 'ro', isa => Types::Standard::ArrayRef, required => 1 );
has range         => ( is => 'ro', isa => Types::Standard::ArrayRef, required => 1 );
has algorithm     => ( is => 'ro', default => sub { 'linear' } );
has beyond_domain => ( is => 'ro', default => sub { 'clamp' } );
has perl_code     => ( is => 'lazy' );
has fn            => ( is => 'lazy' );
has sanitize      => ( is => 'ro', default => sub { 1 } );

sub BUILDARGS {
	my $self= shift;
	my $args= $self->next::method(@_);
	if ($args->{points} && !$args->{domain} && !$args->{range}) {
		my (@domain, @range);
		ref $args->{points} eq 'ARRAY'
			or croak "points must be an arrayref";
		# If points is an arrayref of arrayrefs, assume each point is a 2-element arrayref
		if (ref $args->{points}[0]) {
			for (@{ delete $args->{points} }) {
				push @domain, $_->[0];
				push @range,  $_->[1];
			}
		}
		# else assume points is an arrayref with the x/y in odd/even slots
		else {
			my $flip= 0;
			for (@{ delete $args->{points} }) {
				$flip++ & 1? (push @range,  $_)
					: (push @domain, $_);
			}
			!($flip & 1)
				or croak "odd number of elements in points";
		}
		$args->{domain}= \@domain;
		$args->{range}=  \@range;
	}
	return $args;
}

sub _sanitize_number_array {
	return [
		map {
			defined $_ or croak "<undef> is not a number";
			my $n= "$_";
			$n =~ /^[-+]?[0-9]*\.?[0-9]+([eE][-+]?[0-9]+)?$/ or croak "$n is not a number";
			$n
		} @{ $_[0] }
	];
}

sub BUILD {
	my $self= shift;
	@{ $self->domain } == @{ $self->range }
		or croak "Domain and range differ in length (".@{ $self->domain }." != ".@{ $self->range }.")";
	@{ $self->domain } > 1
		or croak "Domain does not contain any intervals";
	my $prev;
	if ($self->sanitize) {
		$self->{domain}= _sanitize_number_array($self->domain);
		$self->{range}=  _sanitize_number_array($self->range);
	}
	for (@{ $self->domain }) {
		croak "Domain is not sorted in non-decreasing order"