in reply to Another word puzzle with too many permutations

this primitive branch-and-bound will eventually spit out a solution but it might take days.

use strict; use warnings; use Data::Dump qw/pp/; use feature qw/say/; my %max =( 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 @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); #%max=( A=>1,D=>2,F=>1,I=>1,O=>1,R=>1,U=>1); #@n = qw/ HONDA TOYOTA AUDI FORD/; my @path; our $level=0; sub rec { my ($idx0,%max) = @_; #pp $idx0,\%count; local $level=$level+1; WORD: for (my $idx = $idx0; $idx <@n; $idx++){ #say "*** ", my $word = $n[$idx]; my %count=%max; # say " " x $level ,$word; for my $char ( grep {/[A-Z]/} split //, uc($word) ) { next WORD if $count{$char}-- <=0; } push @path, $word; unless (grep { $_ != 0 } values %count ) { print "RESULT: ", join ",",@path,"\n"; # return; goto STOP; } rec($idx+1,%count); pop @path; } } rec(0,%max); STOP:

a smarter approach would be to count the letters for each word in an initialization phase and to sort them according to exotic letters.

for instance if Z is 0 there is no point to check words with a Z in the following branch.

So start to find all allowed combinations for the most rare letter and continuing with the next rare one should greatly improve runtime.

Unfortunately I have no time to fiddle with entertainment problems, I hope my input helps! =)

Cheers Rolf

( addicted to the Perl Programming Language)

Replies are listed 'Best First'.
Re^2: Another word puzzle with too many permutations
by sarchasm (Acolyte) on Oct 15, 2013 at 21:36 UTC
    I do appreciate your input. I am learning a lot by going through the options presented here. Thank you.