File Coverage

lib/Panotools/Matrix.pm
Criterion Covered Total %
statement 69 69 100.0
branch 1 2 50.0
condition n/a
subroutine 11 11 100.0
pod 0 5 0.0
total 81 87 93.1


line stmt bran cond sub pod time code
1             package Panotools::Matrix;
2              
3             =head1 NAME
4              
5             Panotools::Matrix - Miscellaneous math for panoramic images
6              
7             =head1 SYNOPSIS
8              
9             $matrix = rollpitchyaw2matrix ($roll, $pitch, $yaw);
10              
11             All angles are in radians not degrees.
12              
13             =head1 DESCRIPTION
14              
15             rollpitchyaw2matrix returns a matrix arrayref that encapsulates a
16             transformation suitable for rotating a vector/point by three degrees of freedom
17             (roll, pitch and yaw).
18              
19             roll is positive rotation around the x-axis
20              
21             pitch is negative rotation around the y-axis
22              
23             yaw is negative rotation around the z axis
24              
25             =head1 USAGE
26              
27             use Panotools::Matrix qw(matrix2rollpitchyaw rollpitchyaw2matrix multiply);
28              
29             my $point = [[$x1], [$y1], [$z1]];
30              
31             my $matrix = rollpitchyaw2matrix ($roll, $pitch, $yaw);
32              
33             my $result = multiply ($matrix, $point);
34              
35             ($x2, $y2, $z2) = ($result->[0][0], $result->[1][0], $result->[2][0]);
36              
37             =cut
38              
39 11     11   88816 use Math::Trig;
  11         279610  
  11         3596  
40 11     11   290 use Math::Trig ':radial';
  11         29  
  11         12136  
41 11     11   198 use strict;
  11         24  
  11         737  
42 11     11   66 use warnings;
  11         22  
  11         434  
43              
44 11     11   57 use Exporter;
  11         25  
  11         522  
45 11     11   63 use vars qw(@ISA @EXPORT);
  11         29  
  11         11217  
46             @ISA = qw(Exporter);
47             @EXPORT = qw(rollpitchyaw2matrix matrix2rollpitchyaw multiply);
48              
49             sub rollpitchyaw2matrix {
50 28     28 0 193 my ($roll, $pitch, $yaw) = @_;
51              
52 28         106 my $cosr = cos ($roll);
53 28         1705 my $sinr = sin ($roll);
54 28         68 my $cosp = cos ($pitch);
55 28         43 my $sinp = sin (0 - $pitch);
56 28         65 my $cosy = cos ($yaw);
57 28         41 my $siny = sin (0 - $yaw);
58              
59 28         147 my $rollm = [[ 1, 0, 0 ],
60             [ 0, $cosr,-1*$sinr ],
61             [ 0, $sinr, $cosr ]];
62              
63 28         115 my $pitchm = [[ $cosp, 0, $sinp ],
64             [ 0, 1, 0 ],
65             [ -1*$sinp, 0, $cosp ]];
66              
67 28         115 my $yawm = [[ $cosy,-1*$siny, 0 ],
68             [ $siny, $cosy, 0 ],
69             [ 0, 0, 1 ]];
70              
71 28         235 my $foo = multiply ($yawm, $pitchm);
72 28         56 multiply ($foo, $rollm);
73             }
74              
75             sub transpose
76             {
77 77     77 0 2516 my $matrix_in = shift;
78 77         72 my $matrix_out;
79              
80 77         80 my $n = 0;
81 77         343 for my $row (@{$matrix_in})
  77         127  
82             {
83 231         232 my $m = 0;
84 231         351 for my $column (@{$row})
  231         1296  
85             {
86 621         1181 $matrix_out->[$m]->[$n] = $matrix_in->[$n]->[$m];
87 621         2084 $m++;
88             }
89 231         444 $n++;
90             }
91 77         777 return $matrix_out;
92             }
93              
94             sub multiply
95             {
96 76     76 0 84 my $matrix_a = shift;
97 76         122 my $transposed_b = transpose (shift);
98 76         81 my $matrix_out;
99              
100 76 50       79 return undef if (scalar @{$matrix_a->[0]} != scalar @{$transposed_b->[0]});
  76         110  
  76         644  
101 76         135 for my $row (@{$matrix_a})
  76         128  
102             {
103 228         372 my $rescol = [];
104 228         2621 for my $column (@{$transposed_b})
  228         472  
105             {
106 612         619 push (@{$rescol}, vekpro ($row, $column));
  612         1723  
107             }
108 228         370 push (@{$matrix_out}, $rescol);
  228         666  
109             }
110 76         637 return $matrix_out;
111             }
112              
113             sub vekpro
114             {
115 612     612 0 912 my ($a, $b) = @_;
116 612         943 my $result = 0;
117              
118 612         659 for my $i (0 .. scalar @{$a} - 1)
  612         974  
119             {
120 1836         6665 $result += $a->[$i] * $b->[$i];
121             }
122 612         1757 $result;
123             }
124              
125             # following copied from a spreadsheet by Stuart Milne
126              
127             sub matrix2rollpitchyaw
128             {
129 8     8 0 14 my $matrix = shift;
130 8         54 my $roll = atan2 ($matrix->[2]->[1], $matrix->[2]->[2]);
131 8         51 my $pitch = -1 * asin (-1 * $matrix->[2]->[0]);
132 8         108 my $yaw = atan2 (-1 * $matrix->[1]->[0], $matrix->[0]->[0]);
133 8         40 return ($roll, $pitch, $yaw);
134             }
135              
136             1;
137