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