Hey there,
Breaking tradition (or continuing it, depending on how often you read this blog ;) we're going to have part 2 of yesterday's two-parter tomorrow and put up our final Perl script to find the maximum guaranteed number sets, or lists, within larger number pools. There's not too much else to explain about it, but we will lay out this road map, so that you can see (or possibly revisit or avoid ;) all of the different topics we covered that are included in this script and/or are directly relevant (kind of a list of directions to this post and its attached script).
In order to get to this script, we've tackled:
1. Number Pools And Guaranteed Matches
2. Permuting Lists and Strings With Perl
3. Sorting Lists And Removing Duplicates With Perl
4. Unique Sorting Of Lists Within Lists Within Lists
5. Determining The Maximum Amount Of Pool Sets In Any Number Pool
6. Finding Overlapping Matches Using Lookahead Assertions
7. Evaluating Number Grids
8. Maximizing Number Set Probability Within Number Pools
And, so, without further ado, the culmination of all that effort (okay, that's a bit of a stretch... how about, the amalgamation of all those different concepts ;) - A simple Perl script that gets all its input interactively, so it can be run very simply, like so (sample run):
host # ./wheel.pl
Highest Number: 39
Number Of Balls Drawn: 5
How Many Numbers To Trap: 3
Enter your numbers
separated by space character : 1 2 3 4 5 6 7 19
Highest Number 39
Balls Drawn 5
How Many Numbers To Trap: 3
Actual Numbers To Seed: 1 2 3 4 5 6 7 19
Running 4 phase permute...
Game 1: 1 2 3 4 19
Game 2: 1 2 3 4 5
Game 3: 1 2 3 4 6
Game 4: 1 2 3 4 7
Game 5: 1 2 3 5 19
Game 6: 1 2 3 5 6
Game 7: 1 2 3 5 7
Game 8: 1 2 3 6 19
Game 9: 1 2 3 6 7
Game 10: 1 2 3 7 19
Game 11: 1 2 4 5 19
Game 12: 1 2 4 5 6
Game 13: 1 2 4 5 7
Game 14: 1 2 4 6 19
Game 15: 1 2 4 6 7
Game 16: 1 2 4 7 19
Game 17: 1 2 5 6 19
Game 18: 1 2 5 6 7
Game 19: 1 2 5 7 19
Game 20: 1 2 6 7 19
Output saved in file: output.1_2_3_4_5_6_7_19.091508.6504
Again, this script isn't meant to used for gambling purposes, although it could be. We only chose this scenario as so many facets of our state's lottery relate directly to the concepts we've been going over for the past 2 weeks and it made it fun for the author :)
In all seriousness, if you have a gambling problem (cards, roulette, lottery, whatever) call 1-800-GAM-BLER or visit 800gambler.org and get some help. Like pretty much everything, the lottery is only fun if it's not hurting you! And, oh yes, if it helps, this number picker does not increase the likelihood that any of the numbers it picks will match any random drawing. Luck, and however many other digits are involved in the number pool, make this a losing proposition, at best. To prove this, I ran a test against the Illinois Lottery's past-drawing numbers for 2008 and found that, for my modest investment of $5,040, I would have made $764 in return. In other words, unless you're lucky, this number selection system will only guarantee that you'll lose more than you gain. Like all the disclaimers all say; it's for entertainment purposes only!
Okay, we've done our part. The PSA is over. Enjoy the script (it, and its parts, can be useful for a variety of other purposes) :)
NOTE: The improved permutation subroutine was found online in an excerpt from the Perl Cookbook, by Tom Christiansen and Nathan Torkington - an excellent read :)
Cheers,
This work is licensed under a
Creative Commons Attribution-Noncommercial-Share Alike 3.0 United States License#!/usr/bin/perl
#
# wheel.pl
# TODO: out of order numseeds do not make correct output
#
#
# 2008 - Mike Golvach - eggi@comcast.net
#
# Creative Commons Attribution-Noncommercial-Share Alike 3.0 United States License
#
print "Highest Number: ";
chomp($highest_number=<STDIN>);
print "Number Of Balls Drawn: ";
chomp($num_balls=<STDIN>);
$array_num_balls=$num_balls - 1;
print "How Many Numbers To Trap: ";
chomp($num_trap=<STDIN>);
$array_num_trap=$num_trap - 1;
print "Enter your numbers\n";
print "separated by space character : ";
chomp($num_seeds=<STDIN>);
$num_seeds =~ s/ /,/g;
@number_seeds = split(/,/, $num_seeds);
$number_seeds = @number_seeds;
if ( $number_balls > $num_seeds ) {
print "--------------------------\n";
print "Your picks $num_seeds\n";
print "is larger than $num_balls nums picked\n";
print "Try again!\n";
print "--------------------------\n";
exit(1);
}
foreach $unique_num (@number_seeds) {
if ($seen{$unique_num}++) {
print "--------------------------\n";
print "Your Number set $num_seeds\n";
print "contains duplicate numbers! Try again!\n";
print "--------------------------\n";
exit(2);
} elsif ( $unique_num > $highest_number ) {
print "--------------------------\n";
print "Your Number set $num_seeds contains\n";
print "a number $unique_num greater than\n";
print "your highest number value: ${highest_number}. Try again!\n";
print "--------------------------\n";
exit(3);
}
}
print "\n\n";
print "Highest Number $highest_number\n";
print "Balls Drawn $num_balls\n";
print "How Many Numbers To Trap: $num_trap\n";
print "Actual Numbers To Seed: @number_seeds\n";
$|=1;
@sperms = permoot(@number_seeds);
print "Running 4 phase permute...\n";
$useless_counter=0;
foreach $unordered (@sperms) {
$unordered =~ s/\s/,/g;
@unsorted = split(/,/, $unordered);
@crazy = @unsorted[0 .. $array_num_balls];
$unsorted = join(" ", @crazy);
@temparray = split(" ", $unsorted);
@temparray = sort { $a <=> $b } (@temparray);
unshift(@sorted_perms, "@temparray");
}
$unik="0";
$last_unik="0";
$useless_counter=0;
foreach $s_p (@sorted_perms) {
@unik = split(" ", $s_p);
@unik = sort(@unik);
$seen2{$s_p}++;
if ( $seen2{$s_p} >= 2 ) {
next;
}
if ( $unik == $last_unik ) {
unshift(@ball_draw_pool,"$s_p");
@last_unik = @unik;
$last_unik++;
} elsif ( @unik == @last_unik ) {
$total = @unik;
$zero = $nope = 0;
while ( $zero < $total ) {
if ( "$unik[$zero]" ne "$last_unik[$zero]" ) {
$nope = 1;
last;
} else {
$zero++;
}
}
if ( $nope ) {
unshift(@ball_draw_pool,"$s_p");
@last_unik = @unik;
}
}
}
$useless_counter=0;
foreach $unordered (@sperms) {
$unordered =~ s/\s/,/g;
@unsorted = split(/,/, $unordered);
@crazy = @unsorted[0 .. $array_num_trap];
$unsorted = join(" ", @crazy);
@temparray = split(" ", $unsorted);
@temparray = sort { $a <=> $b } (@temparray);
unshift(@sorted_perms, "@temparray");
}
$useless_counter=0;
$unik="0";
$last_unik="0";
foreach $s_p (@sorted_perms) {
@unik = split(" ", $s_p);
@unik = sort(@unik);
$seen2{$s_p}++;
if ( $seen2{$s_p} >= 2 ) {
next;
}
if ( $unik == $last_unik ) {
unshift(@ball_trap_pool,"$s_p");
@last_unik = @unik;
$last_unik++;
} elsif ( @unik == @last_unik ) {
$total = @unik;
$zero = $nope = 0;
while ( $zero < $total ) {
if ( "$unik[$zero]" ne "$last_unik[$zero]" ) {
$nope = 1;
last;
} else {
$zero++;
}
}
if ( $nope ) {
unshift(@ball_trap_pool,"$s_p");
@last_unik = @unik;
}
}
}
print "\n";
foreach $smaller (@ball_trap_pool) {
@smaller = split(" ",$smaller);
foreach $larger (@ball_draw_pool) {
if ( $larger =~ $smaller[0] && $larger =~ $smaller[1] && $larger =~ $smaller[2] ) {
$total_pool{$larger} .= $smaller;
last;
$|=1;
}
}
}
chomp($date=`date +%m%d%y`);
$var = $$;
$con_num_seeds = $num_seeds;
$con_num_seeds =~ s/,/_/g;
$lfile_name = "output.${con_num_seeds}.${date}.${var}";
print "\n";
open(LFILE, ">$lfile_name") or die "Cannot open FILE";
print LFILE "Output File output.${con_num_seeds}.${var}\n";
print LFILE "--------------------------------\n";
print LFILE "$highest_number Ball Selection - Pick $num_balls - Trap $num_trap\n";
print LFILE "Seed Numbers: $number_seeds\n";
print LFILE "--------------------------------\n";
$counter = 1;
foreach $key (sort keys %total_pool ) {
print "Game $counter: $key\n";
$|=1;
print LFILE "Game $counter: $key\n";
$counter++;
}
close(LFILE);
print "\nOutput saved in file: $lfile_name\n";
sub permoot {
#
# The improved permutation subroutine was found online in an excerpt from the Perl Cookbook, by Tom Christiansen and Nathan Torkington
@DATA = @_;
foreach ("@DATA") {
my @data = split;
my $num_permutations = factorial(scalar @data);
for (my $i=0; $i < $num_permutations; $i++) {
@permutation = @data[n2perm($i, $#data)];
@sortperms = join(" ", @permutation);
push(@sperms, "@sortperms" );
}
}
return @sperms;
BEGIN {
my @fact = (1);
sub factorial($) {
my $n = shift;
return $fact[$n] if defined $fact[$n];
$fact[$n] = $n * factorial($n - 1);
}
}
sub n2pat {
my $i = 1;
my $N = shift;
my $len = shift;
my @pat;
while ($i <= $len + 1) {
push @pat, $N % $i;
$N = int($N/$i);
$i++;
}
return @pat;
}
sub pat2perm {
my @pat = @_;
my @source = (0 .. $#pat);
my @perm;
push @perm, splice(@source, (pop @pat), 1) while @pat;
return @perm;
}
sub n2perm {
pat2perm(n2pat(@_));
}
}
, Mike
Please note that this blog accepts comments via email only. See our Mission And Policy Statement for further details.
