[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 3992 - (download) (as text) (annotate)
Mon Jan 30 16:20:09 2006 UTC (13 years, 10 months ago) by dpvc
File size: 6122 byte(s)
When checking for division by zero, don't do fuzzy check.

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

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9