Here is a backtracking method which works on sorted data, dogs with rare letters first. (Similar to LanX's proposal.)

use strict; use warnings; use Data::Dumper; sub score { my ($dog, $letters) = @_; my $sum = 0; $sum += $$letters{$_}//0 for grep {/\w/} split //, $dog; return $sum/length($dog); } my @n = qw(Affenpinscher AfghanHound AiredaleTerrier Akita AlaskanMala +mute AmericanEnglishCoonhound AmericanEskimoDog AmericanFoxhound Base +nji BassetHound Beagle BeardedCollie Beauceron BlackandTanCoonhound B +loodhound BluetickCoonhound BorderCollie BorderTerrier Borzoi BostonT +errier BouvierdesFlandres Boxer BoykinSpaniel Briard Brittany Brussel +sGriffon BullTerrier Bulldog Bullmastiff ChesapeakeBayRetriever Chihu +ahua ChineseCrested ChineseShar-Pei Chinook ChowChow ClumberSpaniel C +ockerSpaniel Collie Curly-CoatedRetriever Dachshund Dalmatian DandieD +inmontTerrier DobermanPinscher DoguedeBordeaux EnglishCockerSpaniel E +nglishFoxhound EnglishSetter EnglishSpringerSpaniel GermanPinscher Ge +rmanShepherdDog GermanShorthairedPointer GermanWirehairedPointer Gian +tSchnauzer GlenofImaalTerrier GoldenRetriever GordonSetter GreatDane +Greyhound Harrier IbizanHound IcelandicSheepdog IrishSetter IrishTerr +ier Kuvasz LabradorRetriever LakelandTerrier LhasaApso Lowchen Maltes +e ManchesterTerrier Mastiff MiniatureBullTerrier MiniaturePinscher Mi +niatureSchnauzer NeapolitanMastiff Newfoundland NorfolkTerrier Peking +ese PembrokeWelshCorgi PharaohHound Plott PortugueseWaterDog Pug Puli + PyreneanShepherd RatTerrier ShibaInu ShihTzu SiberianHusky SilkyTerr +ier SkyeTerrier SmoothFoxTerrier SoftCoatedWheatenTerrier SpinoneItal +iano St.Bernard StaffordshireBullTerrier WireFoxTerrier WirehairedPoi +ntingGriffon Xoloitzcuintli YorkshireTerrier); my $letters = "A(8),B(2),C(5),D(8),E(7),F(1),G(3),H(9),I(8),K(1),L(9), +M(1),N(12),O(13),P(1),Q(0),R(5),S(6),T(4),U(6),V(0),W(1),X(1),Y(0),Z( +1)"; my %letters = map { /(\w)\((\d+)\)/; { $1 => $2 } } split /,/, $letter +s; @n = map { $_->[0] } sort { $a->[1] <=> $b->[1] } map { [ $_, score( $ +_, \%letters ) ] } @n; $letters = join '', sort { length $a <=> length $b } map { /(\w)\((\d+ +)\)/; $2?$1 x $2:'' } split /,/, $letters; sub dogtree { my ( $level, $tree, $letters, @dogs ) = @_; print "$tree\n" and exit unless $letters; DOG: while( my $dog = shift @dogs) { my $remaining = $letters; $remaining =~ s/$_//i or next DOG for grep { /\w/ } split //, $dog +; dogtree( $level+1, "$tree $dog", $remaining, @dogs ); } } dogtree 0, '', $letters, @n;

Takes 14 seconds on my machine to find one solution.


In reply to Re: Another word puzzle with too many permutations by hdb
in thread Another word puzzle with too many permutations by sarchasm

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post, it's "PerlMonks-approved HTML":



  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, details, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, summary, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.