Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

Merge pull request #1 from blabos/master

Chained frequencies
  • Loading branch information...
commit 5abf3bd0ef38c1ac99f691c6842aa5386f9b1376 2 parents bfb5cae + 984ee65
@garu authored
Showing with 106 additions and 14 deletions.
  1. +1 −0  .gitignore
  2. +3 −0  Changes
  3. +102 −14 lib/Sub/Frequency.pm
View
1  .gitignore
@@ -0,0 +1 @@
+.project
View
3  Changes
@@ -1,5 +1,8 @@
Revision history for Sub::Frequency
+0.03 2011-06-16
+ Chained frequencies
+
0.02 2010-12-17
Improving documentation
View
116 lib/Sub/Frequency.pm
@@ -1,4 +1,5 @@
package Sub::Frequency;
+
use strict;
use warnings;
@@ -6,43 +7,108 @@ use Scalar::Util 'looks_like_number';
use Carp 'croak';
use parent 'Exporter';
+
our @EXPORT = qw(
- always normally usually sometimes maybe
- rarely seldom never with_probability
+ always normally usually often sometimes maybe
+ rarely seldom never with_probability
);
-our @EXPORT_OK = @EXPORT;
+our @EXPORT_OK = @EXPORT;
-our $VERSION = '0.02';
+our $VERSION = '0.03';
+my %probabilities = (
+ 'Sub::Frequency::Always' => 1.00,
+ 'Sub::Frequency::Normally' => 0.75,
+ 'Sub::Frequency::Sometimes' => 0.50,
+ 'Sub::Frequency::Rarely' => 0.25,
+ 'Sub::Frequency::Never' => 0.00,
+);
-sub always (&) { $_[0]->() }
+sub always(&;@) {
+ my ( $code, @rest ) = @_;
+ my $name = 'Sub::Frequency::Always';
+ if (wantarray) {
+ return ( bless( $code, $name ), @rest );
+ }
+ else {
+ _exec( $code, $name, @rest );
+ }
+}
-sub normally (&) { with_probability( 0.75, @_ ) }
-*usually = \&normally;
+sub normally(&;@) {
+ my ( $code, @rest ) = @_;
+ my $name = 'Sub::Frequency::Normally';
+ if (wantarray) {
+ return ( bless( $code, $name ), @rest );
+ }
+ else {
+ _exec( $code, $name, @rest );
+ }
+}
-sub sometimes (&) { with_probability( 0.5, @_ ) }
-*maybe = \&sometimes;
+sub sometimes(&;@) {
+ my ( $code, @rest ) = @_;
+ my $name = 'Sub::Frequency::Sometimes';
+ if (wantarray) {
+ return ( bless( $code, $name ), @rest );
+ }
+ else {
+ _exec( $code, $name, @rest );
+ }
+}
-sub rarely (&) { with_probability( 0.25, @_ ) }
-*seldom = \&rarely;
+sub rarely(&;@) {
+ my ( $code, @rest ) = @_;
+ my $name = 'Sub::Frequency::Rarely';
+ if (wantarray) {
+ return ( bless( $code, $name ), @rest );
+ }
+ else {
+ _exec( $code, $name, @rest );
+ }
+}
-sub never (&) { return }
+sub never(&;@) {
+ my ( $code, @rest ) = @_;
+ my $name = 'Sub::Frequency::Never';
+ if (wantarray) {
+ return ( bless( $code, $name ), @rest );
+ }
+ else {
+ _exec( $code, $name, @rest );
+ }
+}
sub with_probability ($;&) {
- my ($probability, $code) = @_;
+ my ( $probability, $code ) = @_;
$probability = _coerce($probability)
- unless looks_like_number($probability);
+ unless looks_like_number($probability);
$code->() if rand() <= $probability;
}
+*often = \&normally;
+*usually = \&normally;
+*maybe = \&sometimes;
+*seldom = \&rarely;
+
+sub _exec {
+ my ( $code, $name, @rest ) = @_;
+
+ $code->() and return if rand() < $probabilities{$name};
+
+ foreach $code (@rest) {
+ $code->() and last if rand() < $probabilities{ ref($code) };
+ }
+}
+
sub _coerce {
my $thing = shift;
@@ -57,6 +123,7 @@ sub _coerce {
42;
__END__
+
=head1 NAME
Sub::Frequency - Run code blocks according to a given probability
@@ -94,6 +161,27 @@ You can also specify your own probability for the code to run:
...
};
+Since version 0.03 you can do a chain of probabilities:
+
+ normally {
+ # code here will run 75% of the time
+ }
+ maybe {
+ # code here will run 50% of the remaining 25% of the time,
+ # ie 12.5% of the total time
+ }
+ seldom {
+ # code here will run 25% of the remaining 12.5% of the time,
+ # ie 3.125% of the total time
+ }
+ always {
+ # code here will run on the remaining time, ie 9,375% of the time
+ };
+
+Note an absence of some semicolons compared with the previous examples.
+
+The function C<with_probability> cannot be chained yet.
+
=head1 DESCRIPTION
Please sign in to comment.
Something went wrong with that request. Please try again.