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

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

Sun Sep 19 14:27:39 2004 UTC (15 years, 5 months ago) by dpvc
File size: 4517 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 package Value::Union;
4 my \$pkg = 'Value::Union';
5
6 use strict;
7 use vars qw(@ISA);
8 @ISA = qw(Value);
9
12        '.'   => \&Value::_dot,
13        'x'   => \&Value::cross,
14        '<=>' => \&compare,
15        'cmp' => \&Value::cmp,
16   'nomethod' => \&Value::nomethod,
17         '""' => \&Value::stringify;
18
19 #
20 #  Convert a value to a union of intervals.  The value must be
21 #      a list of two or more Interval, Union or Point objects.
22 #      Points will be converted to intervals if they are length 1 or 2.
23 #
24 sub new {
25   my \$self = shift; my \$class = ref(\$self) || \$self;
26   @_ = split("U",@_[0]) if scalar(@_) == 1 && !ref(\$_[0]);
27   Value::Error("Unions must be of at least two intervals") unless scalar(@_) > 1;
28   my @intervals = (); my \$isFormula = 0;
29   foreach my \$xx (@_) {
30     my \$x = \$xx; \$x = Value::Interval->new(\$x) if !ref(\$x);
31     if (Value::isFormula(\$x)) {
32       \$x->{tree}->typeRef->{name} = 'Interval' if (\$x->type eq 'Point' && \$x->length == 1);
33       if (\$x->type eq 'Interval') {push(@intervals,\$x)}
34       elsif (\$x->type eq 'Union') {push(@intervals,\$x->{tree}->makeUnion)}
35       else {Value::Error("Unions can be taken only for Intervals")}
36       \$isFormula = 1;
37     } else {
38       if (Value::class(\$x) eq 'Point' || Value::class(\$x) eq 'List') {
39         if (\$x->length == 1) {\$x = Value::Interval->new('[',\$x->value,\$x->value,']')}
40         elsif (\$x->length == 2) {\$x = Value::Interval->new(\$x->{open},\$x->value,\$x->{close})}
41       }
42       if (Value::class(\$x) eq 'Interval') {push(@intervals,\$x)}
43       elsif (Value::class(\$x) eq 'Union') {push(@intervals,@{\$x->{data}})}
44       else {Value::Error("Unions can be taken only for Intervals")}
45     }
46   }
47   return \$self->formula(@intervals) if \$isFormula;
48   bless {data => [@intervals], canBeInterval => 1}, \$class;
49 }
50
51 #
52 #  Return the appropriate data.
53 #
54 sub length {return scalar(@{shift->{data}})}
55 sub typeRef {
56   my \$self = shift;
57   return Value::Type(\$self->class, \$self->length, \$self->data->[0]->typeRef);
58 }
59
60 sub isOne {0}
61 sub isZero {0}
62
63 #
64 #  Recursively convert the list of intervals to a tree of unions
65 #
66 sub formula {
67   my \$selft = shift;
68   my \$formula = Value::Formula->blank;
69   \$formula->{tree} = recursiveUnion(\$formula,Value::toFormula(\$formula,@_));
70   return \$formula
71 }
72 sub recursiveUnion {
73   my \$formula = shift; my \$right = pop(@_);
74   return \$right if (scalar(@_) == 0);
75   return \$formula->{context}{parser}{BOP}->
76     new(\$formula,'U',recursiveUnion(\$formula,@_),\$right);
77 }
78
79 ############################################
80 #
81 #  Operations on unions
82 #
83
84 #
86 #
88   my (\$l,\$r,\$flag) = @_;
90   if (\$flag) {my \$tmp = \$l; \$l = \$r; \$r = \$tmp}
91   Value::Error("Unions can only be added to Intervals or Unions")
92     unless Value::class(\$l) =~ m/Interval|Union/ &&
93            Value::class(\$r) =~ m/Interval|Union/;
94   \$l = \$pkg->make(\$l) if (\$l->class eq 'Interval');
95   \$r = \$pkg->make(\$r) if (\$r->class eq 'Interval');
96   return \$pkg->make(@{\$l->data},@{\$r->data});
97 }
99
100 #
101 #  @@@ Needs work @@@
102 #
103 #  Sort the intervals lexicographically, and then
104 #    compare interval by interval.
105 #
106 sub compare {
107   my (\$l,\$r,\$flag) = @_;
108   if (\$flag) {my \$tmp = \$l; \$l = \$r; \$r = \$tmp};
109   return  1 if Value::class(\$r) ne 'Union';
110   return -1 if Value::class(\$l) ne 'Union';
111   my @l = sort(@{\$l->data}); my @r = sort(@{\$r->data});
112   return scalar(@l) <=> scalar(@r) unless scalar(@l) == scalar(@r);
113   my \$cmp = 0;
114   foreach my \$i (0..\$#l) {
115     \$cmp = \$l[\$i] <=> \$r[\$i];
116     last if \$cmp;
117   }
118   return \$cmp;
119 }
120
121 # @@@ simplify (combine intervals, if possible) @@@
122
123 ############################################
124 #
125 #  Generate the various output formats
126 #
127
128 sub string {
129   my \$self = shift; my \$equation = shift;
130   my \$context = \$equation->{context} || \$\$Value::context;
131   my \$union = \$context->{operators}{'U'}{string} || ' U ';
132   my @intervals = ();
133   foreach my \$x (@{\$self->data}) {push(@intervals,\$x->string(\$equation))}
134   return join(\$union,@intervals);
135 }
136
137 sub TeX {
138   my \$self = shift; my \$equation = shift;
139   my \$context = \$equation->{context} || \$\$Value::context;
140   my @intervals = (); my \$op = \$context->{operators}{'U'};
141   foreach my \$x (@{\$self->data}) {push(@intervals,\$x->TeX(\$equation))}
142   return join(\$op->{TeX} || \$op->{string} || ' U ',@intervals);
143 }
144
145 ###########################################################################
146
147 1;
148
```