[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 2626 - (download) (as text) (annotate)
Mon Aug 16 19:44:26 2004 UTC (15 years, 4 months ago) by dpvc
File size: 6572 byte(s)
One more fix for handling intervals properly (I think it's really
right this time).  Also, named constants that end in numbers will
produce TeX output with the number as a subscript (this was already
true for variable names).

    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   my $open  = $x->{open};  $open  = '(' unless defined($open);
  137   my $close = $x->{close}; $close = ')' unless defined($close);
  138   return $pkg->new($open,@{$x->data},$close)
  139     if Value::class($x) =~ m/^(Point|List)$/ && $x->length == 2 &&
  140        ($open eq '(' || $open eq '[') && ($close eq ')' || $close eq ']');
  141   Value::Error("Can't convert ".Value::showClass($x)." to an Interval");
  142 }
  143 
  144 ############################################
  145 #
  146 #  Operations on intervals
  147 #
  148 
  149 #
  150 #  Addition forms unions
  151 #
  152 sub add {
  153   my ($l,$r,$flag) = @_;
  154   if ($l->promotePrecedence($r)) {return $r->add($l,!$flag)}
  155   $r = promote($r);
  156   if ($flag) {my $tmp = $l; $l = $r; $r = $tmp}
  157   Value::Error("Intervals can only be added to Intervals")
  158     unless Value::class($l) eq 'Interval' && Value::class($r) eq 'Interval';
  159   return Value::Union->new($l,$r);
  160 }
  161 sub dot {add(@_)}
  162 
  163 
  164 #
  165 #  Lexicographic order, but with type of endpoint included
  166 #    in the test.
  167 #
  168 sub compare {
  169   my ($l,$r,$flag) = @_;
  170   if ($l->promotePrecedence($r)) {return $r->compare($l,!$flag)}
  171   $r = promote($r);
  172   if ($flag) {my $tmp = $l; $l = $r; $r = $tmp};
  173   my ($la,$lb) = @{$l->data}; my ($ra,$rb) = @{$r->data};
  174   my $cmp = $la <=> $ra; return $cmp if $cmp;
  175   $cmp = $l->{open} cmp $r->{open}; return $cmp if $cmp;
  176   $cmp = $lb <=> $rb; return $cmp if $cmp;
  177   return $l->{close} cmp $r->{close};
  178 }
  179 
  180 ############################################
  181 #
  182 #  Generate the various output formats.
  183 #
  184 
  185 sub string {
  186   my $self = shift; my $equation = shift;
  187   my ($a,$b) = @{$self->data};
  188   $a = $a->string($equation) if Value::isValue($a);
  189   $b = $b->string($equation) if Value::isValue($b);
  190 #  return $self->{open}.$a.$self->{close}
  191 #    if !$self->{leftInfinte} && !$self->{rightInfinite} && $a == $b;
  192   return $self->{open}.$a.','.$b.$self->{close};
  193 }
  194 
  195 sub TeX {
  196   my $self = shift; my $equation = shift;
  197   my ($a,$b) = @{$self->data};
  198   $a = $a->TeX($equation) if Value::isValue($a);
  199   $b = $b->TeX($equation) if Value::isValue($b);
  200   my $open = $self->{open}; my $close = $self->{close};
  201   $open = '\{' if $open eq '{'; $close = '\}' if $close eq '}';
  202   $open = '\left'.$open if $open; $close = '\right'.$close if $close;
  203 #  return $open.$a.$close if !$self->{leftInfinte} && !$self->{rightInfinite} && $a == $b;
  204   return $open.$a.','.$b.$close;
  205 }
  206 
  207 ###########################################################################
  208 
  209 1;

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9