[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 3716 - (download) (as text) (annotate)
Sun Oct 16 03:37:17 2005 UTC (14 years, 2 months ago) by dpvc
File size: 5197 byte(s)
In the past, when Value objects were inserted into strings, they would
automatically include parentheses so that if you had $f equal to 1+x
and $g equal to 1-x, then Formula("$f/$g") would mean (1+x)/(1-x)
rather than 1+(x/1)-x, which is what would happen as a straing string
substitution.

The problem is that this would also happen for real numbers, vectors,
and everything else, even when it wasn't necessary.  So if $x=Real(3),
then "Let x = $x" would be "Let x = (3)".

I have changed the behavior of the string concatenation for Value
objects so that parentheses are only added in a few cases: for
Formulas, Complex numbers, and Unions.  This makes the other Value
objects work more like regular variables in strings, but might cause
some problems with strings that are used as formulas.  For example, if
$a = Real(-3), then "x + 2 $a" will become "x + 2 -3", or "x-1" rather
than the expected "x - 6".  (The old approach would have made it "x +
2 (-3)" which would have worked properly).  For the most part, it is
easier to use something like "x + 2*$a" or even "x" + 2*$a in this
case, so the extra trouble of having to avoid parentheses when you
really meant to substitute the value into a string didn't seem worth
it.

    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        '+'   => sub {shift->add(@_)},
   14        '-'   => sub {shift->sub(@_)},
   15        '*'   => sub {shift->mult(@_)},
   16        '/'   => sub {shift->div(@_)},
   17        '**'  => sub {shift->power(@_)},
   18        '.'   => sub {shift->_dot(@_)},
   19        'x'   => sub {shift->cross(@_)},
   20        '<=>' => sub {shift->compare(@_)},
   21        'cmp' => sub {shift->compate_string(@_)},
   22        'neg' => sub {shift->neg},
   23        'abs' => sub {shift->abs},
   24   'nomethod' => sub {shift->nomethod(@_)},
   25         '""' => sub {shift->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 %s",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 #  Try to promote arbitrary data to a point
   62 #
   63 sub promote {
   64   my $x = shift;
   65   return $pkg->new($x,@_) if scalar(@_) > 0 || ref($x) eq 'ARRAY';
   66   return $x if ref($x) eq $pkg;
   67   Value::Error("Can't convert %s to a Point",Value::showClass($x));
   68 }
   69 
   70 ############################################
   71 #
   72 #  Operations on points
   73 #
   74 
   75 sub add {
   76   my ($l,$r,$flag) = @_;
   77   if ($l->promotePrecedence($r)) {return $r->add($l,!$flag)}
   78   ($l,$r) = (promote($l)->data,promote($r)->data);
   79   Value::Error("Point addition with different number of coordiantes")
   80     unless scalar(@{$l}) == scalar(@{$r});
   81   my @s = ();
   82   foreach my $i (0..scalar(@{$l})-1) {push(@s,$l->[$i] + $r->[$i])}
   83   return $pkg->make(@s);
   84 }
   85 
   86 sub sub {
   87   my ($l,$r,$flag) = @_;
   88   if ($l->promotePrecedence($r)) {return $r->sub($l,!$flag)}
   89   ($l,$r) = (promote($l)->data,promote($r)->data);
   90   Value::Error("Point subtraction with different number of coordiantes")
   91     unless scalar(@{$l}) == scalar(@{$r});
   92   if ($flag) {my $tmp = $l; $l = $r; $r = $tmp};
   93   my @s = ();
   94   foreach my $i (0..scalar(@{$l})-1) {push(@s,$l->[$i] - $r->[$i])}
   95   return $pkg->make(@s);
   96 }
   97 
   98 sub mult {
   99   my ($l,$r,$flag) = @_;
  100   if ($l->promotePrecedence($r)) {return $r->mult($l,!$flag)}
  101   Value::Error("Points can only be multiplied by numbers")
  102     unless (Value::matchNumber($r) || Value::isComplex($r));
  103   my @coords = ();
  104   foreach my $x (@{$l->data}) {push(@coords,$x*$r)}
  105   return $pkg->make(@coords);
  106 }
  107 
  108 sub div {
  109   my ($l,$r,$flag) = @_;
  110   if ($l->promotePrecedence($r)) {return $r->div($l,!$flag)}
  111   Value::Error("Can't divide by a point") if $flag;
  112   Value::Error("Points can only be divided by numbers")
  113     unless (Value::matchNumber($r) || Value::isComplex($r));
  114   Value::Error("Division by zero") if $r == 0;
  115   my @coords = ();
  116   foreach my $x (@{$l->data}) {push(@coords,$x/$r)}
  117   return $pkg->make(@coords);
  118 }
  119 
  120 sub power {
  121   my ($l,$r,$flag) = @_;
  122   if ($l->promotePrecedence($r)) {return $r->power($l,!$flag)}
  123   Value::Error("Can't raise Points to powers") unless $flag;
  124   Value::Error("Can't use Points in exponents");
  125 }
  126 
  127 #
  128 #  Promote to vectors and do it there
  129 #
  130 sub cross {
  131   my ($l,$r,$flag) = @_;
  132   $l = Value::Vector::promote($l);
  133   $l->cross($r,$flag);
  134 }
  135 
  136 #
  137 #  If points are different length, shorter is smaller,
  138 #  Otherwise, do lexicographic comparison.
  139 #
  140 sub compare {
  141   my ($l,$r,$flag) = @_;
  142   if ($l->promotePrecedence($r)) {return $r->compare($l,!$flag)}
  143   ($l,$r) = (promote($l)->data,promote($r)->data);
  144   return scalar(@{$l}) <=> scalar(@{$r}) unless scalar(@{$l}) == scalar(@{$r});
  145   if ($flag) {my $tmp = $l; $l = $r; $r = $tmp};
  146   my $cmp = 0;
  147   foreach my $i (0..scalar(@{$l})-1) {
  148     $cmp = $l->[$i] <=> $r->[$i];
  149     last if $cmp;
  150   }
  151   return $cmp;
  152 }
  153 
  154 sub neg {
  155   my $p = promote(@_)->data;
  156   my @coords = ();
  157   foreach my $x (@{$p}) {push(@coords,-$x)}
  158   return $pkg->make(@coords);
  159 }
  160 
  161 #
  162 #  abs() is norm of vector
  163 #
  164 sub abs {
  165   my $p = promote(@_)->data;
  166   my $s = 0;
  167   foreach my $x (@{$p}) {$s += $x*$x}
  168   return CORE::sqrt($s);
  169 }
  170 
  171 ###########################################################################
  172 
  173 1;

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9