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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 3716 - (download) (as text) (annotate)
Sun Oct 16 03:37:17 2005 UTC (14 years, 1 month ago) by dpvc
File size: 2895 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 List object
    4 #
    5 package Value::List;
    6 my $pkg = 'Value::List';
    7 
    8 use strict;
    9 use vars qw(@ISA);
   10 @ISA = qw(Value);
   11 
   12 use overload
   13        '+'   => sub {shift->add(@_)},
   14        '.'   => sub {shift->_dot(@_)},
   15        'x'   => sub {shift->cross(@_)},
   16        '<=>' => sub {shift->compare(@_)},
   17        'cmp' => sub {shift->compare_string(@_)},
   18   'nomethod' => sub {shift->nomethod(@_)},
   19         '""' => sub {shift->stringify(@_)};
   20 
   21 #
   22 #  Make a List out of a list of entries or a
   23 #    reference to an array of entries, or the data from a Value object
   24 #
   25 sub new {
   26   my $self = shift; my $class = ref($self) || $self;
   27   my $p = shift; my $isFormula = 0;
   28   my $isSingleton = (scalar(@_) == 0 && !(Value::isValue($p) && $p->class eq 'List'));
   29   $p = $p->data if (Value::isValue($p) && $p->class eq 'List' && scalar(@_) == 0);
   30   $p = [$p,@_] if (ref($p) ne 'ARRAY' || scalar(@_) > 0);
   31   my $type;
   32   foreach my $x (@{$p}) {
   33     $x = Value::makeValue($x) unless ref($x);
   34     $isFormula = 1 if Value::isFormula($x);
   35     if (Value::isValue($x)) {
   36       if (!$type) {$type = $x->type}
   37         else {$type = 'unknown' unless $type eq $x->type}
   38     } else {$type = 'unknown'}
   39   }
   40   return $p->[0] if ($isSingleton && $type eq 'List' && !$p->[0]{open});
   41   return $self->formula($p) if $isFormula;
   42   bless {data => $p, type => $type}, $class;
   43 }
   44 
   45 #
   46 #  Return the proper data
   47 #
   48 sub typeRef {
   49   my $self = shift;
   50   return Value::Type($self->class, $self->length, Value::Type($self->{type},1));
   51 }
   52 
   53 sub isOne {0}
   54 sub isZero {0}
   55 
   56 #
   57 #  Turn arbitrary data into a List
   58 #
   59 sub promote {
   60   my $x = shift;
   61   return $x if (ref($x) eq $pkg && scalar(@_) == 0);
   62   return $pkg->new($x,@_)
   63     if (scalar(@_) > 0 || !Value::isValue($x) || Value::isComplex($x));
   64   return $pkg->make(@{$x->data});
   65 }
   66 
   67 ############################################
   68 #
   69 #  Operations on lists
   70 #
   71 
   72 #
   73 #  Add is concatenation
   74 #
   75 sub add {
   76   my ($l,$r,$flag) = @_;
   77   if ($l->promotePrecedence($r)) {return $r->add($l,!$flag)}
   78   if ($flag) {my $tmp = $l; $l = $r; $r = $tmp}
   79   $l = $pkg->make($l) if Value::class($l) =~ m/Point|Vector|Matrix/;
   80   $r = $pkg->make($r) if Value::class($r) =~ m/Point|Vector|Matrix/;
   81   ($l,$r) = (promote($l)->data,promote($r)->data);
   82   return $pkg->new(@{$l},@{$r});
   83 }
   84 sub dot {my $self = shift; $self->add(@_)}
   85 
   86 #
   87 #  Lexicographic compare
   88 #
   89 sub compare {
   90   my ($l,$r,$flag) = @_;
   91   if ($l->promotePrecedence($r)) {return $r->compare($l,!$flag)}
   92   ($l,$r) = (promote($l)->data,promote($r)->data);
   93   if ($flag) {my $tmp = $l; $l = $r; $r = $tmp};
   94   my $cmp = 0; my $n = scalar(@{$l}); $n = scalar(@{$r}) if scalar(@{$r}) < $n;
   95   foreach my $i (0..$n-1) {
   96     $cmp = $l->[$i] <=> $r->[$i];
   97     return $cmp if $cmp;
   98   }
   99   return scalar(@{$l}) <=> scalar(@{$r});
  100 }
  101 
  102 ###########################################################################
  103 
  104 1;
  105 

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9