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

Annotation of /trunk/pg/lib/Value/Point.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 5696 - (view) (download) (as text)

1 : sh002i 2558 ###########################################################################
2 :     #
3 :     # Implements the Point object
4 :     #
5 :     package Value::Point;
6 :     my $pkg = 'Value::Point';
7 :    
8 : dpvc 5696 use strict; no strict "refs";
9 : dpvc 4975 our @ISA = qw(Value);
10 : sh002i 2558
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 : dpvc 3166 # a string that evaluates to a point
17 : sh002i 2558 #
18 :     sub new {
19 :     my $self = shift; my $class = ref($self) || $self;
20 : dpvc 4991 my $context = (Value::isContext($_[0]) ? shift : $self->context);
21 : dpvc 5103 my $p = shift; $p = [$p,@_] if scalar(@_) > 0;
22 : dpvc 5101 $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 : dpvc 4993 if (Value::classMatch($p,'Point','Vector')) {$p = $p->data}
26 : dpvc 5101 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 : sh002i 2558 else {
30 : dpvc 5101 $p = [$p] if defined($p) && ref($p) ne 'ARRAY';
31 : sh002i 2558 Value::Error("Points must have at least one coordinate")
32 :     unless defined($p) && scalar(@{$p}) > 0;
33 :     foreach my $x (@{$p}) {
34 : dpvc 4991 $x = Value::makeValue($x,context=>$context);
35 : sh002i 2558 $isFormula = 1 if Value::isFormula($x);
36 : dpvc 3370 Value::Error("Coordinate of Point can't be %s",Value::showClass($x))
37 : sh002i 2558 unless Value::isNumber($x);
38 :     }
39 :     }
40 :     return $self->formula($p) if $isFormula;
41 : dpvc 4991 bless {data => $p, context=>$context}, $class;
42 : sh002i 2558 }
43 :    
44 :     #
45 :     # Try to promote arbitrary data to a point
46 :     #
47 :     sub promote {
48 : dpvc 4975 my $self = shift; my $class = ref($self) || $self;
49 : dpvc 4996 my $context = (Value::isContext($_[0]) ? shift : $self->context);
50 : dpvc 4975 my $x = (scalar(@_) ? shift: $self);
51 : dpvc 4996 return $self->new($context,$x,@_) if scalar(@_) > 0 || ref($x) eq 'ARRAY';
52 : dpvc 5103 $x = Value::makeValue($x,context=>$context);
53 : dpvc 4996 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 : sh002i 2558 }
56 :    
57 :     ############################################
58 :     #
59 :     # Operations on points
60 :     #
61 :    
62 :     sub add {
63 : dpvc 5468 my ($self,$l,$r,$other) = Value::checkOpOrderWithPromote(@_);
64 : dpvc 4975 my @l = $l->value; my @r = $r->value;
65 : dpvc 5101 Value::Error("Can't add Points with different numbers of coordinates")
66 : dpvc 4975 unless scalar(@l) == scalar(@r);
67 : sh002i 2558 my @s = ();
68 : dpvc 4975 foreach my $i (0..scalar(@l)-1) {push(@s,$l[$i] + $r[$i])}
69 : dpvc 5468 return $self->inherit($other)->make(@s);
70 : sh002i 2558 }
71 :    
72 :     sub sub {
73 : dpvc 5468 my ($self,$l,$r,$other) = Value::checkOpOrderWithPromote(@_);
74 : dpvc 4975 my @l = $l->value; my @r = $r->value;
75 : dpvc 5101 Value::Error("Can't subtract Points with different numbers of coordinates")
76 : dpvc 4975 unless scalar(@l) == scalar(@r);
77 : sh002i 2558 my @s = ();
78 : dpvc 4975 foreach my $i (0..scalar(@l)-1) {push(@s,$l[$i] - $r[$i])}
79 : dpvc 5468 return $self->inherit($other)->make(@s);
80 : sh002i 2558 }
81 :    
82 :     sub mult {
83 : dpvc 4975 my ($l,$r) = @_; my $self = $l;
84 : dpvc 5101 Value::Error("Points can only be multiplied by Numbers")
85 : sh002i 2558 unless (Value::matchNumber($r) || Value::isComplex($r));
86 :     my @coords = ();
87 : dpvc 4975 foreach my $x ($l->value) {push(@coords,$x*$r)}
88 :     return $self->make(@coords);
89 : sh002i 2558 }
90 :    
91 :     sub div {
92 : dpvc 4975 my ($l,$r,$flag) = @_; my $self = $l;
93 : dpvc 5101 Value::Error("Can't divide by a Point") if $flag;
94 :     Value::Error("Points can only be divided by Numbers")
95 : sh002i 2558 unless (Value::matchNumber($r) || Value::isComplex($r));
96 :     Value::Error("Division by zero") if $r == 0;
97 :     my @coords = ();
98 : dpvc 4975 foreach my $x ($l->value) {push(@coords,$x/$r)}
99 :     return $self->make(@coords);
100 : sh002i 2558 }
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 : dpvc 5012 my $context = $l->context;
114 :     $l = $context->Package("Vector")->promote($context,$l);
115 : sh002i 2558 $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 : dpvc 5042 my ($self,$l,$r) = Value::checkOpOrderWithPromote(@_);
124 : dpvc 4975 my @l = $l->value; my @r = $r->value;
125 :     return scalar(@l) <=> scalar(@r) unless scalar(@l) == scalar(@r);
126 : sh002i 2558 my $cmp = 0;
127 : dpvc 4975 foreach my $i (0..scalar(@l)-1) {
128 :     $cmp = $l[$i] <=> $r[$i];
129 : sh002i 2558 last if $cmp;
130 :     }
131 :     return $cmp;
132 :     }
133 :    
134 :     sub neg {
135 : dpvc 4975 my $self = promote(@_); my @coords = ();
136 :     foreach my $x ($self->value) {push(@coords,-$x)}
137 :     return $self->make(@coords);
138 : sh002i 2558 }
139 :    
140 :     #
141 :     # abs() is norm of vector
142 :     #
143 :     sub abs {
144 : dpvc 4975 my $self = promote(@_); my $s = 0;
145 :     foreach my $x ($self->value) {$s += $x*$x}
146 : sh002i 2558 return CORE::sqrt($s);
147 :     }
148 :    
149 :     ###########################################################################
150 :    
151 :     1;

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9