view release on metacpan or  search on metacpan

lib/Sidef/Types/Number/Number.pm  view on Meta::CPAN

    # die ((caller(1))[3], ' -- ', (caller(0))[2]) if index(ref($x), 'Sidef::') == 0;

    $x = (_any2mpz($x) // return undef) if ref($x) ne 'Math::GMPz';

    Math::GMPz::Rmpz_fits_ulong_p($x)
      ? Math::GMPz::Rmpz_get_ui($x)
      : ((Math::GMPz::Rmpz_sgn($x) >= 0) ? Math::GMPz::Rmpz_get_str($x, 10) : undef);
}

# Big to positive integer-string
sub _big2pistr {
    my ($x) = @_;

    $x = $$x if ref($x) eq __PACKAGE__;
    ref($x) || return (($x > 0) ? $x : undef);

    # die ((caller(1))[3], ' -- ', (caller(0))[2]) if index(ref($x), 'Sidef::') == 0;

    $x = (_any2mpz($x) // return undef) if ref($x) ne 'Math::GMPz';

    if (Math::GMPz::Rmpz_fits_ulong_p($x)) {
        my $ui = Math::GMPz::Rmpz_get_ui($x);
        return (($ui > 0) ? $ui : undef);
    }

    (Math::GMPz::Rmpz_sgn($x) > 0)
      ? Math::GMPz::Rmpz_get_str($x, 10)
      : undef;
}

sub _array {
    Sidef::Types::Array::Array->new(@_);
}

sub _sanitize_mpz {
    my ($n) = @_;

    if (ref($n) ne 'Math::GMPz') {
        __is_int__($n) || return undef;
        $n = _any2mpz($n) // return undef;
    }

    $n;
}

sub _normalize_numeric_type {
    my ($n) = @_;
    ref($n) eq 'Math::GMPz'
      ? (
           Math::GMPz::Rmpz_fits_ulong_p($n)
         ? Math::GMPz::Rmpz_get_ui($n)
         : Math::GMPz::Rmpz_get_str($n, 10)
        )
      : $n;
}

sub _execute_pari_gp {
    my ($code) = @_;
    say STDERR ":: Executing PARI/GP with: $code" if $VERBOSE;

    state $_x = require IPC::Open2;

    # Maintain persistent handles for the lifetime of the interpreter
    state ($gp_in, $gp_out, $gp_pid);

    state $gp_cmd = 'gp -q -f --default parisize=500M --default parisizemax=0 --default threadsizemax=0';

    # Lazy initialization: only spawn the process on the first call
    if (!$gp_pid) {
        $gp_pid = IPC::Open2::open2($gp_out, $gp_in, $gp_cmd);

        # Disable buffering on the input handle to ensure GP gets commands immediately
        my $old_fh = select($gp_in);
        $| = 1;
        select($old_fh);
    }

    # Unique sentinel to mark the end of the GP output stream
    my $sentinel = "---END_OF_OUTPUT---";

    # Protect against script crashes if the GP process was killed externally
    local $SIG{PIPE} = 'IGNORE';

    # Send the code.
    # The sentinel is sent on a new line so that even if $code triggers
    # a GP syntax error, the sentinel is still evaluated and prevents a deadlock.
    my $write_ok = print $gp_in "$code\nprint(\"$sentinel\");\n";

    # Handle GP process death and auto-restart
    if (!$write_ok) {
        say STDERR "[WARNING] PARI/GP pipe broke, restarting..." if $VERBOSE;
        close $gp_in                                             if $gp_in;
        close $gp_out                                            if $gp_out;
        undef $gp_pid;

        # Re-initialize and retry exactly once
        $gp_pid = IPC::Open2::open2($gp_out, $gp_in, $gp_cmd);
        my $old_fh = select($gp_in);
        $| = 1;
        select($old_fh);

        print $gp_in "$code\nprint(\"$sentinel\");\n" or return undef;
    }

    my @output;
    while (my $line = <$gp_out>) {
        chomp $line;
        last if $line eq $sentinel;
        push @output, $line;
    }

    # GP errors are printed to STDERR natively, bypassing @output.
    # If $code fails or returns nothing, @output will be safely empty.
    my $res = join("\n", @output);
    return undef if $res eq '';
    return $res;
}

sub _execute_in_tmpdir {
    my ($cmd) = @_;

lib/Sidef/Types/Number/Number.pm  view on Meta::CPAN

        if ($v == 0) {
            return bless \$x;
        }

        if ($v == 1) {
            my $q =
              HAS_PRIME_UTIL
              ? Math::Prime::Util::divint($x, $y)
              : Math::Prime::Util::GMP::divint($x, $y);
            return bless \$q;
        }

        my $q =
          HAS_PRIME_UTIL
          ? Math::Prime::Util::divint($x, Math::Prime::Util::powint($y, $v))
          : Math::Prime::Util::GMP::divint($x, Math::Prime::Util::GMP::powint($y, $v));
        return bless \$q;
    }

    $x = _any2mpz($x) // goto &nan;
    $y = _any2mpz($y) // goto &nan;

    Math::GMPz::Rmpz_cmpabs_ui($y, 1) <= 0 and return $_[0];

    my $r = Math::GMPz::Rmpz_init();
    Math::GMPz::Rmpz_remove($r, $x, $y);
    bless \$r;
}

