[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 5696 - (download) (as text) (annotate)
Sat Jun 14 12:14:21 2008 UTC (11 years, 7 months ago) by dpvc
File size: 4632 byte(s)
Added

	 no strict "refs"

to try to avoid new error checking in Perl 5.10.

    1 ###########################################################################
    2 #
    3 #  Implements the Point object
    4 #
    5 package Value::Point;
    6 my $pkg = 'Value::Point';
    7 
    8 use strict; no strict "refs";
    9 our @ISA = qw(Value);
   10 
   11 #
   12 #  Convert a value to a point.  The value can be
   13 #    a list of numbers, or an reference to an array of numbers
   14 #    a point or vector object (demote a vector)
   15 #    a matrix if it is  n x 1  or  1 x n
   16 #    a string that evaluates to a point
   17 #
   18 sub new {
   19   my $self = shift; my $class = ref($self) || $self;
   20   my $context = (Value::isContext($_[0]) ? shift : $self->context);
   21   my $p = shift; $p = [$p,@_] if scalar(@_) > 0;
   22   $p = Value::makeValue($p,context=>$context) if defined($p) && !ref($p);
   23   return $p if Value::isFormula($p) && Value::classMatch($self,$p->type);
   24   my $isFormula = 0; my @d; @d = $p->dimensions if Value::classMatch($p,'Matrix');
   25   if (Value::classMatch($p,'Point','Vector')) {$p = $p->data}
   26   elsif (scalar(@d) == 1) {$p = [$p->value]}
   27   elsif (scalar(@d) == 2 && $d[0] == 1) {$p = ($p->value)[0]}
   28   elsif (scalar(@d) == 2 && $d[1] == 1) {$p = ($p->transpose->value)[0]}
   29   else {
   30     $p = [$p] if defined($p) && ref($p) ne 'ARRAY';
   31     Value::Error("Points must have at least one coordinate")
   32       unless defined($p) && scalar(@{$p}) > 0;
   33     foreach my $x (@{$p}) {
   34       $x = Value::makeValue($x,context=>$context);
   35       $isFormula = 1 if Value::isFormula($x);
   36       Value::Error("Coordinate of Point can't be %s",Value::showClass($x))
   37         unless Value::isNumber($x);
   38     }
   39   }
   40   return $self->formula($p) if $isFormula;
   41   bless {data => $p, context=>$context}, $class;
   42 }
   43 
   44 #
   45 #  Try to promote arbitrary data to a point
   46 #
   47 sub promote {
   48   my $self = shift; my $class = ref($self) || $self;
   49   my $context = (Value::isContext($_[0]) ? shift : $self->context);
   50   my $x = (scalar(@_) ? shift: $self);
   51   return $self->new($context,$x,@_) if scalar(@_) > 0 || ref($x) eq 'ARRAY';
   52   $x = Value::makeValue($x,context=>$context);
   53   return $x->inContext($context) if ref($x) eq $class;
   54   Value::Error("Can't convert %s to %s",Value::showClass($x),Value::showClass($self));
   55 }
   56 
   57 ############################################
   58 #
   59 #  Operations on points
   60 #
   61 
   62 sub add {
   63   my ($self,$l,$r,$other) = Value::checkOpOrderWithPromote(@_);
   64   my @l = $l->value; my @r = $r->value;
   65   Value::Error("Can't add Points with different numbers of coordinates")
   66     unless scalar(@l) == scalar(@r);
   67   my @s = ();
   68   foreach my $i (0..scalar(@l)-1) {push(@s,$l[$i] + $r[$i])}
   69   return $self->inherit($other)->make(@s);
   70 }
   71 
   72 sub sub {
   73   my ($self,$l,$r,$other) = Value::checkOpOrderWithPromote(@_);
   74   my @l = $l->value; my @r = $r->value;
   75   Value::Error("Can't subtract Points with different numbers of coordinates")
   76     unless scalar(@l) == scalar(@r);
   77   my @s = ();
   78   foreach my $i (0..scalar(@l)-1) {push(@s,$l[$i] - $r[$i])}
   79   return $self->inherit($other)->make(@s);
   80 }
   81 
   82 sub mult {
   83   my ($l,$r) = @_; my $self = $l;
   84   Value::Error("Points can only be multiplied by Numbers")
   85     unless (Value::matchNumber($r) || Value::isComplex($r));
   86   my @coords = ();
   87   foreach my $x ($l->value) {push(@coords,$x*$r)}
   88   return $self->make(@coords);
   89 }
   90 
   91 sub div {
   92   my ($l,$r,$flag) = @_; my $self = $l;
   93   Value::Error("Can't divide by a Point") if $flag;
   94   Value::Error("Points can only be divided by Numbers")
   95     unless (Value::matchNumber($r) || Value::isComplex($r));
   96   Value::Error("Division by zero") if $r == 0;
   97   my @coords = ();
   98   foreach my $x ($l->value) {push(@coords,$x/$r)}
   99   return $self->make(@coords);
  100 }
  101 
  102 sub power {
  103   my ($l,$r,$flag) = @_;
  104   Value::Error("Can't raise Points to powers") unless $flag;
  105   Value::Error("Can't use Points in exponents");
  106 }
  107 
  108 #
  109 #  Promote to vectors and do it there
  110 #
  111 sub cross {
  112   my ($l,$r,$flag) = @_;
  113   my $context = $l->context;
  114   $l = $context->Package("Vector")->promote($context,$l);
  115   $l->cross($r,$flag);
  116 }
  117 
  118 #
  119 #  If points are different length, shorter is smaller,
  120 #  Otherwise, do lexicographic comparison.
  121 #
  122 sub compare {
  123   my ($self,$l,$r) = Value::checkOpOrderWithPromote(@_);
  124   my @l = $l->value; my @r = $r->value;
  125   return scalar(@l) <=> scalar(@r) unless scalar(@l) == scalar(@r);
  126   my $cmp = 0;
  127   foreach my $i (0..scalar(@l)-1) {
  128     $cmp = $l[$i] <=> $r[$i];
  129     last if $cmp;
  130   }
  131   return $cmp;
  132 }
  133 
  134 sub neg {
  135   my $self = promote(@_); my @coords = ();
  136   foreach my $x ($self->value) {push(@coords,-$x)}
  137   return $self->make(@coords);
  138 }
  139 
  140 #
  141 #  abs() is norm of vector
  142 #
  143 sub abs {
  144   my $self = promote(@_); my $s = 0;
  145   foreach my $x ($self->value) {$s += $x*$x}
  146   return CORE::sqrt($s);
  147 }
  148 
  149 ###########################################################################
  150 
  151 1;

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9