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