[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 5084 - (download) (as text) (annotate)
Fri Jun 29 19:11:05 2007 UTC (12 years, 7 months ago) by dpvc
File size: 5675 byte(s)
Adjusted some of the type checking to use more appropriate tests.

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

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9