[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 2800 - (download) (as text) (annotate)
Sun Sep 19 14:27:39 2004 UTC (15 years, 5 months ago) by dpvc
File size: 4314 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 #  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) && $p->class eq 'List' && 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 sub isOne {0}
   53 sub isZero {0}
   54 
   55 #
   56 #  Turn arbitrary data into a List
   57 #
   58 sub promote {
   59   my $x = shift;
   60   return $x if (ref($x) eq $pkg && scalar(@_) == 0);
   61   return $pkg->new($x,@_)
   62     if (scalar(@_) > 0 || !Value::isValue($x) || Value::isComplex($x));
   63   return $pkg->make(@{$x->data});
   64 }
   65 
   66 ############################################
   67 #
   68 #  Operations on lists
   69 #
   70 
   71 #
   72 #  Add is concatenation
   73 #
   74 sub add {
   75   my ($l,$r,$flag) = @_;
   76   if ($l->promotePrecedence($r)) {return $r->add($l,!$flag)}
   77   if ($flag) {my $tmp = $l; $l = $r; $r = $tmp}
   78   $l = $pkg->make($l) if Value::class($l) =~ m/Point|Vector|Matrix/;
   79   $r = $pkg->make($r) if Value::class($r) =~ m/Point|Vector|Matrix/;
   80   ($l,$r) = (promote($l)->data,promote($r)->data);
   81   return $pkg->new(@{$l},@{$r});
   82 }
   83 sub dot {add(@_)}
   84 
   85 #
   86 #  Lexicographic compare
   87 #
   88 sub compare {
   89   my ($l,$r,$flag) = @_;
   90   if ($l->promotePrecedence($r)) {return $r->compare($l,!$flag)}
   91   ($l,$r) = (promote($l)->data,promote($r)->data);
   92   if ($flag) {my $tmp = $l; $l = $r; $r = $tmp};
   93   my $cmp = 0; my $n = scalar(@{$l}); $n = scalar(@{$r}) if scalar(@{$r}) < $n;
   94   foreach my $i (0..$n-1) {
   95     $cmp = $l->[$i] <=> $r->[$i];
   96     return $cmp if $cmp;
   97   }
   98   return scalar(@{$l}) <=> scalar(@{$r});
   99 }
  100 
  101 ############################################
  102 #
  103 #  Generate the various output formats.
  104 #
  105 
  106 sub stringify {
  107   my $self = shift;
  108   return $self->TeX() if $$Value::context->flag('StringifyAsTeX');
  109   my $open = $self->{open}; my $close = $self->{close};
  110   $open  = $$Value::context->lists->get('List')->{open} unless defined($open);
  111   $close = $$Value::context->lists->get('List')->{close} unless defined($close);
  112   $open.join(', ',@{$self->data}).$close;
  113 }
  114 
  115 sub string {
  116   my $self = shift; my $equation = shift;
  117   my $def = ($equation->{context} || $$Value::context)->lists->get('List');
  118   my $open = shift; my $close = shift;
  119   $open  = $def->{open} unless defined($open);
  120   $close = $def->{close} unless defined($close);
  121   my @coords = ();
  122   foreach my $x (@{$self->data}) {
  123     if (Value::isValue($x))
  124       {push(@coords,$x->string($equation))} else {push(@coords,$x)}
  125   }
  126   return $open.join(', ',@coords).$close;
  127 }
  128 sub TeX {
  129   my $self = shift; my $equation = shift;
  130   my $context = $equation->{context} || $$Value::context;
  131   my $def = $context->lists->get('List');
  132   my $open = shift; my $close = shift;
  133   $open  = $def->{open} unless defined($open);
  134   $close = $def->{close} unless defined($close);
  135   $open = '\{' if $open eq '{'; $close = '\}' if $close eq '}';
  136   $open = '\left'.$open if $open; $close = '\right'.$close if $close;
  137   my @coords = (); my $str = $context->{strings};
  138   foreach my $x (@{$self->data}) {
  139     if (Value::isValue($x)) {push(@coords,$x->TeX($equation))}
  140     elsif (defined($str->{$x}) && $str->{$x}{TeX}) {push(@coords,$str->{$x}{TeX})}
  141     else {push(@coords,$x)}
  142   }
  143   return $open.join(',',@coords).$close;
  144 }
  145 
  146 ###########################################################################
  147 
  148 1;
  149 

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9