1package Math::Random::MT::Auto::Range; { 2 3use strict; 4use warnings; 5 6our $VERSION = '6.23'; 7$VERSION = eval $VERSION; 8 9use Scalar::Util 1.18; 10 11# Declare ourself as a subclass 12use Object::InsideOut 'Math::Random::MT::Auto' => [ ':!auto' ]; 13 14 15### Inside-out Object Attributes ### 16 17# Object data is stored in these attribute hashes, and is keyed to the object 18# by a unique ID that is stored in the object's scalar reference. 19# 20# These hashes are declared using the 'Field' attribute. 21 22# Range information for our objects 23my %type_of :Field; # Type of return value: INTEGER or DOUBLE 24my %low_for :Field; # Low end of the range 25my %high_for :Field; # High end of the range 26my %range_for :Field; # 'Difference' between LOW and HIGH 27 # (used for performance considerations) 28 29 30### Inside-out Object Internal Subroutines ### 31 32my %init_args :InitArgs = ( 33 'LOW' => { 34 'REGEX' => qr/^lo(?:w)?$/i, 35 'MANDATORY' => 1, 36 'TYPE' => 'NUMBER', 37 }, 38 'HIGH' => { 39 'REGEX' => qr/^hi(?:gh)?$/i, 40 'MANDATORY' => 1, 41 'TYPE' => 'NUMBER', 42 }, 43 'TYPE' => qr/^type$/i, # Range type 44); 45 46# Object initializer 47sub _init :Init 48{ 49 my $self = $_[0]; 50 my $args = $_[1]; # Hash ref containing arguments from object 51 # constructor as specified by %init_args above 52 53 # Default 'TYPE' to 'INTEGER' if 'LOW' and 'HIGH' are both integers. 54 # Otherwise, default to 'DOUBLE'. 55 if (! exists($$args{'TYPE'})) { 56 my $lo = $$args{'LOW'}; 57 my $hi = $$args{'HIGH'}; 58 $$args{'TYPE'} = (($lo == int($lo)) && ($hi == int($hi))) 59 ? 'INTEGER' 60 : 'DOUBLE'; 61 } 62 63 # Initialize object 64 $self->set_range_type($$args{'TYPE'}); 65 $self->set_range($$args{'LOW'}, $$args{'HIGH'}); 66} 67 68 69### Object Methods ### 70 71# Sets numeric type random values 72sub set_range_type 73{ 74 my $self = shift; 75 76 # Check argument 77 my $type = $_[0]; 78 if (! defined($type) || $type !~ /^[ID]/i) { 79 MRMA::Args->die( 80 'caller_level' => (caller() eq __PACKAGE__) ? 2 : 0, 81 'message' => "Bad range type: $type", 82 'Usage' => q/Range type must be 'INTEGER' or 'DOUBLE'/); 83 } 84 85 $type_of{$$self} = ($type =~ /^I/i) ? 'INTEGER' : 'DOUBLE'; 86} 87 88 89# Return current range type 90sub get_range_type 91{ 92 my $self = shift; 93 return ($type_of{$$self}); 94} 95 96 97# Set random number range 98sub set_range 99{ 100 my $self = shift; 101 102 # Check for arguments 103 my ($lo, $hi) = @_; 104 if (! Scalar::Util::looks_like_number($lo) || 105 ! Scalar::Util::looks_like_number($hi)) 106 { 107 MRMA::Args->die( 108 'message' => q/Bad range arguments/, 109 'Usage' => q/Range must be specified using 2 numeric arguments/); 110 } 111 112 # Ensure arguments are of the proper type 113 if ($type_of{$$self} eq 'INTEGER') { 114 $lo = int($lo); 115 $hi = int($hi); 116 } else { 117 $lo = 0.0 + $lo; 118 $hi = 0.0 + $hi; 119 } 120 # Make sure 'LOW' and 'HIGH' are not the same 121 if ($lo == $hi) { 122 MRMA::Args->die( 123 'caller_level' => (caller() eq __PACKAGE__) ? 2 : 0, 124 'message' => q/Invalid arguments: LOW and HIGH are equal/, 125 'Usage' => q/The range must be a non-zero interval/); 126 } 127 # Ensure LOW < HIGH 128 if ($lo > $hi) { 129 ($lo, $hi) = ($hi, $lo); 130 } 131 132 # Set range parameters 133 $low_for{$$self} = $lo; 134 $high_for{$$self} = $hi; 135 if ($type_of{$$self} eq 'INTEGER') { 136 $range_for{$$self} = ($high_for{$$self} - $low_for{$$self}) + 1; 137 } else { 138 $range_for{$$self} = $high_for{$$self} - $low_for{$$self}; 139 } 140} 141 142 143# Return object's random number range 144sub get_range 145{ 146 my $self = shift; 147 return ($low_for{$$self}, $high_for{$$self}); 148} 149 150 151# Return a random number of the configured type and within the configured 152# range. 153sub rrand 154{ 155 my $self = $_[0]; 156 157 if ($type_of{$$self} eq 'INTEGER') { 158 # Integer random number range [LOW, HIGH] 159 return (($self->irand() % $range_for{$$self}) + $low_for{$$self}); 160 } else { 161 # Floating-point random number range [LOW, HIGH) 162 return ($self->rand($range_for{$$self}) + $low_for{$$self}); 163 } 164} 165 166 167### Overloading ### 168 169sub as_string :Stringify :Numerify 170{ 171 return ($_[0]->rrand()); 172} 173 174sub bool :Boolify 175{ 176 return ($_[0]->rrand() & 1); 177} 178 179sub array :Arrayify 180{ 181 my $self = $_[0]; 182 my $count = $_[1] || 1; 183 184 my @ary; 185 do { 186 push(@ary, $self->rrand()); 187 } while (--$count > 0); 188 189 return (\@ary); 190} 191 192sub _code :Codify 193{ 194 my $self = $_[0]; 195 return (sub { $self->rrand(); }); 196} 197 198 199### Serialization ### 200 201# Support for ->dump() method 202sub _dump :Dumper 203{ 204 my $obj = shift; 205 206 return ({ 207 'HIGH' => $high_for{$$obj}, 208 'LOW' => $low_for{$$obj}, 209 'TYPE' => $type_of{$$obj} 210 }); 211} 212 213# Support for Object::InsideOut::pump() 214sub _pump :Pumper 215{ 216 my ($obj, $data) = @_; 217 218 $obj->set_range_type($$data{'TYPE'}); 219 $obj->set_range($$data{'LOW'}, $$data{'HIGH'}); 220} 221 222} # End of package's lexical scope 223 2241; 225 226__END__ 227 228=head1 NAME 229 230Math::Random::MT::Auto::Range - Range-valued PRNGs 231 232=head1 SYNOPSIS 233 234 use strict; 235 use warnings; 236 use Math::Random::MT::Auto::Range; 237 238 # Integer random number range 239 my $die = Math::Random::MT::Auto::Range->new(LO => 1, HI => 6); 240 my $roll = $die->rrand(); 241 242 # Floating-point random number range 243 my $compass = Math::Random::MT::Auto::Range->new(LO => 0, HI => 360, 244 TYPE => 'DOUBLE'); 245 my $course = $compass->rrand(); 246 247=head1 DESCRIPTION 248 249This module creates range-valued pseudorandom number generators (PRNGs) that 250return random values between two specified limits. 251 252While useful in itself, the primary purpose of this module is to provide an 253example of how to create subclasses of Math::Random::MT::Auto within 254L<Object::InsideOut>'s inside-out object model. 255 256=head1 MODULE DECLARATION 257 258Add the following to the top of our application code: 259 260 use strict; 261 use warnings; 262 use Math::Random::MT::Auto::Range; 263 264This module is strictly OO, and does not export any functions or symbols. 265 266=head1 METHODS 267 268=over 269 270=item Math::Random::MT::Auto::Range->new 271 272Creates a new range-valued PRNG. 273 274 my $prng = Math::Random::MT::Auto::Range->new( %options ); 275 276Available options are: 277 278=over 279 280=item 'LOW' => $num 281 282=item 'HIGH' => $num 283 284Sets the limits over which the values return by the PRNG will range. These 285arguments are mandatory, and C<LOW> must not be equal to C<HIGH>. 286 287If the C<TYPE> for the PRNG is C<INTEGER>, then the range will be C<LOW> to 288C<HIGH> inclusive (i.e., [LOW, HIGH]). If C<DOUBLE>, then C<LOW> inclusive to 289C<HIGH> exclusive (i.e., [LOW, HIGH)). 290 291C<LO> and C<HI> can be used as synonyms for C<LOW> and C<HIGH>, respectively. 292 293=item 'TYPE' => 'INTEGER' 294 295=item 'TYPE' => 'DOUBLE' 296 297Sets the type for the values returned from the PRNG. If C<TYPE> is not 298specified, it will default to C<INTEGER> if both C<LOW> and C<HIGH> are 299integers. 300 301=back 302 303The options above are also supported using lowercase and mixed-case (e.g., 304'low', 'hi', 'Type', etc.). 305 306Additionally, objects created with this package can take any of the options 307supported by the L<Math::Random::MT::Auto> class, namely, C<STATE>, C<SEED> 308and C<STATE>. 309 310=item $obj->new 311 312Creates a new PRNG in the same manner as 313L</"Math::Random::MT::Auto::Range-E<gt>new">. 314 315 my $prng2 = $prng1->new( %options ); 316 317=back 318 319In addition to the methods describe below, the objects created by this package 320inherit all the object methods provided by the L<Math::Random::MT::Auto> 321class, including the C<->clone()> method. 322 323=over 324 325=item $obj->rrand 326 327Returns a random number of the configured type within the configured range. 328 329 my $rand = $prng->rrand(); 330 331If the C<TYPE> for the PRNG is C<INTEGER>, then the range will be C<LOW> to 332C<HIGH> inclusive (i.e., [LOW, HIGH]). If C<DOUBLE>, then C<LOW> inclusive to 333C<HIGH> exclusive (i.e., [LOW, HIGH)). 334 335=item $obj->set_range_type 336 337Sets the numeric type for the random numbers returned by the PRNG. 338 339 $prng->set_range_type('INTEGER'); 340 # or 341 $prng->set_range_type('DOUBLE'); 342 343=item $obj->get_range_type 344 345Returns the numeric type ('INTEGER' or 'DOUBLE') for the random numbers 346returned by the PRNG. 347 348 my $type = $prng->get_range_type(); 349 350=item $obj->set_range 351 352Sets the limits for the PRNG's return value range. 353 354 $prng->set_range($lo, $hi); 355 356C<$lo> must not be equal to C<$hi>. 357 358=item $obj->get_range 359 360Returns a list of the PRNG's range limits. 361 362 my ($lo, $hi) = $prng->get_range(); 363 364=back 365 366=head1 INSIDE-OUT OBJECTS 367 368Capabilities provided by L<Object::InsideOut> are supported by this modules. 369See L<Math::Random::MT::Auto/"INSIDE-OUT OBJECTS"> for more information. 370 371=head2 Coercion 372 373Object coercion is supported in the same manner as documented in 374See L<Math::Random::MT::Auto/"Coercion"> except that the underlying random 375number method is C<-E<gt>rrand()>. 376 377=head1 DIAGNOSTICS 378 379=over 380 381=item * Missing parameter: LOW 382 383=item * Missing parameter: HIGH 384 385The L<LOW and HIGH|/"'LOW' =E<gt> $num"> values for the range must be 386specified to L<-E<gt>new()|/"Math::Random::MT::Auto::Range-E<gt>new">. 387 388=item * Arg to ->set_range_type() must be 'INTEGER' or 'DOUBLE' 389 390Self explanatory. 391 392=item * ->range() requires two numeric args 393 394Self explanatory. 395 396=item * Invalid arguments: LOW and HIGH are equal 397 398You cannot specify a range of zero width. 399 400=back 401 402This module will reverse the range limits if they are specified in the wrong 403order (i.e., it makes sure that C<LOW < HIGH>). 404 405=head1 SEE ALSO 406 407L<Math::Random::MT::Auto> 408 409L<Object::InsideOut> 410 411=head1 AUTHOR 412 413Jerry D. Hedden, S<E<lt>jdhedden AT cpan DOT orgE<gt>> 414 415=head1 COPYRIGHT AND LICENSE 416 417Copyright 2005 - 2009 Jerry D. Hedden. All rights reserved. 418 419This program is free software; you can redistribute it and/or modify it under 420the same terms as Perl itself. 421 422=cut 423