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 min
 188 {
 189     # Martin A. Hansen, August 2006.
 190
 191     # Return the smallest of two given numbers.
 192
 193     my ( $x,    # first number
 194          $y,    # second number
 195        ) = @_;
 196
 197     # Returns number
 198
 199     if ( $x <= $y ) {
 200         return $x;
 201     } else {
 202         return $y;
 203     }
 204 }
 205
 206 sub max
 207 {
 208     # Martin A. Hansen, November 2006.
 209
 210     # Return the largest of two given numbers.
 211
 212     my ( $x,    # first number
 213          $y,    # second number
 214        ) = @_;
 215
 216     # Returns number
 217
 218     if ( $x > $y ) {
 219         return $x;
 220     } else {
 221         return $y;
 222     }
 223 }
 224
 225
 226 sub minmax
 227 {
 228     # Martin A. Hansen, April 2007.
 229
 230     # given a list of numbers returns a tuple with min and max
 231
 232     my ( $list,   # list of numbers
 233        ) = @_;
 234
 235     # returns a tuple
 236
 237     my ( $num, $min, $max );
 238
 239     $min = $max = $list->[ 0 ];
 240
 241     foreach $num ( @{ $list } )
 242     {
 243         $min = $num if $num < $min;
 244         $max = $num if $num > $max;
 245     }
 246
 247     return wantarray ? ( $min, $max ) : [ $min, $max ];
 248 }
 249
 250
 251 sub list_max
 252 {
 253     # Martin A. Hansen, August 2007.
 254
 255     # Returns the maximum number in a given list.
 256
 257     my ( $list,   # list of numbers
 258        ) = @_;
 259
 260     # Returns float
 261
 262     my ( $max, $num );
 263
 264     $max = $list->[ 0 ];
 265
 266     foreach $num ( @{ $list } ) {
 267         $max = $num if $num > $max;
 268     }
 269
 270     return $max;
 271 }
 272
 273
 274 sub list_min
 275 {
 276     # Martin A. Hansen, August 2007.
 277
 278     # Returns the minimum number in a given list.
 279
 280     my ( $list,   # list of numbers
 281        ) = @_;
 282
 283     # Returns float
 284
 285     my ( $min, $num );
 286
 287     $min = $list->[ 0 ];
 288
 289     foreach $num ( @{ $list } ) {
 290         $min = $num if $num < $min;
 291     }
 292
 293     return $min;
 294 }
 295
 296
 297 sub sum
 298 {
 299     # Martin A. Hansen, April 2007.
 300
 301     # Sums a list of given numbers and
 302     # returns the sum.
 303
 304     my ( $list,   # list of numbers
 305        ) = @_;
 306
 307     # returns float
 308
 309     my ( $sum );
 310
 311     $sum = 0;
 312
 313     map { $sum += $_ } @{ $list };
 314
 315     return $sum;
 316 }
 317
 318
 319 sub log10
 320 {
 321     # Martin A. Hansen, August 2008.
 322
 323     # Calculate the log10 of a given number.
 324
 325     my ( $num,   # number
 326        ) = @_;
 327
 328     # Returns a float.
 329
 330     return log( $num ) / log( 10 );
 331 }
 332
 333
 334 sub overlap
 335 {
 336     # Martin A. Hansen, November 2003.
 337
 338     # Tests if two invervals overlap
 339     # returns 1 if overlapping else 0.
 340
 341     my ( $beg1,
 342          $end1,
 343          $beg2,
 344          $end2,
 345        ) = @_;
 346
 347     # returns integer
 348
 349     if ( $beg1 > $end1 ) { ( $beg1, $end1 ) = ( $end1, $beg1 ) };
 350     if ( $beg2 > $end2 ) { ( $beg2, $end2 ) = ( $end2, $beg2 ) };
 351
 352     if ( $end1 < $beg2 or $beg1 > $end2 ) {
 353         return 0;
 354     } else {
 355         return 1;
 356     }
 357 }
 358
 359
 360 # >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
 361
 362
 363 __END__