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