#!/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";