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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 2800 - (download) (as text) (annotate)
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 
   10 use overload
   11        '+'   => \&add,
   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 #
   85 #  Addition forms additional unions
   86 #
   87 sub add {
   88   my ($l,$r,$flag) = @_;
   89   if ($l->promotePrecedence($r)) {return $r->add($l,!$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 }
   98 sub dot {add(@_)}
   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 

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9