bigrat.pm

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

  # n ** -x => 1/n ** x
  ($x->{_d},$x->{_n}) = ($x->{_n},$x->{_d}) if $y->{sign} eq '-'; 
  $x->bnorm()->round(@r);
  }

sub blog
  {
  # 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,$class,@_);
    }

  # blog(1,Y) => 0
  return $x->bzero() if $x->is_one() && $y->{sign} eq '+';

  # $x <= 0 => NaN
  return $x->bnan() if $x->is_zero() || $x->{sign} ne '+' || $y->{sign} ne '+';

  if ($x->is_int() && $y->is_int())
    {
    return $self->new($x->as_number()->blog($y->as_number(),@r));
    }

  # do it with floats
  $x->_new_from_float( $x->_as_float()->blog(Math::BigFloat->new("$y"),@r) );
  }

sub bexp
  {
  # 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,$class,@_);
    }

  return $x->binf() if $x->{sign} eq '+inf';
  return $x->bzero() if $x->{sign} eq '-inf';

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

  # also takes care of the "error in _find_round_parameters?" case
  return $x if $x->{sign} eq 'NaN';

  # 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
    $params[1] = undef;                 # P = undef
    $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's not enough...
    $scale = abs($params[0] || $params[1]) + 4; # take whatever is defined
    }

  return $x->bone(@params) if $x->is_zero();

  # See the comments in Math::BigFloat on how this algorithm works.
  # Basically we calculate A and B (where B is faculty(N)) so that A/B = e

  my $x_org = $x->copy();
  if ($scale <= 75)
    {
    # set $x directly from a cached string form
    $x->{_n} = $MBI->_new("90933395208605785401971970164779391644753259799242");
    $x->{_d} = $MBI->_new("33452526613163807108170062053440751665152000000000");
    $x->{sign} = '+';
    }
  else
    {
    # compute A and B so that e = A / B.

    # After some terms we end up with this, so we use it as a starting point:
    my $A = $MBI->_new("90933395208605785401971970164779391644753259799242");
    my $F = $MBI->_new(42); my $step = 42;

    # Compute how many steps we need to take to get $A and $B sufficiently big
    my $steps = Math::BigFloat::_len_to_steps($scale - 4);
#    print STDERR "# Doing $steps steps for ", $scale-4, " digits\n";
    while ($step++ <= $steps)
      {
      # calculate $a * $f + 1
      $A = $MBI->_mul($A, $F);
      $A = $MBI->_inc($A);
      # increment f
      $F = $MBI->_inc($F);
      }
    # compute $B as factorial of $steps (this is faster than doing it manually)
    my $B = $MBI->_fac($MBI->_new($steps));

#  print "A ", $MBI->_str($A), "\nB ", $MBI->_str($B), "\n";

    $x->{_n} = $A;
    $x->{_d} = $B;
    $x->{sign} = '+';
    }

  # $x contains now an estimate of e, with some surplus digits, so we can round
  if (!$x_org->is_one())
    {
    # raise $x to the wanted power and round it in one step:
    $x->bpow($x_org, @params);
    }
  else
    {
    # else just round the already computed result
    delete $x->{_a}; delete $x->{_p};
    # 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};
    }

  $x;
  }

sub bnok
  {
  # 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,$class,@_);
    }

  # do it with floats
  $x->_new_from_float( $x->_as_float()->bnok(Math::BigFloat->new("$y"),@r) );
  }

sub _float_from_part
  {
  my $x = shift;

  my $f = Math::BigFloat->bzero();
  $f->{_m} = $MBI->_copy($x);
  $f->{_e} = $MBI->_zero();

  $f;
  }

sub _as_float
  {
  my $x = shift;

  local $Math::BigFloat::upgrade = undef;
  local $Math::BigFloat::accuracy = undef;
  local $Math::BigFloat::precision = undef;
  # 22/7 => 3.142857143..

  my $a = $x->accuracy() || 0;
  if ($a != 0 || !$MBI->_is_one($x->{_d}))
    {
    # n/d
    return Math::BigFloat->new($x->{sign} . $MBI->_str($x->{_n}))->bdiv( $MBI->_str($x->{_d}), $x->accuracy());
    }
  # just n
  Math::BigFloat->new($x->{sign} . $MBI->_str($x->{_n}));
  }

