File Coverage

blib/lib/Math/Shape/Vector.pm
Criterion Covered Total %
statement 89 93 95.7
branch 51 62 82.2
condition 8 9 88.8
subroutine 25 25 100.0
pod 19 19 100.0
total 192 208 92.3


line stmt bran cond sub pod time code
1 7     7   64920 use strict;
  7         12  
  7         232  
2 7     7   28 use warnings;
  7         9  
  7         274  
3             package Math::Shape::Vector;
4             $Math::Shape::Vector::VERSION = '0.14';
5 7     7   105 use 5.008;
  7         16  
  7         178  
6 7     7   25 use Carp;
  7         10  
  7         416  
7 7     7   2270 use Math::Shape::Utils;
  7         15  
  7         455  
8 7     7   33 use Math::Trig qw/acos :pi/;
  7         12  
  7         8149  
9              
10             # ABSTRACT: A 2d vector library in cartesian space
11              
12              
13             sub new {
14 1768 100   1768 1 3032 croak 'incorrect number of arguments' unless @_ == 3;
15 1766         5421 return bless { x => $_[1],
16             y => $_[2] }, $_[0];
17             }
18              
19              
20             sub add_vector {
21 226 100   226 1 578 croak 'must pass a vector object' unless $_[1]->isa('Math::Shape::Vector');
22 224         196 my ($self, $v2) = @_;
23              
24 224         474 Math::Shape::Vector->new(
25             $self->{x} + $v2->{x},
26             $self->{y} + $v2->{y},
27             );
28             }
29              
30              
31             sub subtract_vector {
32 331 100   331 1 923 croak 'must pass a vector object' unless $_[1]->isa('Math::Shape::Vector');
33 328         280 my ($self, $v2) = @_;
34              
35 328         765 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 28 my $self = shift;
44              
45 27         67 Math::Shape::Vector->new(
46             - $self->{x},
47             - $self->{y},
48             );
49             }
50              
51              
52             sub is_equal {
53 12 100   12 1 83 croak 'must pass a vector object' unless $_[1]->isa('Math::Shape::Vector');
54 11         15 my ($self, $v2) = @_;
55 11 100 100     114 $self->{x} == $v2->{x} && $self->{y} == $v2->{y}
56             ? 1 : 0;
57             }
58              
59              
60             sub multiply {
61 42 100   42 1 126 croak 'incorrect number of args' unless @_ == 2;
62 41         45 my ($self, $multiplier) = @_;
63              
64 41         114 Math::Shape::Vector->new(
65             $self->{x} * $multiplier,
66             $self->{y} * $multiplier,
67             );
68             }
69              
70              
71             sub divide {
72 97 100   97 1 180 croak 'incorrect number of args' unless @_ == 2;
73 96         88 my ($self, $divisor) = @_;
74              
75             # avoid division by zero
76 96 100       287 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 286 croak 'incorrect number of args' unless @_ == 2;
85 189         157 my ($self, $radians) = @_;
86              
87 189         725 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 73 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 734 croak 'must pass a vector object' unless $_[1]->isa('Math::Shape::Vector');
107 367         303 my ($self, $v2) = @_;
108 367         1053 $self->{x} * $v2->{x} + $self->{y} * $v2->{y};
109             }
110              
111              
112             sub length {
113 163     163 1 144 my $self = shift;
114             # avoid division by zero for null vectors
115 163         303 my $sum_of_squares = $self->{x} ** 2 + $self->{y} ** 2;
116              
117 163 100       378 return 0 unless $sum_of_squares;
118 138         418 sqrt $sum_of_squares;
119             }
120              
121              
122             sub convert_to_unit_vector {
123 95     95 1 77 my $self = shift;
124              
125 95         121 my $length = $self->length;
126              
127             # if the vector length is zero (or lower?) return self
128 95 50       168 return $self if $length < 0;
129              
130             # else return unit vector
131 95         133 $self->divide($length);
132             }
133              
134              
135             sub project {
136 19 50   19 1 54 croak 'must pass a vector object' unless $_[1]->isa('Math::Shape::Vector');
137 19         20 my ($self, $v2) = @_;
138              
139 19         32 my $d = $v2->dot_product($v2);
140              
141 19 100       35 if ($d > 0) {
142 16         22 $v2->multiply( $self->dot_product($v2) / $d );
143             }
144             else {
145 3         7 $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         26 my ($self, $v2) = @_;
154 25         37 my $vector_na = $self->rotate_90;
155 25         41 equal_floats(0, $vector_na->dot_product($v2));
156             }
157              
158              
159             sub enclosed_angle
160             {
161 4 50   4 1 1191 croak 'must pass a vector object' unless $_[1]->isa('Math::Shape::Vector');
162 4         6 my ($self, $v2) = @_;
163              
164 4         7 my $ua = $self->convert_to_unit_vector;
165 4         6 my $ub = $v2->convert_to_unit_vector;
166              
167 4         7 acos( $ua->dot_product($ub) );
168             }
169              
170              
171             sub radians
172             {
173 6     6 1 27 my $radians = atan2 $_[0]->{x}, $_[0]->{y};
174             # if less than zero
175 6 100       29 $radians < 0 ? pi2 + $radians : $radians;
176             }
177              
178              
179             sub header_vector
180             {
181 4 50   4 1 19 croak 'must pass a vector object' unless $_[1]->isa('Math::Shape::Vector');
182 4         8 $_[1]->subtract_vector($_[0])->convert_to_unit_vector;
183             }
184              
185              
186             sub collides
187             {
188 27     27 1 52 my ($self, $other_obj) = @_;
189              
190 27 100       231 if ($other_obj->isa('Math::Shape::Vector'))
    100          
    100          
    100          
    100          
    50          
191             {
192 9 100 100     72 $self->{x} == $other_obj->{x} && $self->{y} == $other_obj->{y} ? 1 : 0;
193             }
194             elsif ($other_obj->isa('Math::Shape::LineSegment'))
195             {
196             # test collision of nearest point on LineSegment with vector
197 6         24 my $d = $other_obj->{end}->subtract_vector($other_obj->{start});
198 6         14 my $lp = $self->subtract_vector($other_obj->{start});
199 6         14 my $pr = $lp->project($d);
200              
201 6 100 66     15 $lp->is_equal($pr)
202             && $pr->length <= $d->length
203             && 0 <= $pr->dot_product($d)
204             ? 1 : 0;
205             }
206             elsif ($other_obj->isa('Math::Shape::Line'))
207             {
208             # test if vector collides with base
209 4 100       14 return 1 if $self->collides($other_obj->{base});
210              
211             # test if vector lies on the direction
212 2         5 my $lp = $self->subtract_vector($other_obj->{base});
213 2         5 $lp->is_parallel($other_obj->{direction});
214             }
215             elsif ($other_obj->isa('Math::Shape::OrientedRectangle'))
216             {
217 4         16 $other_obj->collides($self);
218             }
219             elsif ($other_obj->isa('Math::Shape::Circle'))
220             {
221 2         6 $other_obj->collides($self);
222             }
223             elsif ($other_obj->isa('Math::Shape::Rectangle'))
224             {
225 2         8 $other_obj->collides($self);
226             }
227             else
228             {
229 0         0 croak 'collides must be called with a Math::Shape::Vector library object';
230             }
231             }
232              
233              
234             sub distance
235             {
236 4     4 1 9 my ($self, $other_obj) = @_;
237              
238 4 100       21 if ($other_obj->isa('Math::Shape::Vector'))
    50          
    0          
239             {
240 3         6 $self->subtract_vector($other_obj)->length;
241             }
242             elsif ($other_obj->isa('Math::Shape::Circle'))
243             {
244 1         5 $self->subtract_vector($other_obj->{center})->length
245             - $other_obj->{radius};
246             }
247             elsif ($other_obj->isa('Math::Shape::OrientedRectangle'))
248             {
249 0           my $circle_hull = $other_obj->circle_hull;
250 0           $self->subtract_vector($circle_hull->{center})->length
251             - $circle_hull->{radius};
252             }
253             else
254             {
255 0           croak 'distance() must be called with a Math::Shape::Vector library object';
256             }
257             }
258              
259              
260             1;
261              
262             __END__