3 # Copyright (C) 2007 Martin A. Hansen.
5 # This program is free software; you can redistribute it and/or
6 # modify it under the terms of the GNU General Public License
7 # as published by the Free Software Foundation; either version 2
8 # of the License, or (at your option) any later version.
10 # This program is distributed in the hope that it will be useful,
11 # but WITHOUT ANY WARRANTY; without even the implied warranty of
12 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
13 # GNU General Public License for more details.
15 # You should have received a copy of the GNU General Public License
16 # along with this program; if not, write to the Free Software
17 # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
19 # http://www.gnu.org/copyleft/gpl.html
22 # >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> DESCRIPTION <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
25 # This modules contains subroutines for simple algebra.
28 # >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
34 use Storable qw( dclone );
35 use vars qw ( @ISA @EXPORT );
38 @ISA = qw( Exporter );
41 # >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
46 # Identify if a string is a number or not.
47 # Taken from perldoc -q 'is a number'.
49 my ( $str, # string to test
54 if ( $str =~ /^([+-]?)(?=\d|\.\d)\d*(\.\d*)?([Ee]([+-]?\d+))?$/ ) {
64 # Martin A. Hansen, October 2009.
66 # Insert comma in long numbers.
68 my ( $num, # number to commify
77 $copy =~ s/(^[-+]?\d+?(?=(?>(?:\d{3})+)(?!\d))|\G\d{3}(?=\d))/$1,/g;
85 # Martin A. Hansen, June 2004.
87 # calculates the distance from at point to a line.
88 # the line is represented by a beg/end set of coordinates.
90 my ( $px, # point x coordinate
91 $py, # point y coordinate
92 $x1, # line 1 x coordinate
93 $y1, # line 1 y coordinate
94 $x2, # line 2 x coordinate
95 $y2, # line 2 y coordinate
100 my ( $dist, $a, $b );
102 $a = ( $y2 - $y1 ) / ( $x2 - $x1 );
106 $dist = abs( $a * $px + $b - $py ) / sqrt( $a ** 2 + 1 );
114 # Martin A. Hansen, April 2004.
116 # calculates the distance between two set of coordinates
128 $dist = sqrt( ( $x2 - $x1 ) ** 2 + ( $y2 - $y1 ) ** 2 );
136 # Martin A. Hansen, February 2008.
138 # Returns the distance between two given intervals.
139 # 0 indicates that the intervals are overlapping.
149 if ( $beg2 > $end1 ) {
150 return $beg2 - $end1;
151 } elsif ( $beg1 > $end2 ) {
152 return $beg1 - $end2;
161 # Martin A. Hansen, April 2007
163 # Given a list of numbers, calculates and returns the mean.
165 my ( $numbers, # list of numbers
168 # returns decimal number
174 map { $sum += $_ } @{ $numbers };
176 $mean = $sum / @{ $numbers };
184 # Martin A. Hansen, January 2008
186 # Given a list of numbers, calculates and returns the median.
188 my ( $numbers, # list of numbers
191 # returns decimal number
193 my ( $num, $median );
195 @{ $numbers } = sort { $a <=> $b } @{ $numbers };
197 $num = scalar @{ $numbers };
199 if ( $num % 2 == 0 ) {
200 $median = mean( [ $numbers->[ $num / 2 ], $numbers->[ $num / 2 + 1 ] ] );
202 $median = $numbers->[ int( $num / 2 ) ];
209 sub standard_deviation
211 # Martin A. Hansen, September 2008
213 # Given a list of numbers calculate and return the standard deviation:
214 # http://en.wikipedia.org/wiki/Standard_deviation
216 my ( $numbers, # list of numbers
221 my ( $mean_num, $num, $dev, $dev_sum, $mean_dev, $std_dev );
223 $mean_num = mean( $numbers );
227 foreach $num ( @{ $numbers } )
229 $dev = ( $num - $mean_num ) ** 2;
234 $mean_dev = $dev_sum / scalar @{ $numbers };
236 $std_dev = sqrt( $mean_dev );
244 # Martin A. Hansen, August 2006.
246 # Return the smallest of two given numbers.
248 my ( $x, # first number
263 # Martin A. Hansen, November 2006.
265 # Return the largest of two given numbers.
267 my ( $x, # first number
283 # Martin A. Hansen, April 2007.
285 # given a list of numbers returns a tuple with min and max
287 my ( $list, # list of numbers
292 my ( $num, $min, $max );
294 $min = $max = $list->[ 0 ];
296 foreach $num ( @{ $list } )
298 $min = $num if $num < $min;
299 $max = $num if $num > $max;
302 return wantarray ? ( $min, $max ) : [ $min, $max ];
308 # Martin A. Hansen, August 2007.
310 # Returns the maximum number in a given list.
312 my ( $list, # list of numbers
321 foreach $num ( @{ $list } ) {
322 $max = $num if $num > $max;
331 # Martin A. Hansen, August 2007.
333 # Returns the minimum number in a given list.
335 my ( $list, # list of numbers
344 foreach $num ( @{ $list } ) {
345 $min = $num if $num < $min;
354 # Martin A. Hansen, April 2007.
356 # Sums a list of given numbers and
359 my ( $list, # list of numbers
368 map { $sum += $_ } @{ $list };
376 # Martin A. Hansen, August 2008.
378 # Calculate the log10 of a given number.
385 return log( $num ) / log( 10 );
389 sub interpolate_linear
391 # Martin A. Hansen, February 2010.
393 # Given two data points and an x value returns the
396 # Formula for linear interpolation:
397 # http://en.wikipedia.org/wiki/Interpolation#Example
410 $y = $y1 + ( $x - $x1 ) * ( ( $y2 - $y1 ) / ( $x2 - $x1 ) );
418 # Martin A. Hansen, November 2003.
420 # Tests if two invervals overlap
421 # returns 1 if overlapping else 0.
431 if ( $beg1 > $end1 ) { ( $beg1, $end1 ) = ( $end1, $beg1 ) };
432 if ( $beg2 > $end2 ) { ( $beg2, $end2 ) = ( $end2, $beg2 ) };
434 if ( $end1 < $beg2 or $beg1 > $end2 ) {
442 # >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<