view release on metacpan or  search on metacpan

cpan/Math-BigInt/lib/Math/BigInt/Lib.pm  view on Meta::CPAN

#
#    return $x;
#}

sub _fac {
    # factorial
    my ($class, $x) = @_;

    # This is an implementation of the split recursive algorithm. See
    # http://www.luschny.de/math/factorial/csharp/FactorialSplit.cs.html

    my $p   = $class -> _one();
    my $r   = $class -> _one();
    my $two = $class -> _two();

    my ($log2n) = $class -> _log_int($class -> _copy($x), $two);
    my $h     = $class -> _zero();
    my $shift = $class -> _zero();
    my $k     = $class -> _one();

    while ($class -> _acmp($h, $x)) {
        $shift = $class -> _add($shift, $h);
        $h = $class -> _rsft($class -> _copy($x), $log2n, $two);
        $log2n = $class -> _dec($log2n) if !$class -> _is_zero($log2n);
        my $high = $class -> _copy($h);
        $high = $class -> _dec($high) if $class -> _is_even($h);
        while ($class -> _acmp($k, $high)) {
            $k = $class -> _add($k, $two);
            $p = $class -> _mul($p, $k);
        }
        $r = $class -> _mul($r, $p);
    }
    return $class -> _lsft($r, $shift, $two);
}

sub _dfac {
    # double factorial
    my ($class, $x) = @_;

    my $two = $class -> _two();

    if ($class -> _acmp($x, $two) < 0) {
        return $class -> _one();
    }

    my $i = $class -> _copy($x);
    while ($class -> _acmp($i, $two) > 0) {
        $i = $class -> _sub($i, $two);
        $x = $class -> _mul($x, $i);
    }

    return $x;
}

sub _log_int {
    # calculate integer log of $x to base $base
    # calculate integer log of $x to base $base
    # ref to array, ref to array - return ref to array
    my ($class, $x, $base) = @_;

    # X == 0 => NaN
    return if $class -> _is_zero($x);

    $base = $class -> _new(2)     unless defined($base);
    $base = $class -> _new($base) unless ref($base);

    # BASE 0 or 1 => NaN
    return if $class -> _is_zero($base) || $class -> _is_one($base);

    # X == 1 => 0 (is exact)
    if ($class -> _is_one($x)) {
        return $class -> _zero(), 1 if wantarray;
        return $class -> _zero();
    }

    my $cmp = $class -> _acmp($x, $base);

    # X == BASE => 1 (is exact)
    if ($cmp == 0) {
        return $class -> _one(), 1 if wantarray;
        return $class -> _one();
    }

    # 1 < X < BASE => 0 (is truncated)
    if ($cmp < 0) {
        return $class -> _zero(), 0 if wantarray;
        return $class -> _zero();
    }

    my $y;

    # log(x) / log(b) = log(xm * 10^xe) / log(bm * 10^be)
    #                 = (log(xm) + xe*(log(10))) / (log(bm) + be*log(10))

    {
        my $x_str = $class -> _str($x);
        my $b_str = $class -> _str($base);
        my $xm    = "." . $x_str;
        my $bm    = "." . $b_str;
        my $xe    = length($x_str);
        my $be    = length($b_str);
        my $log10 = log(10);
        my $guess = int((log($xm) + $xe * $log10) / (log($bm) + $be * $log10));
        $y = $class -> _new($guess);
    }

    my $trial = $class -> _pow($class -> _copy($base), $y);
    my $acmp  = $class -> _acmp($trial, $x);

    # Too small?

    while ($acmp < 0) {
        $trial = $class -> _mul($trial, $base);
        $y     = $class -> _inc($y);
        $acmp  = $class -> _acmp($trial, $x);
    }

    # Too big?

    while ($acmp > 0) {
        $trial = $class -> _div($trial, $base);
        $y     = $class -> _dec($y);
        $acmp  = $class -> _acmp($trial, $x);
    }

    return wantarray ? ($y, 1) : $y if $acmp == 0;      # result is exact
    return wantarray ? ($y, 0) : $y;                    # result is too small