[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 2625 - (download) (as text) (annotate)
Mon Aug 16 18:35:12 2004 UTC (15 years, 3 months ago) by dpvc
File size: 4261 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 #  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        '+'   => \&add,
   14        '.'   => \&Value::_dot,
   15        'x'   => \&Value::cross,
   16        '<=>' => \&compare,
   17        'cmp' => \&Value::cmp,
   18   'nomethod' => \&Value::nomethod,
   19         '""' => \&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   $p = $p->data if (Value::isValue($p) && scalar(@_) == 0);
   29   $p = [$p,@_] if (ref($p) ne 'ARRAY' || scalar(@_) > 0);
   30   my $type;
   31   foreach my $x (@{$p}) {
   32     $isFormula = 1 if Value::isFormula($x);
   33     $x = Value::makeValue($x) unless ref($x);
   34     if (Value::isValue($x)) {
   35       if (!$type) {$type = $x->type}
   36         else {$type = 'unknown' unless $type eq $x->type}
   37     } else {$type = 'unknown'}
   38   }
   39   return $self->formula($p) if $isFormula;
   40   bless {data => $p, type => $type}, $class;
   41 }
   42 
   43 #
   44 #  Return the proper data
   45 #
   46 sub length {return scalar(@{shift->{data}})}
   47 sub typeRef {
   48   my $self = shift;
   49   return Value::Type($self->class, $self->length, Value::Type($self->{type},1));
   50 }
   51 
   52 #
   53 #  Turn arbitrary data into a List
   54 #
   55 sub promote {
   56   my $x = shift;
   57   return $x if (ref($x) eq $pkg && scalar(@_) == 0);
   58   return $pkg->new($x,@_)
   59     if (scalar(@_) > 0 || !Value::isValue($x) || Value::isComplex($x));
   60   return $pkg->make(@{$x->data});
   61 }
   62 
   63 ############################################
   64 #
   65 #  Operations on lists
   66 #
   67 
   68 #
   69 #  Add is concatenation
   70 #
   71 sub add {
   72   my ($l,$r,$flag) = @_;
   73   if ($l->promotePrecedence($r)) {return $r->add($l,!$flag)}
   74   if ($flag) {my $tmp = $l; $l = $r; $r = $tmp}
   75   $l = $pkg->make($l) if Value::class($l) =~ m/Point|Vector|Matrix/;
   76   $r = $pkg->make($r) if Value::class($r) =~ m/Point|Vector|Matrix/;
   77   ($l,$r) = (promote($l)->data,promote($r)->data);
   78   return $pkg->new(@{$l},@{$r});
   79 }
   80 sub dot {add(@_)}
   81 
   82 #
   83 #  Lexicographic compare
   84 #
   85 sub compare {
   86   my ($l,$r,$flag) = @_;
   87   if ($l->promotePrecedence($r)) {return $r->compare($l,!$flag)}
   88   ($l,$r) = (promote($l)->data,promote($r)->data);
   89   if ($flag) {my $tmp = $l; $l = $r; $r = $tmp};
   90   my $cmp = 0; my $n = scalar(@{$l}); $n = scalar(@{$r}) if scalar(@{$r}) < $n;
   91   foreach my $i (0..$n-1) {
   92     $cmp = $l->[$i] <=> $r->[$i];
   93     return $cmp if $cmp;
   94   }
   95   return scalar(@{$l}) <=> scalar(@{$r});
   96 }
   97 
   98 ############################################
   99 #
  100 #  Generate the various output formats.
  101 #
  102 
  103 sub stringify {
  104   my $self = shift;
  105   return $self->TeX() if $$Value::context->flag('StringifyAsTeX');
  106   my $open = $self->{open}; my $close = $self->{close};
  107   $open  = $$Value::context->lists->get('List')->{open} unless defined($open);
  108   $close = $$Value::context->lists->get('List')->{close} unless defined($close);
  109   $open.join(', ',@{$self->data}).$close;
  110 }
  111 
  112 sub string {
  113   my $self = shift; my $equation = shift;
  114   my $def = ($equation->{context} || $$Value::context)->lists->get('List');
  115   my $open = shift; my $close = shift;
  116   $open  = $def->{open} unless defined($open);
  117   $close = $def->{close} unless defined($close);
  118   my @coords = ();
  119   foreach my $x (@{$self->data}) {
  120     if (Value::isValue($x))
  121       {push(@coords,$x->string($equation))} else {push(@coords,$x)}
  122   }
  123   return $open.join(', ',@coords).$close;
  124 }
  125 sub TeX {
  126   my $self = shift; my $equation = shift;
  127   my $context = $equation->{context} || $$Value::context;
  128   my $def = $context->lists->get('List');
  129   my $open = shift; my $close = shift;
  130   $open  = $def->{open} unless defined($open);
  131   $close = $def->{close} unless defined($close);
  132   $open = '\{' if $open eq '{'; $close = '\}' if $close eq '}';
  133   $open = '\left'.$open if $open; $close = '\right'.$close if $close;
  134   my @coords = (); my $str = $context->{strings};
  135   foreach my $x (@{$self->data}) {
  136     if (Value::isValue($x)) {push(@coords,$x->TeX($equation))}
  137     elsif (defined($str->{$x}) && $str->{$x}{TeX}) {push(@coords,$str->{$x}{TeX})}
  138     else {push(@coords,$x)}
  139   }
  140   return $open.join(',',@coords).$close;
  141 }
  142 
  143 ###########################################################################
  144 
  145 1;
  146 

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9