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

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9