Parent Directory
| 
Revision Log
Revision 3444 - (view) (download) (as text)
| 1 : | sh002i | 2558 | ########################################################################### |
| 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 : | dpvc | 3192 | '+' => sub {shift->add(@_)}, |
| 14 : | sh002i | 2558 | '.' => \&Value::_dot, |
| 15 : | dpvc | 3192 | 'x' => sub {shift->cross(@_)}, |
| 16 : | '<=>' => sub {shift->compare(@_)}, | ||
| 17 : | 'cmp' => sub {shift->compare_string(@_)}, | ||
| 18 : | 'nomethod' => sub {shift->nomethod(@_)}, | ||
| 19 : | '""' => sub {shift->stringify(@_)}; | ||
| 20 : | sh002i | 2558 | |
| 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 : | dpvc | 3444 | my $isSingleton = (scalar(@_) == 0 && !(Value::isValue($p) && $p->class eq 'List')); |
| 29 : | dpvc | 2629 | $p = $p->data if (Value::isValue($p) && $p->class eq 'List' && scalar(@_) == 0); |
| 30 : | sh002i | 2558 | $p = [$p,@_] if (ref($p) ne 'ARRAY' || scalar(@_) > 0); |
| 31 : | dpvc | 2621 | my $type; |
| 32 : | dpvc | 2599 | foreach my $x (@{$p}) { |
| 33 : | dpvc | 2621 | $isFormula = 1 if Value::isFormula($x); |
| 34 : | dpvc | 2603 | $x = Value::makeValue($x) unless ref($x); |
| 35 : | dpvc | 2621 | if (Value::isValue($x)) { |
| 36 : | if (!$type) {$type = $x->type} | ||
| 37 : | else {$type = 'unknown' unless $type eq $x->type} | ||
| 38 : | } else {$type = 'unknown'} | ||
| 39 : | dpvc | 2599 | } |
| 40 : | dpvc | 3444 | return $p->[0] if ($isSingleton && $type eq 'List' && !$p->[0]{open}); |
| 41 : | sh002i | 2558 | return $self->formula($p) if $isFormula; |
| 42 : | dpvc | 2621 | bless {data => $p, type => $type}, $class; |
| 43 : | sh002i | 2558 | } |
| 44 : | |||
| 45 : | # | ||
| 46 : | # Return the proper data | ||
| 47 : | # | ||
| 48 : | sub typeRef { | ||
| 49 : | my $self = shift; | ||
| 50 : | dpvc | 2621 | return Value::Type($self->class, $self->length, Value::Type($self->{type},1)); |
| 51 : | sh002i | 2558 | } |
| 52 : | |||
| 53 : | dpvc | 2800 | sub isOne {0} |
| 54 : | sub isZero {0} | ||
| 55 : | |||
| 56 : | sh002i | 2558 | # |
| 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 : | dpvc | 2603 | if (scalar(@_) > 0 || !Value::isValue($x) || Value::isComplex($x)); |
| 64 : | sh002i | 2558 | 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 : | dpvc | 2592 | my $cmp = 0; my $n = scalar(@{$l}); $n = scalar(@{$r}) if scalar(@{$r}) < $n; |
| 95 : | foreach my $i (0..$n-1) { | ||
| 96 : | sh002i | 2558 | $cmp = $l->[$i] <=> $r->[$i]; |
| 97 : | dpvc | 2592 | return $cmp if $cmp; |
| 98 : | sh002i | 2558 | } |
| 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 : | dpvc | 2612 | return $self->TeX() if $$Value::context->flag('StringifyAsTeX'); |
| 110 : | dpvc | 2604 | my $open = $self->{open}; my $close = $self->{close}; |
| 111 : | dpvc | 2592 | $open = $$Value::context->lists->get('List')->{open} unless defined($open); |
| 112 : | $close = $$Value::context->lists->get('List')->{close} unless defined($close); | ||
| 113 : | dpvc | 2604 | $open.join(', ',@{$self->data}).$close; |
| 114 : | sh002i | 2558 | } |
| 115 : | |||
| 116 : | sub string { | ||
| 117 : | my $self = shift; my $equation = shift; | ||
| 118 : | dpvc | 2612 | my $def = ($equation->{context} || $$Value::context)->lists->get('List'); |
| 119 : | dpvc | 2592 | my $open = shift; my $close = shift; |
| 120 : | dpvc | 2612 | $open = $def->{open} unless defined($open); |
| 121 : | $close = $def->{close} unless defined($close); | ||
| 122 : | sh002i | 2558 | my @coords = (); |
| 123 : | foreach my $x (@{$self->data}) { | ||
| 124 : | if (Value::isValue($x)) | ||
| 125 : | dpvc | 2612 | {push(@coords,$x->string($equation))} else {push(@coords,$x)} |
| 126 : | sh002i | 2558 | } |
| 127 : | dpvc | 2604 | return $open.join(', ',@coords).$close; |
| 128 : | sh002i | 2558 | } |
| 129 : | sub TeX { | ||
| 130 : | my $self = shift; my $equation = shift; | ||
| 131 : | dpvc | 2612 | my $context = $equation->{context} || $$Value::context; |
| 132 : | my $def = $context->lists->get('List'); | ||
| 133 : | dpvc | 2592 | my $open = shift; my $close = shift; |
| 134 : | dpvc | 2612 | $open = $def->{open} unless defined($open); |
| 135 : | $close = $def->{close} unless defined($close); | ||
| 136 : | sh002i | 2558 | $open = '\{' if $open eq '{'; $close = '\}' if $close eq '}'; |
| 137 : | dpvc | 2599 | $open = '\left'.$open if $open; $close = '\right'.$close if $close; |
| 138 : | dpvc | 2612 | my @coords = (); my $str = $context->{strings}; |
| 139 : | sh002i | 2558 | foreach my $x (@{$self->data}) { |
| 140 : | dpvc | 2612 | if (Value::isValue($x)) {push(@coords,$x->TeX($equation))} |
| 141 : | sh002i | 2558 | elsif (defined($str->{$x}) && $str->{$x}{TeX}) {push(@coords,$str->{$x}{TeX})} |
| 142 : | else {push(@coords,$x)} | ||
| 143 : | } | ||
| 144 : | dpvc | 2599 | return $open.join(',',@coords).$close; |
| 145 : | sh002i | 2558 | } |
| 146 : | |||
| 147 : | ########################################################################### | ||
| 148 : | |||
| 149 : | 1; | ||
| 150 : |
| aubreyja at gmail dot com | ViewVC Help |
| Powered by ViewVC 1.0.9 |