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, June 2004.
66 # calculates the distance from at point to a line.
67 # the line is represented by a beg/end set of coordinates.
69 my ( $px, # point x coordinate
70 $py, # point y coordinate
71 $x1, # line 1 x coordinate
72 $y1, # line 1 y coordinate
73 $x2, # line 2 x coordinate
74 $y2, # line 2 y coordinate
81 $a = ( $y2 - $y1 ) / ( $x2 - $x1 );
85 $dist = abs( $a * $px + $b - $py ) / sqrt( $a ** 2 + 1 );
93 # Martin A. Hansen, April 2004.
95 # calculates the distance between two set of coordinates
107 $dist = sqrt( ( $x2 - $x1 ) ** 2 + ( $y2 - $y1 ) ** 2 );
115 # Martin A. Hansen, February 2008.
117 # Returns the distance between two given intervals.
118 # 0 indicates that the intervals are overlapping.
128 if ( $beg2 > $end1 ) {
129 return $beg2 - $end1;
130 } elsif ( $beg1 > $end2 ) {
131 return $beg1 - $end2;
140 # Martin A. Hansen, April 2007
142 # Given a list of numbers, calculates and returns the mean.
144 my ( $numbers, # list of numbers
147 # returns decimal number
153 map { $sum += $_ } @{ $numbers };
155 $mean = $sum / @{ $numbers };
163 # Martin A. Hansen, January 2008
165 # Given a list of numbers, calculates and returns the median.
167 my ( $numbers, # list of numbers
170 # returns decimal number
172 my ( $num, $median );
174 @{ $numbers } = sort { $a <=> $b } @{ $numbers };
176 $num = scalar @{ $numbers };
178 if ( $num % 2 == 0 ) {
179 $median = mean( [ $numbers->[ $num / 2 ], $numbers->[ $num / 2 + 1 ] ] );
181 $median = $numbers->[ int( $num / 2 ) ];
188 sub standard_deviation
190 # Martin A. Hansen, September 2008
192 # Given a list of numbers calculate and return the standard deviation:
193 # http://en.wikipedia.org/wiki/Standard_deviation
195 my ( $numbers, # list of numbers
200 my ( $mean_num, $num, $div, $div_sum, $mean_div, $std_div );
202 $mean_num = mean( $numbers );
206 foreach $num ( @{ $numbers } )
208 $div = ( $num - $mean_num ) ** 2;
213 $mean_div = $div_sum / scalar @{ $numbers };
215 $std_div = sqrt( abs( $mean_div ) );
223 # Martin A. Hansen, August 2006.
225 # Return the smallest of two given numbers.
227 my ( $x, # first number
242 # Martin A. Hansen, November 2006.
244 # Return the largest of two given numbers.
246 my ( $x, # first number
262 # Martin A. Hansen, April 2007.
264 # given a list of numbers returns a tuple with min and max
266 my ( $list, # list of numbers
271 my ( $num, $min, $max );
273 $min = $max = $list->[ 0 ];
275 foreach $num ( @{ $list } )
277 $min = $num if $num < $min;
278 $max = $num if $num > $max;
281 return wantarray ? ( $min, $max ) : [ $min, $max ];
287 # Martin A. Hansen, August 2007.
289 # Returns the maximum number in a given list.
291 my ( $list, # list of numbers
300 foreach $num ( @{ $list } ) {
301 $max = $num if $num > $max;
310 # Martin A. Hansen, August 2007.
312 # Returns the minimum number in a given list.
314 my ( $list, # list of numbers
323 foreach $num ( @{ $list } ) {
324 $min = $num if $num < $min;
333 # Martin A. Hansen, April 2007.
335 # Sums a list of given numbers and
338 my ( $list, # list of numbers
347 map { $sum += $_ } @{ $list };
355 # Martin A. Hansen, August 2008.
357 # Calculate the log10 of a given number.
364 return log( $num ) / log( 10 );
370 # Martin A. Hansen, November 2003.
372 # Tests if two invervals overlap
373 # returns 1 if overlapping else 0.
383 if ( $beg1 > $end1 ) { ( $beg1, $end1 ) = ( $end1, $beg1 ) };
384 if ( $beg2 > $end2 ) { ( $beg2, $end2 ) = ( $end2, $beg2 ) };
386 if ( $end1 < $beg2 or $beg1 > $end2 ) {
394 # >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<