bigfloat.pm

视频监控网络部分的协议ddns,的模块的实现代码,请大家大胆指正.

      $rem = $x->copy();
      }

    $x->{sign} = $x->{sign} ne $y->sign() ? '-' : '+'; 

    # check for / +-1 ( +/- 1E0)
    if ($y_not_one)
      {
      # promote BigInts and it's subclasses (except when already a BigFloat)
      $y = $self->new($y) unless $y->isa('Math::BigFloat'); 

      # calculate the result to $scale digits and then round it
      # a * 10 ** b / c * 10 ** d => a/c * 10 ** (b-d)
      $MBI->_lsft($x->{_m},$MBI->_new($scale),10);
      $MBI->_div ($x->{_m},$y->{_m});	# a/c

      # correct exponent of $x
      ($x->{_e},$x->{_es}) = _e_sub($x->{_e}, $y->{_e}, $x->{_es}, $y->{_es});
      # correct for 10**scale
      ($x->{_e},$x->{_es}) = _e_sub($x->{_e}, $MBI->_new($scale), $x->{_es}, '+');
      $x->bnorm();		# remove trailing 0's
      }
    } # ende else $x != $y

  # shortcut to not run through _find_round_parameters again
  if (defined $params[0])
    {
    delete $x->{_a}; 				# clear before round
    $x->bround($params[0],$params[2]);		# then round accordingly
    }
  else
    {
    delete $x->{_p}; 				# clear before round
    $x->bfround($params[1],$params[2]);		# then round accordingly
    }
  if ($fallback)
    {
    # clear a/p after round, since user did not request it
    delete $x->{_a}; delete $x->{_p};
    }

  if (wantarray)
    {
    if ($y_not_one)
      {
      $rem->bmod($y,@params);			# copy already done
      }
    if ($fallback)
      {
      # clear a/p after round, since user did not request it
      delete $rem->{_a}; delete $rem->{_p};
      }
    return ($x,$rem);
    }
  $x;
  }

sub bmod 
  {
  # (dividend: BFLOAT or num_str, divisor: BFLOAT or num_str) return reminder 

  # set up parameters
  my ($self,$x,$y,$a,$p,$r) = (ref($_[0]),@_);
  # objectify is costly, so avoid it
  if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
    {
    ($self,$x,$y,$a,$p,$r) = objectify(2,@_);
    }

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

  # handle NaN, inf, -inf
  if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/))
    {
    my ($d,$re) = $self->SUPER::_div_inf($x,$y);
    $x->{sign} = $re->{sign};
    $x->{_e} = $re->{_e};
    $x->{_m} = $re->{_m};
    return $x->round($a,$p,$r,$y);
    } 
  if ($y->is_zero())
    {
    return $x->bnan() if $x->is_zero();
    return $x;
    }

  return $x->bzero() if $x->is_zero()
 || ($x->is_int() &&
  # check that $y == +1 or $y == -1:
    ($MBI->_is_zero($y->{_e}) && $MBI->_is_one($y->{_m})));

  my $cmp = $x->bacmp($y);			# equal or $x < $y?
  return $x->bzero($a,$p) if $cmp == 0;		# $x == $y => result 0

  # only $y of the operands negative? 
  my $neg = 0; $neg = 1 if $x->{sign} ne $y->{sign};

  $x->{sign} = $y->{sign};				# calc sign first
  return $x->round($a,$p,$r) if $cmp < 0 && $neg == 0;	# $x < $y => result $x
  
  my $ym = $MBI->_copy($y->{_m});
  
  # 2e1 => 20
  $MBI->_lsft( $ym, $y->{_e}, 10) 
   if $y->{_es} eq '+' && !$MBI->_is_zero($y->{_e});
 
  # if $y has digits after dot
  my $shifty = 0;			# correct _e of $x by this
  if ($y->{_es} eq '-')			# has digits after dot
    {
    # 123 % 2.5 => 1230 % 25 => 5 => 0.5
    $shifty = $MBI->_num($y->{_e}); 	# no more digits after dot
    $MBI->_lsft($x->{_m}, $y->{_e}, 10);# 123 => 1230, $y->{_m} is already 25
    }
  # $ym is now mantissa of $y based on exponent 0

  my $shiftx = 0;			# correct _e of $x by this
  if ($x->{_es} eq '-')			# has digits after dot
    {
    # 123.4 % 20 => 1234 % 200
    $shiftx = $MBI->_num($x->{_e});	# no more digits after dot
    $MBI->_lsft($ym, $x->{_e}, 10);	# 123 => 1230
    }
  # 123e1 % 20 => 1230 % 20
  if ($x->{_es} eq '+' && !$MBI->_is_zero($x->{_e}))
    {
    $MBI->_lsft( $x->{_m}, $x->{_e},10);	# es => '+' here
    }

  $x->{_e} = $MBI->_new($shiftx);
  $x->{_es} = '+'; 
  $x->{_es} = '-' if $shiftx != 0 || $shifty != 0;
  $MBI->_add( $x->{_e}, $MBI->_new($shifty)) if $shifty != 0;
  
  # now mantissas are equalized, exponent of $x is adjusted, so calc result

  $x->{_m} = $MBI->_mod( $x->{_m}, $ym);

  $x->{sign} = '+' if $MBI->_is_zero($x->{_m});		# fix sign for -0
  $x->bnorm();

  if ($neg != 0)	# one of them negative => correct in place
    {
    my $r = $y - $x;
    $x->{_m} = $r->{_m};
    $x->{_e} = $r->{_e};
    $x->{_es} = $r->{_es};
    $x->{sign} = '+' if $MBI->_is_zero($x->{_m});	# fix sign for -0
    $x->bnorm();
    }

  $x->round($a,$p,$r,$y);	# round and return
  }

