[system] / trunk / pg / lib / Value / Interval.pm Repository: Repository Listing bbplugincoursesdistsnplrochestersystemwww

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

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