[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";