Rite-Aid's Game of Life

I recently came into ownership of a very large number of Rite-Aid's "Game of Life" tickets. Apparently, the promotion ends soon.

I nearly gave myself an repetitive stress injury tearing off all those little tabs.

But, success was mine!

Now, I'm fantastically unlucky. Seriously. I'm the guy that always has to read the "Releaase Notes" section for a standard upgrade, because something listed there (usually with an asterisk and "may cause mass extinction event") will happen to me. So, I held no hope of winning anyting big.

I was curious about the distribution, and just what my odds of not-winning really were. These game pieces are broken down into three parts:

  1. A coupon (I save these, as I am also a cheap bastard)
  2. A token (1 of 2) for a CHANCE TO WIN a cruise. Essentially, every two pieces and you get to go through six more hoops if you want to get a on aboat. I, having seen Titanic coupled with aforementioned unluckyness, pass on this opportunity.
  3. Finally, 4 "game pieces".

These game pieces are not unlike the Monopoly game at McDonald's. There are several sets, of varying value, and you collect all the pieces to win! Each piece is designated by a number, 1 through 51.

I decided a bit of code was in order. First, a database, to hold some useful information for me. I used the following schema (PostgreSQL): 

CREATE TABLE pieces (
 pid SERIAL PRIMARY KEY,
 num INTEGER NOT NULL
);

CREATE TABLE sets (
 setid SERIAL PRIMARY KEY,
 setdesc TEXT
);

CREATE TABLE piece_map (
 mapid SERIAL PRIMARY KEY,
 setid INTEGER REFERENCES sets(setid),
 piece INTEGER
);

CREATE VIEW total_freq AS
 SELECT piece_map.piece, count(pieces.num) AS count
 FROM piece_map
 LEFT JOIN pieces ON piece_map = pieces.num
 GROUP BY piece_map.piece
 ORDER BY piece_map.piece;

CREATE VIEW set_freq AS
 SELECT total_freq.piece, total_freq.count, sets.setdesc, sets.setid, round(total_freq.count::numeric / (( SELECT sum(total_freq.count) AS sum
           FROM total_freq)) * 100::numeric, 2) AS percent
   FROM total_freq
   JOIN piece_map ON total_freq.piece = piece_map.piece
   JOIN sets ON sets.setid = piece_map.setid;

All very normalized and maybe slightly more complicated than I needed, but nothing irritates me more than having to go look up the ALTER TABLE syntax AGAIN.

Next up, I needed to get this all into the database. The idea of repeatedly typing INSERT INTO.. made me cringe, even with up-arrow love. Thankfully, I know perl. And perl is very good at playing with databases. First, I needed some DBIx::Class love. I opted to use the automatic version of DBIx::Class::Schema::Loader.

My Schema class, in its entirety: 

package Schema;
use base 'DBIx::Class:Schema::Loader';
1;

That's it, really. But now, the hard part! I needed to get lots of boring numbers into a big table. I decided to use Term::ReadLine, as it is good at doing terminal stuff, and reading lines. My solution has two basic functions. First, you type in a number (any number) and it is inserted into the 'pieces' table. The other is a unique syntax, set set name=set members. This creates an entry in the 'sets' table as well as populates the 'piece_map' table with the members. There is no going back, and I only had to fire up and do a couple manual deletes while entering all the numbers.

