[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 5696 - (download) (as text) (annotate)
Sat Jun 14 12:14:21 2008 UTC (11 years, 8 months ago) by dpvc
File size: 9961 byte(s)
Added

	 no strict "refs"

to try to avoid new error checking in Perl 5.10.

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

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9