[system] / trunk / pg / lib / Value / Vector.pm Repository:
ViewVC logotype

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 5042 - (download) (as text) (annotate)
Thu Jun 28 01:31:09 2007 UTC (12 years, 7 months ago) by dpvc
File size: 9343 byte(s)
Recent changes to automatically do promotion in the Value methods was
a mistake.  I put it back into the subclass methods again.

    1 ###########################################################################
    2 #
    3 #  Implements Vector class
    4 #
    5 package Value::Vector;
    6 my $pkg = 'Value::Vector';
    7 
    8 use strict;
    9 our @ISA = qw(Value);
   10 
   11 #
   12 #  Convert a value to a Vector.  The value can be
   13 #    a list of numbers, or an reference to an array of numbers
   14 #    a point or vector object (demote a vector)
   15 #    a matrix if it is  n x 1  or  1 x n
   16 #    a string that parses to a vector
   17 #
   18 sub new {
   19   my $self = shift; my $class = ref($self) || $self;
   20   my $context = (Value::isContext($_[0]) ? shift : $self->context);
   21   my $p = shift; $p = [$p,@_] if (scalar(@_) > 0);
   22   $p = Value::makeValue($p,context=>$context) if (defined($p) && !ref($p));
   23   return $p if (Value::isFormula($p) && Value::classMatch($self,$p->type));
   24   my $isMatrix = Value::classMatch($p,'Matrix'); my $isFormula = 0;
   25   my @d; @d = $p->dimensions if $isMatrix;
   26   if (Value::classMatch($p,'Point','Vector')) {$p = $p->data}
   27   elsif ($isMatrix && scalar(@d) == 1) {$p = [$p->value]}
   28   elsif ($isMatrix && scalar(@d) == 2 && $d[0] == 1) {$p = ($p->value)[0]}
   29   elsif ($isMatrix && scalar(@d) == 2 && $d[1] == 1) {$p = ($p->transpose->value)[0]}
   30   else {
   31     $p = [$p] if (defined($p) && ref($p) ne 'ARRAY');
   32     Value::Error("Vectors must have at least one coordinate") unless defined($p) && scalar(@{$p}) > 0;
   33     foreach my $x (@{$p}) {
   34       $x = Value::makeValue($x,context=>$context);
   35       $isFormula = 1 if Value::isFormula($x);
   36       Value::Error("Coordinate of Vector can't be %s",Value::showClass($x))
   37         unless Value::isNumber($x);
   38     }
   39   }
   40   if ($isFormula) {
   41     my $v = $self->formula($p);
   42     if (ref($self) && $self->{ColumnVector}) {
   43       $v->{tree}{ColumnVector} = 1;
   44       $v->{tree}{open} = $v->{tree}{close} = undef;
   45     }
   46     return $v;
   47   }
   48   my $v = bless {data => $p, context => $context}, $class;
   49   $v->{ColumnVector} = 1 if ref($self) && $self->{ColumnVector};
   50   return $v;
   51 }
   52 
   53 #
   54 #  Try to promote arbitary data to a vector
   55 #
   56 sub promote {
   57   my $self = shift; my $class = ref($self) || $self;
   58   my $context = (Value::isContext($_[0]) ? shift : $self->context);
   59   my $x = (scalar(@_) ? shift : $self);
   60   return $self->new($context,$x,@_) if scalar(@_) > 0 || ref($x) eq 'ARRAY';
   61   return $x->inContext($context) if ref($x) eq $class;
   62   return $self->make($context,$x->value) if Value::classMatch($x,'Point');
   63   Value::Error("Can't convert %s to %s",Value::showClass($x),Value::showClass($self));
   64 }
   65 
   66 ############################################
   67 #
   68 #  Operations on vectors
   69 #
   70 
   71 sub add {
   72   my ($self,$l,$r) = Value::checkOpOrderWithPromote(@_);
   73   my @l = $l->value; my @r = $r->value;
   74   Value::Error("Vector addition with different number of coordinates")
   75     unless scalar(@l) == scalar(@r);
   76   my @s = ();
   77   foreach my $i (0..scalar(@l)-1) {push(@s,$l[$i] + $r[$i])}
   78   return $self->make(@s);
   79 }
   80 
   81 sub sub {
   82   my ($self,$l,$r) = Value::checkOpOrderWithPromote(@_);
   83   my @l = $l->value; my @r = $r->value;
   84   Value::Error("Vector subtraction with different number of coordinates")
   85     unless scalar(@l) == scalar(@r);
   86   my @s = ();
   87   foreach my $i (0..scalar(@l)-1) {push(@s,$l[$i] - $r[$i])}
   88   return $self->make(@s);
   89 }
   90 
   91 sub mult {
   92   my ($l,$r,$flag) = @_; my $self = $l;
   93   Value::Error("Vectors can only be multiplied by numbers")
   94     unless (Value::matchNumber($r) || Value::isComplex($r));
   95   my @coords = ();
   96   foreach my $x ($l->value) {push(@coords,$x*$r)}
   97   return $self->make(@coords);
   98 }
   99 
  100 sub div {
  101   my ($l,$r,$flag) = @_; my $self = $l;
  102   Value::Error("Can't divide by a Vector") if $flag;
  103   Value::Error("Vectors can only be divided by numbers")
  104     unless (Value::matchNumber($r) || Value::isComplex($r));
  105   Value::Error("Division by zero") if $r == 0;
  106   my @coords = ();
  107   foreach my $x ($l->value) {push(@coords,$x/$r)}
  108   return $self->make(@coords);
  109 }
  110 
  111 sub power {
  112   my ($l,$r,$flag) = @_;
  113   Value::Error("Can't raise Vectors to powers") unless $flag;
  114   Value::Error("Can't use Vectors in exponents");
  115 }
  116 
  117 sub dot {
  118   my ($self,$l,$r) = Value::checkOpOrderWithPromote(@_);
  119   my @l = $l->value; my @r = $r->value;
  120   Value::Error("Vector dot product with different number of coordinates")
  121     unless scalar(@l) == scalar(@r);
  122   my $s = 0;
  123   foreach my $i (0..scalar(@l)-1) {$s += $l[$i] * $r[$i]}
  124   return $s;
  125 }
  126 
  127 sub cross {
  128   my ($self,$l,$r) = Value::checkOpOrderWithPromote(@_);
  129   my @l = $l->value; my @r = $r->value;
  130   Value::Error("Vector must be in 3-space for cross product")
  131     unless scalar(@l) == 3 && scalar(@r) == 3;
  132   $pkg->make($l[1]*$r[2] - $l[2]*$r[1],
  133            -($l[0]*$r[2] - $l[2]*$r[0]),
  134              $l[0]*$r[1] - $l[1]*$r[0]);
  135 }
  136 
  137 #
  138 #  If points are different length, shorter is smaller,
  139 #  Otherwise, do lexicographic comparison.
  140 #
  141 sub compare {
  142   my ($self,$l,$r) = Value::checkOpOrderWithPromote(@_);
  143   my @l = $l->value; my @r = $r->value;
  144   return scalar(@l) <=> scalar(@r) unless scalar(@l) == scalar(@r);
  145   my $cmp = 0;
  146   foreach my $i (0..scalar(@l)-1) {
  147     $cmp = $l[$i] <=> $r[$i];
  148     last if $cmp;
  149   }
  150   return $cmp;
  151 }
  152 
  153 sub neg {
  154   my $self = promote(@_); my @coords = ();
  155   foreach my $x ($self->value) {push(@coords,-$x)}
  156   return $self->make(@coords);
  157 }
  158 
  159 sub abs {my $self = shift; $self->norm(@_)}
  160 sub norm {
  161   my $self = promote(@_); my $s = 0;
  162   foreach my $x ($self->value) {$s += $x*$x}
  163   return CORE::sqrt($s);
  164 }
  165 
  166 sub unit {
  167   my $self = promote(@_);
  168   my $n = $self->norm; return $self if $n == 0;
  169   return $self / $n;
  170 }
  171 
  172 ############################################
  173 #
  174 #  Check for parallel vectors
  175 #
  176 
  177 sub isParallel {
  178   my $self = (ref($_[0]) ? $_[0] : shift);
  179   my $U = $self->promote(shift); my $V = $self->promote(shift);
  180   my $context =  $self->context;
  181   my $sameDirection = shift;
  182   my @u = $U->value; my @v = $V->value;
  183   return 0 unless  scalar(@u) == scalar(@v);
  184   my $k = ''; # will be scaling factor for u = k v
  185   foreach my $i (0..$#u) {
  186     #
  187     #  make sure we use fuzzy math
  188     #
  189     $u[$i] = Value::Real->new($context,$u[$i]) unless Value::isReal($u[$i]);
  190     $v[$i] = Value::Real->new($context,$v[$i]) unless Value::isReal($v[$i]);
  191     if ($k ne '') {
  192       return 0 if ($v[$i] != $k*$u[$i]);
  193     } else {
  194       #
  195       #  if one is zero and the other isn't then not parallel
  196       #  otherwise use the ratio of the two as k.
  197       #
  198       if ($u[$i] == 0) {
  199   return 0 if $v[$i] != 0;
  200       } else {
  201   return 0 if $v[$i] == 0;
  202   $k = ($v[$i]/$u[$i])->value;
  203         return 0 if $k < 0 && $sameDirection;
  204       }
  205     }
  206   }
  207   #
  208   #  Note: it will return 1 if both are zero vectors.  This is a
  209   #  feature, since one is provided by the problem writer, and he
  210   #  should only supply the zero vector if he means it.  One could
  211   #  return ($k ne '') to return 0 if both are zero.
  212   #
  213   return 1;
  214 }
  215 
  216 sub areParallel {isParallel(@_)}
  217 
  218 
  219 ############################################
  220 #
  221 #  Generate the various output formats
  222 #
  223 
  224 my $ijk_string = ['i','j','k','0'];
  225 my $ijk_TeX = ['\boldsymbol{i}','\boldsymbol{j}','\boldsymbol{k}','\boldsymbol{0}'];
  226 
  227 sub stringify {
  228   my $self = shift;
  229   return $self->TeX if $self->getFlag('StringifyAsTeX');
  230   $self->string;
  231 }
  232 
  233 sub string {
  234   my $self = shift; my $equation = shift;
  235   return $self->ijk($ijk_string)
  236     if ($self->{ijk} || $equation->{ijk} || $self->getFlag("ijk")) &&
  237         !$self->{ColumnVector};
  238   return $self->SUPER::string($equation,@_);
  239 }
  240 
  241 sub pdot {
  242   my $self = shift;
  243   my $string = $self->string;
  244   $string = '('.$string.')' if $string =~ m/[-+]/ &&
  245     ($self->getFlag("ijk")) && !$self->{ColumnVector};
  246   return $string;
  247 }
  248 
  249 sub TeX {
  250   my $self = shift; my $equation = shift;
  251   if ($self->{ColumnVector}) {
  252     my $def = ($equation->{context} || $self->context)->lists->get('Matrix');
  253     my $open = shift; my $close = shift;
  254     $open  = $self->{open}  unless defined($open);
  255     $open  = $def->{open}   unless defined($open);
  256     $close = $self->{close} unless defined($close);
  257     $close = $def->{close}  unless defined($close);
  258     $open =~ s/([{}])/\\$1/g; $close =~ s/([{}])/\\$1/g;
  259     $open = '\left'.$open if $open; $close = '\right'.$close if $close;
  260     my @coords = ();
  261     foreach my $x (@{$self->data}) {
  262       if (Value::isValue($x)) {push(@coords,$x->TeX($equation))} else {push(@coords,$x)}
  263     }
  264     return $open.'\begin{array}{c}'.join('\\\\',@coords).'\\\\\end{array}'.$close;
  265   }
  266   return $self->ijk if ($self->{ijk} || $equation->{ijk} || $self->getFlag("ijk"));
  267   return $self->SUPER::TeX($equation,@_);
  268 }
  269 
  270 sub ijk {
  271   my $self = shift; my $ijk = shift;
  272   if (!$ijk) {
  273     my $context = $self->context;
  274     $ijk = []; $ijk->[3] = '{\bf 0}';
  275     foreach my $i (0,1,2)
  276      {$ijk->[$i] = $context->{constants}{$ijk_string->[$i]}{TeX} || $ijk_TeX->[$i]}
  277   }
  278   my @coords = @{$self->data};
  279   Value::Error("Method 'ijk' can only be used on vectors in three-space")
  280     unless (scalar(@coords) <= 3);
  281   my $string = ''; my $n; my $term;
  282   foreach $n (0..scalar(@coords)-1) {
  283     $term = $coords[$n]; $term = (Value::isValue($term))? $term->string : "$term";
  284     if ($term ne 0) {
  285       $term = '' if $term eq '1'; $term = '-' if $term eq '-1';
  286       $term = '('.$term.')' if $term =~ m/e/i;
  287       $term = '+' . $term unless $string eq '' or $term =~ m/^-/;
  288       $string .= $term . $ijk->[$n];
  289     }
  290   }
  291   $string = $ijk->[3] if $string eq '';
  292   return $string;
  293 }
  294 
  295 ###########################################################################
  296 
  297 1;
  298 

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9