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

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

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

Revision 5092 Revision 5093
24 } 24 }
25 return $self->promote($x); 25 return $self->promote($x);
26 } 26 }
27 my @params = @_; 27 my @params = @_;
28 Value::Error("Interval can't be empty") unless scalar(@params) > 0; 28 Value::Error("Interval can't be empty") unless scalar(@params) > 0;
29 Value::Error("Extra arguments for Interval()") if scalar(@params) > 4; 29 Value::Error("Too many arguments for Interval") if scalar(@params) > 4;
30 return $context->Package("Set")->new($context,@params) if scalar(@params) == 1; 30 return $context->Package("Set")->new($context,@params) if scalar(@params) == 1;
31 @params = ('(',@params,')') if (scalar(@params) == 2); 31 @params = ('(',@params,')') if (scalar(@params) == 2);
32 my ($open,$a,$b,$close) = @params; 32 my ($open,$a,$b,$close) = @params;
33 if (!defined($close)) {$close = $b; $b = $a} 33 if (!defined($close)) {$close = $b; $b = $a}
34 $a = Value::makeValue($a,context=>$context); $b = Value::makeValue($b,context=>$context); 34 $a = Value::makeValue($a,context=>$context); $b = Value::makeValue($b,context=>$context);
48 unless $close eq ')' || $close eq ']'; 48 unless $close eq ')' || $close eq ']';
49 return $self->formula($open,$a,$b,$close) 49 return $self->formula($open,$a,$b,$close)
50 if Value::isFormula($a) || Value::isFormula($b); 50 if Value::isFormula($a) || Value::isFormula($b);
51 Value::Error("Single point intervals must use '[' and ']'") 51 Value::Error("Single point intervals must use '[' and ']'")
52 if $a == $b && ($open ne '[' || $close ne ']'); 52 if $a == $b && ($open ne '[' || $close ne ']');
53 return $context->Package("Set")->new($context,$a) if $a == $b;
53 bless { 54 bless {
54 data => [$a,$b], open => $open, close => $close, 55 data => [$a,$b], open => $open, close => $close,
55 leftInfinite => $nia, rightInfinite => $ib, 56 leftInfinite => $nia, rightInfinite => $ib,
56 context => $context, 57 context => $context,
57 }, $class; 58 }, $class;
124# 125#
125# Return the number of endpoints 126# Return the number of endpoints
126# 127#
127sub length { 128sub length {
128 my $self = shift; 129 my $self = shift;
129 my ($a,$b) = $self->data; 130 my ($a,$b) = $self->value;
130 return $a == $b ? 1 : 2; 131 return $a == $b ? 1 : 2;
132}
133
134#
135# Only transfer flags to the endpoints
136#
137sub transferFlags {
138 my $self = shift;
139 foreach my $flag (@_) {
140 next unless defined $self->{$flag};
141 foreach my $i (1,2) {$self->{data}[$i]->{$flag} = $self->{$flag}}
142 }
131} 143}
132 144
133# 145#
134# Convert points and lists to intervals, when needed 146# Convert points and lists to intervals, when needed
135# 147#
136sub promote { 148sub promote {
137 my $self = shift; 149 my $self = shift;
138 my $context = (Value::isContext($_[0]) ? shift : $self->context); 150 my $context = (Value::isContext($_[0]) ? shift : $self->context);
139 my $x = (scalar(@_) ? shift : $self); 151 my $x = (scalar(@_) ? shift : $self);
152 return $self->new($context,$x,@_) if scalar(@_) > 0;
140 $x = Value::makeValue($x,context=>$context); 153 $x = Value::makeValue($x,context=>$context);
141 return $self->new($context,$x,@_) if scalar(@_) > 0;
142 return $x if $x->isSetOfReals; 154 return $x if $x->isSetOfReals;
143 return $context->Package("Set")->new($context,$x) if Value::isReal($x); 155 return $context->Package("Set")->new($context,$x) if Value::isReal($x);
144 my $open = $x->{open}; $open = '(' unless defined($open); 156 my $open = $x->{open}; $open = '(' unless defined($open);
145 my $close = $x->{close}; $close = ')' unless defined($close); 157 my $close = $x->{close}; $close = ')' unless defined($close);
146 return $self->new($context,$open,$x->value,$close) if $x->canBeInUnion; 158 return $self->new($context,$open,$x->value,$close) if $x->canBeInUnion;
164# 176#
165# Subtraction can split into a union 177# Subtraction can split into a union
166# 178#
167sub sub { 179sub sub {
168 my ($self,$l,$r) = Value::checkOpOrderWithPromote(@_); 180 my ($self,$l,$r) = Value::checkOpOrderWithPromote(@_);
169 Value::Union::form($self->context,subIntervalInterval($l,$r)); 181 Value::Union::form($self->context,Value::Union::subUnionUnion([$l],[$r]));
170} 182}
171 183
172# 184#
173# Subtract an interval from another 185# Subtract an interval from another
174# (returns the resulting interval(s), set 186# (returns the resulting interval(s), set
211sub compare { 223sub compare {
212 my ($self,$l,$r) = Value::checkOpOrderWithPromote(@_); 224 my ($self,$l,$r) = Value::checkOpOrderWithPromote(@_);
213 my ($la,$lb) = $l->value; my ($ra,$rb) = $r->value; 225 my ($la,$lb) = $l->value; my ($ra,$rb) = $r->value;
214 my $cmp = $la <=> $ra; return $cmp if $cmp; 226 my $cmp = $la <=> $ra; return $cmp if $cmp;
215 my $ignoreEndpointTypes = $l->getFlag('ignoreEndpointTypes'); 227 my $ignoreEndpointTypes = $l->getFlag('ignoreEndpointTypes');
216 $cmp = $l->{open} cmp $r->{open}; return $cmp if $cmp && !$ignoreEndpointTypes; 228 $cmp = $r->{open} cmp $l->{open}; return $cmp if $cmp && !$ignoreEndpointTypes;
217 $cmp = $lb <=> $rb; return $cmp if $cmp || $ignoreEndpointTypes; 229 $cmp = $lb <=> $rb; return $cmp if $cmp || $ignoreEndpointTypes;
218 return $l->{close} cmp $r->{close}; 230 return $l->{close} cmp $r->{close};
219} 231}
220 232
221############################################ 233############################################
231# 243#
232# Tests for containment, subsets, etc. 244# Tests for containment, subsets, etc.
233# 245#
234 246
235sub contains { 247sub contains {
236 my $self = shift; my $other = $self->promote(shift); 248 my $self = shift; my $other = $self->promote(@_);
237 return ($other - $self)->isEmpty; 249 return ($other - $self)->isEmpty;
238} 250}
239 251
240sub isSubsetOf { 252sub isSubsetOf {
241 my $self = shift; my $other = $self->promote(shift); 253 my $self = shift; my $other = $self->promote(@_);
242 return $other->contains($self); 254 return $other->contains($self);
243} 255}
244 256
245sub isEmpty {0} 257sub isEmpty {0}
246 258
247sub intersect { 259sub intersect {
248 my $self = shift; my $other = shift; 260 my $self = shift; my $other = $self->promote(@_);
249 return $self-($self-$other); 261 return $self-($self-$other);
250} 262}
251 263
252sub intersects { 264sub intersects {
253 my $self = shift; my $other = shift; 265 my $self = shift; my $other = $self->promote(@_);
254 return !$self->intersect($other)->isEmpty; 266 return !$self->intersect($other)->isEmpty;
255} 267}
256 268
257########################################################################### 269###########################################################################
258 270

Legend:
Removed from v.5092  
changed lines
  Added in v.5093

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9