Here is the bit, in its entirety: 

  1 use strict;
  2 use warnings;
  3 use lib qw(.);
  4 use Schema;
  5 use Term::ReadLine;
  6 use Scalar::Util qw(looks_like_number);
  7 
  8 my $schema = Schema->connect( 'dbi:Pg:dbname=riteaid' );
  9 
 10 my $r = Term::ReadLine->new('RiteAid Calc');
 11 my $OUT = $r->OUT || \*STDOUT;
 12 
 13 while( defined( $_ = $r->readline('Piece number: ') ) ) {
 14    my $num = $_;
 15    if( looks_like_number( $num ) ) {
 16       my $p = $schema->resultset('Pieces')->create({
 17          num => $num
 18       });
 19       $p->update;
 20       print $OUT "'$num' added.\n";
 21    } else {
 22       if( $num =~ /^set/ ) {
 23          my ($setname, $pieces) = ($num =~ /^set (.*?)=(.*)$/);
 24          my $set = $schema->resultset('Sets')->create({
 25             setdesc => $setname
 26          });
 27          $set->update;
 28          print $OUT "Created set '$setname'\n";
 29          for my $p ( split( ' ', $pieces ) ) {
 30             my $pmap = $schema->resultset('PieceMap')
 31                ->create({
 32                   setid    => $set->setid,
 33                   piece    => $p
 34                });
 35 
 36             print $OUT "Added piece '$p' to '$setname'\n";
 37          }
 38          next;
 39       } else {
 40          print $OUT "'$num' does not appear to be a number.\n";
 41       }
 42    }
 43 }

Yikes! But, you'll notice: Not one bit of SQL in that entire mess. The most syntax is done with my poor checking of edge cases in the while() loop. Line 8 connects to the proper database and loads the schema.

This worked fantastically for me, and in fact, when I was done, I check my work: 

riteaid=# select count(num) from pieces;
 count 
-------
   567
(1 row)

Well. Now I needed to make something pretty. When I think of pretty numbers, I think of charts. And in the perl world, when you do charts, you used to have to make ugly things with GD::Graph or, ImageMagick. No longer!

Chart::Clicker to the rescue.

And here is the code for that sexy chart: 

  1 use strict;
  2 use warnings;
  3 use Chart::Clicker;
  4 use Chart::Clicker::Renderer::Line;
  5 use Chart::Clicker::Data::Series;
  6 use Chart::Clicker::Data::DataSet;
  7 use Graphics::Primitive::Brush;
  8 use Number::Format;
  9 use Schema;
 10 
 11 my $nf = Number::Format->new;
 12 
 13 my $cc = Chart::Clicker->new(
 14    width => 1024,
 15    height => 300
 16 );
 17 
 18 my $schema = Schema->connect('dbi:Pg:dbname=riteaid');
 19 
 20 my $rs = $schema->resultset('SetFreq')
 21    ->search({},
 22    {
 23       order_by => 'piece ASC'
 24    });
 25 
 26 my @sets;
 27 while( my $row = $rs->next ) {
 28    my( $setid, $count, $piece, $desc ) =
 29       ( $row->setid, $row->count, $row->piece, $row->setdesc );
 30    $sets[$setid]->{$piece} = $count;
 31    $sets[$setid]->{title} = $desc;
 32 }
 33 
 34 my $dataset = Chart::Clicker::Data::DataSet->new;
 35 
 36 for my $d ( @sets ) {
 37    next unless defined $d;
 38    my $name = delete $d->{title};
 39 
 40    my $series = Chart::Clicker::Data::Series->new(
 41       name => $name,
 42    );
 43    for( sort {$a <=> $b} keys %$d ) {
 44       $series->add_pair( $_, $d->{$_} );
 45    }
 46    $dataset->add_to_series( $series );
 47 }
 48 
 49 $cc->add_to_datasets( $dataset );
 50
(Everything from here-on-out is just fiddling, making the graph pretty) 
 51 $cc->title->text('Frequency of Pieces');
 52 $cc->title->font->size(15);
 53 $cc->get_context('default')
 54    ->domain_axis
 55    ->tick_label_angle(1.57);
 56 $cc->get_context('default')
 57    ->domain_axis
 58    ->format( sub {
 59       $nf->format_number( shift, 0, 0 );
 60    });
 61 $cc->get_context('default')
 62    ->domain_axis
 63    ->tick_values( [ 1..52 ] );
 64 $cc->set_renderer(
 65    Chart::Clicker::Renderer::Line->new(
 66       brush => Graphics::Primitive::Brush->new({
 67          line_cap => 'round',
 68          width => 10,
 69          line_join => 'round'
 70       })
 71    )
 72 );
 73 $cc->write_output('freq.png');

Not bad, huh?

Maybe later, I'll whip up a couple with percentages and so forth, showing just how fantastically lucky you have to be to win a new Infinti Convertible.