[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 2625 - (download) (as text) (annotate)
Mon Aug 16 18:35:12 2004 UTC (15 years, 4 months ago) by dpvc
File size: 5297 byte(s)
Added string comparison to all Value object classes (to compare the
string value of an object to another string).

Overloaded perl '.' operator to do dot product when the operands are
formulas returning vectors.  (Part of the auto-generation of
formulas).

A few improvements to real and complex class output results.

Made Union class slightly more robust and removed need for makeUnion
method other than in the Union itself.

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

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9