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

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9