Alphabetical exercises
Weekly challenge 216 — 8 May 2023
Week 216: 8 May 2023
You are given a list of word stickers and a target word. Write a script to find out how many word stickers are needed to make up the given target word. From the examples we can see that you may use multiples of each sticker if required.
The first question is the meaning of 'needed' in the challenge. We could solve a specific example in some way and say 'I needed 5 stickers'. However, I suspect that the intention is to find the minimum number of stickers that can be used for a given set of data.
This is quite a difficult problem! It could be done with a recursive solution with each instantiation taking the analysis one step forward, but for a long word - see my fourth example, the options branch alarmingly fast.
One simplification that can be made is to note that the challenege specifies the (minimum) number of stickers, and not the minimum number of pieces of sticker. This means the solution can work with sourcing individual letters (say a, b and c) rather than having to consider strings of letters (abc).
But the major complication and the one that can give rise to major backtracking is the option to use multiple copies of a sticker. As soon as it becomes clear that this will need to be done, potentially the entire sourcing of previous characters needs to be revisited.
So, in the time available, I have come up with a non-backtracking solution that will
come up with the minimum-stickers solution in most cases, but, as in my 4th example,
will not always do so. Interestingly, because of Perl's indeterminate ordering of
the construct for $x (keys %t) {}
, it comes up with a range of different
solutions if run several times.
I look forward to seeing how others have approached this challenge.
#!/usr/bin/perl use v5.16; # The Weekly Challenge - 2023-05-08 use utf8; # Week 216 task 2 - Word stickers use strict; # Peter Campbell Smith use warnings; # Blog: http://ccgi.campbellsmiths.force9.co.uk/challenge word_stickers(['perl','raku','python'], 'peon'); word_stickers(['love','hate','angry'], 'goat'); word_stickers(['come','nation','delta'], 'accommodation'); word_stickers(['nail', 'sited', 'belt', 'marsh'], 'antidisestablishmentarianism'); sub word_stickers { my ($best, $count, $how_many, $most, $need_to_match, $occurs, $occurs_in, $rubric, $s, $s1, $stars, $ties, $times, $times_all, $times_here, $to_match, $word, $x, $x1, $z, %in_sticker, %in_word, %needed, %used, @stickers); # initialise @stickers = @{$_[0]}; $word = $_[1]; $rubric = ''; say qq[\nInput: \@stickers = ('] . join(qq[', '], @stickers) . qq['), \$word = '$word']; # create $in_word{$x} as quantity of $x in $word while ($word =~ m|([a-z])|g) { $in_word{$1} ++; } # create $in_sticker{$x}{$s} as quantity of $x in $stickers[$s] for ($s = 0; $s < scalar @stickers; $s ++) { while ($stickers[$s] =~ m|([a-z])|g) { $in_sticker{$1}{$s} ++; } } # loop over letters in $word for $x (sort keys %in_word) { next unless $in_word{$x} > 0; # check for $x n times in stickers and >=n times in word for $x (keys %in_word) { $most = 0; # find sticker with most $x - this may not be the best $times_all = 0; for ($s = 0; $s < scalar @stickers; $s ++) { $times_here = ($in_sticker{$x}{$s} or 0); $times_all += $times_here; if ($times_here > $most) { $most = $times_here; $best = $s; } } # check for impossibility (letter from word not in any sticker) if ($most == 0) { say qq[Output: 0 - '$x' not in any sticker]; return; } # if $x occurs more times in word than in stickers, # need to add duplicate stickers $need_to_match = $in_word{$x}; $z = 0; while ($need_to_match > $times_all) { $s1 = scalar @stickers; $stickers[$s1] = $stickers[$best] . '*'; for $x1 (keys %in_word) { $in_sticker{$x1}{$s1} = $in_sticker{$x1}{$best}; } $need_to_match -= $in_sticker{$x}{$best}; } # now we have enough stickers $need_to_match = $in_word{$x}; for ($s = 0; $s < scalar @stickers; $s ++) { next unless ($in_sticker{$x}{$s} or 0); $to_match = $need_to_match > $in_sticker{$x}{$s} ? $in_sticker{$x}{$s} : $need_to_match; $need_to_match -= $to_match; $used{$s} .= $x x $to_match; $in_sticker{$x}{$s} = 0; $in_word{$x} = 0; $needed{$s} = 1; last if $need_to_match <= 0; } $in_word{$x} = 0; } } # format output $count = 0; for $s (keys %needed) { $count ++; } say qq[Output: $count]; for $s (sort keys %used) { say qq[ '$used{$s}' from '$stickers[$s]']; $stars ++ if $stickers[$s] =~ m|\*|; } say qq[ * indicates duplicated sticker] if $stars; }
Input: @stickers = ('perl', 'raku', 'python'), $word = 'peon' Output: 2 'ep' from 'perl' 'on' from 'python' Input: @stickers = ('love', 'hate', 'angry'), $word = 'goat' Output: 3 'o' from 'love' 'at' from 'hate' 'g' from 'angry' Input: @stickers = ('come', 'nation', 'delta'), $word = 'accommodation' Output: 4 'omc' from 'come' 'oatin' from 'nation' 'ad' from 'delta' 'omc' from 'come*' * indicates duplicated sticker Input: @stickers = ('nail', 'sited', 'belt', 'marsh'), $word = 'antidisestablishmentarianism' Output: 8 'nali' from 'nail' 'tised' from 'sited' 'tbe' from 'belt' 'mhars' from 'marsh' 'mas' from 'marsh*' 'tis' from 'sited*' 'nai' from 'nail*' 'ni' from 'nail*' * indicates duplicated sticker
Any content of this website which has been created by Peter Campbell Smith is in the public domain