April 2020 Archives

Perl Weekly Challenge 057: Invert Tree and Shortest Unique Prefix

Shortest Unique Prefix

Write a script to find the shortest unique prefix for each each word in the given list. The prefixes will not necessarily be of the same length.

Sample Input

[ "alphabet", "book", "carpet", "cadmium", "cadeau", "alpine" ]

Expected Output

[ "alph", "b", "car", "cadm", "cade", "alpi" ]

Let me start with the second task as it was definitely simpler (at least for me).

We iterate over all the input words. For each word, we try to find the shortest prefix possible. To know what prefixes have already been used, we keep two hashes: one stores the abandoned prefixes (i.e. those that were not unique anymore), the second one stores the “current” prefixes (the prefix is the key, the actual word is the value). We start from length 1 and add 1 in each step. If the prefix isn’t used and hasn’t been used, we assign it to the word and proceed to the next word. If the prefix is currently used for a different word, we store the prefix as “used” and prolong the prefix for the old word by one—but we continue the loop for the current word, in case their common prefix is longer.

Perl Weekly Challenge 056: Diff-K and Path Sum

Diff-K

You are given an array @N of positive integers (sorted) and another non negative integer $k. Write a script to find if there exists 2 indices $i and $j such that $A[$i] - $A[$j] == $k and $i != $j. It should print the pairs of indices, if any such pairs exist.

Example:

@N = (2, 7, 9);
$k = 2;

Output: 2, 1

I totally ignored the fact that the input array is sorted. My solution works for any input array, but it’s still rather efficient.

The basic trick is that we don’t have to compute $A[$i] - $A[$j] for each combination or $i and $j. We know $k from the very beginning, so we can just iterate the array for the first time to store it in a hash, and iterate it for the second time to check the hash whether the corresponding number exists in the array.

#!/usr/bin/perl
use warnings;
use strict;
use feature qw{ say };

my @N = (2, 7, 9);
my $k = 2;

my %in_array;
@in_array{ @N } = 0 .. $#N;

for (@N) {
    say join ', ', @in_array{ $k + $_, $_ }
        if exists $in_array{ $k + $_ };
}

Perl Weekly Challenge 054: Kth Permutation Sequence + Collatz Conjecture

Kth Permutation Sequence

Write a script to accept two integers n (>=1) and k (>=1). It should print the k-th permutation of n integers.

For example, n=3 and k=4, the possible permutation sequences are listed below:

123
132
213
231
312
321

The script should print the 4th permutation sequence 231.

The straightforward way is to generate all the permutations in the correct order and then output the kth one. To generate them, we can use recursion: To get all the permutations of n elements, start with each element and extend it with all the permutations of the remaining elements.

About E. Choroba

user-pic I blog about Perl.