File Coverage

lib/Math/MatrixDecomposition/Util.pm
Criterion Covered Total %
statement 43 46 93.4
branch 12 14 85.7
condition n/a
subroutine 12 12 100.0
pod 5 5 100.0
total 72 77 93.5


line stmt bran cond sub pod time code
1             ## Math/MatrixDecomposition/Util.pm --- utility functions.
2              
3             # Copyright (C) 2010 Ralph Schleicher. All rights reserved.
4              
5             # This program is free software; you can redistribute it and/or
6             # modify it under the same terms as Perl itself.
7              
8             ## Code:
9              
10             package Math::MatrixDecomposition::Util;
11              
12 3     3   83827 use strict;
  3         4  
  3         76  
13 3     3   12 use warnings;
  3         4  
  3         68  
14 3     3   11 use Exporter qw(import);
  3         3  
  3         65  
15 3     3   461 use POSIX qw(fmod);
  3         5380  
  3         11  
16              
17             BEGIN
18             {
19 3     3   1404 our $VERSION = '1.05';
20 3         7 our @EXPORT_OK = qw(eps mod min max sign hypot cdiv);
21 3         1086 our %EXPORT_TAGS = (all => [@EXPORT_OK]);
22             }
23              
24             # Machine precision.
25             my $epsilon = 1.0;
26              
27 56     56   151 *eps = sub () { $epsilon; };
28              
29             INIT
30             {
31 3     3   195 my $tem;
32              
33 3         5 while (1)
34             {
35 159         138 $tem = 1.0 + $epsilon / 2.0;
36 159 100       195 last if $tem == 1.0;
37 156         127 $epsilon /= 2.0;
38             }
39             }
40              
41             # Remainder of floating-point division.
42             *mod = \&fmod;
43              
44             # Minimum value.
45             sub min ($$)
46             {
47 46     46 1 60 my ($a, $b) = @_;
48              
49 46 100       90 $a < $b ? $a : $b;
50             }
51              
52             # Maximum value.
53             sub max ($$)
54             {
55 7     7 1 11 my ($a, $b) = @_;
56              
57 7 100       39 $a > $b ? $a : $b;
58             }
59              
60             # Transfer sign.
61             sub sign ($$)
62             {
63 48     48 1 62 my ($a, $b) = @_;
64              
65 48 100       125 ($a < 0) == ($b < 0) ? $a : -$a;
66             }
67              
68             # Length of the hypotenuse of a right triangle.
69             sub hypot ($$)
70             {
71 15     15 1 19 my $a = abs (shift);
72 15         17 my $b = abs (shift);
73              
74             # Work variables.
75 15         15 my ($s, $t);
76              
77 15 100       20 if ($a >= $b)
78             {
79 12         13 $s = $a;
80             # Avoid division by zero.
81 12 50       14 $t = ($a == $b ? 1.0 : $b / $a);
82             }
83             else
84             {
85 3         5 $s = $b;
86 3         5 $t = $a / $b;
87             }
88              
89 15         27 $s * sqrt (1.0 + $t * $t);
90             }
91              
92             # Complex division.
93             sub cdiv ($$$$)
94             {
95 1     1 1 3 my ($a_re, $a_im, $b_re, $b_im) = @_;
96              
97             # Work variables.
98 1         1 my ($r, $d, @z);
99              
100 1 50       4 if (abs ($b_re) > abs ($b_im))
101             {
102 0         0 $r = $b_im / $b_re;
103 0         0 $d = $b_re + $r * $b_im;
104 0         0 @z = (($a_re + $r * $a_im) / $d,
105             ($a_im - $r * $a_re) / $d);
106             }
107             else
108             {
109 1         2 $r = $b_re / $b_im;
110 1         2 $d = $b_im + $r * $b_re;
111 1         4 @z = (($r * $a_re + $a_im) / $d,
112             ($r * $a_im - $a_re) / $d);
113             }
114              
115 1         3 @z;
116             }
117              
118             1;
119              
120             __END__