| vague documentation | Contained in the vague distribution. |
vague - Perl pragma to reduce precision in your programming constructs
use vague;
This pragma exports a set of new, imprecise keywords into your namespace to facilitate fuzzy programming methodologies and nondeterministic algorithms.
If given a list of arguments these methods return some random subset of the list, from roughly 'none' items to roughly 'all' of them. If given a single scalar that is numeric they return a number that is appropriately smaller than the input variable. If given a string they return an appropriately long substring, starting at the start of the string.
In scalar context it returns an element from its list of arguments. In list context it returns the entire list, shuffled.
$x = any of qw(a b c d e f g h i j);
foreach ( any qw(a b c d e f g h i j) ) {
#...
Returns a number that is roughly $scalar. Optionally you can supply a ceiling, and a floor, to limit the range returned. The $spread argument just says how wide the deviations can be.
Probably execute the code referred to. You can say, for example:
probably sub { print "Hello world\n"; };
generally \&trace('message');
Returns a pseudo-random word if followed by 'word', or pseudo-random integer otherwise. The sequence repeats every 20 calls to this functions. Occasionally you will get 'feck!' or 22/7 returned instead of one of the usual values. This is normal behaviour.
Does nothing, but allows nice English-like constructions such as:
for (most of 1..20) { # etc...
print some of 1, 2, 3, 4, 5, 6, 7, 8, 9, 10;
print nearly all of "And did those feet in ancient times walk upon England's mountains green.";
print hardly any of "And did those feet in ancient times walk upon England's mountains green.";
my $number = roughly 20;
$number = almost 20;
my @widgets = qw(a b c d e f g);
my $x = any @widgets;
for (most of 1..20) {
generally \&foo('hello');
}
probably sub { foo('prob') };
for (1..30) {
print random word, " ", random number, "\n";
}
sub foo { my $msg = shift; print "In foo msg $msg\n"; }
P Kent, pause@selsyn.co.uk Nov 2001 This is covered by the same terms as Perl itself.
$Id: vague.pm,v 1.3 2001/12/20 05:13:24 piers Exp $
| vague documentation | Contained in the vague distribution. |
package vague; use Exporter; use vars qw($VERSION @ISA @EXPORT $VERSION %AMOUNTS $AUTOLOAD $ness $rnd_index $rnd_indexw @rnd_words @rnd_numbers); # define our vagueness terms %AMOUNTS = ( none => 0, hardly => 0.08, few => 0.10, some => 0.25, many => 0.40, quite => 0.50, lots => 0.65, most => 0.80, almost => 0.90, nearly => 0.95, all => 1, ); @rnd_words = qw(country horizon halibut glockespiel pipe water sun he epworth cloying relax pluck matted tissue bye-bye eight llanblethian didn't supple wenge); @rnd_numbers = qw(4 8 6 15 2 3 12 17 9 20 16 18 10 11 7 13 14 1 5 19 ); $rnd_indexw = int( rand( scalar(@rnd_words) ) ); $rnd_index = int( rand( scalar(@rnd_numbers) ) ); # default vagueness $ness = 0.15; # Exporter stuff @ISA = 'Exporter'; @EXPORT = (keys(%AMOUNTS) , qw(of roughly any generally probably random word number)); ($VERSION) = ('$Revision: 1.3 $' =~ /([\d\.]+)/); ### Main Methods ############################ # we use this as the generic list operator sub AUTOLOAD { my $quality = $AUTOLOAD; $quality =~ s/^.*://; # only work if we know the adjective in question if (exists $AMOUNTS{$quality}) { if ($#_ > 0) { # if operating on an array return 'some' of it return ( grep { rand(1) < roughly($AMOUNTS{$quality}, 1, 0) } @_ ); } elsif ($#_ == 0) { # if given a single scalar, so scale it return _rough_scalar($_[0], $quality); } } else { warn("vague.pm probably doesn't know how to handle $quality"); } } # well it doesn't really mean much, but it allows a much more English style of perl sub of { return @_; } # depending on context either return the whole thing, shuffled # or return 'any element' of the list sub any { if (wantarray()) { my @new = (); while (@_) { push(@new, splice(@_, rand @_, 1)); } return @new; } else { return $_[ int( rand( scalar( @_ ) ) ) ]; } } # Return a rough version of the supplied scalar. Other args optional sub roughly { my $mean = shift; my $ceil = shift; my $floor = shift; my $dev = shift || ( $ness * $mean ); my $rand = (rand() * 2) - 1; my $delta = $dev * ( $rand * abs($rand) ) * 2; # 2 because we want all of the values within $dev my $rv = $mean + $delta; if (defined($ceil) && $rv > $ceil) { $rv = $ceil; } if (defined($floor) && $rv < $floor) { $rv = $floor; } return $rv; } # probably execute a coderef - makes most sense in a loop sub generally { my $ref = shift; if ( (rand() < $AMOUNTS{'most'}) && (ref($ref) eq 'CODE') ) { &$ref; }; } # a synonym that reads best outside a loop construct *probably = *generally; # return a pseudo-random number or word. sub random { my $type = shift; my $rv; if ($type eq 'word') { $rnd_indexw++; $rv = (rand() < 0.04)? 'feck!' : $rnd_words[ $rnd_indexw % scalar(@rnd_words) ]; } else { $rnd_index++; $rv = (rand() < 0.04)? 22/7 : $rnd_numbers[ $rnd_index % scalar(@rnd_numbers) ]; } if (wantarray()) { return ($rv, @_); } else { return $rv; } } # just to stop strict complaining sub word { 'word' } sub number { 'number' } ### Private #################### sub _rough_scalar { my ($scalar, $adjective) = @_; my $amount = roughly($AMOUNTS{$adjective}, 1, 0); if ($scalar =~ m/^[\d\.\-eE]+$/) { # if given a single numeric scalar, multiply it return ($amount * $scalar); } else { # if given a single text scalar, give back 'some' of the string return substr($scalar, 0, int( $amount * length($scalar) )); } }