## File: Vector.pm

package info (click to toggle)
algotutor 0.8.6-4
 `123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159` ``````# Author: Chao-Kuei Hung # For more info, including license, please see doc/index.html package Vector; # Mathematical Vector use strict; use Carp; use vars qw(@ISA); @ISA = qw(); my (%generated); BEGIN { my (\$functemplate) = q{ sub { my (\$self, \$that) = @_; my (\$r) = bless [], ref(\$self); my (\$i); if (ref \$that) { croak "dimension mismatch (", \$#\$self+1, " vs ", \$#\$that+1, ") in " unless \$#\$self == \$#\$that; for (\$i=0; \$i<=\$#\$self; ++\$i) { \$r->[\$i] = \$self->[\$i] \$that->[\$i]; } } else { for (\$i=0; \$i<=\$#\$self; ++\$i) { \$r->[\$i] = \$self->[\$i] \$that; } } return \$r; } }; my (%functab) = ( add => '+', sbt => '-', mul => '*', div => '/', ); my (\$name, \$op); while ((\$name, \$op) = each %functab) { my (\$t) = \$functemplate; \$t =~ s//\$op/g; \$generated{\$name} = eval \$t; } } # see perldoc overload, especially the "MAGIC AUTOGENERATION" section use overload '=' => '_clone', '""' => 'stringify', '+' => \$generated{add}, '-' => \$generated{sbt}, 'neg'=> 'negate', '*' => \$generated{mul}, '/' => \$generated{div}, 'fallback' => undef ; sub pw_mul { return \$generated{mul}->(@_); } sub pw_div { return \$generated{div}->(@_); } # Different from "Perl Cookbook", chap 13.6, p.461 "cloning objects" # See Randal Schwartz's "Constructing Objects" at # http://www.stonehenge.com/merlyn/UnixReview/col52.html # (search for "three camps") sub new { my (\$proto, @data) = @_; my (\$class) = ref \$proto || \$proto; # if (ref \$data[0] eq "Vector") { if (ref \$proto) { return bless [ @\$proto ], \$class; } else { return bless [@data], \$class; } } # Copy constructor is very tricky. It is _not_ called until # just before a mutator is applied to one of the reference # variables sharing the same copy. See perldoc overload, # especially the "Copy Constructor" section. sub _clone { my (\$a, \$b, \$switch) = @_; print STDERR "Vector::_clone : switch is undef!\n" unless defined \$switch; # print STDERR \$switch ? "+" : "-"; # always prints "-" return \$switch ? bless([@\$a],"Vector") : bless([@\$b],"Vector"); } sub stringify { my (\$self) = @_; my (\$r) = sprintf "[ %8g", \$self->[0]; foreach (@{\$self}[1..\$#\$self]) { \$r .= sprintf(", %8g", \$_); } return \$r . " ]"; } sub negate { my (\$self) = @_; return bless [map { -\$_ } @\$self], ref \$self; } sub x { return \$_[0]->[0]; } sub y { return \$_[0]->[1]; } sub z { return \$_[0]->[2]; } sub dot { # dot product my (\$t) = \$_[0]->pw_mul(\$_[1]); my (\$s, \$i); for (\$i=0; \$i<=\$#\$t; ++\$i) { \$s += \$t->[\$i]; } return \$s; } sub norm { my (\$self) = @_; return sqrt(\$self->dot(\$self)); } sub angle_cos { my (\$self, \$b) = @_; return \$self->dot(\$b)/\$self->norm()/\$b->norm(); } sub cob { # change of basis my (\$self, \$b) = @_; die unless (\$#\$b == \$#\$self and \$#\$b == \$#{\$b->[0]}); my (\$r) = \$self->new(); map { \$_ = 0; } @\$r; my (\$i); for (\$i=0; \$i<=\$#\$self; ++\$i) { \$r += \$b->[\$i]->pw_mul(\$self->[\$i]); } return \$r; } if (\$0 =~ /Vector.pm\$/) { # being tested as a stand-alone program, so run test code. my (\$p, \$q, \$r); \$p = Vector->new(4,-3); \$q = Vector->new(5,12); print \$p+\$q, ",", \$p-\$q, "\n"; \$r = \$p; \$r += \$q; \$q = \$q->pw_div(2); print \$p, ",", \$q, ",", \$r, ",", \$p->pw_mul(3), ",", -\$p, "\n"; } 1; ``````