sub broot
  {
  # 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,@_);
    }

  if ($x->is_int() && $y->is_int())
    {
    return $self->new($x->as_number()->broot($y->as_number(),@r));
    }

  # do it with floats
  $x->_new_from_float( $x->_as_float()->broot($y,@r) );
  }

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

  # $x or $y or $m are NaN or +-inf => NaN
  return $x->bnan()
   if $x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]$/ ||
   $m->{sign} !~ /^[+-]$/;

  if ($x->is_int() && $y->is_int() && $m->is_int())
    {
    return $self->new($x->as_number()->bmodpow($y->as_number(),$m,@r));
    }

  warn ("bmodpow() not fully implemented");
  $x->bnan();
  }

sub bmodinv
  {
  # 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,@_);
    }

  # $x or $y are NaN or +-inf => NaN
  return $x->bnan() 
   if $x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]$/;

  if ($x->is_int() && $y->is_int())
    {
    return $self->new($x->as_number()->bmodinv($y->as_number(),@r));
    }

  warn ("bmodinv() not fully implemented");
  $x->bnan();
  }

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

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

  local $Math::BigFloat::upgrade = undef;
  local $Math::BigFloat::downgrade = undef;
  local $Math::BigFloat::precision = undef;
  local $Math::BigFloat::accuracy = undef;
  local $Math::BigInt::upgrade = undef;
  local $Math::BigInt::precision = undef;
  local $Math::BigInt::accuracy = undef;

  $x->{_n} = _float_from_part( $x->{_n} )->bsqrt();
  $x->{_d} = _float_from_part( $x->{_d} )->bsqrt();

  # XXX TODO: we probably can optimze this:

  # if sqrt(D) was not integer
  if ($x->{_d}->{_es} ne '+')
    {
    $x->{_n}->blsft($x->{_d}->exponent()->babs(),10);	# 7.1/4.51 => 7.1/45.1
    $x->{_d} = $MBI->_copy( $x->{_d}->{_m} );		# 7.1/45.1 => 71/45.1
    }
  # if sqrt(N) was not integer
  if ($x->{_n}->{_es} ne '+')
    {
    $x->{_d}->blsft($x->{_n}->exponent()->babs(),10);	# 71/45.1 => 710/45.1
    $x->{_n} = $MBI->_copy( $x->{_n}->{_m} );		# 710/45.1 => 710/451
    }

  # convert parts to $MBI again 
  $x->{_n} = $MBI->_lsft( $MBI->_copy( $x->{_n}->{_m} ), $x->{_n}->{_e}, 10)
    if ref($x->{_n}) ne $MBI && ref($x->{_n}) ne 'ARRAY';
  $x->{_d} = $MBI->_lsft( $MBI->_copy( $x->{_d}->{_m} ), $x->{_d}->{_e}, 10)
    if ref($x->{_d}) ne $MBI && ref($x->{_d}) ne 'ARRAY';

  $x->bnorm()->round(@r);
  }

sub blsft
  {
  my ($self,$x,$y,$b,@r) = objectify(3,@_);
 
  $b = 2 unless defined $b;
  $b = $self->new($b) unless ref ($b);
  $x->bmul( $b->copy()->bpow($y), @r);
  $x;
  }

sub brsft
  {
  my ($self,$x,$y,$b,@r) = objectify(3,@_);

  $b = 2 unless defined $b;
  $b = $self->new($b) unless ref ($b);
  $x->bdiv( $b->copy()->bpow($y), @r);
  $x;
  }

##############################################################################
# round

sub round
  {
  $_[0];
  }

sub bround
  {
  $_[0];
  }

sub bfround
  {
  $_[0];
  }

##############################################################################
# comparing

