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 # >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
33 use Storable qw( dclone );
34 use vars qw ( @ISA @EXPORT );
37 @ISA = qw( Exporter );
40 # >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
45 # Identify if a string is a number or not.
46 # Taken from perldoc -q 'is a number'.
48 my ( $str, # string to test
53 if ( $str =~ /^([+-]?)(?=\d|\.\d)\d*(\.\d*)?([Ee]([+-]?\d+))?$/ ) {
63 # Martin A. Hansen, June 2004.
65 # calculates the distance from at point to a line.
66 # the line is represented by a beg/end set of coordinates.
68 my ( $px, # point x coordinate
69 $py, # point y coordinate
70 $x1, # line 1 x coordinate
71 $y1, # line 1 y coordinate
72 $x2, # line 2 x coordinate
73 $y2, # line 2 y coordinate
80 $a = ( $y2 - $y1 ) / ( $x2 - $x1 );
84 $dist = abs( $a * $px + $b - $py ) / sqrt( $a ** 2 + 1 );
92 # Martin A. Hansen, April 2004.
94 # calculates the distance between two set of coordinates
106 $dist = sqrt( ( $x2 - $x1 ) ** 2 + ( $y2 - $y1 ) ** 2 );
114 # Martin A. Hansen, February 2008.
116 # Returns the distance between two given intervals.
117 # 0 indicates that the intervals are overlapping.
127 if ( $beg2 > $end1 ) {
128 return $beg2 - $end1;
129 } elsif ( $beg1 > $end2 ) {
130 return $beg1 - $end2;
139 # Martin A. Hansen, April 2007
141 # Given a list of numbers, calculates and returns the mean.
143 my ( $numbers, # list of numbers
146 # returns decimal number
152 map { $sum += $_ } @{ $numbers };
154 $mean = $sum / @{ $numbers };
162 # Martin A. Hansen, January 2008
164 # Given a list of numbers, calculates and returns the median.
166 my ( $numbers, # list of numbers
169 # returns decimal number
171 my ( $num, $median );
173 @{ $numbers } = sort { $a <=> $b } @{ $numbers };
175 $num = scalar @{ $numbers };
177 if ( $num % 2 == 0 ) {
178 $median = mean( [ $numbers->[ $num / 2 ], $numbers->[ $num / 2 + 1 ] ] );
180 $median = $numbers->[ int( $num / 2 ) ];
189 # Martin A. Hansen, August 2006.
191 # Return the smallest of two given numbers.
193 my ( $x, # first number
208 # Martin A. Hansen, November 2006.
210 # Return the largest of two given numbers.
212 my ( $x, # first number
228 # Martin A. Hansen, April 2007.
230 # given a list of numbers returns a tuple with min and max
232 my ( $list, # list of numbers
237 my ( $num, $min, $max );
239 $min = $max = $list->[ 0 ];
241 foreach $num ( @{ $list } )
243 $min = $num if $num < $min;
244 $max = $num if $num > $max;
247 return wantarray ? ( $min, $max ) : [ $min, $max ];
253 # Martin A. Hansen, August 2007.
255 # Returns the maximum number in a given list.
257 my ( $list, # list of numbers
266 foreach $num ( @{ $list } ) {
267 $max = $num if $num > $max;
276 # Martin A. Hansen, August 2007.
278 # Returns the minimum number in a given list.
280 my ( $list, # list of numbers
289 foreach $num ( @{ $list } ) {
290 $min = $num if $num < $min;
299 # Martin A. Hansen, April 2007.
301 # Sums a list of given numbers and
304 my ( $list, # list of numbers
313 map { $sum += $_ } @{ $list };
321 # Martin A. Hansen, November 2003.
323 # Tests if two invervals overlap
324 # returns 1 if overlapping else 0.
334 if ( $beg1 > $end1 ) { ( $beg1, $end1 ) = ( $end1, $beg1 ) };
335 if ( $beg2 > $end2 ) { ( $beg2, $end2 ) = ( $end2, $beg2 ) };
337 if ( $end1 < $beg2 or $beg1 > $end2 ) {
345 # >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<