ch06.066_prob

Perl Best Practices the source code

##############################################################################
## Code fragment (NOT RECOMMENDED) from Chapter 6 of "Perl Best Practices"  ##
##     Copyright (c) O'Reilly & Associates, 2005. All Rights Reserved.      ##
##  See: http://www.oreilly.com/pub/a/oreilly/ask_tim/2001/codepolicy.html  ##
##############################################################################


# Standard modules...
use strict;
use warnings;
use IO::Prompt;
use Carp;
use English qw( -no_match_vars );
use Data::Alias;
use Readonly;

my @points = (
    { x=>0, y=>1 },
    { x=>1, y=>1 },
    { x=>1, y=>0 },
);
use List::Util qw( max );
Readonly my $JITTER_FACTOR => 0.01;   # Jitter by a maximum of 1%

my @jittered_points 
    = map { my $x = $_->{x};
            my $y = $_->{y};
 
            my $max_jitter = max($x, $y) / $JITTER_FACTOR;
 
            { x => $x + gaussian_rand({mean=>0, dev=>0.25, scale=>$max_jitter}),
              y => $y + gaussian_rand({mean=>0, dev=>0.25, scale=>$max_jitter}),
            } 
          } @points;


use Data::Dumper 'Dumper';
warn Dumper [ @jittered_points ];


BEGIN {
    use List::Util qw( sum );
    Readonly my $SAMPLES              => 12;
    Readonly my $DEVIATIONS_PER_CURVE => 5;

    sub gaussian_rand {
        my ($arg_ref) = @_;

        my $grand = 2 * sum(map {rand 1} 1..$SAMPLES) / $SAMPLES - 1;

        if (defined $arg_ref->{dev}) {
            $grand *= $arg_ref->{dev} / $DEVIATIONS_PER_CURVE;
        }

        if (defined $arg_ref->{scale}) {
            $grand *= $arg_ref->{scale};
        }

        if (defined $arg_ref->{mean}) {
            $grand += $arg_ref->{mean};
        }

        return $grand;
    }
}