bigint.pm

1. 记录每个帖子的访问人情况

  # objectify is costly, so avoid it
  if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
    {
    ($self,$x,$y,@r) = objectify(2,@_);
    }
  
  return $x if $x->modify('band');

  $r[3] = $y;				# no push!
  local $Math::BigInt::upgrade = undef;

  return $x->bnan() if ($x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]$/);
  return $x->bzero(@r) if $y->is_zero() || $x->is_zero();

  my $sign = 0;					# sign of result
  $sign = 1 if ($x->{sign} eq '-') && ($y->{sign} eq '-');
  my $sx = 1; $sx = -1 if $x->{sign} eq '-';
  my $sy = 1; $sy = -1 if $y->{sign} eq '-';
  
  if ($CALC->can('_and') && $sx == 1 && $sy == 1)
    {
    $x->{value} = $CALC->_and($x->{value},$y->{value});
    return $x->round(@r);
    }

  my $m = $self->bone(); my ($xr,$yr);
  my $x10000 = $self->new (0x1000);
  my $y1 = copy(ref($x),$y);	 		# make copy
  $y1->babs();					# and positive
  my $x1 = $x->copy()->babs(); $x->bzero();	# modify x in place!
  use integer;					# need this for negative bools
  while (!$x1->is_zero() && !$y1->is_zero())
    {
    ($x1, $xr) = bdiv($x1, $x10000);
    ($y1, $yr) = bdiv($y1, $x10000);
    # make both op's numbers!
    $x->badd( bmul( $class->new(
       abs($sx*int($xr->numify()) & $sy*int($yr->numify()))), 
      $m));
    $m->bmul($x10000);
    }
  $x->bneg() if $sign;
  $x->round(@r);
  }

sub bior 
  {
  #(BINT or num_str, BINT or num_str) return BINT
  # compute x | y
  
  # set up parameters
  my ($self,$x,$y,@r) = (ref($_[0]),@_);
  # objectify is costly, so avoid it
  if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
    {
    ($self,$x,$y,@r) = objectify(2,@_);
    }

  return $x if $x->modify('bior');
  $r[3] = $y;				# no push!

  local $Math::BigInt::upgrade = undef;

  return $x->bnan() if ($x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]$/);
  return $x->round(@r) if $y->is_zero();

  my $sign = 0;					# sign of result
  $sign = 1 if ($x->{sign} eq '-') || ($y->{sign} eq '-');
  my $sx = 1; $sx = -1 if $x->{sign} eq '-';
  my $sy = 1; $sy = -1 if $y->{sign} eq '-';

  # don't use lib for negative values
  if ($CALC->can('_or') && $sx == 1 && $sy == 1)
    {
    $x->{value} = $CALC->_or($x->{value},$y->{value});
    return $x->round(@r);
    }

  my $m = $self->bone(); my ($xr,$yr);
  my $x10000 = $self->new(0x10000);
  my $y1 = copy(ref($x),$y);	 		# make copy
  $y1->babs();					# and positive
  my $x1 = $x->copy()->babs(); $x->bzero();	# modify x in place!
  use integer;					# need this for negative bools
  while (!$x1->is_zero() || !$y1->is_zero())
    {
    ($x1, $xr) = bdiv($x1,$x10000);
    ($y1, $yr) = bdiv($y1,$x10000);
    # make both op's numbers!
    $x->badd( bmul( $class->new(
       abs($sx*int($xr->numify()) | $sy*int($yr->numify()))), 
      $m));
    $m->bmul($x10000);
    }
  $x->bneg() if $sign;
  $x->round(@r);
  }

sub bxor 
  {
  #(BINT or num_str, BINT or num_str) return BINT
  # compute x ^ y
  
  # set up parameters
  my ($self,$x,$y,@r) = (ref($_[0]),@_);
  # objectify is costly, so avoid it
  if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
    {
    ($self,$x,$y,@r) = objectify(2,@_);
    }

  return $x if $x->modify('bxor');
  $r[3] = $y;				# no push!

  local $Math::BigInt::upgrade = undef;

  return $x->bnan() if ($x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]$/);
  return $x->round(@r) if $y->is_zero();
  
  my $sign = 0;					# sign of result
  $sign = 1 if $x->{sign} ne $y->{sign};
  my $sx = 1; $sx = -1 if $x->{sign} eq '-';
  my $sy = 1; $sy = -1 if $y->{sign} eq '-';

  # don't use lib for negative values
  if ($CALC->can('_xor') && $sx == 1 && $sy == 1)
    {
    $x->{value} = $CALC->_xor($x->{value},$y->{value});
    return $x->round(@r);
    }

  my $m = $self->bone(); my ($xr,$yr);
  my $x10000 = $self->new(0x10000);
  my $y1 = copy(ref($x),$y);	 		# make copy
  $y1->babs();					# and positive
  my $x1 = $x->copy()->babs(); $x->bzero();	# modify x in place!
  use integer;					# need this for negative bools
  while (!$x1->is_zero() || !$y1->is_zero())
    {
    ($x1, $xr) = bdiv($x1, $x10000);
    ($y1, $yr) = bdiv($y1, $x10000);
    # make both op's numbers!
    $x->badd( bmul( $class->new(
       abs($sx*int($xr->numify()) ^ $sy*int($yr->numify()))), 
      $m));
    $m->bmul($x10000);
    }
  $x->bneg() if $sign;
  $x->round(@r);
  }

