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

    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        '.'   => \&Value::_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     $isFormula = 1 if Value::isFormula($x);
   34     $x = Value::makeValue($x) unless ref($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 {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 #  Generate the various output formats.
  105 #
  106 
  107 sub stringify {
  108   my $self = shift;
  109   return $self->TeX() if $$Value::context->flag('StringifyAsTeX');
  110   my $open = $self->{open}; my $close = $self->{close};
  111   $open  = $$Value::context->lists->get('List')->{open} unless defined($open);
  112   $close = $$Value::context->lists->get('List')->{close} unless defined($close);
  113   $open.join(', ',@{$self->data}).$close;
  114 }
  115 
  116 sub string {
  117   my $self = shift; my $equation = shift;
  118   my $def = ($equation->{context} || $$Value::context)->lists->get('List');
  119   my $open = shift; my $close = shift;
  120   $open  = $def->{open} unless defined($open);
  121   $close = $def->{close} unless defined($close);
  122   my @coords = ();
  123   foreach my $x (@{$self->data}) {
  124     if (Value::isValue($x))
  125       {push(@coords,$x->string($equation))} else {push(@coords,$x)}
  126   }
  127   return $open.join(', ',@coords).$close;
  128 }
  129 sub TeX {
  130   my $self = shift; my $equation = shift;
  131   my $context = $equation->{context} || $$Value::context;
  132   my $def = $context->lists->get('List');
  133   my $open = shift; my $close = shift;
  134   $open  = $def->{open} unless defined($open);
  135   $close = $def->{close} unless defined($close);
  136   $open = '\{' if $open eq '{'; $close = '\}' if $close eq '}';
  137   $open = '\left'.$open if $open; $close = '\right'.$close if $close;
  138   my @coords = (); my $str = $context->{strings};
  139   foreach my $x (@{$self->data}) {
  140     if (Value::isValue($x)) {push(@coords,$x->TeX($equation))}
  141     elsif (defined($str->{$x}) && $str->{$x}{TeX}) {push(@coords,$str->{$x}{TeX})}
  142     else {push(@coords,$x)}
  143   }
  144   return $open.join(',',@coords).$close;
  145 }
  146 
  147 ###########################################################################
  148 
  149 1;
  150