File Coverage

blib/lib/Math/Shape/Vector.pm
Criterion Covered Total %
statement 85 89 95.5
branch 48 58 82.7
condition 8 9 88.8
subroutine 23 23 100.0
pod 17 17 100.0
total 181 196 92.3


line stmt bran cond sub pod time code
1 7     7   63435 use strict;
  7         11  
  7         269  
2 7     7   31 use warnings;
  7         11  
  7         302  
3             package Math::Shape::Vector;
4             $Math::Shape::Vector::VERSION = '0.13';
5 7     7   122 use 5.008;
  7         20  
  7         222  
6 7     7   27 use Carp;
  7         17  
  7         457  
7 7     7   2388 use Math::Shape::Utils;
  7         15  
  7         544  
8 7     7   42 use Math::Trig;
  7         10  
  7         9023  
9              
10             # ABSTRACT: A 2d vector library in cartesian space
11              
12              
13             sub new {
14 1749 100   1749 1 2526 croak 'incorrect number of arguments' unless @_ == 3;
15 1747         5261 return bless { x => $_[1],
16             y => $_[2] }, $_[0];
17             }
18              
19              
20             sub add_vector {
21 226 100   226 1 609 croak 'must pass a vector object' unless $_[1]->isa('Math::Shape::Vector');
22 224         198 my ($self, $v2) = @_;
23              
24 224         469 Math::Shape::Vector->new(
25             $self->{x} + $v2->{x},
26             $self->{y} + $v2->{y},
27             );
28             }
29              
30              
31             sub subtract_vector {
32 327 100   327 1 860 croak 'must pass a vector object' unless $_[1]->isa('Math::Shape::Vector');
33 324         287 my ($self, $v2) = @_;
34              
35 324         785 Math::Shape::Vector->new(
36             $self->{x} - $v2->{x},
37             $self->{y} - $v2->{y},
38             );
39             }
40              
41              
42             sub negate {
43 27     27 1 29 my $self = shift;
44              
45 27         61 Math::Shape::Vector->new(
46             - $self->{x},
47             - $self->{y},
48             );
49             }
50              
51              
52             sub is_equal {
53 12 100   12 1 80 croak 'must pass a vector object' unless $_[1]->isa('Math::Shape::Vector');
54 11         13 my ($self, $v2) = @_;
55 11 100 100     97 $self->{x} == $v2->{x} && $self->{y} == $v2->{y}
56             ? 1 : 0;
57             }
58              
59              
60             sub multiply {
61 42 100   42 1 123 croak 'incorrect number of args' unless @_ == 2;
62 41         42 my ($self, $multiplier) = @_;
63              
64 41         118 Math::Shape::Vector->new(
65             $self->{x} * $multiplier,
66             $self->{y} * $multiplier,
67             );
68             }
69              
70              
71             sub divide {
72 93 100   93 1 179 croak 'incorrect number of args' unless @_ == 2;
73 92         85 my ($self, $divisor) = @_;
74              
75             # avoid division by zero
76 92 100       283 Math::Shape::Vector->new(
    100          
77             ($divisor ? $self->{x} / $divisor : 0),
78             ($divisor ? $self->{y} / $divisor : 0),
79             );
80             }
81              
82              
83             sub rotate {
84 189 50   189 1 280 croak 'incorrect number of args' unless @_ == 2;
85 189         167 my ($self, $radians) = @_;
86              
87 189         880 Math::Shape::Vector->new(
88             $self->{x} * cos($radians) - $self->{y} * sin($radians),
89             $self->{x} * sin($radians) + $self->{y} * cos($radians),
90             );
91             }
92              
93              
94             sub rotate_90
95             {
96 70     70 1 75 my $self = shift;
97              
98 70         146 Math::Shape::Vector->new(
99             - $self->{y},
100             $self->{x},
101             );
102             }
103              
104              
105             sub dot_product {
106 367 50   367 1 750 croak 'must pass a vector object' unless $_[1]->isa('Math::Shape::Vector');
107 367         289 my ($self, $v2) = @_;
108 367         1041 $self->{x} * $v2->{x} + $self->{y} * $v2->{y};
109             }
110              
111              
112             sub length {
113 159     159 1 143 my $self = shift;
114             # avoid division by zero for null vectors
115 159         312 my $sum_of_squares = $self->{x} ** 2 + $self->{y} ** 2;
116              
117 159 100       370 return 0 unless $sum_of_squares;
118 134         436 sqrt $sum_of_squares;
119             }
120              
121              
122             sub convert_to_unit_vector {
123 91     91 1 82 my $self = shift;
124              
125 91         126 my $length = $self->length;
126              
127             # if the vector length is zero (or lower?) return self
128 91 50       162 return $self if $length < 0;
129              
130             # else return unit vector
131 91         142 $self->divide($length);
132             }
133              
134              
135             sub project {
136 19 50   19 1 59 croak 'must pass a vector object' unless $_[1]->isa('Math::Shape::Vector');
137 19         22 my ($self, $v2) = @_;
138              
139 19         33 my $d = $v2->dot_product($v2);
140              
141 19 100       37 if ($d > 0) {
142 16         21 $v2->multiply( $self->dot_product($v2) / $d );
143             }
144             else {
145 3         18 $v2;
146             }
147             }
148              
149              
150             sub is_parallel
151             {
152 25 50   25 1 70 croak 'must pass a vector object' unless $_[1]->isa('Math::Shape::Vector');
153 25         25 my ($self, $v2) = @_;
154 25         40 my $vector_na = $self->rotate_90;
155 25         38 equal_floats(0, $vector_na->dot_product($v2));
156             }
157              
158              
159             sub enclosed_angle
160             {
161 4 50   4 1 1157 croak 'must pass a vector object' unless $_[1]->isa('Math::Shape::Vector');
162 4         8 my ($self, $v2) = @_;
163              
164 4         6 my $ua = $self->convert_to_unit_vector;
165 4         7 my $ub = $v2->convert_to_unit_vector;
166              
167 4         9 acos( $ua->dot_product($ub) );
168             }
169              
170              
171              
172             sub collides
173             {
174 27     27 1 53 my ($self, $other_obj) = @_;
175              
176 27 100       240 if ($other_obj->isa('Math::Shape::Vector'))
    100          
    100          
    100          
    100          
    50          
177             {
178 9 100 100     81 $self->{x} == $other_obj->{x} && $self->{y} == $other_obj->{y} ? 1 : 0;
179             }
180             elsif ($other_obj->isa('Math::Shape::LineSegment'))
181             {
182             # test collision of nearest point on LineSegment with vector
183 6         29 my $d = $other_obj->{end}->subtract_vector($other_obj->{start});
184 6         14 my $lp = $self->subtract_vector($other_obj->{start});
185 6         16 my $pr = $lp->project($d);
186              
187 6 100 66     23 $lp->is_equal($pr)
188             && $pr->length <= $d->length
189             && 0 <= $pr->dot_product($d)
190             ? 1 : 0;
191             }
192             elsif ($other_obj->isa('Math::Shape::Line'))
193             {
194             # test if vector collides with base
195 4 100       23 return 1 if $self->collides($other_obj->{base});
196              
197             # test if vector lies on the direction
198 2         5 my $lp = $self->subtract_vector($other_obj->{base});
199 2         5 $lp->is_parallel($other_obj->{direction});
200             }
201             elsif ($other_obj->isa('Math::Shape::OrientedRectangle'))
202             {
203 4         15 $other_obj->collides($self);
204             }
205             elsif ($other_obj->isa('Math::Shape::Circle'))
206             {
207 2         6 $other_obj->collides($self);
208             }
209             elsif ($other_obj->isa('Math::Shape::Rectangle'))
210             {
211 2         7 $other_obj->collides($self);
212             }
213             else
214             {
215 0         0 croak 'collides must be called with a Math::Shape::Vector library object';
216             }
217             }
218              
219              
220             sub distance
221             {
222 4     4 1 10 my ($self, $other_obj) = @_;
223              
224 4 100       20 if ($other_obj->isa('Math::Shape::Vector'))
    50          
    0          
225             {
226 3         4 $self->subtract_vector($other_obj)->length;
227             }
228             elsif ($other_obj->isa('Math::Shape::Circle'))
229             {
230 1         6 $self->subtract_vector($other_obj->{center})->length
231             - $other_obj->{radius};
232             }
233             elsif ($other_obj->isa('Math::Shape::OrientedRectangle'))
234             {
235 0           my $circle_hull = $other_obj->circle_hull;
236 0           $self->subtract_vector($circle_hull->{center})->length
237             - $circle_hull->{radius};
238             }
239             else
240             {
241 0           croak 'distance() must be called with a Math::Shape::Vector library object';
242             }
243             }
244              
245              
246             1;
247              
248             __END__