[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 3171 - (download) (as text) (annotate)
Tue Feb 15 21:53:23 2005 UTC (15 years ago) by dpvc
File size: 5805 byte(s)
Improved the Real(), Complex(), Point(), Vector(), Matrix() and
String() constructors so that they will process formulas passed to
them as strings rather than requiring perl objects for these.

For example, you can use Real("2/3") rather than Real(2/3) if you
want.  Also, Real("1+x") will return a formula returning a real
(essentially the same as Formula("1+x") in this case).

    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 #  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 ".scalar(@{$x})." to ".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 ".Value::showClass($x)." to ".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 
   76 #
   77 #  return the real number
   78 #
   79 sub value {(shift)->{data}[0]}
   80 
   81 sub isZero {shift eq "0"}
   82 sub isOne {shift eq "1"}
   83 
   84 
   85 ##################################################
   86 
   87 #
   88 #  Return a real if it already is one, otherwise make it one
   89 #
   90 sub promote {
   91   my $x = shift;
   92   return $x if (ref($x) eq $pkg && scalar(@_) == 0);
   93   return $pkg->new($x,@_);
   94 }
   95 #
   96 #  Get the data from the promoted item
   97 #
   98 sub promoteData {@{(promote(shift))->data}}
   99 
  100 ##################################################
  101 #
  102 #  Binary operations
  103 #
  104 
  105 sub add {
  106   my ($l,$r,$flag) = @_;
  107   if ($l->promotePrecedence($r)) {return $r->add($l,!$flag)}
  108   $r = promote($r);
  109   return $pkg->make($l->{data}[0] + $r->{data}[0]);
  110 }
  111 
  112 sub sub {
  113   my ($l,$r,$flag) = @_;
  114   if ($l->promotePrecedence($r)) {return $r->sub($l,!$flag)}
  115   $r = promote($r);
  116   if ($flag) {my $tmp = $l; $l = $r; $r = $tmp}
  117   return $pkg->make($l->{data}[0] - $r->{data}[0]);
  118 }
  119 
  120 sub mult {
  121   my ($l,$r,$flag) = @_;
  122   if ($l->promotePrecedence($r)) {return $r->mult($l,!$flag)}
  123   $r = promote($r);
  124   return $pkg->make($l->{data}[0]*$r->{data}[0]);
  125 }
  126 
  127 sub div {
  128   my ($l,$r,$flag) = @_;
  129   if ($l->promotePrecedence($r)) {return $r->div($l,!$flag)}
  130   $r = promote($r);
  131   if ($flag) {my $tmp = $l; $l = $r; $r = $tmp}
  132   Value::Error("Division by zero") if $r == 0;
  133   return $pkg->make($l->{data}[0]/$r->{data}[0]);
  134 }
  135 
  136 sub power {
  137   my ($l,$r,$flag) = @_;
  138   if ($l->promotePrecedence($r)) {return $r->power($l,!$flag)}
  139   $r = promote($r);
  140   if ($flag) {my $tmp = $l; $l = $r; $r = $tmp}
  141   my $x = $l->{data}[0]**$r->{data}[0];
  142   return $pkg->make($x) unless $x eq 'nan';
  143   Value::Error("Can't raise a negative number to a power") if ($l->{data}[0] < 0);
  144   Value::Error("result of exponention is not a number");
  145 }
  146 
  147 sub compare {
  148   my ($l,$r,$flag) = @_;
  149   if ($l->promotePrecedence($r)) {return $r->compare($l,!$flag)}
  150   $r = promote($r);
  151   if ($flag) {my $tmp = $l; $l = $r; $r = $tmp}
  152   my ($a,$b) = ($l->{data}[0],$r->{data}[0]);
  153   if ($$Value::context->{flags}{useFuzzyReals}) {
  154     my $tolerance = $$Value::context->flag('tolerance');
  155     if ($$Value::context->flag('tolType') eq 'relative') {
  156       my $zeroLevel = $$Value::context->flag('zeroLevel');
  157       if (abs($a) < $zeroLevel || abs($b) < $zeroLevel) {
  158   $tolerance = $$Value::context->flag('zeroLevelTol');
  159       } else {
  160   $tolerance = $tolerance * abs($a);
  161       }
  162     }
  163     return 0 if abs($a-$b) < $tolerance;
  164   }
  165   return $a <=> $b;
  166 }
  167 
  168 ##################################################
  169 #
  170 #   Numeric functions
  171 #
  172 
  173 sub abs {$pkg->make(CORE::abs(shift->{data}[0]))}
  174 sub neg {$pkg->make(-(shift->{data}[0]))}
  175 sub exp {$pkg->make(CORE::exp(shift->{data}[0]))}
  176 sub log {$pkg->make(CORE::log(shift->{data}[0]))}
  177 
  178 sub sqrt {
  179   my $self = shift;
  180   return $pkg->make(0) if $self == 0;
  181   return $pkg->make(CORE::sqrt($self->{data}[0]));
  182 }
  183 
  184 ##################################################
  185 #
  186 #   Trig functions
  187 #
  188 
  189 sub sin {$pkg->make(CORE::sin(shift->{data}[0]))}
  190 sub cos {$pkg->make(CORE::cos(shift->{data}[0]))}
  191 
  192 sub atan2 {
  193   my ($l,$r,$flag) = @_;
  194   if ($flag) {my $tmp = $l; $l = $r; $r = $l}
  195   return $pkg->make(CORE::atan2($l->{data}[0],$r->{data}[0]));
  196 }
  197 
  198 ##################################################
  199 
  200 sub string {
  201   my $self = shift; my $equation = shift; my $prec = shift;
  202   my $n = $self->{data}[0];
  203   my $format = ($equation->{context} || $$Value::context)->{format}{number};
  204   $n = sprintf($format,$n) if $format; #  use the specified precision, if any
  205   $n = uc($n); # force e notation to E
  206   $n = 0 if $self == 0; # make near zero print as zero
  207   $n = "(".$n.")" if ($n < 0 || $n =~ m/E/i) && defined($prec) && $prec >= 1;
  208   return $n;
  209 }
  210 
  211 sub TeX {
  212   my $n = (shift)->string(@_);
  213   $n =~ s/E\+?(-?)0*([^)]*)/\\times 10^{$1$2}/i; # convert E notation to x10^(...)
  214   return $n;
  215 }
  216 
  217 
  218 ###########################################################################
  219 
  220 1;
  221 

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9