sub broot
  {
  # calculate $y'th root of $x
  
  # set up parameters
  my ($self,$x,$y,$a,$p,$r) = (ref($_[0]),@_);
  # objectify is costly, so avoid it
  if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
    {
    ($self,$x,$y,$a,$p,$r) = objectify(2,@_);
    }

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

  # NaN handling: $x ** 1/0, x or y NaN, or y inf/-inf or y == 0
  return $x->bnan() if $x->{sign} !~ /^\+/ || $y->is_zero() ||
         $y->{sign} !~ /^\+$/;

  return $x if $x->is_zero() || $x->is_one() || $x->is_inf() || $y->is_one();
  
  # we need to limit the accuracy to protect against overflow
  my $fallback = 0;
  my (@params,$scale);
  ($x,@params) = $x->_find_round_parameters($a,$p,$r);

  return $x if $x->is_nan();		# error in _find_round_parameters?

  # no rounding at all, so must use fallback
  if (scalar @params == 0) 
    {
    # simulate old behaviour
    $params[0] = $self->div_scale();	# and round to it as accuracy
    $scale = $params[0]+4; 		# at least four more for proper round
    $params[2] = $r;			# iound mode by caller or undef
    $fallback = 1;			# to clear a/p afterwards
    }
  else
    {
    # the 4 below is empirical, and there might be cases where it is not
    # enough...
    $scale = abs($params[0] || $params[1]) + 4; # take whatever is defined
    }

  # when user set globals, they would interfere with our calculation, so
  # disable them and later re-enable them
  no strict 'refs';
  my $abr = "$self\::accuracy"; my $ab = $$abr; $$abr = undef;
  my $pbr = "$self\::precision"; my $pb = $$pbr; $$pbr = undef;
  # we also need to disable any set A or P on $x (_find_round_parameters took
  # them already into account), since these would interfere, too
  delete $x->{_a}; delete $x->{_p};
  # need to disable $upgrade in BigInt, to avoid deep recursion
  local $Math::BigInt::upgrade = undef;	# should be really parent class vs MBI

  # remember sign and make $x positive, since -4 ** (1/2) => -2
  my $sign = 0; $sign = 1 if $x->{sign} eq '-'; $x->{sign} = '+';

  my $is_two = 0;
  if ($y->isa('Math::BigFloat'))
    {
    $is_two = ($y->{sign} eq '+' && $MBI->_is_two($y->{_m}) && $MBI->_is_zero($y->{_e}));
    }
  else
    {
    $is_two = ($y == 2);
    }

  # normal square root if $y == 2:
  if ($is_two)
    {
    $x->bsqrt($scale+4);
    }
  elsif ($y->is_one('-'))
    {
    # $x ** -1 => 1/$x
    my $u = $self->bone()->bdiv($x,$scale);
    # copy private parts over
    $x->{_m} = $u->{_m};
    $x->{_e} = $u->{_e};
    $x->{_es} = $u->{_es};
    }
  else
    {
    # calculate the broot() as integer result first, and if it fits, return
    # it rightaway (but only if $x and $y are integer):

    my $done = 0;				# not yet
    if ($y->is_int() && $x->is_int())
      {
      my $i = $MBI->_copy( $x->{_m} );
      $MBI->_lsft( $i, $x->{_e}, 10 ) unless $MBI->_is_zero($x->{_e});
      my $int = Math::BigInt->bzero();
      $int->{value} = $i;
      $int->broot($y->as_number());
      # if ($exact)
      if ($int->copy()->bpow($y) == $x)
        {
        # found result, return it
        $x->{_m} = $int->{value};
        $x->{_e} = $MBI->_zero();
        $x->{_es} = '+';
        $x->bnorm();
        $done = 1;
        }
      }
    if ($done == 0)
      {
      my $u = $self->bone()->bdiv($y,$scale+4);
      delete $u->{_a}; delete $u->{_p};         # otherwise it conflicts
      $x->bpow($u,$scale+4);                    # el cheapo
      }
    }
  $x->bneg() if $sign == 1;
  
  # shortcut to not run through _find_round_parameters again
  if (defined $params[0])
    {
    $x->bround($params[0],$params[2]);		# then round accordingly
    }
  else
    {
    $x->bfround($params[1],$params[2]);		# then round accordingly
    }
  if ($fallback)
    {
    # clear a/p after round, since user did not request it
    delete $x->{_a}; delete $x->{_p};
    }
  # restore globals
  $$abr = $ab; $$pbr = $pb;
  $x;
  }

