My wife loves puzzles. Crosswords, logic problems, whatever. And she hates to be beat by them. So when she saw these Letter Power puzzles, she was really annoyed at how the authors of the puzzles always came up with way higher scores than her. So this last time, she sat down with crossword dictionaries, yellowpages, and other sources to come up with as many words as possible to fit the puzzle, and then tried to figure out what was the best score she could get - and that's when we decided a computer could plow through it faster than she could.
The puzzle is this: there are 10 categories (some have more, some have less, this one has 10). You get up to 8 letters per answer. And scoring is a simple algorithmic progression. Each time you use a letter, it scores one point more than last time you used that letter. So, for example, the first 'a' is 1 point, the second 'a' is 2 points, and so one. Obviously, if you can get a bunch of words using two or three of the same letter, that can add up over 10 answers. Think of, for example, "US States" as a category. Now think of "Alabama" - 4 a's!
The hard part is coming up with acceptable answers. Assuming you have acceptable answers, how would you find the best combination of answers to come together to give the best score?
I have an initial solution here, but when running it with the list of possibilities shown, I get an "Out of memory!" error. I have 4GB of RAM - and I see it went about 380MB into my swap as well. So it doesn't seem to work - I'm not sure why. Perhaps someone will find it entertaining to find a faster/smaller/more elegant/less buggy solution (one or more of these, or any other variation you want). I'm sure there is some sort of short-circuiting you could do if you weren't using Algorithm::Loop::NestedLoops.
Here's my second try:
#! /usr/bin/perl use strict; use warnings; use Data::Dumper; # just for debugging... use Algorithm::Loops qw(NestedLoops); use List::Util; use Time::HiRes qw(gettimeofday tv_interval); my $t0 = [gettimeofday]; my @words = readwords(\*DATA); # Calculate the letters in each - do this up front for speed? my %letters_cache; foreach my $inner (@words) { foreach my $word (@$inner) { my %letters; foreach (split '', $word) { $letters{$_}++; } $letters_cache{$word} = \%letters; } } my @best_words; my $best_score = 0; my $iter = NestedLoops(\@words); my $count = 0; while (my @list = $iter->()) { ++$count; my @words = @list; my $score = calculate_score(@words); if ($score > $best_score) { $best_score = $score; @best_words = @list; } my $t_now = tv_interval($t0, [gettimeofday]); if ($count % 15 == 0) { local $|=1; print "$count\r"; } }; my $elapsed = tv_interval($t0, [gettimeofday]); print "The best score is $best_score, using the words:\n", map { "\t$_ +\n" } @best_words; print "Elapsed time: $elapsed seconds\n"; #print Dumper(\%letters_cache); sub calculate_score { my $total = 0; my %letters; foreach my $w (@_) { $w = $letters_cache{$w} unless ref $w; while (my ($l,$n) = each %$w) { $letters{$l} += $n; } } # add them up. our ($a,$b); # get rid of warning? List::Util::reduce { $a + calculate_letter_value($b) } 0, values % +letters; } sub calculate_letter_value { my $n = shift; ($n * ($n + 1)) / 2; } # slurp in all the possible words. sub readwords { my $fh = shift; unless (ref $fh) { require IO::File; $fh = IO::File->new($fh, 'r') || die "Can't open $fh for read: + $!"; } local $_; my @words; while (<$fh>) { my ($num, $word) = split ' ', lc; push @{$words[$num-1]}, $word; } @words; } __DATA__ 1 alabama 1 arkansas 1 alaska 1 delaware 1 hawaii 1 indiana 1 kansas 1 montana 1 delaware 2 sazerac 2 sangrita 3 radiator 3 gastank 3 engine 3 heater 3 fender 3 wheel 3 detent 3 battery 3 clutch 3 mirror 3 window 4 alloy 4 amalgam 4 vanadium 4 copper 4 steel 5 rutabaga 5 limabean 5 cress 5 carrot 5 sorrel 5 squash 5 cabbage 5 pepper 5 lettuce 5 beet 5 leek 5 celery 5 endive 5 rhubarb 5 parsnip 5 pumpkin 6 azalia 6 camellia 6 dahlia 6 gardenia 6 gentian 6 vervain 6 canna 6 hepatica 6 bluebell 6 anemone 6 oleander 7 lasagna 7 macaroni 7 pastina 7 gnocchi 7 tortelli 7 alfabeto 8 mascagni 8 britten 8 menotti 9 unamas 9 tacotime 9 pizzahut 9 tacobell 9 panago 9 tacomayo 9 edojapan 9 hardees 10 caramel 10 marzipan 10 taiglach 10 taffy 10 brittle 10 fondant 10 toffee 10 dragee
PS: this isn't even all the possible "reasonable" words she came up with ;-) The list if you want something that executes and comes up with an answer in almost no time and comes to a good answer quickly (beating the one in the book, by the way) is:
which gives:1 alabama 1 arkansas 2 sangrita 3 radiator 3 gastank 4 amalgam 4 vanadium 5 rutabaga 5 limabean 6 azalia 6 camellia 6 dahlia 6 gardenia 7 lasagna 7 macaroni 7 pastina 8 mascagni 9 unamas 10 caramel 10 marzipan 10 taiglach
The best score is 474, using the words: alabama sangrita gastank amalgam rutabaga azalia lasagna mascagni unamas taiglach
In reply to Challenge: Letter Power by Tanktalus
| For: | Use: | ||
| & | & | ||
| < | < | ||
| > | > | ||
| [ | [ | ||
| ] | ] |