[16:53:40] Starting search... [16:53:41] Newfoundland LhasaApso Bulldog Bloodhound AmericanEnglishCoonhound EnglishSetter Harrier Chinook Xoloitzcuintli Dachshund [16:54:00] Search options exhausted. real 0m19.753s user 0m19.625s sys 0m0.028s #### [16:29:23] Starting search... [16:29:39] Xoloitzcuintli Bloodhound Bulldog Chinook AmericanEnglishCoonhound Dachshund EnglishSetter Newfoundland Harrier LhasaApso [16:40:40] Search options exhausted. real 11m16.853s user 11m6.458s sys 0m0.300s #### #!/usr/bin/perl use strict; use warnings; use Data::Dump; use List::Util; use Date::Format; my %target_alfabet = ('A' => 8, 'B' => 2, 'C' => 5, 'D' => 8, 'E' => 7, 'F' => 1, 'G' => 3, 'H' => 9, 'I' => 8, 'J' => 0, '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 AlaskanMalamute AmericanEnglishCoonhound AmericanEskimoDog AmericanFoxhound Basenji BassetHound Beagle BeardedCollie Beauceron BlackandTanCoonhound Bloodhound BluetickCoonhound BorderCollie BorderTerrier Borzoi BostonTerrier BouvierdesFlandres Boxer BoykinSpaniel Briard Brittany BrusselsGriffon BullTerrier Bulldog Bullmastiff ChesapeakeBayRetriever Chihuahua ChineseCrested ChineseShar-Pei Chinook ChowChow ClumberSpaniel CockerSpaniel Collie Curly-CoatedRetriever Dachshund Dalmatian DandieDinmontTerrier DobermanPinscher DoguedeBordeaux EnglishCockerSpaniel EnglishFoxhound EnglishSetter EnglishSpringerSpaniel GermanPinscher GermanShepherdDog GermanShorthairedPointer GermanWirehairedPointer GiantSchnauzer GlenofImaalTerrier GoldenRetriever GordonSetter GreatDane Greyhound Harrier IbizanHound IcelandicSheepdog IrishSetter IrishTerrier Kuvasz LabradorRetriever LakelandTerrier LhasaApso Lowchen Maltese ManchesterTerrier Mastiff MiniatureBullTerrier MiniaturePinscher MiniatureSchnauzer NeapolitanMastiff Newfoundland NorfolkTerrier Pekingese PembrokeWelshCorgi PharaohHound Plott PortugueseWaterDog Pug Puli PyreneanShepherd RatTerrier ShibaInu ShihTzu SiberianHusky SilkyTerrier SkyeTerrier SmoothFoxTerrier SoftCoatedWheatenTerrier SpinoneItaliano St.Bernard StaffordshireBullTerrier WireFoxTerrier WirehairedPointingGriffon Xoloitzcuintli YorkshireTerrier); #my @n = qw(TOYOTA HONDA AUDI FORD); #my %target_alfabet = ('A' => 1, 'D' =>2, 'F' => 1, 'I' => 1, 'O' => 1, 'R' => 1, 'U' => 1); sub get_alfabet { my ($word) = @_; my $hr_count = {}; foreach my $letter (split('', uc $word)) { $hr_count->{$letter}++; } return $hr_count; } sub get_alfabet_array { my @words = @_; my $hr_count = {}; foreach my $word (@words) { my $hr_alfabet = get_alfabet($word); while (my ($key, $value) = each %{$hr_alfabet}) { $hr_count->{$key} += $value; } } return $hr_count; } sub search { my ($hr_state) = @_; # Is this a solution? if (@{$hr_state->{current_words}} == $hr_state->{target_words} and List::Util::sum(values %{$hr_state->{target_alfabet}}) == 0) { # Yes! print '[' . time2str("%H:%M:%S", time) . '] ' . join(' ', @{$hr_state->{current_words}}) . "\n"; return; } my %target_alfabet = %{$hr_state->{target_alfabet}}; my %available_words = %{$hr_state->{available_words}}; my @current_words = @{$hr_state->{current_words}}; # Reduce %available_words to exclude words that contain more of a specific letter than we have available while (my ($word, $hr_alfabet) = each %available_words) { while (my ($letter, $amount) = each %{$hr_alfabet}) { if (!defined $target_alfabet{$letter} or $amount > $target_alfabet{$letter}) { delete $available_words{$word}; } } } # If there are not enough words available, backtrack if ($hr_state->{target_words} - @{$hr_state->{current_words}} > scalar keys %available_words) { return; } # If our remaining alfabet contains more of a specific letter than is present in the totality of the available words, backtrack my $hr_alfabet_remaining = get_alfabet_array(keys %available_words); while (my ($letter, $amount) = each %target_alfabet) { if ($amount > ($hr_alfabet_remaining->{$letter} // 0)) { return; } } # Find the next fitting item while (my ($word, $hr_alfabet) = each %available_words) { my %new_target_alfabet = %target_alfabet; delete $available_words{$word}; # Duplicates not allowed for (keys %{$hr_alfabet}) { $new_target_alfabet{$_}-= $hr_alfabet->{$_}; if ($new_target_alfabet{$_} < 0) { next; } } my $hr_newstate = { target_alfabet => \%new_target_alfabet, target_words => $hr_state->{target_words}, available_words => \%available_words, current_words => [ @current_words, $word ], }; search($hr_newstate); } } my %frop = map { $_ => get_alfabet($_); } @n; # State { # target_alfabet => { 'A' => a1, 'B' => a2, ... , 'Z' => a26 } # target_words => n # current_words => [ 'item1', 'item2' ... ] # available_words => { 'item1' => { 'A' => n1, 'B' => n2, ... }, 'item2' => { 'A' => m1, 'B' => m2, ... }, ... } my $hr_startstate = { target_alfabet => \%target_alfabet, target_words => 10, current_words => [], available_words => \%frop }; print '[' . time2str("%H:%M:%S", time) . "] Starting search...\n"; search($hr_startstate); print '[' . time2str("%H:%M:%S", time) . "] Search options exhausted.\n";