*remdiv = \&remove;

sub make_coprime {
    my ($n, $k) = @_;

    ref($k) eq __PACKAGE__ or _valid(\$k);

    $n = _any2mpz($$n) // goto &nan;
    $k = _any2mpz($$k) // goto &nan;

    if (Math::GMPz::Rmpz_sgn($n) == 0) {
        return _set_int($n);
    }

    my $r = Math::GMPz::Rmpz_init_set($n);
    my $g = Math::GMPz::Rmpz_init();

    Math::GMPz::Rmpz_gcd($g, $r, $k);

    while (Math::GMPz::Rmpz_cmp_ui($g, 1) > 0) {
        Math::GMPz::Rmpz_remove($r, $r, $g);
        Math::GMPz::Rmpz_gcd($g, $r, $g);
    }

    bless \$r;
}

sub useed {
    my ($n) = @_;

    state $_x = require Digest::SHA;

    my $z = _any2mpz($$n) // die "[ERROR] Number.useed(): invalid seed value <<$n>> (expected an integer)";

    my $hex = Math::GMPz::Rmpz_get_str($z, 16);
    $hex = substr($hex, 1) if (substr($hex, 0, 1) eq '-');

    my $bin  = CORE::pack('H*', $hex);
    my $seed = Digest::SHA::sha512($bin);

    while (CORE::length($seed) < 1024) {
        $seed = Digest::SHA::sha512($seed) . CORE::reverse($seed);
    }

    Math::Prime::Util::GMP::seed_csprng(1024, $seed);
    return $TRUE;
}

*iseed = \&useed;

sub urandomm {
    my ($n, $m) = @_;

    if (defined($m)) {
        ref($m) eq __PACKAGE__ or _valid(\$m);

        $n = $$n;
        $m = $$m;

        $n = (ref($n) ? _any2mpz($n) : $n) // return ZERO;
        $m = (ref($m) ? _any2mpz($m) : $m) // return ZERO;

        if (__cmp__($n, $m) > 0) {
            ($n, $m) = ($m, $n);
        }

        if (ref($n)) {
            $n = _big2uistr($n) // 0;
        }
        else {
            $n >= 0 or do { $n = 0 };
        }

        if (ref($m)) {
            $m = _big2uistr($m) // 0;
        }
        else {
            $m >= 0 or do { $m = 0 };
        }

        return _set_int(Math::Prime::Util::GMP::urandomr($n, $m) || return ZERO);
    }

    _set_int(Math::Prime::Util::GMP::urandomm(_big2uistr($$n) || return ZERO) || return ZERO);
}

*urand = \&urandomm;

sub irand {
    my ($n, $m) = @_;