code_perl/Maasha/Calc.pm

   1 package Maasha::Calc;
   2
   3 # Copyright (C) 2007 Martin A. Hansen.
   4
   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.
   9
  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.
  14
  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.
  18
  19 # http://www.gnu.org/copyleft/gpl.html
  20
  21
  22 # >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> DESCRIPTION <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
  23
  24
  25 # This modules contains subroutines for simple algebra.
  26
  27
  28 # >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
  29
  30
  31 use strict;
  32 use Data::Dumper;
  33 use Storable qw( dclone );
  34 use vars qw ( @ISA @EXPORT );
  35 use Exporter;
  36
  37 @ISA = qw( Exporter );
  38
  39
  40 # >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
  41
  42
  43 sub is_a_number
  44 {
  45     # Identify if a string is a number or not.
  46     # Taken from perldoc -q 'is a number'.
  47
  48     my ( $str,   # string to test
  49        ) = @_;
  50
  51     # Returns boolean.
  52
  53     if ( $str =~ /^([+-]?)(?=\d|\.\d)\d*(\.\d*)?([Ee]([+-]?\d+))?$/ ) {
  54         return 1;
  55     } else {
  56         return 0;
  57     }
  58 }
  59
  60
  61 sub dist_point2line
  62 {
  63     # Martin A. Hansen, June 2004.
  64
  65     # calculates the distance from at point to a line.
  66     # the line is represented by a beg/end set of coordinates.
  67
  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
  74        ) = @_;
  75
  76     # returns float
  77
  78     my ( $dist, $a, $b );
  79
  80     $a = ( $y2 - $y1 ) / ( $x2 - $x1 );
  81
  82     $b = $y1 - $a * $x1;
  83
  84     $dist = abs( $a * $px + $b - $py ) / sqrt( $a ** 2 + 1 );
  85
  86     return $dist;
  87 }
  88
  89
  90 sub dist_point2point
  91 {
  92     # Martin A. Hansen, April 2004.
  93
  94     # calculates the distance between two set of coordinates
  95
  96     my ( $x1,
  97          $y1,
  98          $x2,
  99          $y2,
 100        ) = @_;
 101
 102     # returns float
 103
 104     my $dist;
 105
 106     $dist = sqrt( ( $x2 - $x1 ) ** 2 + ( $y2 - $y1 ) ** 2 );
 107
 108     return $dist;
 109 }
 110
 111
 112 sub dist_interval
 113 {
 114     # Martin A. Hansen, February 2008.
 115
 116     # Returns the distance between two given intervals.
 117     # 0 indicates that the intervals are overlapping.
 118
 119     my ( $beg1,
 120          $end1,
 121          $beg2,
 122          $end2,
 123        ) = @_;
 124
 125     # Returns number
 126
 127     if ( $beg2 > $end1 ) {
 128         return $beg2 - $end1;
 129     } elsif ( $beg1 > $end2 ) {
 130         return $beg1 - $end2;
 131     } else {
 132         return 0;
 133     }
 134 }
 135
 136
 137 sub mean
 138 {
 139     # Martin A. Hansen, April 2007
 140
 141     # Given a list of numbers, calculates and returns the mean.
 142
 143     my ( $numbers,   #  list of numbers
 144        ) = @_;
 145
 146     # returns decimal number
 147
 148     my ( $sum, $mean );
 149
 150     $sum = 0;
 151
 152     map { $sum += $_ } @{ $numbers };
 153
 154     $mean = $sum / @{ $numbers };
 155
 156     return $mean;
 157 }
 158
 159
 160 sub median
 161 {
 162     # Martin A. Hansen, January 2008
 163
 164     # Given a list of numbers, calculates and returns the median.
 165
 166     my ( $numbers,   #  list of numbers
 167        ) = @_;
 168
 169     # returns decimal number
 170
 171     my ( $num, $median );
 172
 173     @{ $numbers } = sort { $a <=> $b } @{ $numbers };
 174
 175     $num = scalar @{ $numbers };
 176
 177     if ( $num % 2 == 0 ) {
 178         $median = mean( [ $numbers->[ $num / 2 ], $numbers->[ $num / 2 + 1 ] ] );
 179     } else {
 180         $median = $numbers->[ int( $num / 2 ) ];
 181     }
 182
 183     return $median;
 184 }
 185
 186
 187 sub standard_deviation
 188 {
 189     # Martin A. Hansen, September 2008
 190
 191     # Given a list of numbers calculate and return the standard deviation:
 192     # http://en.wikipedia.org/wiki/Standard_deviation
 193
 194     my ( $numbers,   # list of numbers
 195        ) = @_;
 196
 197     # Returns a float.
 198
 199     my ( $mean_num, $num, $div, $div_sum, $mean_div, $std_div );
 200
 201     $mean_num = mean( $numbers );
 202
 203     $div_sum  = 0;
 204
 205     foreach $num ( @{ $numbers } )
 206     {
 207         $div = ( $num - $mean_num ) ** 2;
 208
 209         $div_sum += $div;
 210     }
 211
 212     $mean_div = $div_sum / scalar @{ $numbers };
 213
 214     $std_div  = sqrt( abs( $mean_div ) );
 215
 216     return $std_div;
 217 }
 218
 219
 220 sub min
 221 {
 222     # Martin A. Hansen, August 2006.
 223
 224     # Return the smallest of two given numbers.
 225
 226     my ( $x,    # first number
 227          $y,    # second number
 228        ) = @_;
 229
 230     # Returns number
 231
 232     if ( $x <= $y ) {
 233         return $x;
 234     } else {
 235         return $y;
 236     }
 237 }
 238
 239 sub max
 240 {
 241     # Martin A. Hansen, November 2006.
 242
 243     # Return the largest of two given numbers.
 244
 245     my ( $x,    # first number
 246          $y,    # second number
 247        ) = @_;
 248
 249     # Returns number
 250
 251     if ( $x > $y ) {
 252         return $x;
 253     } else {
 254         return $y;
 255     }
 256 }
 257
 258
 259 sub minmax
 260 {
 261     # Martin A. Hansen, April 2007.
 262
 263     # given a list of numbers returns a tuple with min and max
 264
 265     my ( $list,   # list of numbers
 266        ) = @_;
 267
 268     # returns a tuple
 269
 270     my ( $num, $min, $max );
 271
 272     $min = $max = $list->[ 0 ];
 273
 274     foreach $num ( @{ $list } )
 275     {
 276         $min = $num if $num < $min;
 277         $max = $num if $num > $max;
 278     }
 279
 280     return wantarray ? ( $min, $max ) : [ $min, $max ];
 281 }
 282
 283
 284 sub list_max
 285 {
 286     # Martin A. Hansen, August 2007.
 287
 288     # Returns the maximum number in a given list.
 289
 290     my ( $list,   # list of numbers
 291        ) = @_;
 292
 293     # Returns float
 294
 295     my ( $max, $num );
 296
 297     $max = $list->[ 0 ];
 298
 299     foreach $num ( @{ $list } ) {
 300         $max = $num if $num > $max;
 301     }
 302
 303     return $max;
 304 }
 305
 306
 307 sub list_min
 308 {
 309     # Martin A. Hansen, August 2007.
 310
 311     # Returns the minimum number in a given list.
 312
 313     my ( $list,   # list of numbers
 314        ) = @_;
 315
 316     # Returns float
 317
 318     my ( $min, $num );
 319
 320     $min = $list->[ 0 ];
 321
 322     foreach $num ( @{ $list } ) {
 323         $min = $num if $num < $min;
 324     }
 325
 326     return $min;
 327 }
 328
 329
 330 sub sum
 331 {
 332     # Martin A. Hansen, April 2007.
 333
 334     # Sums a list of given numbers and
 335     # returns the sum.
 336
 337     my ( $list,   # list of numbers
 338        ) = @_;
 339
 340     # returns float
 341
 342     my ( $sum );
 343
 344     $sum = 0;
 345
 346     map { $sum += $_ } @{ $list };
 347
 348     return $sum;
 349 }
 350
 351
 352 sub log10
 353 {
 354     # Martin A. Hansen, August 2008.
 355
 356     # Calculate the log10 of a given number.
 357
 358     my ( $num,   # number
 359        ) = @_;
 360
 361     # Returns a float.
 362
 363     return log( $num ) / log( 10 );
 364 }
 365
 366
 367 sub overlap
 368 {
 369     # Martin A. Hansen, November 2003.
 370
 371     # Tests if two invervals overlap
 372     # returns 1 if overlapping else 0.
 373
 374     my ( $beg1,
 375          $end1,
 376          $beg2,
 377          $end2,
 378        ) = @_;
 379
 380     # returns integer
 381
 382     if ( $beg1 > $end1 ) { ( $beg1, $end1 ) = ( $end1, $beg1 ) };
 383     if ( $beg2 > $end2 ) { ( $beg2, $end2 ) = ( $end2, $beg2 ) };
 384
 385     if ( $end1 < $beg2 or $beg1 > $end2 ) {
 386         return 0;
 387     } else {
 388         return 1;
 389     }
 390 }
 391
 392
 393 # >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
 394
 395
 396 __END__