sub length
  {
  my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);

  my $e = $CALC->_len($x->{value}); 
  return wantarray ? ($e,0) : $e;
  }

sub digit
  {
  # return the nth decimal digit, negative values count backward, 0 is right
  my ($self,$x,$n) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_);

  $CALC->_digit($x->{value},$n||0);
  }

sub _trailing_zeros
  {
  # return the amount of trailing zeros in $x
  my $x = shift;
  $x = $class->new($x) unless ref $x;

  return 0 if $x->is_zero() || $x->is_odd() || $x->{sign} !~ /^[+-]$/;

  return $CALC->_zeros($x->{value}) if $CALC->can('_zeros');

  # if not: since we do not know underlying internal representation:
  my $es = "$x"; $es =~ /([0]*)$/;
  return 0 if !defined $1;	# no zeros
  CORE::length("$1");		# as string, not as +0!
  }

sub bsqrt
  {
  my ($self,$x,@r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_);

  return $x if $x->modify('bsqrt');

  return $x->bnan() if $x->{sign} ne '+';	# -x or inf or NaN => NaN
  return $x->bzero(@r) if $x->is_zero();			# 0 => 0
  return $x->round(@r) if $x->is_one();			# 1 => 1

  return $upgrade->bsqrt($x,@r) if defined $upgrade;

  if ($CALC->can('_sqrt'))
    {
    $x->{value} = $CALC->_sqrt($x->{value});
    return $x->round(@r);
    }

  return $x->bone('+',@r) if $x < 4;				# 2,3 => 1
  my $y = $x->copy();
  my $l = int($x->length()/2);
  
  $x->bone();					# keep ref($x), but modify it
  $x->blsft($l,10);

  my $last = $self->bzero();
  my $two = $self->new(2);
  my $lastlast = $x+$two;
  while ($last != $x && $lastlast != $x)
    {
    $lastlast = $last; $last = $x->copy(); 
    $x->badd($y / $x); 
    $x->bdiv($two);
    }
  $x->bdec() if $x * $x > $y;				# overshot?
  $x->round(@r);
  }

sub exponent
  {
  # return a copy of the exponent (here always 0, NaN or 1 for $m == 0)
  my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
 
  if ($x->{sign} !~ /^[+-]$/)
    {
    my $s = $x->{sign}; $s =~ s/^[+-]//;
    return $self->new($s); 		# -inf,+inf => inf
    }
  my $e = $class->bzero();
  return $e->binc() if $x->is_zero();
  $e += $x->_trailing_zeros();
  $e;
  }

sub mantissa
  {
  # return the mantissa (compatible to Math::BigFloat, e.g. reduced)
  my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);

  if ($x->{sign} !~ /^[+-]$/)
    {
    return $self->new($x->{sign}); 		# keep + or - sign
    }
  my $m = $x->copy();
  # that's inefficient
  my $zeros = $m->_trailing_zeros();
  $m->brsft($zeros,10) if $zeros != 0;
  $m;
  }

sub parts
  {
  # return a copy of both the exponent and the mantissa
  my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);

  return ($x->mantissa(),$x->exponent());
  }
   
##############################################################################
# rounding functions

sub bfround
  {
  # precision: round to the $Nth digit left (+$n) or right (-$n) from the '.'
  # $n == 0 || $n == 1 => round to integer
  my $x = shift; $x = $class->new($x) unless ref $x;
  my ($scale,$mode) = $x->_scale_p($x->precision(),$x->round_mode(),@_);
  return $x if !defined $scale;		# no-op
  return $x if $x->modify('bfround');

  # no-op for BigInts if $n <= 0
  if ($scale <= 0)
    {
    $x->{_a} = undef;				# clear an eventual set A
    $x->{_p} = $scale; return $x;
    }

  $x->bround( $x->length()-$scale, $mode);
  $x->{_a} = undef;				# bround sets {_a}
  $x->{_p} = $scale;				# so correct it
  $x;
  }

sub _scan_for_nonzero
  {
  my $x = shift;
  my $pad = shift;
  my $xs = shift;
 
  my $len = $x->length();
  return 0 if $len == 1;		# '5' is trailed by invisible zeros
  my $follow = $pad - 1;
  return 0 if $follow > $len || $follow < 1;

  # since we do not know underlying represention of $x, use decimal string
  #my $r = substr ($$xs,-$follow);
  my $r = substr ("$x",-$follow);
  return 1 if $r =~ /[^0]/;
  0;
  }

sub fround
  {
  # to make life easier for switch between MBF and MBI (autoload fxxx()
  # like MBF does for bxxx()?)
  my $x = shift;
  return $x->bround(@_);
  }

