[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 2558 - (download) (as text) (annotate)
Wed Jul 28 20:32:33 2004 UTC (15 years, 6 months ago) by sh002i
File size: 5339 byte(s)
merged changes from rel-2-1-a1 -- stop using that branch.

    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' => \&compare,
   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     }
   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 arbitrary data to a point
   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   Value::Error("Can't convert ".Value::showClass($x)." to a Point");
   69 }
   70 
   71 ############################################
   72 #
   73 #  Operations on points
   74 #
   75 
   76 sub add {
   77   my ($l,$r,$flag) = @_;
   78   if ($l->promotePrecedence($r)) {return $r->add($l,!$flag)}
   79   ($l,$r) = (promote($l)->data,promote($r)->data);
   80   Value::Error("Point addition with different number of coordiantes")
   81     unless scalar(@{$l}) == scalar(@{$r});
   82   my @s = ();
   83   foreach my $i (0..scalar(@{$l})-1) {push(@s,$l->[$i] + $r->[$i])}
   84   return $pkg->make(@s);
   85 }
   86 
   87 sub sub {
   88   my ($l,$r,$flag) = @_;
   89   if ($l->promotePrecedence($r)) {return $r->sub($l,!$flag)}
   90   ($l,$r) = (promote($l)->data,promote($r)->data);
   91   Value::Error("Point subtraction with different number of coordiantes")
   92     unless scalar(@{$l}) == scalar(@{$r});
   93   if ($flag) {my $tmp = $l; $l = $r; $r = $tmp};
   94   my @s = ();
   95   foreach my $i (0..scalar(@{$l})-1) {push(@s,$l->[$i] - $r->[$i])}
   96   return $pkg->make(@s);
   97 }
   98 
   99 sub mult {
  100   my ($l,$r,$flag) = @_;
  101   if ($l->promotePrecedence($r)) {return $r->mult($l,!$flag)}
  102   Value::Error("Points can only be multiplied by numbers")
  103     unless (Value::matchNumber($r) || Value::isComplex($r));
  104   my @coords = ();
  105   foreach my $x (@{$l->data}) {push(@coords,$x*$r)}
  106   return $pkg->make(@coords);
  107 }
  108 
  109 sub div {
  110   my ($l,$r,$flag) = @_;
  111   if ($l->promotePrecedence($r)) {return $r->div($l,!$flag)}
  112   Value::Error("Can't divide by a point") if $flag;
  113   Value::Error("Points can only be divided by numbers")
  114     unless (Value::matchNumber($r) || Value::isComplex($r));
  115   Value::Error("Division by zero") if $r == 0;
  116   my @coords = ();
  117   foreach my $x (@{$l->data}) {push(@coords,$x/$r)}
  118   return $pkg->make(@coords);
  119 }
  120 
  121 sub power {
  122   my ($l,$r,$flag) = @_;
  123   if ($l->promotePrecedence($r)) {return $r->power($l,!$flag)}
  124   Value::Error("Can't raise Points to powers") unless $flag;
  125   Value::Error("Can't use Points in exponents");
  126 }
  127 
  128 #
  129 #  Promote to vectors and do it there
  130 #
  131 sub cross {
  132   my ($l,$r,$flag) = @_;
  133   $l = Value::Vector::promote($l);
  134   $l->cross($r,$flag);
  135 }
  136 
  137 #
  138 #  If points are different length, shorter is smaller,
  139 #  Otherwise, do lexicographic comparison.
  140 #
  141 sub compare {
  142   my ($l,$r,$flag) = @_;
  143   if ($l->promotePrecedence($r)) {return $r->compare($l,!$flag)}
  144   ($l,$r) = (promote($l)->data,promote($r)->data);
  145   return scalar(@{$l}) <=> scalar(@{$r}) unless scalar(@{$l}) == scalar(@{$r});
  146   if ($flag) {my $tmp = $l; $l = $r; $r = $tmp};
  147   my $cmp = 0;
  148   foreach my $i (0..scalar(@{$l})-1) {
  149     $cmp = $l->[$i] <=> $r->[$i];
  150     last if $cmp;
  151   }
  152   return $cmp;
  153 }
  154 
  155 sub neg {
  156   my $p = promote(@_)->data;
  157   my @coords = ();
  158   foreach my $x (@{$p}) {push(@coords,-$x)}
  159   return $pkg->make(@coords);
  160 }
  161 
  162 #
  163 #  abs() is norm of vector
  164 #
  165 sub abs {
  166   my $p = promote(@_)->data;
  167   my $s = 0;
  168   foreach my $x (@{$p}) {$s += $x*$x}
  169   return CORE::sqrt($s);
  170 }
  171 
  172 
  173 ############################################
  174 #
  175 #  Generate the various output formats
  176 #
  177 
  178 sub stringify {
  179   my $self = shift;
  180   $Value::parens{Point}{open}.join(',',@{$self->data}).$Value::parens{Point}{close};
  181 }
  182 
  183 sub string {
  184   my $self = shift; my $equation = shift;
  185   my $open = shift || $Value::parens{Point}{open};
  186   my $close = shift || $Value::parens{Point}{close};
  187   return $open.join(',',@{$self->data}).$close;
  188 }
  189 
  190 ###########################################################################
  191 
  192 1;
  193 

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9