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

View of /trunk/pg/lib/Value/Point.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: 6060 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 the Point object
    4 #
    5 package Value::Point;
    6 my $pkg = 'Value::Point';
    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 point.  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("Points must have at least one coordinate")
   45       unless defined($p) && scalar(@{$p}) > 0;
   46     foreach my $x (@{$p}) {
   47       $isFormula = 1 if Value::isFormula($x);
   48       Value::Error("Coordinate of Point can't be ".Value::showClass($x))
   49         unless Value::isNumber($x);
   50       $x = Value::Real->make($x) unless ref($x);
   51     }
   52   }
   53   return $self->formula($p) if $isFormula;
   54   bless {data => $p}, $class;
   55 }
   56 
   57 #
   58 #  The number of coordinates
   59 #
   60 sub length {return scalar(@{shift->{data}})}
   61 
   62 #
   63 #  Try to promote arbitrary data to a point
   64 #
   65 sub promote {
   66   my $x = shift;
   67   return $pkg->new($x,@_) if scalar(@_) > 0 || ref($x) eq 'ARRAY';
   68   return $x if ref($x) eq $pkg;
   69   Value::Error("Can't convert ".Value::showClass($x)." to a Point");
   70 }
   71 
   72 ############################################
   73 #
   74 #  Operations on points
   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("Point 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("Point 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("Points 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 point") if $flag;
  114   Value::Error("Points 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 Points to powers") unless $flag;
  126   Value::Error("Can't use Points in exponents");
  127 }
  128 
  129 #
  130 #  Promote to vectors and do it there
  131 #
  132 sub cross {
  133   my ($l,$r,$flag) = @_;
  134   $l = Value::Vector::promote($l);
  135   $l->cross($r,$flag);
  136 }
  137 
  138 #
  139 #  If points are different length, shorter is smaller,
  140 #  Otherwise, do lexicographic comparison.
  141 #
  142 sub compare {
  143   my ($l,$r,$flag) = @_;
  144   if ($l->promotePrecedence($r)) {return $r->compare($l,!$flag)}
  145   ($l,$r) = (promote($l)->data,promote($r)->data);
  146   return scalar(@{$l}) <=> scalar(@{$r}) unless scalar(@{$l}) == scalar(@{$r});
  147   if ($flag) {my $tmp = $l; $l = $r; $r = $tmp};
  148   my $cmp = 0;
  149   foreach my $i (0..scalar(@{$l})-1) {
  150     $cmp = $l->[$i] <=> $r->[$i];
  151     last if $cmp;
  152   }
  153   return $cmp;
  154 }
  155 
  156 sub neg {
  157   my $p = promote(@_)->data;
  158   my @coords = ();
  159   foreach my $x (@{$p}) {push(@coords,-$x)}
  160   return $pkg->make(@coords);
  161 }
  162 
  163 #
  164 #  abs() is norm of vector
  165 #
  166 sub abs {
  167   my $p = promote(@_)->data;
  168   my $s = 0;
  169   foreach my $x (@{$p}) {$s += $x*$x}
  170   return CORE::sqrt($s);
  171 }
  172 
  173 
  174 ############################################
  175 #
  176 #  Generate the various output formats
  177 #
  178 
  179 sub stringify {
  180   my $self = shift;
  181   return $self->TeX(undef,$self->{open},$self->{close}) if $$Value::context->flag('StringifyAsTeX');
  182   return $self->string(undef,$self->{open},$self->{close});
  183 }
  184 
  185 sub string {
  186   my $self = shift; my $equation = shift;
  187   my $def = ($equation->{context} || $$Value::context)->lists->get('Point');
  188   my $open = shift || $def->{open}; my $close = shift || $def->{close};
  189   my @coords = ();
  190   foreach my $x (@{$self->data}) {
  191     if (Value::isValue($x)) {push(@coords,$x->string($equation))} else {push(@coords,$x)}
  192   }
  193   return $open.join(',',@coords).$close;
  194 }
  195 
  196 sub TeX {
  197   my $self = shift; my $equation = shift;
  198   my $def = ($equation->{context} || $$Value::context)->lists->get('Point');
  199   my $open = shift || $def->{open}; my $close = shift || $def->{close};
  200   my @coords = ();
  201   foreach my $x (@{$self->data}) {
  202     if (Value::isValue($x)) {push(@coords,$x->TeX($equation))} else {push(@coords,$x)}
  203   }
  204   return '\left'.$open.join(',',@coords).'\right'.$close;
  205 }
  206 
  207 ###########################################################################
  208 
  209 1;
  210 

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9