July 2019 Archives

Perl Weekly Challenge 018/2: Priority Queue

Write a script to implement Priority Queue. It is like regular queue except each element has a priority associated with it. In a priority queue, an element with high priority is served before an element with low priority. Please check this wiki page for more information. It should serve the following operations:
  1. is_empty: check whether the queue has no elements.
  2. insert_with_priority: add an element to the queue with an associated priority.
  3. pull_highest_priority_element: remove the element from the queue that has the highest priority, and return it. If two elements have the same priority, then return element added first.

The Naive Implementation

If the priorities are non-negative integers and bounded by a reasonable maximum, the following implementation might be all you need. Let’s implement the queue as an array of arrays, each array element at position $p represents all the queue elements with priority $p.

Perl Weekly Challenge 018/1: Longest Common Substring

Write a script that takes 2 or more strings as command line parameters and prints the longest common substring.

A naive solution

For a naive solution, we first need to make an observation: although the longest common substring (lcs) must be a substring of all the strings, we don’t have to process all pairs of strings to find it. We can just take all the substrings of one of the strings (using the shortest one would be fastest) and try to find each substring in all other strings. If the substring is present in all the strings and is longer than the lcs found so far, we have a new lcs candidate. I decided to keep all the lcs’s of the same length.

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

my @longest = ("");
my $string  = shift;
for my $pos (1 .. length $string) {
    for my $length (1 .. 1 - $pos + length $string) {
        next if $length < length $longest[0];

        my $substr = substr $string, $pos - 1, $length;
        my $found = 0;
        -1 != index $_, $substr and ++$found for @ARGV;
        if ($found == @ARGV) {
            if ($length == length $longest[0]) {
                push @longest, $substr;
            } else {
                @longest = $substr;
            }
        }
    }
}
say "<$_>" for @longest;

Using next is another optimisation: there’s no need to try a substring that’s shorter than the lcs found so far.

The algorithm seems to work fine for simple inputs, but when I tried to run it on two 10KB sized text documents, it took it more than 1m 30s to finish. That was expected and I wanted to find a more effective solution.

Perl Weekly Challenge 017: Ackermann Function and URL Parsing

Ackermann Function

A(m, n) = n + 1                  if m = 0
A(m, n) = A(m - 1, 1)            if m > 0 and n = 0
A(m, n) = A(m - 1, A(m, n - 1))  if m > 0 and n > 0

I know that Perl6 supports multisubs, but when I see a function definition of this kind, I always think Erlang, where you get pattern matching and multisubs by default. Here’s how it looks:

-module(ackermann).
-export([ackermann/2]).

ackermann(0, N) ->
    N + 1;
ackermann(M, 0) ->
    ackermann(M - 1, 1);
ackermann(M, N) ->
    ackermann(M - 1, ackermann(M, N - 1)).

Perl solution is a bit less straightforward.

Perl Weekly Challenge 016: Pythagoras Pie Puzzle and Bitcoin Address Validation

Pythagoras Pie Puzzle

At a party a pie is to be shared by 100 guest. The first guest gets 1% of the pie, the second guest gets 2% of the remaining pie, the third gets 3% of the remaining pie, the fourth gets 4% and so on. Write a script that figures out which guest gets the largest piece of pie.

I started with a straightforward implementation of the specification. Start with the pie of size 1; in each step, find out the size of the corresponding guest’s part, remember it if it’s largest one so far, and decrease the size of the pie.

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

my $pie = 1;
my @max = (0, -1);

for (1 .. 100) {
    my $part = $pie / 100 * $_;
    $pie -= $part;
    @max = ($_, $part) if $part > $max[1];
}

say "@max";

Perl Weekly Challenge 015: Strong and Weak Primes, and Vigenère Cipher

Strong and Weak Primes

Write a script to generate first 10 strong and weak prime numbers.

The two sets of primes are defined with the following formulas:

  • p(n) is Strong when p(n) > [ p(n-1) + p(n+1) ] / 2
  • p(n) is Weak when p(n) < [ p(n-1) + p(n+1) ] / 2

It took me some time to realise there is a third set of primes which isn’t mentioned in the above list: there are also Balanced primes. The comparison operator for them is =.

To generate primes, I reused the (slightly modified) module I created for the Challenge 012. It caches the primes found so far and extends their list when needed.

About E. Choroba

user-pic I blog about Perl.