Yary H

Over the holidays, a few friends challenged us to video-game duels. We enjoyed them enough to want a game system of our own. A bit of on-line price comparisons turned up an interesting trend- the bundles seemed more expensive then buying items separately. Perhaps there's greater demand and price competition on simpler, single items? Nevertheless, there are a variety of bundles, controller packs, and accessories, and I was curious what the price range was for the various ways to assemble a given system.

What better way then Perl*. And it turns out the same program can be used to price anything with various parts assembled or not- or to plan a multi-city trip, showing the total cost difference between various modes of travel, lodgings, etc. The code below only uses one module not included in the standard distribution, "enum", and if you don't want to install it you can "use constant" instead to define the name-to-number mapping.

Start by keeping a spreadsheet to keep track of the package prices. The first columns are for the system components, then a "label" column, then a "price" column, then any notes. In each "component" column, put in the number of items a particular package provides, leaving blank or entering "0" for items not included. That spreadsheet then becomes the data, which you can copy & paste into the __DATA__ section at the end of the program file.

The @goal variable stores what you want to end up with. If you're wondering why this isn't a hash-- an earlier, pre-optimized version took several seconds to complete, and minutes when looking for 4 controllers / nunchucks / motion+bricks instead of 2. The innermost loop had to cycle through hash keys, and replacing the hashes with arrays reduced the run-time noticeably. Here's a benchmark comparing small data structures in arrays vs hashes. Any other situation, the hash's readability would be a win over arrays & enum.

The code starts with an optimization. It knows that every solution must contain exactly one console, and it partitions the list of packages in to those containing a console vs. those that don't. Later, it will use the "exactly one" packages in @pick1 as an outer loop while creating permutations, somewhat reducing the combinations to check.

Next, it finds the maximum times any package can show up in a solution. A package providing only a "motion accessory" could appear twice, assuming the goal includes 2 "motion accessories". A package with both a "motion accessory" and "Resort game" can only appear once, because 2 would exceed the "Resort game" goal of 1.

Then comes the code's powerhouse. It loops through the packages that must appear only once, and inside that loop it finds all combinations that respect the limits found earlier. It keeps track of any combination that adds up to the goal.

The last step sorts by total price and prints the results. Answer: about $130 difference between the least and most expensive of the 19 ways to get a Wii + Fit Plus + Resort, for two. And for the most part, it's cheaper to buy the pieces separately. That's based on rapidly changing prices found around Jan 1st 2010.

Ps. We didn't get the video game. Instead we bought a couple of foam "boffer" swords and started hacking at each other for exercise.

I was a little surprised that I didn't use more from CPAN. I looked at Math::Combinatorics ("next_multiset" looked promising), Set::Scalar ("powerset" looked promising), Set::Bag, and a couple others, but none quite had just the right functionality to solve this. One the one hand, it makes me wonder if some of this should be packaged into a CPAN module? On the other hand, does it belong as an enhancement to one of those, or some other extant module? Or did I just not look hard enough?

*well maybe Prolog would be a better language to solve this challenge. I've spent a few hours on a Prolog tutorial and it's interesting. It may express the program more clearly, though it will lack a couple of the niceties in the Perl code- simply due to my lack of experience in Prolog. It's moot, I don't think I'll finish the re-write.

---

#!perl -w
use strict;
use 5.010;
use warnings FATAL=>'all';

# Copy & paste 1st spreadsheet row for the column labels
use enum qw(console controller nunchuck fit_plus motion resort other name price URL total);

# What are we looking for?
my @goal;

# Only makes sense to have one console
$goal[console]=1;

# Pretty sure no games allow two balance pads, and only want one resort game
$goal[fit_plus]=$goal[resort]=1;

# I'd like an equal number of nunchuck, motion, remotes
$goal[controller]=2;
$goal[nunchuck]=$goal[motion]=$goal[controller];

# Read in the data, partitioning list of items by "need exactly one" vs. "need other amount"
# Can only do this for one item, so partition on console
my (@pick1, @stuff);
while (<DATA>) {
  chomp;
  my @data=split / *\t */;
  for (@data) {$_=0 if $_ eq ''}
  if ($data[console]) {push @pick1 ,\@data }
  else {push @stuff, \@data }
}

# Helper subs
# Given stuff, retrun true if the items in it matches the goal
sub match {
  my @sum; # Sum of items
  for my $item (0..$#goal) {
    for my $package (@_) {
      $sum[$item] += $package->[$item];
    }
    return if $sum[$item] != $goal[$item];
  }
  1;
}

# Given a bag of stuff, return the next bag
{
# First, find out the maximum number each component can possibly fit
# Unfortunately, can't use 'state' variable for an array (or hash), otherwise
# I'd put @limit as a state variable inside of increment 
my @limit = map {
  my $min;
  for my $item (0..$#goal) {
    if ($_->[$item]) {
      my $can_fit = int($goal[$item]/$_->[$item]);
      $min = $can_fit if !defined($min) || $min > $can_fit;
    }
  }
  $min
} @stuff;

sub increment {
  my @bag=@_;
  for (my $i=0; $i<@bag;++$i) {
    if (++$bag[$i] > $limit[$i]) { $bag[$i] = 0 }
    else { return @bag }
  }
  # Reached the end, so given bag was the last. Return nothing
  return
}
}

# Get and check each combination
my @matches;
for my $main (@pick1) {
  my $ptr;
  # Check combination, store if it is a match
  my @bag=(-1,(0) x $#stuff); # Init with -1 at start, so first test will be with 0 accessories
  while (@bag = increment @bag) {
    my @bag_items = ($main, map {($stuff[$_]) x $bag[$_]} 0..$#stuff);
    push @matches,\@bag_items if match @bag_items;
  }
}

print "Found ",scalar(@matches), " matches\n";
for my $match (@matches) {
  my $total=0;
  for (@$match) {
    (my $price=$_->[price])=~tr/$,//d;
    $total += $price;
  }
  $match->[total]=$total;
}

# Sort in order of price
my $i=0;
@matches= sort {$a->[total] <=> $b->[total]} @matches;
for my $match (@matches) {
  print "\nMatch ", ++$i,":\n";
  print "  ",$_->[price],"\t",$_->[name],"\n" for grep ref,@$match;
  print ' Total: $', $match->[total],"\n";
}


# Tabs separate the columns below, copied from a spreadsheet.
__DATA__
0	0	1	1	1	1	mat	Wii Fit Plus Resort Bundle	$240.39 	http://www.elgobay.com/
0	0	0	1	0	0		fit plus (only)	$99 	http://store.discovery.com/
0	0	0	1	0	0	mat,gloves	Fit Plus "Super" Bundle	$144.99 	http://www.overstock.com/Books-Movies-Music-Games/Nintendo-Wii-Fit-Plus-Super-Bundle-Green/4335055/product.html
0				1	1		wii resort	$40 	http://www.bing.com/shopping/Wii-Sports-Resort-complete-package/
0		1					nunchuck	$12 	
0	1						controller	$33 	http://www.google.com/products/catalog?q=wii+remote&hl=en&ci
0	1			1			mot+remote	$50 	
0	1	1		1			Rem+mot+nun	$70 	
0				1			motion	$19 	
1	1	0	0	0	0		console + 1 controller	$169 	http://www.consumerdepot.com
1	1	1	0	1	1		Console + resort	$281.99 	http://www.wiiworldstore.com/
1	2	2	1	0	0	mat,HD	Nintendo Wii "Get in Shape" Bundle	456.39	http://www.elgobay.com/
1	1	1	1	0	0		wii + fit plus	$299 	http://www.target.com/