Parent Directory
| 
Revision Log
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 |