[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 2625 - (download) (as text) (annotate)
Mon Aug 16 18:35:12 2004 UTC (15 years, 3 months ago) by dpvc
File size: 6482 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 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   Value::Error("Endpoints of intervals must be numbers on infinities") unless
   39     isNumOrInfinity($a) && isNumOrInfinity($b);
   40   my ($ia,$ib) = (isInfinity($a),isInfinity($b));
   41   my ($nia,$nib) = (isNegativeInfinity($a),isNegativeInfinity($b));
   42   Value::Error("Can't make an interval only out of Infinity") if ($ia && $ib) || ($nia && $nib);
   43   Value::Error("Left endpoint must be less than right endpoint")
   44     unless $nia || $ib || ($a <= $b && !$ia && !$nib);
   45   $open  = '(' if $open  eq '[' && $nia; # should be error ?
   46   $close = ')' if $close eq ']' && $ib;  # ditto?
   47   Value::Error("Open parenthesis of interval must be '(' or '['")
   48     unless $open eq '(' || $open eq '[';
   49   Value::Error("Close parenthesis of interval must be ')' or ']'")
   50     unless $close eq ')' || $close eq ']';
   51   return $self->formula($open,$a,$b,$close)
   52     if Value::isFormula($a) || Value::isFormula($b);
   53   Value::Error("Single point intervals must use '[' and ']'")
   54     if $a == $b && ($open ne '[' || $close ne ']');
   55   bless {
   56     data => [$a,$b], open => $open, close => $close,
   57     leftInfinite => $nia, rightInfinite => $ib,
   58     canBeInterval => 1,
   59   }, $class;
   60 }
   61 
   62 #
   63 #  Similarly for make, but without the error checks
   64 #
   65 sub make {
   66   my $self = shift; my $class = ref($self) || $self;
   67   my ($open,$a,$b,$close) = @_;
   68   $close = $b, $b = $a unless defined($close);
   69   bless {
   70     data => [$a,$b], open => $open, close => $close,
   71     leftInfinite => isNegativeInfinity($a), rightInfinite => isInfinity($b),
   72     canBeInterval => 1,
   73   }, $class
   74 }
   75 
   76 #
   77 #  Make a formula out of the data for an interval
   78 #
   79 sub formula {
   80   my $self = shift;
   81   my ($open,$a,$b,$close) = @_;
   82   my $formula = Value::Formula->blank;
   83   ($a,$b) = Value::toFormula($formula,$a,$b);
   84   $formula->{tree} = Parser::List->new($formula,[$a,$b],0,
   85      $formula->{context}{parens}{$open},$Value::Type{number},$open,$close);
   86 #   return $formula->eval if scalar(%{$formula->{variables}}) == 0;
   87   return $formula;
   88 
   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 #
  112 #  Return the open and close parens as well as the endpoints
  113 #
  114 sub value {
  115   my $self = shift;
  116   my ($a,$b) = @{$self->data};
  117   return ($a,$b,$self->{open},$self->{close});
  118 }
  119 
  120 #
  121 #  Return the number of endpoints
  122 #
  123 sub length {
  124   my $self = shift;
  125   my ($a,$b) = $self->data;
  126   return $a == $b ? 1 : 2;
  127 }
  128 
  129 #
  130 #  Convert points and lists to intervals, when needed
  131 #
  132 sub promote {
  133   my $x = shift;
  134   return $pkg->new($x,@_) if scalar(@_) > 0 || ref($x) eq 'ARRAY';
  135   return $x if ref($x) eq $pkg;
  136   return $pkg->new($x->{open},@{$x->data},$x->{close})
  137     if Value::class($x) =~ m/^(Point|List)$/ && $x->length == 2 &&
  138        ($x->{open} eq '(' || $x->{open} eq '[') &&
  139        ($x->{close} eq ')' || $x->{close} eq ']');
  140   Value::Error("Can't convert ".Value::showClass($x)." to an Interval");
  141 }
  142 
  143 ############################################
  144 #
  145 #  Operations on intervals
  146 #
  147 
  148 #
  149 #  Addition forms unions
  150 #
  151 sub add {
  152   my ($l,$r,$flag) = @_;
  153   if ($l->promotePrecedence($r)) {return $r->add($l,!$flag)}
  154   $r = promote($r);
  155   if ($flag) {my $tmp = $l; $l = $r; $r = $tmp}
  156   Value::Error("Intervals can only be added to Intervals")
  157     unless Value::class($l) eq 'Interval' && Value::class($r) eq 'Interval';
  158   return Value::Union->new($l,$r);
  159 }
  160 sub dot {add(@_)}
  161 
  162 
  163 #
  164 #  Lexicographic order, but with type of endpoint included
  165 #    in the test.
  166 #
  167 sub compare {
  168   my ($l,$r,$flag) = @_;
  169   if ($l->promotePrecedence($r)) {return $r->compare($l,!$flag)}
  170   $r = promote($r);
  171   if ($flag) {my $tmp = $l; $l = $r; $r = $tmp};
  172   my ($la,$lb) = @{$l->data}; my ($ra,$rb) = @{$r->data};
  173   my $cmp = $la <=> $ra; return $cmp if $cmp;
  174   $cmp = $l->{open} cmp $r->{open}; return $cmp if $cmp;
  175   $cmp = $lb <=> $rb; return $cmp if $cmp;
  176   return $l->{close} cmp $r->{close};
  177 }
  178 
  179 ############################################
  180 #
  181 #  Generate the various output formats.
  182 #
  183 
  184 sub string {
  185   my $self = shift; my $equation = shift;
  186   my ($a,$b) = @{$self->data};
  187   $a = $a->string($equation) if Value::isValue($a);
  188   $b = $b->string($equation) if Value::isValue($b);
  189 #  return $self->{open}.$a.$self->{close}
  190 #    if !$self->{leftInfinte} && !$self->{rightInfinite} && $a == $b;
  191   return $self->{open}.$a.','.$b.$self->{close};
  192 }
  193 
  194 sub TeX {
  195   my $self = shift; my $equation = shift;
  196   my ($a,$b) = @{$self->data};
  197   $a = $a->TeX($equation) if Value::isValue($a);
  198   $b = $b->TeX($equation) if Value::isValue($b);
  199   my $open = $self->{open}; my $close = $self->{close};
  200   $open = '\{' if $open eq '{'; $close = '\}' if $close eq '}';
  201   $open = '\left'.$open if $open; $close = '\right'.$close if $close;
  202 #  return $open.$a.$close if !$self->{leftInfinte} && !$self->{rightInfinite} && $a == $b;
  203   return $open.$a.','.$b.$close;
  204 }
  205 
  206 ###########################################################################
  207 
  208 1;

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9