[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 5056 - (download) (as text) (annotate)
Thu Jun 28 11:32:10 2007 UTC (12 years, 7 months ago) by dpvc
File size: 2756 byte(s)
Make List() preserve the correct_ans field when it is used to coerce a
single element to a singleton list.

    1 ###########################################################################
    2 #
    3 #  Implements the List object
    4 #
    5 package Value::List;
    6 my $pkg = 'Value::List';
    7 
    8 use strict;
    9 our @ISA = qw(Value);
   10 
   11 #
   12 #  Make a List out of a list of entries or a
   13 #    reference to an array of entries, or the data from a Value object
   14 #
   15 sub new {
   16   my $self = shift; my $class = ref($self) || $self;
   17   my $context = (Value::isContext($_[0]) ? shift : $self->context);
   18   my $p = shift; my $isFormula = 0;
   19   my $isSingleton = (scalar(@_) == 0 && !(Value::isValue($p) && $p->classMatch('List')));
   20   $p = $p->data if (Value::isValue($p) && $p->classMatch('List') && scalar(@_) == 0);
   21   $p = [$p,@_] if (ref($p) ne 'ARRAY' || scalar(@_) > 0);
   22   my $type;
   23   foreach my $x (@{$p}) {
   24     $x = Value::makeValue($x,context=>$context) unless ref($x);
   25     $isFormula = 1 if Value::isFormula($x);
   26     if (Value::isValue($x)) {
   27       if (!$type) {$type = $x->type}
   28         else {$type = 'unknown' unless $type eq $x->type}
   29     } else {$type = 'unknown'}
   30   }
   31   return $p->[0] if ($isSingleton && $type eq 'List' && !$p->[0]{open});
   32   return $self->formula($p) if $isFormula;
   33   my $list = bless {data => $p, type => $type, context=>$context}, $class;
   34   $list->{correct_ans} = $p->[0]{correct_ans} if $isSingleton && defined $p->[0]{correct_ans};
   35   return $list;
   36 }
   37 
   38 #
   39 #  Return the proper data
   40 #
   41 sub typeRef {
   42   my $self = shift;
   43   return Value::Type($self->class, $self->length, Value::Type($self->{type},1));
   44 }
   45 
   46 sub isOne {0}
   47 sub isZero {0}
   48 
   49 #
   50 #  Turn arbitrary data into a List
   51 #
   52 sub promote {
   53   my $self = shift; my $class = ref($self) || $self;
   54   my $context = (Value::isContext($_[0]) ? shift : $self->context);
   55   my $x = (scalar(@_) ? shift : $self);
   56   return $x->inContext($context) if ref($x) eq $class && scalar(@_) == 0;
   57   return $self->new($context,$x,@_)
   58     if (scalar(@_) > 0 || !Value::isValue($x) || Value::isComplex($x));
   59   return $self->make($context,$x->value);
   60 }
   61 
   62 ############################################
   63 #
   64 #  Operations on lists
   65 #
   66 
   67 #
   68 #  Add is concatenation
   69 #
   70 sub add {
   71   my ($self,$l,$r) = Value::checkOpOrder(@_);
   72   $l = $self->make($l) if Value::classMatch($l,'Point','Vector','Matrix');
   73   $r = $self->make($r) if Value::classMatch($r,'Point','Vector','Matrix');
   74   return $self->new($l->value,$r->value);
   75 }
   76 sub dot {my $self = shift; $self->add(@_)}
   77 
   78 #
   79 #  Lexicographic compare
   80 #
   81 sub compare {
   82   my ($self,$l,$r) = Value::checkOpOrderWithPromote(@_);
   83   my @l = $l->value; my @r = $r->value;
   84   my $cmp = 0; my $n = scalar(@l); $n = scalar(@r) if scalar(@r) < $n;
   85   foreach my $i (0..$n-1) {
   86     $cmp = $l[$i] <=> $r[$i];
   87     return $cmp if $cmp;
   88   }
   89   return scalar(@l) <=> scalar(@r);
   90 }
   91 
   92 ###########################################################################
   93 
   94 1;
   95 

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9