[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 3716 - (download) (as text) (annotate)
Sun Oct 16 03:37:17 2005 UTC (14 years, 1 month ago) by dpvc
File size: 6111 byte(s)
In the past, when Value objects were inserted into strings, they would
automatically include parentheses so that if you had $f equal to 1+x
and $g equal to 1-x, then Formula("$f/$g") would mean (1+x)/(1-x)
rather than 1+(x/1)-x, which is what would happen as a straing string
substitution.

The problem is that this would also happen for real numbers, vectors,
and everything else, even when it wasn't necessary.  So if $x=Real(3),
then "Let x = $x" would be "Let x = (3)".

I have changed the behavior of the string concatenation for Value
objects so that parentheses are only added in a few cases: for
Formulas, Complex numbers, and Unions.  This makes the other Value
objects work more like regular variables in strings, but might cause
some problems with strings that are used as formulas.  For example, if
$a = Real(-3), then "x + 2 $a" will become "x + 2 -3", or "x-1" rather
than the expected "x - 6".  (The old approach would have made it "x +
2 (-3)" which would have worked properly).  For the most part, it is
easier to use something like "x + 2*$a" or even "x" + 2*$a in this
case, so the extra trouble of having to avoid parentheses when you
really meant to substitute the value into a string didn't seem worth
it.

    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 == 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