sub bround
  {
  # accuracy: +$n preserve $n digits from left,
  #           -$n preserve $n digits from right (f.i. for 0.1234 style in MBF)
  # no-op for $n == 0
  # and overwrite the rest with 0's, return normalized number
  # do not return $x->bnorm(), but $x

  my $x = shift; $x = $class->new($x) unless ref $x;
  my ($scale,$mode) = $x->_scale_a($x->accuracy(),$x->round_mode(),@_);
  return $x if !defined $scale;			# no-op
  return $x if $x->modify('bround');
  
  if ($x->is_zero() || $scale == 0)
    {
    $x->{_a} = $scale if !defined $x->{_a} || $x->{_a} > $scale; # 3 > 2
    return $x;
    }
  return $x if $x->{sign} !~ /^[+-]$/;		# inf, NaN

  # we have fewer digits than we want to scale to
  my $len = $x->length();
  # convert $scale to a scalar in case it is an object (put's a limit on the
  # number length, but this would already limited by memory constraints), makes
  # it faster
  $scale = $scale->numify() if ref ($scale);

  # scale < 0, but > -len (not >=!)
  if (($scale < 0 && $scale < -$len-1) || ($scale >= $len))
    {
    $x->{_a} = $scale if !defined $x->{_a} || $x->{_a} > $scale; # 3 > 2
    return $x; 
    }
   
  # count of 0's to pad, from left (+) or right (-): 9 - +6 => 3, or |-6| => 6
  my ($pad,$digit_round,$digit_after);
  $pad = $len - $scale;
  $pad = abs($scale-1) if $scale < 0;

  # do not use digit(), it is costly for binary => decimal

  my $xs = $CALC->_str($x->{value});
  my $pl = -$pad-1;

  # pad:   123: 0 => -1, at 1 => -2, at 2 => -3, at 3 => -4
  # pad+1: 123: 0 => 0,  at 1 => -1, at 2 => -2, at 3 => -3
  $digit_round = '0'; $digit_round = substr($$xs,$pl,1) if $pad <= $len;
  $pl++; $pl ++ if $pad >= $len;
  $digit_after = '0'; $digit_after = substr($$xs,$pl,1) if $pad > 0;

  # in case of 01234 we round down, for 6789 up, and only in case 5 we look
  # closer at the remaining digits of the original $x, remember decision
  my $round_up = 1;					# default round up
  $round_up -- if
    ($mode eq 'trunc')				||	# trunc by round down
    ($digit_after =~ /[01234]/)			|| 	# round down anyway,
							# 6789 => round up
    ($digit_after eq '5')			&&	# not 5000...0000
    ($x->_scan_for_nonzero($pad,$xs) == 0)		&&
    (
     ($mode eq 'even') && ($digit_round =~ /[24680]/) ||
     ($mode eq 'odd')  && ($digit_round =~ /[13579]/) ||
     ($mode eq '+inf') && ($x->{sign} eq '-')   ||
     ($mode eq '-inf') && ($x->{sign} eq '+')   ||
     ($mode eq 'zero')		# round down if zero, sign adjusted below
    );
  my $put_back = 0;					# not yet modified
	
  if (($pad > 0) && ($pad <= $len))
    {
    substr($$xs,-$pad,$pad) = '0' x $pad;
    $put_back = 1;
    }
  elsif ($pad > $len)
    {
    $x->bzero();					# round to '0'
    }

  if ($round_up)					# what gave test above?
    {
    $put_back = 1;
    $pad = $len, $$xs = '0' x $pad if $scale < 0;	# tlr: whack 0.51=>1.0	

    # we modify directly the string variant instead of creating a number and
    # adding it, since that is faster (we already have the string)
    my $c = 0; $pad ++;				# for $pad == $len case
    while ($pad <= $len)
      {
      $c = substr($$xs,-$pad,1) + 1; $c = '0' if $c eq '10';
      substr($$xs,-$pad,1) = $c; $pad++;
      last if $c != 0;				# no overflow => early out
      }
    $$xs = '1'.$$xs if $c == 0;

    }
  $x->{value} = $CALC->_new($xs) if $put_back == 1;	# put back in if needed

  $x->{_a} = $scale if $scale >= 0;
  if ($scale < 0)
    {
    $x->{_a} = $len+$scale;
    $x->{_a} = 0 if $scale < -$len;
    }
  $x;
  }

sub bfloor
  {
  # return integer less or equal then number, since it is already integer,
  # always returns $self
  my ($self,$x,@r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_);

  $x->round(@r);
  }

sub bceil
  {
  # return integer greater or equal then number, since it is already integer,
  # always returns $self
  my ($self,$x,@r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_);

  $x->round(@r);
  }

##############################################################################
# private stuff (internal use only)

sub __one
  {
  # internal speedup, set argument to 1, or create a +/- 1
  my $self = shift;
  my $x = $self->bone(); # $x->{value} = $CALC->_one();
  $x->{sign} = shift || '+';
  $x;
  }

sub _swap
  {
  # Overload will swap params if first one is no object ref so that the first
  # one is always an object