sub bcmp
  {
  # compare two signed numbers 
  
  # set up parameters
  my ($self,$x,$y) = (ref($_[0]),@_);
  # objectify is costly, so avoid it
  if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
    {
    ($self,$x,$y) = objectify(2,@_);
    }

  if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/))
    {
    # handle +-inf and NaN
    return undef if (($x->{sign} eq $nan) || ($y->{sign} eq $nan));
    return 0 if $x->{sign} eq $y->{sign} && $x->{sign} =~ /^[+-]inf$/;
    return +1 if $x->{sign} eq '+inf';
    return -1 if $x->{sign} eq '-inf';
    return -1 if $y->{sign} eq '+inf';
    return +1;
    }
  # check sign for speed first
  return 1 if $x->{sign} eq '+' && $y->{sign} eq '-';   # does also 0 <=> -y
  return -1 if $x->{sign} eq '-' && $y->{sign} eq '+';  # does also -x <=> 0

  # shortcut
  my $xz = $MBI->_is_zero($x->{_n});
  my $yz = $MBI->_is_zero($y->{_n});
  return 0 if $xz && $yz;                               # 0 <=> 0
  return -1 if $xz && $y->{sign} eq '+';                # 0 <=> +y
  return 1 if $yz && $x->{sign} eq '+';                 # +x <=> 0
 
  my $t = $MBI->_mul( $MBI->_copy($x->{_n}), $y->{_d});
  my $u = $MBI->_mul( $MBI->_copy($y->{_n}), $x->{_d});

  my $cmp = $MBI->_acmp($t,$u);				# signs are equal
  $cmp = -$cmp if $x->{sign} eq '-';			# both are '-' => reverse
  $cmp;
  }

sub bacmp
  {
  # compare two numbers (as unsigned)
 
  # set up parameters
  my ($self,$x,$y) = (ref($_[0]),@_);
  # objectify is costly, so avoid it
  if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
    {
    ($self,$x,$y) = objectify(2,$class,@_);
    }

  if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/))
    {
    # handle +-inf and NaN
    return undef if (($x->{sign} eq $nan) || ($y->{sign} eq $nan));
    return 0 if $x->{sign} =~ /^[+-]inf$/ && $y->{sign} =~ /^[+-]inf$/;
    return 1 if $x->{sign} =~ /^[+-]inf$/ && $y->{sign} !~ /^[+-]inf$/;
    return -1;
    }

  my $t = $MBI->_mul( $MBI->_copy($x->{_n}), $y->{_d});
  my $u = $MBI->_mul( $MBI->_copy($y->{_n}), $x->{_d});
  $MBI->_acmp($t,$u);					# ignore signs
  }

##############################################################################
# output conversation

sub numify
  {
  # convert 17/8 => float (aka 2.125)
  my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
 
  return $x->bstr() if $x->{sign} !~ /^[+-]$/;	# inf, NaN, etc

  # N/1 => N
  my $neg = ''; $neg = '-' if $x->{sign} eq '-';
  return $neg . $MBI->_num($x->{_n}) if $MBI->_is_one($x->{_d});

  $x->_as_float()->numify() + 0.0;
  }

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

  # NaN, inf etc
  return Math::BigInt->new($x->{sign}) if $x->{sign} !~ /^[+-]$/;
 
  my $u = Math::BigInt->bzero();
  $u->{sign} = $x->{sign};
  $u->{value} = $MBI->_div( $MBI->_copy($x->{_n}), $x->{_d});	# 22/7 => 3
  $u;
  }

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

  return $x unless $x->is_int();

  my $s = $x->{sign}; $s = '' if $s eq '+';
  $s . $MBI->_as_bin($x->{_n});
  }

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

  return $x unless $x->is_int();

  my $s = $x->{sign}; $s = '' if $s eq '+';
  $s . $MBI->_as_hex($x->{_n});
  }

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

  return $x unless $x->is_int();

  my $s = $x->{sign}; $s = '' if $s eq '+';
  $s . $MBI->_as_oct($x->{_n});
  }

##############################################################################

sub from_hex
  {
  my $class = shift;

  $class->new(@_);
  }

sub from_bin
  {
  my $class = shift;

  $class->new(@_);
  }

sub from_oct
  {
  my $class = shift;

  my @parts;
  for my $c (@_)
    {
    push @parts, Math::BigInt->from_oct($c);
    }
  $class->new ( @parts );
  }

##############################################################################
# import

sub import