[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 2625 - (download) (as text) (annotate)
Mon Aug 16 18:35:12 2004 UTC (15 years, 3 months ago) by dpvc
File size: 4529 byte(s)
Added string comparison to all Value object classes (to compare the
string value of an object to another string).

Overloaded perl '.' operator to do dot product when the operands are
formulas returning vectors.  (Part of the auto-generation of
formulas).

A few improvements to real and complex class output results.

Made Union class slightly more robust and removed need for makeUnion
method other than in the Union itself.

    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 #
   61 #  Recursively convert the list of intervals to a tree of unions
   62 #
   63 sub formula {
   64   my $selft = shift;
   65   my $formula = Value::Formula->blank;
   66   $formula->{tree} = recursiveUnion($formula,Value::toFormula($formula,@_));
   67 #   return $formula->eval if scalar(%{$formula->{variables}}) == 0;
   68   return $formula
   69 }
   70 sub recursiveUnion {
   71   my $formula = shift; my $right = pop(@_);
   72   return $right if (scalar(@_) == 0);
   73   return Parser::BOP->new($formula,'U',recursiveUnion($formula,@_),$right);
   74 }
   75 
   76 ############################################
   77 #
   78 #  Operations on unions
   79 #
   80 
   81 #
   82 #  Addition forms additional unions
   83 #
   84 sub add {
   85   my ($l,$r,$flag) = @_;
   86   if ($l->promotePrecedence($r)) {return $r->add($l,!$flag)}
   87   if ($flag) {my $tmp = $l; $l = $r; $r = $tmp}
   88   Value::Error("Unions can only be added to Intervals or Unions")
   89     unless Value::class($l) =~ m/Interval|Union/ &&
   90            Value::class($r) =~ m/Interval|Union/;
   91   $l = $pkg->make($l) if ($l->class eq 'Interval');
   92   $r = $pkg->make($r) if ($r->class eq 'Interval');
   93   return $pkg->make(@{$l->data},@{$r->data});
   94 }
   95 sub dot {add(@_)}
   96 
   97 #
   98 #  @@@ Needs work @@@
   99 #
  100 #  Sort the intervals lexicographically, and then
  101 #    compare interval by interval.
  102 #
  103 sub compare {
  104   my ($l,$r,$flag) = @_;
  105   if ($flag) {my $tmp = $l; $l = $r; $r = $tmp};
  106   return  1 if Value::class($r) ne 'Union';
  107   return -1 if Value::class($l) ne 'Union';
  108   my @l = sort(@{$l->data}); my @r = sort(@{$r->data});
  109   return scalar(@l) <=> scalar(@r) unless scalar(@l) == scalar(@r);
  110   my $cmp = 0;
  111   foreach my $i (0..$#l) {
  112     $cmp = $l[$i] <=> $r[$i];
  113     last if $cmp;
  114   }
  115   return $cmp;
  116 }
  117 
  118 # @@@ simplify (combine intervals, if possible) @@@
  119 
  120 ############################################
  121 #
  122 #  Generate the various output formats
  123 #
  124 
  125 sub string {
  126   my $self = shift; my $equation = shift;
  127   my $context = $equation->{context} || $$Value::context;
  128   my $union = $context->{operators}{'U'}{string} || ' U ';
  129   my @intervals = ();
  130   foreach my $x (@{$self->data}) {push(@intervals,$x->string($equation))}
  131   return join($union,@intervals);
  132 }
  133 
  134 sub TeX {
  135   my $self = shift; my $equation = shift;
  136   my $context = $equation->{context} || $$Value::context;
  137   my @intervals = (); my $op = $context->{operators}{'U'};
  138   foreach my $x (@{$self->data}) {push(@intervals,$x->TeX($equation))}
  139   return join($op->{TeX} || $op->{string} || ' U ',@intervals);
  140 }
  141 
  142 ###########################################################################
  143 
  144 1;
  145 

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9