[system] / trunk / pg / lib / Value / Interval.pm Repository:
ViewVC logotype

View of /trunk/pg/lib/Value/Interval.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 2800 - (download) (as text) (annotate)
Sun Sep 19 14:27:39 2004 UTC (15 years, 5 months ago) by dpvc
File size: 6713 byte(s)
Added isZero and isOne checks for Parser::Value objects (i.e., for
constants within formulas).  These now correctly handle vector and
matrices, in particular.  The isOne and isZero checks are used in the
reduce() method to simplify formulas.

    1 ###########################################################################
    2 #
    3 #  Implements the Interval class
    4 #
    5 package Value::Interval;
    6 my $pkg = 'Value::Interval';
    7 
    8 use strict;
    9 use vars qw(@ISA);
   10 @ISA = qw(Value);
   11 
   12 use overload
   13        '+'   => \&add,
   14        '.'   => \&Value::_dot,
   15        'x'   => \&Value::cross,
   16        '<=>' => \&compare,
   17        'cmp' => \&Value::cmp,
   18   'nomethod' => \&Value::nomethod,
   19         '""' => \&Value::stringify;
   20 
   21 #
   22 #  Convert a value to an interval.  The value consists of
   23 #    an open paren string, one or two real numbers or infinities,
   24 #    and a close paren string.
   25 #
   26 sub new {
   27   my $self = shift; my $class = ref($self) || $self;
   28   if (scalar(@_) == 1 && !ref($_[0])) {
   29     my $num = $$Value::context->{pattern}{signedNumber};
   30     my $inf = $$Value::context->{pattern}{infinite};
   31     @_ = ($1,$2,$3,$4) if $_[0] =~ m/^ *(\(|\[) *($num|$inf) *, *($num|$inf) *(\)|\]) *$/;
   32   }
   33   my ($open,$a,$b,$close) = @_;
   34   if (!defined($close)) {$close = $b; $b = $a}
   35   Value::Error("Interval() must be called with 3 or 4 arguments")
   36     unless defined($open) && defined($a) && defined($b) && defined($close);
   37   $a = Value::makeValue($a); $b = Value::makeValue($b);
   38   return $self->formula($open,$a,$b,$close) if Value::isFormula($a) || Value::isFormula($b);
   39   Value::Error("Endpoints of intervals must be numbers on infinities") unless
   40     isNumOrInfinity($a) && isNumOrInfinity($b);
   41   my ($ia,$ib) = (isInfinity($a),isInfinity($b));
   42   my ($nia,$nib) = (isNegativeInfinity($a),isNegativeInfinity($b));
   43   Value::Error("Can't make an interval only out of Infinity") if ($ia && $ib) || ($nia && $nib);
   44   Value::Error("Left endpoint must be less than right endpoint")
   45     unless $nia || $ib || ($a <= $b && !$ia && !$nib);
   46   $open  = '(' if $open  eq '[' && $nia; # should be error ?
   47   $close = ')' if $close eq ']' && $ib;  # ditto?
   48   Value::Error("Open parenthesis of interval must be '(' or '['")
   49     unless $open eq '(' || $open eq '[';
   50   Value::Error("Close parenthesis of interval must be ')' or ']'")
   51     unless $close eq ')' || $close eq ']';
   52   return $self->formula($open,$a,$b,$close)
   53     if Value::isFormula($a) || Value::isFormula($b);
   54   Value::Error("Single point intervals must use '[' and ']'")
   55     if $a == $b && ($open ne '[' || $close ne ']');
   56   bless {
   57     data => [$a,$b], open => $open, close => $close,
   58     leftInfinite => $nia, rightInfinite => $ib,
   59     canBeInterval => 1,
   60   }, $class;
   61 }
   62 
   63 #
   64 #  Similarly for make, but without the error checks
   65 #
   66 sub make {
   67   my $self = shift; my $class = ref($self) || $self;
   68   my ($open,$a,$b,$close) = @_;
   69   $close = $b, $b = $a unless defined($close);
   70   bless {
   71     data => [$a,$b], open => $open, close => $close,
   72     leftInfinite => isNegativeInfinity($a), rightInfinite => isInfinity($b),
   73     canBeInterval => 1,
   74   }, $class
   75 }
   76 
   77 #
   78 #  Make a formula out of the data for an interval
   79 #
   80 sub formula {
   81   my $self = shift;
   82   my ($open,$a,$b,$close) = @_;
   83   my $formula = Value::Formula->blank;
   84   ($a,$b) = Value::toFormula($formula,$a,$b);
   85   $formula->{tree} = $formula->{context}{parser}{List}->new($formula,[$a,$b],0,
   86      $formula->{context}{parens}{$open},$Value::Type{number},$open,$close);
   87 #   return $formula->eval if scalar(%{$formula->{variables}}) == 0;
   88   return $formula;
   89 }
   90 
   91 #
   92 #  Tests for infinities
   93 #
   94 sub isNumOrInfinity {
   95   my $n = shift;
   96   return isInfinity($n) || isNegativeInfinity($n) || Value::isNumber($n);
   97 }
   98 sub isInfinity {
   99   my $n = shift;
  100   return $n->{tree}{isInfinity} if Value::isFormula($n);
  101   $n = Value::makeValue($n); return 0 unless ref($n);
  102   return $n->{isInfinite} && !$n->{isNegative};
  103 }
  104 sub isNegativeInfinity {
  105   my $n = shift;
  106   return $n->{tree}{isNegativeInfinity} if Value::isFormula($n);
  107   $n = Value::makeValue($n); return 0 unless ref($n);
  108   return $n->{isInfinite} && $n->{isNegative};
  109 }
  110 
  111 sub isOne {0}
  112 sub isZero {0}
  113 
  114 #
  115 #  Return the open and close parens as well as the endpoints
  116 #
  117 sub value {
  118   my $self = shift;
  119   my ($a,$b) = @{$self->data};
  120   return ($a,$b,$self->{open},$self->{close});
  121 }
  122 
  123 #
  124 #  Return the number of endpoints
  125 #
  126 sub length {
  127   my $self = shift;
  128   my ($a,$b) = $self->data;
  129   return $a == $b ? 1 : 2;
  130 }
  131 
  132 #
  133 #  Convert points and lists to intervals, when needed
  134 #
  135 sub promote {
  136   my $x = shift;
  137   return $pkg->new($x,@_) if scalar(@_) > 0 || ref($x) eq 'ARRAY';
  138   return $x if ref($x) eq $pkg;
  139   my $open  = $x->{open};  $open  = '(' unless defined($open);
  140   my $close = $x->{close}; $close = ')' unless defined($close);
  141   return $pkg->new($open,@{$x->data},$close)
  142     if Value::class($x) =~ m/^(Point|List)$/ && $x->length == 2 &&
  143        ($open eq '(' || $open eq '[') && ($close eq ')' || $close eq ']');
  144   Value::Error("Can't convert ".Value::showClass($x)." to an Interval");
  145 }
  146 
  147 ############################################
  148 #
  149 #  Operations on intervals
  150 #
  151 
  152 #
  153 #  Addition forms unions
  154 #
  155 sub add {
  156   my ($l,$r,$flag) = @_;
  157   if ($l->promotePrecedence($r)) {return $r->add($l,!$flag)}
  158   $r = promote($r);
  159   if ($flag) {my $tmp = $l; $l = $r; $r = $tmp}
  160   Value::Error("Intervals can only be added to Intervals")
  161     unless Value::class($l) eq 'Interval' && Value::class($r) eq 'Interval';
  162   return Value::Union->new($l,$r);
  163 }
  164 sub dot {add(@_)}
  165 
  166 
  167 #
  168 #  Lexicographic order, but with type of endpoint included
  169 #    in the test.
  170 #
  171 sub compare {
  172   my ($l,$r,$flag) = @_;
  173   if ($l->promotePrecedence($r)) {return $r->compare($l,!$flag)}
  174   $r = promote($r);
  175   if ($flag) {my $tmp = $l; $l = $r; $r = $tmp};
  176   my ($la,$lb) = @{$l->data}; my ($ra,$rb) = @{$r->data};
  177   my $cmp = $la <=> $ra; return $cmp if $cmp;
  178   $cmp = $l->{open} cmp $r->{open}; return $cmp if $cmp;
  179   $cmp = $lb <=> $rb; return $cmp if $cmp;
  180   return $l->{close} cmp $r->{close};
  181 }
  182 
  183 ############################################
  184 #
  185 #  Generate the various output formats.
  186 #
  187 
  188 sub string {
  189   my $self = shift; my $equation = shift;
  190   my ($a,$b) = @{$self->data};
  191   $a = $a->string($equation) if Value::isValue($a);
  192   $b = $b->string($equation) if Value::isValue($b);
  193 #  return $self->{open}.$a.$self->{close}
  194 #    if !$self->{leftInfinte} && !$self->{rightInfinite} && $a == $b;
  195   return $self->{open}.$a.','.$b.$self->{close};
  196 }
  197 
  198 sub TeX {
  199   my $self = shift; my $equation = shift;
  200   my ($a,$b) = @{$self->data};
  201   $a = $a->TeX($equation) if Value::isValue($a);
  202   $b = $b->TeX($equation) if Value::isValue($b);
  203   my $open = $self->{open}; my $close = $self->{close};
  204   $open = '\{' if $open eq '{'; $close = '\}' if $close eq '}';
  205   $open = '\left'.$open if $open; $close = '\right'.$close if $close;
  206 #  return $open.$a.$close if !$self->{leftInfinte} && !$self->{rightInfinite} && $a == $b;
  207   return $open.$a.','.$b.$close;
  208 }
  209 
  210 ###########################################################################
  211 
  212 1;

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9