#! perl -slw use strict; use Time::HiRes qw[ time ]; my $start = time; my @lookup = map{ ($_+1) * $_ /2 } 0 .. 80; sub calcScore { my( %chars, $score ); $chars{ $_ }++ for map{ split'' } @{ $_[0] }; $score += $lookup[ $_ ] for values %chars; return $score; } my @cats = map{ [ split ' ' ] } ; close DATA; ## Sort the words in each category by their individual scores (descending) my %wordScores; @{ $cats[ $_ ] } = sort{ ( $wordScores{ $b } ||= calcScore [$b] ) <=> ( $wordScores{ $a } ||= calcScore [$a] ) } @{ $cats[ $_ ] } for 0 .. $#cats; ## form our guess from the highest scoring words in each category my @guess = map{ $cats[ $_ ][ 0 ] } 0 .. $#cats; my $best = calcScore \@guess;