[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 2908 - (download) (as text) (annotate)
Tue Oct 12 20:46:43 2004 UTC (15 years, 4 months ago) by dpvc
File size: 5695 byte(s)
Report errors for powers of negative numbers rather than return 'nan'.
Don't allow 'nan' to be made into a Real object.

    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;
   10 use vars qw(@ISA);
   11 @ISA = qw(Value);
   12 
   13 use overload
   14        '+'   => \&add,
   15        '-'   => \&sub,
   16        '*'   => \&mult,
   17        '/'   => \&div,
   18        '**'  => \&power,
   19        '.'   => \&Value::_dot,
   20        'x'   => \&Value::cross,
   21        '<=>' => \&compare,
   22        'cmp' => \&Value::cmp,
   23        'neg' => sub {$_[0]->neg},
   24        'abs' => sub {$_[0]->abs},
   25        'sqrt'=> sub {$_[0]->sqrt},
   26        'exp' => sub {$_[0]->exp},
   27        'log' => sub {$_[0]->log},
   28        'sin' => sub {$_[0]->sin},
   29        'cos' => sub {$_[0]->cos},
   30      'atan2' => \&atan2,
   31   'nomethod' => \&Value::nomethod,
   32         '""' => \&Value::stringify;
   33 
   34 #
   35 #  Check that the input is a real number or a formula
   36 #  Make a formula if either part is a formula
   37 #
   38 sub new {
   39   my $self = shift; my $class = ref($self) || $self;
   40   my $x = shift; $x = [$x,@_] if scalar(@_) > 0;
   41   $x = $x->data if ref($x) eq $pkg;
   42   $x = [$x] unless ref($x) eq 'ARRAY';
   43   Value::Error("Can't convert ARRAY of length ".scalar(@{$x})." to a Real Number")
   44     unless (scalar(@{$x}) == 1);
   45   Value::Error("Real Number can't be ".Value::showClass($x->[0]))
   46      unless (Value::isRealNumber($x->[0]));
   47   return $self->formula($x->[0]) if Value::isFormula($x->[0]);
   48   bless {data => $x}, $class;
   49 }
   50 
   51 #
   52 #  Check that result is a number
   53 #
   54 sub make {
   55   my $self = shift;
   56   return $self->SUPER::make(@_) unless $_[0] eq "nan";
   57   Value::Error("Result is not a real number");
   58 }
   59 
   60 #
   61 #  Create a new formula from the number
   62 #
   63 sub formula {
   64   my $self = shift; my $value = shift;
   65   Value::Formula->new($value);
   66 }
   67 
   68 #
   69 #  Return the real number type
   70 #
   71 sub typeRef {return $Value::Type{number}}
   72 
   73 #
   74 #  return the real number
   75 #
   76 sub value {(shift)->{data}[0]}
   77 
   78 sub isZero {shift eq "0"}
   79 sub isOne {shift eq "1"}
   80 
   81 
   82 ##################################################
   83 
   84 #
   85 #  Return a real if it already is one, otherwise make it one
   86 #
   87 sub promote {
   88   my $x = shift;
   89   return $x if (ref($x) eq $pkg && scalar(@_) == 0);
   90   return $pkg->new($x,@_);
   91 }
   92 #
   93 #  Get the data from the promoted item
   94 #
   95 sub promoteData {@{(promote(shift))->data}}
   96 
   97 ##################################################
   98 #
   99 #  Binary operations
  100 #
  101 
  102 sub add {
  103   my ($l,$r,$flag) = @_;
  104   if ($l->promotePrecedence($r)) {return $r->add($l,!$flag)}
  105   $r = promote($r);
  106   return $pkg->make($l->{data}[0] + $r->{data}[0]);
  107 }
  108 
  109 sub sub {
  110   my ($l,$r,$flag) = @_;
  111   if ($l->promotePrecedence($r)) {return $r->sub($l,!$flag)}
  112   $r = promote($r);
  113   if ($flag) {my $tmp = $l; $l = $r; $r = $tmp}
  114   return $pkg->make($l->{data}[0] - $r->{data}[0]);
  115 }
  116 
  117 sub mult {
  118   my ($l,$r,$flag) = @_;
  119   if ($l->promotePrecedence($r)) {return $r->mult($l,!$flag)}
  120   $r = promote($r);
  121   return $pkg->make($l->{data}[0]*$r->{data}[0]);
  122 }
  123 
  124 sub div {
  125   my ($l,$r,$flag) = @_;
  126   if ($l->promotePrecedence($r)) {return $r->div($l,!$flag)}
  127   $r = promote($r);
  128   if ($flag) {my $tmp = $l; $l = $r; $r = $tmp}
  129   Value::Error("Division by zero") if $r == 0;
  130   return $pkg->make($l->{data}[0]/$r->{data}[0]);
  131 }
  132 
  133 sub power {
  134   my ($l,$r,$flag) = @_;
  135   if ($l->promotePrecedence($r)) {return $r->power($l,!$flag)}
  136   $r = promote($r);
  137   if ($flag) {my $tmp = $l; $l = $r; $r = $tmp}
  138   my $x = $l->{data}[0]**$r->{data}[0];
  139   return $pkg->make($x) unless $x eq 'nan';
  140   Value::Error("Can't raise a negative number to a power") if ($l->{data}[0] < 0);
  141   Value::Error("result of exponention is not a number");
  142 }
  143 
  144 sub compare {
  145   my ($l,$r,$flag) = @_;
  146   if ($l->promotePrecedence($r)) {return $r->compare($l,!$flag)}
  147   $r = promote($r);
  148   if ($flag) {my $tmp = $l; $l = $r; $r = $tmp}
  149   my ($a,$b) = ($l->{data}[0],$r->{data}[0]);
  150   if ($$Value::context->{flags}{useFuzzyReals}) {
  151     my $tolerance = $$Value::context->flag('tolerance');
  152     if ($$Value::context->flag('tolType') eq 'relative') {
  153       my $zeroLevel = $$Value::context->flag('zeroLevel');
  154       if (abs($a) < $zeroLevel || abs($b) < $zeroLevel) {
  155   $tolerance = $$Value::context->flag('zeroLevelTol');
  156       } else {
  157   $tolerance = $tolerance * abs($a);
  158       }
  159     }
  160     return 0 if abs($a-$b) < $tolerance;
  161   }
  162   return $a <=> $b;
  163 }
  164 
  165 ##################################################
  166 #
  167 #   Numeric functions
  168 #
  169 
  170 sub abs {$pkg->make(CORE::abs(shift->{data}[0]))}
  171 sub neg {$pkg->make(-(shift->{data}[0]))}
  172 sub exp {$pkg->make(CORE::exp(shift->{data}[0]))}
  173 sub log {$pkg->make(CORE::log(shift->{data}[0]))}
  174 
  175 sub sqrt {
  176   my $self = shift;
  177   return $pkg->make(0) if $self == 0;
  178   return $pkg->make(CORE::sqrt($self->{data}[0]));
  179 }
  180 
  181 ##################################################
  182 #
  183 #   Trig functions
  184 #
  185 
  186 sub sin {$pkg->make(CORE::sin(shift->{data}[0]))}
  187 sub cos {$pkg->make(CORE::cos(shift->{data}[0]))}
  188 
  189 sub atan2 {
  190   my ($l,$r,$flag) = @_;
  191   if ($flag) {my $tmp = $l; $l = $r; $r = $l}
  192   return $pkg->make(CORE::atan2($l->{data}[0],$r->{data}[0]));
  193 }
  194 
  195 ##################################################
  196 
  197 sub string {
  198   my $self = shift; my $equation = shift; my $prec = shift;
  199   my $n = $self->{data}[0];
  200   my $format = ($equation->{context} || $$Value::context)->{format}{number};
  201   $n = sprintf($format,$n) if $format; #  use the specified precision, if any
  202   $n = uc($n); # force e notation to E
  203   $n = 0 if $self == 0; # make near zero print as zero
  204   $n = "(".$n.")" if ($n < 0 || $n =~ m/E/i) && defined($prec) && $prec >= 1;
  205   return $n;
  206 }
  207 
  208 sub TeX {
  209   my $n = (shift)->string(@_);
  210   $n =~ s/E\+?(-?)0*([^)]*)/\\times 10^{$1$2}/i; # convert E notation to x10^(...)
  211   return $n;
  212 }
  213 
  214 
  215 ###########################################################################
  216 
  217 1;
  218 

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9