[system] / trunk / pg / lib / Value / Real.pm Repository:
ViewVC logotype

View of /trunk/pg/lib/Value/Real.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 6118 - (download) (as text) (annotate)
Thu Oct 1 14:10:02 2009 UTC (10 years, 4 months ago) by dpvc
File size: 5882 byte(s)
Fix error message for powers of negatives

    1 ##########################################################################
    2 #
    3 #  Implements "fuzzy" real numbers (two are equal when they are "close enough")
    4 #
    5 
    6 package Value::Real;
    7 my $pkg = 'Value::Real';
    8 
    9 use strict; no strict "refs";
   10 our @ISA = qw(Value);
   11 
   12 #
   13 #  Check that the input is a real number or a formula
   14 #  or a string that evaluates to a number
   15 #
   16 sub new {
   17   my $self = shift; my $class = ref($self) || $self;
   18   my $context = (Value::isContext($_[0]) ? shift : $self->context);
   19   my $x = shift; $x = [$x,@_] if scalar(@_) > 0;
   20   return $x->inContext($context) if Value::isReal($x);
   21   $x = [$x] unless ref($x) eq 'ARRAY';
   22   Value::Error("Can't convert ARRAY of length %d to %s",scalar(@{$x}),Value::showClass($self))
   23     unless (scalar(@{$x}) == 1);
   24   if (Value::matchNumber($x->[0])) {
   25     return $self->formula($x->[0]) if Value::isFormula($x->[0]);
   26     return (bless {data => $x, context=>$context}, $class);
   27   }
   28   $x = Value::makeValue($x->[0],context=>$context);
   29   return $x if Value::isRealNumber($x);
   30   Value::Error("Can't convert %s to %s",Value::showClass($x),Value::showClass($self));
   31 }
   32 
   33 #
   34 #  Check that result is a number
   35 #
   36 sub make {
   37   my $self = shift;
   38   my $n = (Value::isContext($_[0]) ? $_[1] : $_[0]);
   39   return $self->SUPER::make(@_) unless $n eq "nan";
   40   Value::Error("Result is not a real number");
   41 }
   42 
   43 #
   44 #  Create a new formula from the number
   45 #
   46 sub formula {
   47   my $self = shift; my $value = shift;
   48   my $context = $self->context;
   49   $context->Package("Formula")->new($context,$value);
   50 }
   51 
   52 #
   53 #  Return the real number type
   54 #
   55 sub typeRef {return $Value::Type{number}}
   56 sub length {1}
   57 
   58 #
   59 #  return the real number
   60 #
   61 sub value {(shift)->{data}[0]}
   62 
   63 sub isZero {shift eq "0"}
   64 sub isOne {shift eq "1"}
   65 
   66 sub transferFlags {}
   67 
   68 
   69 ##################################################
   70 #
   71 #  Binary operations
   72 #
   73 
   74 sub add {
   75   my ($self,$l,$r,$other) = Value::checkOpOrderWithPromote(@_);
   76   return $self->inherit($other)->make($l->{data}[0] + $r->{data}[0]);
   77 }
   78 
   79 sub sub {
   80   my ($self,$l,$r,$other) = Value::checkOpOrderWithPromote(@_);
   81   return $self->inherit($other)->make($l->{data}[0] - $r->{data}[0]);
   82 }
   83 
   84 sub mult {
   85   my ($self,$l,$r,$other) = Value::checkOpOrderWithPromote(@_);
   86   return $self->inherit($other)->make($l->{data}[0] * $r->{data}[0]);
   87 }
   88 
   89 sub div {
   90   my ($self,$l,$r,$other) = Value::checkOpOrderWithPromote(@_);
   91   Value::Error("Division by zero") if $r->{data}[0] == 0;
   92   return $self->inherit($other)->make($l->{data}[0] / $r->{data}[0]);
   93 }
   94 
   95 sub power {
   96   my ($self,$l,$r,$other) = Value::checkOpOrderWithPromote(@_);
   97   my $x = $l->{data}[0] ** $r->{data}[0];
   98   return $self->inherit($other)->make($x) unless $x eq 'nan';
   99   Value::Error("Can't raise a negative number to a non-integer power") if ($l->{data}[0] < 0);
  100   Value::Error("Result of exponention is not a number");
  101 }
  102 
  103 sub modulo {
  104   my ($self,$l,$r,$other) = Value::checkOpOrderWithPromote(@_);
  105   $l = $l->{data}[0]; $r = $r->{data}[0];
  106   return $self->inherit($other)->make(0) if $r == 0; # non-fuzzy check
  107   my $m = $l/$r;
  108   my $n = int($m); $n-- if $n > $m; # act as floor() rather than int()
  109   return $self->inherit($other)->make($l - $n*$r);
  110 }
  111 
  112 sub compare {
  113   my ($self,$l,$r) = Value::checkOpOrderWithPromote(@_);
  114   #
  115   #  Handle periodic Reals
  116   #
  117   my $m = $self->getFlag("period");
  118   if (defined $m) {
  119     $l = $l->with(period=>undef);  # make sure tests below don't use period
  120     $r = $r->with(period=>undef);
  121     if ($self->getFlag("logPeriodic")) {
  122       return 1 if $l->value == 0 || $r->value == 0; # non-fuzzy checks
  123       $l = log($l); $r = log($r);
  124     }
  125     $m = $self->promote($m); my $m2 = $m/2;
  126     $m2 = 3*$m/2 if $m2 == -$l; # make sure we don't get zero tolerances accidentally
  127     return $l + (($l-$r+$m2) % $m) <=> $l + $m2; # tolerances appropriate to $l centered in $m
  128   }
  129 
  130   my ($a,$b) = ($l->{data}[0],$r->{data}[0]);
  131   if ($self->getFlag('useFuzzyReals')) {
  132     my $tolerance = $self->getFlag('tolerance');
  133     if ($self->getFlag('tolType') eq 'relative') {
  134       my $zeroLevel = $self->getFlag('zeroLevel');
  135       if (abs($a) < $zeroLevel || abs($b) < $zeroLevel) {
  136   $tolerance = $self->getFlag('zeroLevelTol');
  137       } else {
  138   $tolerance = $tolerance * abs($a);
  139       }
  140     }
  141     return 0 if abs($a-$b) < $tolerance;
  142   }
  143   return $a <=> $b;
  144 }
  145 
  146 ##################################################
  147 #
  148 #   Numeric functions
  149 #
  150 
  151 sub abs  {my $self = shift; $self->make(CORE::abs($self->{data}[0]))}
  152 sub neg  {my $self = shift; $self->make(-($self->{data}[0]))}
  153 sub exp  {my $self = shift; $self->make(CORE::exp($self->{data}[0]))}
  154 sub log  {my $self = shift; $self->make(CORE::log($self->{data}[0]))}
  155 sub sqrt {my $self = shift; $self->make(CORE::sqrt($self->{data}[0]))}
  156 
  157 ##################################################
  158 #
  159 #   Trig functions
  160 #
  161 
  162 sub sin {my $self = shift; $self->make(CORE::sin($self->{data}[0]))}
  163 sub cos {my $self = shift; $self->make(CORE::cos($self->{data}[0]))}
  164 
  165 sub atan2 {
  166   my ($self,$l,$r,$other) = Value::checkOpOrderWithPromote(@_);
  167   return $self->inherit($other)->make(CORE::atan2($l->{data}[0],$r->{data}[0]));
  168 }
  169 
  170 ##################################################
  171 
  172 sub string {
  173   my $self = shift; my $equation = shift; my $prec = shift;
  174   my $n = $self->{data}[0];
  175   my $format = $self->getFlag("format",$equation->{format} ||
  176               ($equation->{context} || $self->context)->{format}{number});
  177   if ($format) {
  178     $n = sprintf($format,$n);
  179     if ($format =~ m/#\s*$/) {$n =~ s/(\.\d*?)0*#$/$1/; $n =~ s/\.$//}
  180   }
  181   $n = uc($n); # force e notation to E
  182   $n = 0 if abs($n) < $self->getFlag('zeroLevelTol');
  183   $n = "(".$n.")" if ($n < 0 || $n =~ m/E/i) && defined($prec) && $prec >= 1;
  184   return $n;
  185 }
  186 
  187 sub TeX {
  188   my $n = (shift)->string(@_);
  189   $n =~ s/E\+?(-?)0*([^)]*)/\\times 10^{$1$2}/i; # convert E notation to x10^(...)
  190   return $n;
  191 }
  192 
  193 
  194 ###########################################################################
  195 
  196 1;

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9