The weekly challenge 216 - word stickers
1 #!/usr/bin/perl 2 # https://theweeklychallenge.org/blog/perl-weekly-challenge-216/#TASK2 3 # 4 # Task 2: Word Stickers 5 # ===================== 6 # 7 # You are given a list of word stickers and a target word. 8 # 9 # Write a script to find out how many word stickers is needed to make up the 10 # given target word. 11 # 12 ## Example 1: 13 ## 14 ## Input: @stickers = ('perl','raku','python'), $word = 'peon' 15 ## Output: 2 16 ## 17 ## We just need 2 stickers i.e. 'perl' and 'python'. 18 ## 'pe' from 'perl' and 19 ## 'on' from 'python' to get the target word. 20 # 21 ## Example 2: 22 ## 23 ## Input: @stickers = ('love','hate','angry'), $word = 'goat' 24 ## Output: 3 25 ## 26 ## We need 3 stickers i.e. 'angry', 'love' and 'hate'. 27 ## 'g' from 'angry' 28 ## 'o' from 'love' and 29 ## 'at' from 'hate' to get the target word. 30 # 31 ## Example 3: 32 ## 33 ## Input: @stickers = ('come','nation','delta'), $word = 'accommodation' 34 ## Output: 4 35 ## 36 ## We just need 2 stickers of 'come' and one each of 'nation' & 'delta'. 37 ## 'a' from 'delta' 38 ## 'ccommo' from 2 stickers 'come' 39 ## 'd' from the same sticker 'delta' and 40 ## 'ation' from 'nation' to get the target word. 41 # 42 ## Example 4: 43 ## 44 ## Input: @stickers = ('come','country','delta'), $word = 'accommodation' 45 ## Output: 0 46 ## 47 ## as there's no "i" in the inputs. 48 # 49 ############################################################ 50 ## 51 ## discussion 52 ## 53 ############################################################ 54 # 55 # This one looks a bit more complicated, but it's basically 56 # a lot of helper functions so we have a bit of a not too 57 # complicated flow. 58 # We split the word into its characters. The result is a hash 59 # that uses the characters as the key and the number of 60 # occurences of this character as the value. We later split 61 # the stickers the same way. That helps to better match the 62 # characters on each sticker with the characters of the word. 63 # 64 # We use the "get_output()" function to calculate the output 65 # for a split word and the split stickers. This is a recursive 66 # function that will call itself with the remaining parts of 67 # the word and the split stickers. That way we can calculate 68 # the minimum solution by calculating all possible solutions 69 # and keeping the minimum. So if the word is "nice", and the 70 # stickers are "on", "ice", and "nice" this doesn't use the 71 # two stickers "on" and "ice" for the solution, but the single 72 # "nice" one. 73 74 use strict; 75 use warnings; 76 77 word_stickers('peon', 'perl','raku','python'); 78 word_stickers('goat', 'love','hate','angry'); 79 word_stickers('accommodation', 'come','nation','delta'); 80 word_stickers('accommodation', 'come','country','delta'); 81 word_stickers('nice', 'on','ice','nice'); # this should return 1, not 2 82 83 sub word_stickers { 84 my ($word, @stickers) = @_; 85 print "Input: (" . join(",", @stickers) . ") - $word\n"; 86 # we split the word 87 my $word_characters = split_a_word($word); 88 # now we split the stickers and keep the results in a single 89 # hash that uses the sticker as the key and the split (a hash 90 # reference) as the value 91 my $sticker_splits = {}; 92 foreach my $sticker (@stickers) { 93 $sticker_splits->{$sticker} = split_a_word($sticker); 94 } 95 # now we just call the recursive function 96 my $output = get_output($sticker_splits, $word_characters); 97 print "Output: $output\n"; 98 } 99 100 sub get_output { 101 my ($sticker_splits, $word_characters) = @_; 102 my $output = 0; 103 # if any of the characters of the word doesn't exist in the stickers, we 104 # can only return 0 as there is no solution 105 return $output unless all_chars_in_splits($word_characters, $sticker_splits); 106 my $minimum = 0; 107 # calculate all possible solutions by checking each single sticker, and if 108 # any of the characters in the word is in the sticker, create a copy of the word 109 # hash (to not overwrite the hash for the next round), the remove all characters 110 # from the word hash that are in the sticker and recursively call get_output() 111 # again to calculate the rest. 112 foreach my $sticker (keys(%$sticker_splits)) { 113 my $current = 0; 114 if(any_char_in_sticker($word_characters, $sticker_splits->{$sticker})) { 115 my $tmp_characters = deep_copy($word_characters); 116 $current = 1; 117 foreach my $key (keys(%{$sticker_splits->{$sticker}})) { 118 $tmp_characters->{$key} -= $sticker_splits->{$sticker}->{$key}; 119 delete $tmp_characters->{$key} if $tmp_characters->{$key} <= 0; 120 } 121 $current += get_output($sticker_splits, $tmp_characters); 122 $minimum = $current if $current < $minimum or $minimum == 0; 123 } 124 } 125 return $minimum; 126 } 127 128 # checks if any of the characters in the word are in the sticker 129 sub any_char_in_sticker { 130 my ($word_characters, $sticker_characters) = @_; 131 foreach my $char (%$word_characters) { 132 return 1 if $sticker_characters->{$char}; 133 } 134 return 0; 135 } 136 137 # create a deep copy of a hash that is given by reference 138 sub deep_copy { 139 my $hash = shift; 140 return undef unless ref($hash) eq "HASH"; 141 my $result = {}; 142 foreach my $key (keys(%$hash)) { 143 $result->{$key} = $hash->{$key}; 144 } 145 return $result; 146 } 147 148 # check if all characters from a word are in the stickers 149 sub all_chars_in_splits { 150 my ($word_characters, $sticker_splits) = @_; 151 foreach my $char (keys(%$word_characters)) { 152 my $found = 0; 153 WORD: foreach my $w (keys(%$sticker_splits)) { 154 foreach my $c (keys(%{$sticker_splits->{$w}})) { 155 if($c eq $char) { 156 $found = 1; 157 last WORD; 158 } 159 } 160 } 161 # if we didn't find the current character we can return 0 162 return 0 unless $found; 163 } 164 # since we found all characters in at least one of the stickers 165 # we can return 1 166 return 1; 167 } 168 169 170 # split a word into its characters and return a hash that has 171 # the characters as keys. The value is the amount of times each 172 # character was found in the word 173 sub split_a_word { 174 my $word = shift; 175 my @chars = split //, $word; 176 my $result; 177 foreach my $c (@chars) { 178 $result->{$c}++; 179 } 180 return $result; 181 } 182