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

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

Revision 3716 - (download) (as text) (annotate)
Sun Oct 16 03:37:17 2005 UTC (14 years, 2 months ago) by dpvc
File size: 9579 byte(s)
In the past, when Value objects were inserted into strings, they would
automatically include parentheses so that if you had $f equal to 1+x and$g equal to 1-x, then Formula("$f/$g") would mean (1+x)/(1-x)
rather than 1+(x/1)-x, which is what would happen as a straing string
substitution.

The problem is that this would also happen for real numbers, vectors,
and everything else, even when it wasn't necessary.  So if $x=Real(3), then "Let x =$x" would be "Let x = (3)".

I have changed the behavior of the string concatenation for Value
objects so that parentheses are only added in a few cases: for
Formulas, Complex numbers, and Unions.  This makes the other Value
objects work more like regular variables in strings, but might cause
some problems with strings that are used as formulas.  For example, if
$a = Real(-3), then "x + 2$a" will become "x + 2 -3", or "x-1" rather
than the expected "x - 6".  (The old approach would have made it "x +
2 (-3)" which would have worked properly).  For the most part, it is
easier to use something like "x + 2*$a" or even "x" + 2*$a in this
case, so the extra trouble of having to avoid parentheses when you
really meant to substitute the value into a string didn't seem worth
it.


    1 ###########################################################################
2
3 package Value::Union;
4 my $pkg = 'Value::Union'; 5 6 use strict; 7 use vars qw(@ISA); 8 @ISA = qw(Value); 9 10 use overload 11 '+' => sub {shift->add(@_)}, 12 '-' => sub {shift->sub(@_)}, 13 '.' => sub {shift->_dot(@_)}, 14 'x' => sub {shift->cross(@_)}, 15 '<=>' => sub {shift->compare(@_)}, 16 'cmp' => sub {shift->compare_string(@_)}, 17 'nomethod' => sub {shift->nomethod(@_)}, 18 '""' => sub {shift->stringify(@_)}; 19 20 # 21 # Convert a value to a union of intervals. The value must be 22 # a list of two or more Interval, Union or Point objects. 23 # Points will be converted to intervals if they are length 1 or 2. 24 # 25 sub new { 26 my$self = shift; my $class = ref($self) || $self; 27 if (scalar(@_) == 1 && !ref($_[0])) {
28     my $x = Value::makeValue($_[0]);
29     if (Value::isFormula($x)) { 30 return$x if $x->type =~ m/Interval|Union|Set/; 31 Value::Error("Formula does not return an Interval, Set or Union"); 32 } 33$x = promote($x);$x = $pkg->make($x) unless $x->type eq 'Union'; 34 return$x;
35   }
36   my @intervals = (); my $isFormula = 0; 37 foreach my$xx (@_) {
38     next if $xx eq ''; my$x = Value::makeValue($xx); 39 if ($x->isFormula) {
40       $x->{tree}->typeRef->{name} = 'Interval' 41 if ($x->type =~ m/Point|List/ && $x->length == 2 && 42$x->typeRef->{entryType}{name} eq 'Number');
43       if ($x->type eq 'Union') {push(@intervals,$x->{tree}->makeUnion)}
44       elsif ($x->isSetOfReals) {push(@intervals,$x)}
45       else {Value::Error("Unions can be taken only for Intervals and Sets")}
46       $isFormula = 1; 47 } else { 48 if ($x->type ne 'Interval' && $x->canBeInUnion) 49 {$x = Value::Interval->new($x->{open},$x->value,$x->{close})} 50 if ($x->class eq 'Union') {push(@intervals,$x->value)} 51 elsif ($x->isSetOfReals) {push(@intervals,$x)} 52 else {Value::Error("Unions can be taken only for Intervals or Sets")} 53 } 54 } 55 Value::Error("Empty unions are not allowed") if scalar(@intervals) == 0; 56 return$self->formula(@intervals) if $isFormula; 57 my$union = form(@intervals);
58   $union =$self->make($union) unless$union->type eq 'Union';
59   return $union; 60 } 61 62 # 63 # Make a union or interval or set, depending on how 64 # many there are in the union, and mark the 65 # 66 # 67 sub form { 68 return$_[0] if scalar(@_) == 1;
69   return Value::Set->new() if scalar(@_) == 0;
70   my $union =$pkg->make(@_);
71   $union =$union->reduce if $union->getFlag('reduceUnions'); 72 return$union;
73 }
74
75 #
76 #  Return the appropriate data.
77 #
78 sub typeRef {
79   my $self = shift; 80 return Value::Type($self->class, $self->length,$self->data->[0]->typeRef);
81 }
82
83 sub isOne {0}
84 sub isZero {0}
85
86 sub canBeInUnion {1}
87 sub isSetOfReals {1}
88
89 #
90 #  Recursively convert the list of intervals to a tree of unions
91 #
92 sub formula {
93   my $selft = shift; 94 my$formula = Value::Formula->blank;
95   $formula->{tree} = recursiveUnion($formula,Value::toFormula($formula,@_)); 96 return$formula
97 }
98 sub recursiveUnion {
99   my $formula = shift; my$right = pop(@_);
100   return $right if (scalar(@_) == 0); 101 return$formula->{context}{parser}{BOP}->
102     new($formula,'U',recursiveUnion($formula,@_),$right); 103 } 104 105 # 106 # Try to promote arbitrary data to a set 107 # 108 sub promote { 109 my$x = Value::makeValue(shift);
110   return Value::Set->new($x,@_) if scalar(@_) > 0 || Value::isRealNumber($x);
111   return $x if ref($x) eq $pkg; 112$x = Value::Interval::promote($x) if$x->canBeInUnion;
113   return $pkg->make($x) if Value::isValue($x) &&$x->isSetOfReals;
114   Value::Error("Can't convert %s to an Interval, Set or Union",Value::showClass($x)); 115 } 116 117 ############################################ 118 # 119 # Operations on unions 120 # 121 122 # 123 # Addition forms unions 124 # 125 sub add { 126 my ($l,$r,$flag) = @_;
127   if ($l->promotePrecedence($r)) {return $r->add($l,!$flag)} 128$r = promote($r); if ($flag) {my $tmp =$l; $l =$r; $r =$tmp}
129   form($l->value,$r->value);
130 }
131 sub dot {my $self = shift;$self->add(@_)}
132
133 #
134 #  Subtraction can split intervals into unions
135 #
136 sub sub {
137   my ($l,$r,$flag) = @_; 138 if ($l->promotePrecedence($r)) {return$r->sub($l,!$flag)}
139   $r = promote($r); if ($flag) {my$tmp = $l;$l = $r;$r = $tmp} 140$l = $l->reduce;$l = $pkg->make($l) unless $l->type eq 'Union'; 141$r = $r->reduce;$r = $pkg->make($r) unless $r->type eq 'Union'; 142 form(subUnionUnion($l->data,$r->data)); 143 } 144 145 # 146 # Which routines to call for the various combinations 147 # of sets and intervals to do subtraction 148 # 149 my %subCall = ( 150 SetSet => \&Value::Set::subSetSet, 151 SetInterval => \&Value::Set::subSetInterval, 152 IntervalSet => \&Value::Set::subIntervalSet, 153 IntervalInterval => \&Value::Interval::subIntervalInterval, 154 ); 155 156 # 157 # Subtract a union from another by running through both lists 158 # and subtracting everything in the second list from everything 159 # in the first. 160 # 161 sub subUnionUnion { 162 my ($l,$r) = @_; 163 my @union = (@{$l});
164   foreach my $J (@{$r}) {
165     my @newUnion = ();
166     foreach my $I (@union) 167 {push(@newUnion,&{$subCall{$I->type.$J->type}}($I,$J))}
168     @union = @newUnion;
169   }
170   return @union;
171 }
172
173 #
174 #  Sort the intervals lexicographically, and then
175 #    compare interval by interval.
176 #
177 sub compare {
178   my ($l,$r,$flag) = @_; 179 if ($l->promotePrecedence($r)) {return$r->compare($l,!$flag)}
180   $r = promote($r);
181   if ($l->getFlag('reduceUnionsForComparison')) { 182$l = $l->reduce;$l = $pkg->make($l) unless $l->type eq 'Union'; 183$r = $r->reduce;$r = $pkg->make($r) unless $r->type eq 'Union'; 184 } 185 if ($flag) {my $tmp =$l; $l =$r; $r =$tmp};
186   my @l = $l->sort->value; my @r =$r->sort->value;
187   while (scalar(@l) && scalar(@r)) {
188     my $cmp = shift(@l) <=> shift(@r); 189 return$cmp if $cmp; 190 } 191 return scalar(@l) - scalar(@r); 192 } 193 194 ############################################ 195 # 196 # Utility routines 197 # 198 199 # 200 # Reduce unions to simplest form 201 # 202 sub reduce { 203 my$self = shift;
204   return $self if$self->{isReduced};
205   my @singletons = (); my @intervals = ();
206   foreach my $x ($self->value) {
207     if ($x->type eq 'Set') {push(@singletons,$x->value)}
208     elsif ($x->{data}[0] ==$x->{data}[1]) {push(@singletons,$x->{data}[0])} 209 else {push(@intervals,$x->copy)}
210   }
211   my @union = (); my @set = (); my $prevX; 212 @intervals = (CORE::sort {$a <=> $b} @intervals); 213 ELEMENT: foreach my$x (sort {$a <=>$b} @singletons) {
214     next if defined($prevX) &&$prevX == $x;$prevX = $x; 215 foreach my$I (@intervals) {
216       my ($a,$b) = $I->value; 217 last if$x < $a; 218 if ($x > $a &&$x < $b) {next ELEMENT} 219 elsif ($x == $a) {$I->{open} = '['; next ELEMENT}
220       elsif ($x ==$b) {$I->{close} = ']'; next ELEMENT} 221 } 222 push(@set,$x);
223   }
224   while (scalar(@intervals) > 1) {
225     my $I = shift(@intervals); my$J = $intervals[0]; 226 my ($a,$b) =$I->value; my ($c,$d) = $J->value; 227 if ($b < $c || ($b == $c &&$I->{close} eq ')' && $J->{open} eq '(')) { 228 push(@union,$I);
229     } else {
230       if ($a <$c) {$J->{data}[0] =$a; $J->{open} =$I->{open}}
231               else {$J->{open} = '[' if$I->{open} eq '['}
232       if ($b >$d) {$J->{data}[1] =$b; $J->{close} =$I->{close}}
233               else {$J->{close} = ']' if$b == $d &&$I->{close} eq ']'}
234     }
235   }
236   push(@union,@intervals);
237   push(@union,Value::Set->make(@set)) unless scalar(@set) == 0;
238   return Value::Set->new() if scalar(@union) == 0;
239   return $union[0] if scalar(@union) == 1; 240 return$pkg->make(@union)->with(isReduced=>1);
241 }
242
243 #
244 #  True if a union is reduced
245 #
246 sub isReduced {
247   my $self = shift; 248 return 1 if$self->{isReduced};
249   my $reduced =$self->reduce;
250   return unless $reduced->type eq 'Union' &&$reduced->length == $self->length; 251 my @R =$reduced->sort->value; my @S = $self->sort->value; 252 foreach my$i (0..$#R) { 253 return unless$R[$i] ==$S[$i] &&$R[$i]->length ==$S[$i]->length; 254 } 255 return 1; 256 } 257 258 # 259 # Sort a union lexicographically 260 # 261 sub sort { 262 my$self = shift;
263   $self->make(CORE::sort {$a <=> $b}$self->value);
264 }
265
266
267 #
268 #  Tests for containment, subsets, etc.
269 #
270
271 sub contains {
272   my $self = shift; my$other = promote(shift);
273   return ($other -$self)->isEmpty;
274 }
275
276 sub isSubsetOf {
277   my $self = shift; my$other = promote(shift);
278   return $other->contains($self);
279 }
280
281 sub isEmpty {
282   my $self = (shift)->reduce; 283$self->type eq 'Set' && $self->isEmpty; 284 } 285 286 sub intersect { 287 my$self = shift; my $other = shift; 288 return$self-($self-$other);
289 }
290
291 sub intersects {
292   my $self = shift; my$other = shift;
293   return !$self->intersect($other)->isEmpty;
294 }
295
296 ############################################
297 #
298 #  Generate the various output formats
299 #
300
301 sub pdot {'('.(shift->stringify).')'}
302
303 sub stringify {
304   my $self = shift; 305 return$self->TeX if $$Value::context->flag('StringifyAsTeX'); 306 self->string; 307 } 308 309 sub string { 310 my self = shift; my equation = shift; shift; shift; my prec = shift; 311 my op = (equation->{context} ||$$Value::context)->{operators}{'U'};
312   my @intervals = ();
313   foreach my $x (@{$self->data}) {push(@intervals,$x->string($equation))}
314   my $string = join($op->{string} || ' U ',@intervals);
315   $string = '('.$string.')' if $prec > ($op->{precedence} || 1.5);
316   return $string; 317 } 318 319 sub TeX { 320 my$self = shift; my $equation = shift; shift; shift; my$prec = shift;
321   my $op = ($equation->{context} || Value::context)->{operators}{'U'};
322   my @intervals = ();
323   foreach my $x (@{$self->data}) {push(@intervals,$x->TeX($equation))}
324   my $TeX = join($op->{TeX} || $op->{string} || ' U ',@intervals); 325$TeX = '\left('.$TeX.'\right)' if$prec > ($op->{precedence} || 1.5); 326 return$TeX;
327 }
328
329 ###########################################################################
330
331 1;
332


 aubreyja at gmail dot com ViewVC Help Powered by ViewVC 1.0.9