sub bsqrt
  { 
  # calculate square root
  my ($self,$x,$a,$p,$r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_);

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

  return $x->bnan() if $x->{sign} !~ /^[+]/;	# NaN, -inf or < 0
  return $x if $x->{sign} eq '+inf';		# sqrt(inf) == inf
  return $x->round($a,$p,$r) if $x->is_zero() || $x->is_one();

  # we need to limit the accuracy to protect against overflow
  my $fallback = 0;
  my (@params,$scale);
  ($x,@params) = $x->_find_round_parameters($a,$p,$r);

  return $x if $x->is_nan();		# error in _find_round_parameters?

  # no rounding at all, so must use fallback
  if (scalar @params == 0) 
    {
    # simulate old behaviour
    $params[0] = $self->div_scale();	# and round to it as accuracy
    $scale = $params[0]+4; 		# at least four more for proper round
    $params[2] = $r;			# round mode by caller or undef
    $fallback = 1;			# to clear a/p afterwards
    }
  else
    {
    # the 4 below is empirical, and there might be cases where it is not
    # enough...
    $scale = abs($params[0] || $params[1]) + 4; # take whatever is defined
    }

  # when user set globals, they would interfere with our calculation, so
  # disable them and later re-enable them
  no strict 'refs';
  my $abr = "$self\::accuracy"; my $ab = $$abr; $$abr = undef;
  my $pbr = "$self\::precision"; my $pb = $$pbr; $$pbr = undef;
  # we also need to disable any set A or P on $x (_find_round_parameters took
  # them already into account), since these would interfere, too
  delete $x->{_a}; delete $x->{_p};
  # need to disable $upgrade in BigInt, to avoid deep recursion
  local $Math::BigInt::upgrade = undef;	# should be really parent class vs MBI

  my $i = $MBI->_copy( $x->{_m} );
  $MBI->_lsft( $i, $x->{_e}, 10 ) unless $MBI->_is_zero($x->{_e});
  my $xas = Math::BigInt->bzero();
  $xas->{value} = $i;

  my $gs = $xas->copy()->bsqrt();	# some guess

  if (($x->{_es} ne '-')		# guess can't be accurate if there are
					# digits after the dot
   && ($xas->bacmp($gs * $gs) == 0))	# guess hit the nail on the head?
    {
    # exact result, copy result over to keep $x
    $x->{_m} = $gs->{value}; $x->{_e} = $MBI->_zero(); $x->{_es} = '+';
    $x->bnorm();
    # shortcut to not run through _find_round_parameters again
    if (defined $params[0])
      {
      $x->bround($params[0],$params[2]);	# then round accordingly
      }
    else
      {
      $x->bfround($params[1],$params[2]);	# then round accordingly
      }
    if ($fallback)
      {
      # clear a/p after round, since user did not request it
      delete $x->{_a}; delete $x->{_p};
      }
    # re-enable A and P, upgrade is taken care of by "local"
    ${"$self\::accuracy"} = $ab; ${"$self\::precision"} = $pb;
    return $x;
    }
 
  # sqrt(2) = 1.4 because sqrt(2*100) = 1.4*10; so we can increase the accuracy
  # of the result by multipyling the input by 100 and then divide the integer
  # result of sqrt(input) by 10. Rounding afterwards returns the real result.

  # The following steps will transform 123.456 (in $x) into 123456 (in $y1)
  my $y1 = $MBI->_copy($x->{_m});

  my $length = $MBI->_len($y1);
  
  # Now calculate how many digits the result of sqrt(y1) would have
  my $digits = int($length / 2);

  # But we need at least $scale digits, so calculate how many are missing
  my $shift = $scale - $digits;

  # That should never happen (we take care of integer guesses above)
  # $shift = 0 if $shift < 0; 

  # Multiply in steps of 100, by shifting left two times the "missing" digits
  my $s2 = $shift * 2;

  # We now make sure that $y1 has the same odd or even number of digits than
  # $x had. So when _e of $x is odd, we must shift $y1 by one digit left,
  # because we always must multiply by steps of 100 (sqrt(100) is 10) and not
  # steps of 10. The length of $x does not count, since an even or odd number
  # of digits before the dot is not changed by adding an even number of digits
  # after the dot (the result is still odd or even digits long).
  $s2++ if $MBI->_is_odd($x->{_e});

  $MBI->_lsft( $y1, $MBI->_new($s2), 10);

  # now take the square root and truncate to integer
  $y1 = $MBI->_sqrt($y1);

  # By "shifting" $y1 right (by creating a negative _e) we calculate the final
  # result, which is than later rounded to the desired scale.

  # calculate how many zeros $x had after the '.' (or before it, depending
  # on sign of $dat, the result should have half as many:
  my $dat = $MBI->_num($x->{_e});
  $dat = -$dat if $x->{_es} eq '-';
  $dat += $length;

  if ($dat > 0)
    {
    # no zeros after the dot (e.g. 1.23, 0.49 etc)
    # preserve half as many digits before the dot than the input had 
    # (but round this "up")
    $dat = int(($dat+1)/2);
    }
  else
    {
    $dat = int(($dat)/2);
    }
  $dat -= $MBI->_len($y1);
  if ($dat < 0)
    {
    $dat = abs($dat);
    $x->{_e} = $MBI->_new( $dat );
    $x->{_es} = '-';
    }
  else
    {    
    $x->{_e} = $MBI->_new( $dat );
    $x->{_es} = '+';
    }
  $x->{_m} = $y1;
  $x->bnorm();

  # shortcut to not run through _find_round_parameters again
  if (defined $params[0])
    {
    $x->bround($params[0],$params[2]);		# then round according