XKCD menu problem

Posted by Chris on May 21st, 2008 filed in programming

So everyone is doing the menu problem (comic) – even job postings for places. It looks like the most common way is to recurse through, starting at the cheapest item and going through again until either the price is right or it goes over the target, then going down and back up, etc. Which is nice and all, but for some reason when I was doing it I felt bad for the diners. Why? Cause you always end up with a bunch of the cheapest appetizers. Solution?(without computing all possible solutions…) Randomize how you go through the list of menu items. 🙂 This is pretty much the first one I went through, since the problem is solved and my interest goes away. But I’m amused enough about feeling bad for the diners that I wanted to remember it later on. So here goes:

#!/usr/bin/perl -w
use strict;
use CGI;
my $cgi=new CGI;
my $file=$cgi->param('file');
$file='menu.txt' if !$file;#reasonable default.

#slurp the lines of the file 🙂
open(F,$file) or die(“Couldn’t open file $file:$!\n”);
my @lines=;
close(F) or die(“Couldn’t close file $file:$!\n”);
chomp(@lines); #remove newlines

#first line is the target price
my $tgt=shift(@lines);
#don’t need $signs

my %price_hash=(); #empty hash to put prices and labels in

#dump the the data into a hash, removing $signs again
#format is ${‘label’}=$price;
foreach my $line(@lines)
$price=~s/\s//g; #remove whitespace also
if($price > $tgt){next;}
#get an array with the names of a match from the function
my @retvals=&compute(\%price_hash,0);
print join(“,”,@retvals).”\n”;
print “No matches found\n”;

#compute($hashref,$ongoing_sum); – returns array of names for a match.
sub compute
my $hashref =shift;
my $sum =shift;
my @keys =randomise(keys %{$hashref});
foreach my $lbl(@keys)
my $price=$$hashref{$lbl};
my $tmpsum=$price+$sum;
if($tmpsum eq $tgt){return $lbl;}#if it matches, return the lbl
if($tmpsum > $tgt){next;}
my @retvals=&compute($hashref,$tmpsum);#none yet, recurse!
push (@retvals,$lbl);
return @retvals;

#function to randomise the elements in an array – for fun
sub randomise
my @arr = @_;
my $i = @arr;
while ($i–)
my $j = int rand ($i+1);
@arr[$i,$j] = @arr[$j,$i];#do the swap – this is a linear algorithm;
return @arr;

Leave a Comment