File Coverage

blib/lib/DateTime/Util/Calc.pm

Criterion	Covered	Total	%
statement	89	112	79.4
branch	17	38	44.7
condition	4	8	50.0
subroutine	29	38	76.3
pod	24	24	100.0
total	163	220	74.0

# $Id: /local/datetime/modules/DateTime-Util-Calc/trunk/lib/DateTime/Util/Calc.pm 11779 2007-05-29T22:12:48.788920Z daisuke  $
#
# Copyright (c) 2004-2015 Daisuke Maki

package DateTime::Util::Calc;
use strict;
use warnings;
use Carp qw(carp);
use Exporter;
use DateTime;
use Math::BigInt   ('lib' => 'GMP,Pari,FastCalc');
use Math::BigFloat ('lib' => 'GMP,Pari,FastCalc');
use Math::Trig ();
use POSIX();

use constant RATA_DIE => DateTime->new(year => 1, time_zone => 'UTC');

use vars qw($VERSION @EXPORT_OK);
use vars qw($DOWNGRADE_ACCURACY);
BEGIN
{
    *import = \&Exporter::import;
    $VERSION = '0.13003';
    @EXPORT_OK = qw(
        bf_downgrade
        bi_downgrade
        binary_search
        search_next
        angle
        polynomial
        sin_deg
        cos_deg
        tan_deg
        asin_deg acos_deg mod amod min
        max bigfloat bigint moment dt_from_moment rata_die
        truncate_to_midday
        revolution
        rev180
    );

    $DOWNGRADE_ACCURACY = 32;
}

sub rata_die { RATA_DIE->clone }

sub bigfloat
{
    return
        UNIVERSAL::isa($_[0], 'Math::BigFloat') ? $_[0] :
            Math::BigFloat->new($_[0]);
}

sub bigint
{
    return UNIVERSAL::isa($_[0], 'Math::BigInt') ? $_[0] : Math::BigInt->new($_[0]);
}

my $warn_bf_downgrade = 0;
my $warn_bi_downgrade = 0;
sub bf_downgrade
{
    $warn_bf_downgrade++ or carp "DateTime::Util::Calc::bf_downgrade has been deprecated, and will be removed in future versions.";
    return $_[0];
}

sub bi_downgrade
{
    $warn_bi_downgrade++ or carp "DateTime::Util::Calc::bi_downgrade has been deprecated, and will be removed in future versions.";
    return $_[0];
}

sub angle
{
    Math::BigFloat->new($_[0]) + (Math::BigFloat->new($_[1]) + (Math::BigFloat->new($_[2]) / 60)) / 60;
}

# polynomial($x, $a(0) ... $a(n))
sub polynomial
{
    if (@_ == 1) {
        require Carp;
        Carp::croak('polynomial requires at least two arguments: polynomial($x, @coeffients)');
    }

    # XXX - There seems to be a bug in adding BigInt and BigFloat
    # Math::BigFloat->bzero must be used
    my $x   = Math::BigFloat->new(shift @_);
    my $v   = Math::BigFloat->bzero();
    my $ret = Math::BigFloat->new(shift @_);

    # reuse $v for sake of efficiency. we just want to check if $x
    # is zero or not
    if ($x == $v) {
        return $ret;
    }

    while (@_) {
        $v = $x * ($v + pop @_);
    }
    return $ret + $v;
}

sub deg2rad
{
    my $deg = ref($_[0]) ? $_[0]->bstr() : $_[0];
    return Math::Trig::deg2rad($deg > 360 ? $deg % 360 : $deg);
}

sub sin_deg  { CORE::sin(deg2rad($_[0])) }
sub cos_deg  { CORE::cos(deg2rad($_[0])) }
sub tan_deg  { Math::Trig::tan(deg2rad($_[0])) }
sub asin_deg
{
    my $v = ref($_[0]) ? $_[0]->bstr() : $_[0];
    return Math::Trig::rad2deg(Math::Trig::asin($v));
}

sub acos_deg
{
    my $v = ref($_[0]) ? $_[0]->bstr() : $_[0];
    Math::Trig::rad2deg(Math::Trig::acos($v));
}

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

    # x mod y = x - y * (floor(x/y));

    if (ref($x) || ref($y)) {
        # Make sure both are M::BF
        $x = Math::BigFloat->new($x) if ! ref ($x);
        $y = Math::BigFloat->new($y) if ! ref ($y);

        return $x - $y * ( ($x / $y)->bfloor );
    } else {
        return $x - $y * ( POSIX::floor($x / $y) );
    }
}

sub amod { mod($_[0], $_[1]) || $_[1]; }
sub min  { $_[0] > $_[1] ? $_[1] : $_[0] }
sub max  { $_[0] < $_[1] ? $_[1] : $_[0] }

sub moment
{
    my $dt = shift;
    my($rd, $seconds) = $dt->utc_rd_values;
    return $rd + $seconds / (24 * 3600);
}

sub dt_from_moment
{
    my $moment  = Math::BigFloat->new('' . shift);

    # Truncate the moment down to an int
    my $rd_days = $moment->as_int();

    # Upgrade here to BigFloat to maintain accuracy to the second
    my $time    = ($moment - $rd_days) * 24 * 3600;
    my $dt      = rata_die();

    if ($rd_days || $time) {
        $dt->add(
            days    => ($rd_days - 1)->bstr(),
            seconds => $time->as_int()->bstr(),
        );
        $dt->truncate(to => 'second');
    }
    return $dt;
}


sub binary_search
{
    my ($lo, $hi, $mu, $phi) = @_;

    $lo = Math::BigFloat->new($lo);
    $hi = Math::BigFloat->new($hi);

    while (1) {
        my $x = ($lo + $hi) / 2;
        if ($mu->($lo, $hi)) {
            return $x;
        } elsif ($phi->($x)) {
            $hi = $x;
        } else {
            $lo = $x;
        }
    }
}

sub __increment_one { $_[0] + 1 }
sub search_next
{
    my %args = @_;
    my $x     = $args{base};
    my $check = $args{check};
    my $next  = $args{next} || \&__increment_one;
    while (! $check->($x) ) {
        $x = $next->($x);
    }
    return $x;
}

sub truncate_to_midday
{
    $_[0]->truncate(to => 'hour');
    $_[0]->set( hour => 12 );
    $_[0];
}

sub revolution
{
    #
    #
    # FUNCTIONAL SEQUENCE for revolution
    #
    # _GIVEN
    # any angle
    #
    # _THEN
    #
    # reduces any angle to within the first revolution
    # by subtracting or adding even multiples of 360.0
    #
    #
    # _RETURN
    #
    # the value of the input is >= 0.0 and < 360.0
    #

    my $x = $_[0];
    return ( $x - 360.0 * POSIX::floor( $x * ( 1.0 / 360.0 ) ) );
}

sub rev180
{
    #
    #
    # FUNCTIONAL SEQUENCE for rev180
    #
    # _GIVEN
    #
    # any angle
    #
    # _THEN
    #
    # Reduce input to within +180..+180 degrees
    #
    #
    # _RETURN
    #
    # angle that was reduced
    #
    my ($x) = @_;
    return ( $x - 360.0 * POSIX::floor( $x * ( 1.0 / 360.0 ) + 0.5 ) );
}


1;

__END__