File Coverage

blib/lib/Math/Intersection/StraightLine.pm
Criterion Covered Total %
statement 98 101 97.0
branch 31 36 86.1
condition 29 45 64.4
subroutine 12 12 100.0
pod 5 5 100.0
total 175 199 87.9


line stmt bran cond sub pod time code
1             package Math::Intersection::StraightLine;
2              
3             # ABSTRACT: Calculate intersection point for two lines
4              
5 1     1   19709 use 5.006001;
  1         2  
  1         31  
6 1     1   4 use strict;
  1         0  
  1         38  
7 1     1   3 use warnings;
  1         1  
  1         1076  
8              
9             our $VERSION = '0.05';
10              
11             sub new{
12 1     1 1 409 my ($class) = @_;
13 1         2 my $self = {};
14 1         3 bless $self,$class;
15 1         4 return $self;
16             }# new
17              
18             sub functions{
19 1     1 1 250 my ($self,$f_one,$f_two) = @_;
20 1         1 my $factor = 3;
21 1         7 my $line_one = [
22             [0,$f_one->[1]],
23             [$factor,($f_one->[0] * $factor) + $f_one->[1]],
24             ];
25 1         6 my $line_two = [
26             [0,$f_two->[1]],
27             [$factor,($f_two->[0] * $factor) + $f_two->[1]],
28             ];
29 1         3 return $self->points($line_one,$line_two);
30             }# function
31              
32             sub vectors{
33 10     10 1 524 my ($self,$vector_one,$vector_two) = @_;
34 10         30 my @equation_one = ($vector_one->[0]->[0],$vector_one->[1]->[0],
35             $vector_two->[0]->[0],$vector_two->[1]->[0],);
36 10         27 my @equation_two = ($vector_one->[0]->[1],$vector_one->[1]->[1],
37             $vector_two->[0]->[1],$vector_two->[1]->[1],);
38 10         41 my $factor_one = $vector_two->[1]->[1];
39 10         17 my $factor_two = $vector_two->[1]->[0];
40            
41 10         18 for(@equation_one){
42 40         45 $_ *= $factor_one;
43             }
44            
45 10         15 for(@equation_two){
46 40         36 $_ *= $factor_two;
47             }
48            
49 10         10 my @result_equation;
50 10         15 for(0..3){
51 40         57 push(@result_equation,$equation_one[$_] - $equation_two[$_]);
52             }
53            
54 10         12 my $point = undef;
55            
56 10 100       20 if($result_equation[1] != 0){
57 6         7 my $constant = $result_equation[2] - $result_equation[0];
58 6         11 my $lambda = $constant / $result_equation[1];
59            
60 6         23 $point = [$vector_one->[0]->[0] + ($vector_one->[1]->[0] * $lambda),
61             $vector_one->[0]->[1] + ($vector_one->[1]->[1] * $lambda),];
62             }
63 10 100       21 if(_check_parallel_vectors($vector_one,$vector_two)){
64 4 100       12 if(defined _check_point_on_vector($vector_one,$vector_two->[0])){
65 1         2 $point = -1;
66             }
67             else{
68 3         4 $point = 0;
69             }
70             }
71 10         47 return $point;
72             }# vectors
73              
74             sub point_limited{
75 5     5 1 1490 my ($self,$line_one,$line_two) = @_;
76 5         11 my @coords_one = @$line_one;
77 5         6 my @coords_two = @$line_two;
78 5         21 my $vector_one = [$coords_one[0],[$coords_one[0]->[0] - $coords_one[1]->[0],
79             $coords_one[0]->[1] - $coords_one[1]->[1]]];
80 5         14 my $vector_two = [$coords_two[0],[$coords_two[0]->[0] - $coords_two[1]->[0],
81             $coords_two[0]->[1] - $coords_two[1]->[1]]];
82 5         8 my $result = $self->vectors($vector_one,$vector_two);
83 5         6 my $return = 0;
84 5 100 66     37 if(defined $result && ref($result) eq 'ARRAY' &&
      100        
      66        
85             _check_point_on_line($vector_one,$result) &&
86             _check_point_on_line($vector_two,$result)){
87 2         3 $return = $result;
88             }
89 5 50       12 if(_check_overlapping_lines($line_one,$line_two,$vector_one,$vector_two)){
90 0         0 $return = -1;
91             }
92 5         22 return $return;
93             }# point_limited
94              
95              
96             sub points{
97 2     2 1 232 my ($self,$line_one,$line_two) = @_;
98 2         6 my @coords_one = @$line_one;
99 2         3 my @coords_two = @$line_two;
100 2         11 my $vector_one = [$coords_one[0],[$coords_one[0]->[0] - $coords_one[1]->[0],
101             $coords_one[0]->[1] - $coords_one[1]->[1]]];
102 2         9 my $vector_two = [$coords_two[0],[$coords_two[0]->[0] - $coords_two[1]->[0],
103             $coords_two[0]->[1] - $coords_two[1]->[1]]];
104 2         497 my $result = $self->vectors($vector_one,$vector_two);
105 2         3 my $return = 0;
106 2 50 33     9 if(defined $result && ref($result) eq 'ARRAY'){
107 2         2 $return = $result;
108             }
109 2 50       4 if(_check_overlapping_lines($line_one,$line_two,$vector_one,$vector_two)){
110 0         0 $return = -1;
111             }
112 2         7 return $return;
113             }# points
114              
115             sub _check_point_on_line{
116 33     33   35 my ($vector,$point) = @_;
117 33         24 my $return = 1;
118            
119 33         44 my $check = _check_point_on_vector($vector,$point);
120 33 100 66     81 if(!defined $check || $check > 0 || $check < -1){
      100        
121 29         24 $return = 0;
122             }
123              
124 33         114 return $return;
125             }# _check_point_on_line
126              
127             sub _check_overlapping_lines{
128 7     7   10 my ($line_one,$line_two,$vector_one,$vector_two) = @_;
129 7         5 my $return = 0;
130 7 50 33     12 if(_check_point_on_line($vector_one,$line_two->[0]) ||
      33        
      33        
131             _check_point_on_line($vector_one,$line_two->[1]) ||
132             _check_point_on_line($vector_two,$line_one->[0]) ||
133             _check_point_on_line($vector_two,$line_one->[1])){
134 0         0 $return = 1;
135             }
136 7         14 return $return;
137             }# _check_overlapping_lines
138              
139             sub _check_parallel_vectors{
140 10     10   11 my ($vector_one,$vector_two) = @_;
141 10         8 my $return = 0;
142 10         13 for(0,1){
143 20 100 66     108 if(($vector_one->[1]->[0] == 0 && $vector_two->[1]->[0] == 0) ||
      66        
      66        
144             ($vector_one->[1]->[1] == 0 && $vector_two->[1]->[1] == 0)){
145 2         5 $return = 1;
146             }
147             else{
148 18 100 66     62 unless($vector_two->[1]->[0] == 0 || $vector_two->[1]->[1] == 0){
149 8         12 my $quot_one = $vector_one->[1]->[0] / $vector_two->[1]->[0];
150 8         10 my $quot_two = $vector_one->[1]->[1] / $vector_two->[1]->[1];
151 8 100       18 if($quot_one == $quot_two){
152 6         10 $return = 1;
153             }
154             }
155             }
156             }
157 10         28 return $return;
158             }# _check_parallel_vectors
159              
160             sub _check_point_on_vector{
161 37     37   29 my ($vector,$point) = @_;
162 37         32 my $return = undef;
163 37         20 my $tmp_check = undef;
164 37         118 for(0,1){
165 61 100 100     288 if($vector->[1]->[$_] == 0 && ($point->[$_] != $vector->[0]->[$_])){
    100          
166 15         11 $return = 0;
167 15         19 last;
168             }
169             elsif($vector->[1]->[$_] != 0){
170 43         65 my $check = ($point->[$_] - $vector->[0]->[$_]) / $vector->[1]->[$_];
171 43 100       79 unless(defined $tmp_check){
    100          
172 24         45 $tmp_check = $check;
173             }
174             elsif(abs($tmp_check - $check) > 0.00001){
175 16         34 $return = 0;
176             }
177             }
178             }
179 37 100 66     117 if(defined $return && $return == 0){
    50          
180 31         24 $return = undef;
181             }
182             elsif(! defined $return){
183 6         5 $return = $tmp_check;
184             }
185 37         59 return $return;
186             }# _check_point_on_vector
187              
188             1;
189              
190             __END__