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

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

Sun Oct 16 03:37:17 2005 UTC (14 years, 2 months ago) by dpvc
File size: 7819 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 #  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
14        '-'   => sub {shift->sub(@_)},
15        '.'   => sub {shift->_dot(@_)},
16        'x'   => sub {shift->cross(@_)},
17        '<=>' => sub {shift->compare(@_)},
18        'cmp' => sub {shift->compare_string(@_)},
19   'nomethod' => sub {shift->nomethod(@_)},
20         '""' => sub {shift->stringify(@_)};
21
22 #
23 #  Convert a value to an interval.  The value consists of
24 #    an open paren string, one or two real numbers or infinities,
25 #    and a close paren string.
26 #
27 sub new {
28   my \$self = shift; my \$class = ref(\$self) || \$self;
29   if (scalar(@_) == 1 && (!ref(\$_[0]) || ref(\$_[0]) eq 'ARRAY')) {
30     my \$x = Value::makeValue(\$_[0]);
31     if (Value::isFormula(\$x)) {
32       return \$x if \$x->type eq 'Interval';
33       Value::Error("Formula does not return an Interval");
34     }
35     return promote(\$x);
36   }
37   my @params = @_;
38   Value::Error("Interval can't be empty") unless scalar(@params) > 0;
39   Value::Error("Extra arguments for Interval()") if scalar(@params) > 4;
40   return Value::Set->new(@params) if scalar(@params) == 1;
41   @params = ('(',@params,')') if (scalar(@params) == 2);
42   my (\$open,\$a,\$b,\$close) = @params;
43   if (!defined(\$close)) {\$close = \$b; \$b = \$a}
44   \$a = Value::makeValue(\$a); \$b = Value::makeValue(\$b);
45   return \$self->formula(\$open,\$a,\$b,\$close) if Value::isFormula(\$a) || Value::isFormula(\$b);
46   Value::Error("Endpoints of intervals must be numbers or infinities") unless
47     isNumOrInfinity(\$a) && isNumOrInfinity(\$b);
48   my (\$ia,\$ib) = (isInfinity(\$a),isInfinity(\$b));
49   my (\$nia,\$nib) = (isNegativeInfinity(\$a),isNegativeInfinity(\$b));
50   Value::Error("Can't make an interval only out of Infinity") if (\$ia && \$ib) || (\$nia && \$nib);
51   Value::Error("Left endpoint must be less than right endpoint")
52     unless \$nia || \$ib || (\$a <= \$b && !\$ia && !\$nib);
53   \$open  = '(' if \$open  eq '[' && \$nia; # should be error ?
54   \$close = ')' if \$close eq ']' && \$ib;  # ditto?
55   Value::Error("Open parenthesis of interval must be '(' or '['")
56     unless \$open eq '(' || \$open eq '[';
57   Value::Error("Close parenthesis of interval must be ')' or ']'")
58     unless \$close eq ')' || \$close eq ']';
59   return \$self->formula(\$open,\$a,\$b,\$close)
60     if Value::isFormula(\$a) || Value::isFormula(\$b);
61   Value::Error("Single point intervals must use '[' and ']'")
62     if \$a == \$b && (\$open ne '[' || \$close ne ']');
63   bless {
64     data => [\$a,\$b], open => \$open, close => \$close,
65     leftInfinite => \$nia, rightInfinite => \$ib,
66   }, \$class;
67 }
68
69 #
70 #  Similarly for make, but without the error checks
71 #
72 sub make {
73   my \$self = shift; my \$class = ref(\$self) || \$self;
74   my (\$open,\$a,\$b,\$close) = @_;
75   \$close = \$b, \$b = \$a unless defined(\$close);
76   bless {
77     data => [\$a,\$b], open => \$open, close => \$close,
78     leftInfinite => isNegativeInfinity(\$a), rightInfinite => isInfinity(\$b),
79   }, \$class
80 }
81
82 #
83 #  Make a formula out of the data for an interval
84 #
85 sub formula {
86   my \$self = shift;
87   my (\$open,\$a,\$b,\$close) = @_;
88   my \$formula = Value::Formula->blank;
89   (\$a,\$b) = Value::toFormula(\$formula,\$a,\$b);
90   \$formula->{tree} = \$formula->{context}{parser}{List}->new(\$formula,[\$a,\$b],0,
91      \$formula->{context}{parens}{\$open},\$Value::Type{number},\$open,\$close);
92   return \$formula;
93 }
94
95 #
96 #  Tests for infinities
97 #
98 sub isNumOrInfinity {
99   my \$n = shift;
100   return isInfinity(\$n) || isNegativeInfinity(\$n) || Value::isNumber(\$n);
101 }
102 sub isInfinity {
103   my \$n = shift;
104   return \$n->{tree}{isInfinity} if Value::isFormula(\$n);
105   \$n = Value::makeValue(\$n); return 0 unless ref(\$n);
106   return \$n->{isInfinite} && !\$n->{isNegative};
107 }
108 sub isNegativeInfinity {
109   my \$n = shift;
110   return \$n->{tree}{isNegativeInfinity} if Value::isFormula(\$n);
111   \$n = Value::makeValue(\$n); return 0 unless ref(\$n);
112   return \$n->{isInfinite} && \$n->{isNegative};
113 }
114
115 sub isOne {0}
116 sub isZero {0}
117
118 sub canBeInUnion {1}
119 sub isSetOfReals {1}
120
121 #
122 #  Return the open and close parens as well as the endpoints
123 #
124 sub value {
125   my \$self = shift;
126   my (\$a,\$b) = @{\$self->data};
127   return (\$a,\$b,\$self->{open},\$self->{close});
128 }
129
130 #
131 #  Return the number of endpoints
132 #
133 sub length {
134   my \$self = shift;
135   my (\$a,\$b) = \$self->data;
136   return \$a == \$b ? 1 : 2;
137 }
138
139 #
140 #  Convert points and lists to intervals, when needed
141 #
142 sub promote {
143   my \$x = Value::makeValue(shift);
144   return \$pkg->new(\$x,@_) if scalar(@_) > 0;
145   return \$x if \$x->isSetOfReals;
146   return Value::Set->new(\$x) if Value::class(\$x) eq 'Real';
147   my \$open  = \$x->{open};  \$open  = '(' unless defined(\$open);
148   my \$close = \$x->{close}; \$close = ')' unless defined(\$close);
149   return \$pkg->new(\$open,\$x->value,\$close) if \$x->canBeInUnion;
150   Value::Error("Can't convert %s to an Interval",Value::showClass(\$x));
151 }
152
153 ############################################
154 #
155 #  Operations on intervals
156 #
157
158 #
160 #
162   my (\$l,\$r,\$flag) = @_;
164   \$r = promote(\$r); if (\$flag) {my \$tmp = \$l; \$l = \$r; \$r = \$tmp}
165   Value::Union::form(\$l,\$r);
166 }
167 sub dot {my \$self = shift; \$self->add(@_)}
168
169 #
170 #  Subtraction can split into a union
171 #
172 sub sub {
173   my (\$l,\$r,\$flag) = @_;
174   if (\$l->promotePrecedence(\$r)) {return \$r->sub(\$l,!\$flag)}
175   \$r = promote(\$r); if (\$flag) {my \$tmp = \$l; \$l = \$r; \$r = \$tmp}
176   Value::Union::form(subIntervalInterval(\$l,\$r));
177 }
178
179 #
180 #  Subtract an interval from another
181 #    (returns the resulting interval(s), set
182 #     or nothing for emtpy set)
183 #
184 sub subIntervalInterval {
185   my (\$l,\$r) = @_; \$l = \$l->copy; \$r = \$r->copy;
186   my (\$a,\$b) = \$l->value; my (\$c,\$d) = \$r->value;
187   my @union = ();
188   if (\$d <= \$a) {
189     \$l->{open} = '(' if \$d == \$a && \$r->{close} eq ']';
190     push(@union,\$l) unless \$a == \$b && \$l->{open} eq '(';
191   } elsif (\$c >= \$b) {
192     \$l->{close} = ')' if \$c == \$b && \$r->{open} eq '[';
193     push(@union,\$l) unless \$a == \$b && \$l->{close} eq ')';
194   } else {
195     if (\$a == \$c) {
196       push(@union,Value::Set->make(\$a))
197   if \$l->{open} eq '[' && \$r->{open} eq '(';
198     } elsif (\$a < \$c) {
199       my \$close = (\$r->{open} eq '[')? ')': ']';
200       push(@union,Value::Interval->make(\$l->{open},\$a,\$c,\$close));
201     }
202     if (\$d == \$b) {
203       push(@union,Value::Set->make(\$b))
204   if \$l->{close} eq ']' && \$r->{close} eq ')';
205     } elsif (\$d < \$b) {
206       my \$open = (\$r->{close} eq ']') ? '(': '[';
207       push(@union,Value::Interval->make(\$open,\$d,\$b,\$l->{close}));
208     }
209   }
210   return @union;
211 }
212
213 #
214 #  Lexicographic order, but with type of endpoint included
215 #    in the test.
216 #
217 sub compare {
218   my (\$l,\$r,\$flag) = @_;
219   if (\$l->promotePrecedence(\$r)) {return \$r->compare(\$l,!\$flag)}
220   \$r = promote(\$r); if (\$flag) {my \$tmp = \$l; \$l = \$r; \$r = \$tmp};
221   my (\$la,\$lb) = @{\$l->data}; my (\$ra,\$rb) = @{\$r->data};
222   my \$cmp = \$la <=> \$ra; return \$cmp if \$cmp;
223   my \$ignoreEndpointTypes = \$l->getFlag('ignoreEndpointTypes');
224   \$cmp = \$l->{open} cmp \$r->{open}; return \$cmp if \$cmp && !\$ignoreEndpointTypes;
225   \$cmp = \$lb <=> \$rb; return \$cmp if \$cmp || \$ignoreEndpointTypes;
226   return \$l->{close} cmp \$r->{close};
227 }
228
229 ############################################
230 #
231 #  Utility routines
232 #
233
234 sub reduce {shift}
235 sub isReduced {1}
236 sub sort {shift}
237
238
239 #
240 #  Tests for containment, subsets, etc.
241 #
242
243 sub contains {
244   my \$self = shift; my \$other = promote(shift);
245   return (\$other - \$self)->isEmpty;
246 }
247
248 sub isSubsetOf {
249   my \$self = shift; my \$other = promote(shift);
250   return \$other->contains(\$self);
251 }
252
253 sub isEmpty {0}
254
255 sub intersect {
256   my \$self = shift; my \$other = shift;
257   return \$self-(\$self-\$other);
258 }
259
260 sub intersects {
261   my \$self = shift; my \$other = shift;
262   return !\$self->intersect(\$other)->isEmpty;
263 }
264
265 ###########################################################################
266
267 1;
```