[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 3171 - (download) (as text) (annotate)
Tue Feb 15 21:53:23 2005 UTC (15 years ago) by dpvc
File size: 6216 byte(s)
Improved the Real(), Complex(), Point(), Vector(), Matrix() and
String() constructors so that they will process formulas passed to
them as strings rather than requiring perl objects for these.

For example, you can use Real("2/3") rather than Real(2/3) if you
want.  Also, Real("1+x") will return a formula returning a real
(essentially the same as Formula("1+x") in this case).

    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 #    a string that evaluates to a point
   33 #
   34 sub new {
   35   my $self = shift; my $class = ref($self) || $self;
   36   my $p = shift; $p = [$p,@_] if (scalar(@_) > 0);
   37   $p = Value::makeValue($p) if (defined($p) && !ref($p));
   38   return $p if (Value::isFormula($p) && $p->type eq Value::class($self));
   39   my $pclass = Value::class($p); my $isFormula = 0;
   40   my @d; @d = $p->dimensions if $pclass eq 'Matrix';
   41   if ($pclass =~ m/Point|Vector/) {$p = $p->data}
   42   elsif ($pclass eq 'Matrix' && scalar(@d) == 1) {$p = [$p->value]}
   43   elsif ($pclass eq 'Matrix' && scalar(@d) == 2 && $d[0] == 1) {$p = ($p->value)[0]}
   44   elsif ($pclass eq 'Matrix' && scalar(@d) == 2 && $d[1] == 1) {$p = ($p->transpose->value)[0]}
   45   else {
   46     $p = [$p] if (defined($p) && ref($p) ne 'ARRAY');
   47     Value::Error("Points must have at least one coordinate")
   48       unless defined($p) && scalar(@{$p}) > 0;
   49     foreach my $x (@{$p}) {
   50       $x = Value::makeValue($x);
   51       $isFormula = 1 if Value::isFormula($x);
   52       Value::Error("Coordinate of Point can't be ".Value::showClass($x))
   53         unless Value::isNumber($x);
   54     }
   55   }
   56   return $self->formula($p) if $isFormula;
   57   bless {data => $p}, $class;
   58 }
   59 
   60 #
   61 #  The number of coordinates
   62 #
   63 sub length {return scalar(@{shift->{data}})}
   64 
   65 #
   66 #  Try to promote arbitrary data to a point
   67 #
   68 sub promote {
   69   my $x = shift;
   70   return $pkg->new($x,@_) if scalar(@_) > 0 || ref($x) eq 'ARRAY';
   71   return $x if ref($x) eq $pkg;
   72   Value::Error("Can't convert ".Value::showClass($x)." to a Point");
   73 }
   74 
   75 ############################################
   76 #
   77 #  Operations on points
   78 #
   79 
   80 sub add {
   81   my ($l,$r,$flag) = @_;
   82   if ($l->promotePrecedence($r)) {return $r->add($l,!$flag)}
   83   ($l,$r) = (promote($l)->data,promote($r)->data);
   84   Value::Error("Point addition with different number of coordiantes")
   85     unless scalar(@{$l}) == scalar(@{$r});
   86   my @s = ();
   87   foreach my $i (0..scalar(@{$l})-1) {push(@s,$l->[$i] + $r->[$i])}
   88   return $pkg->make(@s);
   89 }
   90 
   91 sub sub {
   92   my ($l,$r,$flag) = @_;
   93   if ($l->promotePrecedence($r)) {return $r->sub($l,!$flag)}
   94   ($l,$r) = (promote($l)->data,promote($r)->data);
   95   Value::Error("Point subtraction with different number of coordiantes")
   96     unless scalar(@{$l}) == scalar(@{$r});
   97   if ($flag) {my $tmp = $l; $l = $r; $r = $tmp};
   98   my @s = ();
   99   foreach my $i (0..scalar(@{$l})-1) {push(@s,$l->[$i] - $r->[$i])}
  100   return $pkg->make(@s);
  101 }
  102 
  103 sub mult {
  104   my ($l,$r,$flag) = @_;
  105   if ($l->promotePrecedence($r)) {return $r->mult($l,!$flag)}
  106   Value::Error("Points can only be multiplied by numbers")
  107     unless (Value::matchNumber($r) || Value::isComplex($r));
  108   my @coords = ();
  109   foreach my $x (@{$l->data}) {push(@coords,$x*$r)}
  110   return $pkg->make(@coords);
  111 }
  112 
  113 sub div {
  114   my ($l,$r,$flag) = @_;
  115   if ($l->promotePrecedence($r)) {return $r->div($l,!$flag)}
  116   Value::Error("Can't divide by a point") if $flag;
  117   Value::Error("Points can only be divided by numbers")
  118     unless (Value::matchNumber($r) || Value::isComplex($r));
  119   Value::Error("Division by zero") if $r == 0;
  120   my @coords = ();
  121   foreach my $x (@{$l->data}) {push(@coords,$x/$r)}
  122   return $pkg->make(@coords);
  123 }
  124 
  125 sub power {
  126   my ($l,$r,$flag) = @_;
  127   if ($l->promotePrecedence($r)) {return $r->power($l,!$flag)}
  128   Value::Error("Can't raise Points to powers") unless $flag;
  129   Value::Error("Can't use Points in exponents");
  130 }
  131 
  132 #
  133 #  Promote to vectors and do it there
  134 #
  135 sub cross {
  136   my ($l,$r,$flag) = @_;
  137   $l = Value::Vector::promote($l);
  138   $l->cross($r,$flag);
  139 }
  140 
  141 #
  142 #  If points are different length, shorter is smaller,
  143 #  Otherwise, do lexicographic comparison.
  144 #
  145 sub compare {
  146   my ($l,$r,$flag) = @_;
  147   if ($l->promotePrecedence($r)) {return $r->compare($l,!$flag)}
  148   ($l,$r) = (promote($l)->data,promote($r)->data);
  149   return scalar(@{$l}) <=> scalar(@{$r}) unless scalar(@{$l}) == scalar(@{$r});
  150   if ($flag) {my $tmp = $l; $l = $r; $r = $tmp};
  151   my $cmp = 0;
  152   foreach my $i (0..scalar(@{$l})-1) {
  153     $cmp = $l->[$i] <=> $r->[$i];
  154     last if $cmp;
  155   }
  156   return $cmp;
  157 }
  158 
  159 sub neg {
  160   my $p = promote(@_)->data;
  161   my @coords = ();
  162   foreach my $x (@{$p}) {push(@coords,-$x)}
  163   return $pkg->make(@coords);
  164 }
  165 
  166 #
  167 #  abs() is norm of vector
  168 #
  169 sub abs {
  170   my $p = promote(@_)->data;
  171   my $s = 0;
  172   foreach my $x (@{$p}) {$s += $x*$x}
  173   return CORE::sqrt($s);
  174 }
  175 
  176 
  177 ############################################
  178 #
  179 #  Generate the various output formats
  180 #
  181 
  182 sub stringify {
  183   my $self = shift;
  184   return $self->TeX(undef,$self->{open},$self->{close}) if $$Value::context->flag('StringifyAsTeX');
  185   return $self->string(undef,$self->{open},$self->{close});
  186 }
  187 
  188 sub string {
  189   my $self = shift; my $equation = shift;
  190   my $def = ($equation->{context} || $$Value::context)->lists->get('Point');
  191   my $open = shift || $def->{open}; my $close = shift || $def->{close};
  192   my @coords = ();
  193   foreach my $x (@{$self->data}) {
  194     if (Value::isValue($x)) {push(@coords,$x->string($equation))} else {push(@coords,$x)}
  195   }
  196   return $open.join(',',@coords).$close;
  197 }
  198 
  199 sub TeX {
  200   my $self = shift; my $equation = shift;
  201   my $def = ($equation->{context} || $$Value::context)->lists->get('Point');
  202   my $open = shift || $def->{open}; my $close = shift || $def->{close};
  203   my @coords = ();
  204   foreach my $x (@{$self->data}) {
  205     if (Value::isValue($x)) {push(@coords,$x->TeX($equation))} else {push(@coords,$x)}
  206   }
  207   return '\left'.$open.join(',',@coords).'\right'.$close;
  208 }
  209 
  210 ###########################################################################
  211 
  212 1;
  213 

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9