perl-weekly-challenge Archives

Perl Weekly Challenge 020: Split on change + amicable numbers

I spent this week in Rīga at the Perl Conference. I had two talks there, a standard 20-minutes one and a lightning talk (5 minutes). I dedicated all my free time to the preparation of the slides, but fortunately the assignments were rather easy this week, so I submitted the solutions on Monday already before leaving for Rīga.

Perl Weekly Challenge 019: Five Weekends and Paragraph Wrapping

This week’s challenge was a bit easier than the recent ones, but I was glad for that. The Perl Conference in Riga is coming and I still don’t have my slides ready!

Five Weekends

Write a script to display months from the year 1900 to 2019 where you find 5 weekends, i.e. 5 Fridays, 5 Saturdays, and 5 Sundays.

I started by running the cal utility (part of the util-linux package) to see how such months might look. For example, this is the output of cal 1904 (5 weekends highlighted manually be me):

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.

Perl Weekly Challenge 014: Van Eck and the US States

This week, there was more work to be done for some of us: in addition to the standard three challenges, there was one more from Neil Bowers. His suggestion for a challenge had been simplified, so he published the original specification.

Van Eck’s Sequence

Let a0 = 0. Then, for n ≥ 0, if there exists an m < n such that am = an, take the largest such m and set an+1 = n − m; otherwise an+1 = 0.

I didn’t find a non-recursive formula for the sequence. I implemented a solution using an iterator: a subroutine that returns the next element of the sequence on each call.

Let’s start with a test.

Perl Weekly Challenge 013: Last Fridays and Hofstadter Female and Male Sequences

Last Fridays

Write a script to print the date of last Friday of every month of a given year.

To handle dates, I used Time::Piece, a core module since 5.10. It has no method to get the last Friday of a month directly, so I tried a simple trick: get the first day of the next month, subtract one day, and continue to subtract days until we get a Friday.

Time::Piece does all the date maths in seconds. I also used Time::Seconds to get the constant ONE_DAY so I didn’t have to count it myself (60 * 60 * 24, right?)

Perl Weekly Challenge 012: Non-Prime Euclid Numbers and the Common Path

The Smallest Non-Prime Euclid Number

An Euclid number is a number that equals 1 + product of a sequence of primes.

To speed things up, I used an object that caches the sequence of primes discovered so far. The method size returns the length of the sequence of primes; extend_to extends the sequence up to the specified number.

About E. Choroba

user-pic I blog about Perl.