Peter Campbell Smith

Alphabetical exercises

Weekly challenge 216 — 8 May 2023

Week 216 - 8 May 2023

Task 2

Task — Word stickers

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.

Try it 

Stickers - example: come, nation, delta

Word - example: accommodation



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:

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];
            # 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

The content of this website which has been created by
Peter Campbell Smith is hereby placed in the public domain