[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 2625 - (download) (as text) (annotate)
Mon Aug 16 18:35:12 2004 UTC (15 years, 3 months ago) by dpvc
File size: 8903 byte(s)
Added string comparison to all Value object classes (to compare the
string value of an object to another string).

Overloaded perl '.' operator to do dot product when the operands are
formulas returning vectors.  (Part of the auto-generation of
formulas).

A few improvements to real and complex class output results.

Made Union class slightly more robust and removed need for makeUnion
method other than in the Union itself.

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

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9