[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 3171 - (download) (as text) (annotate)
Tue Feb 15 21:53:23 2005 UTC (15 years ago) by dpvc
File size: 9098 byte(s)
Improved the Real(), Complex(), Point(), Vector(), Matrix() and
String() constructors so that they will process formulas passed to
them as strings rather than requiring perl objects for these.

For example, you can use Real("2/3") rather than Real(2/3) if you
want.  Also, Real("1+x") will return a formula returning a real
(essentially the same as Formula("1+x") in this case).

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