laurent_r

These are some answers to the Week 12 of the Perl Weekly Challenge organized by Mohammad S. Anwar.

Spoiler Alert: This weekly challenge deadline is due in several days from now (June 16, 2019). This blog post offers some solutions to this challenge, please don't read on if you intend to complete the challenge on your own.

Challenge # 1: Euclid's Numbers

The numbers formed by adding one to the products of the smallest primes are called the Euclid Numbers (see wiki). Write a script that finds the smallest Euclid Number that is not prime. This challenge was proposed by Laurent Rosenfeld.

I did not even remember I proposed this challenge to my friend Mohammad Anwar.

So far, in my blogs about the Perl Weekly Challenge, I have always prepared and presented the Perl 5 solutions first and then the Perl 6 solutions, as it seems to be slightly more natural to do it in this order. This time, for a change, I'll do it the other way around and start with a Perl 6 solution. This way, I'll not be tempted to just translate a P5 solution into P6.

Euclid's Numbers in Perl 6

For this, we can use two infinite (lazy) lists: one for the primes and one for Euclid's numbers, and then pick up the first Euclid's number that is not prime:

use v6;

my @primes = grep {.is-prime}, 1..*;
my @euclids = map {1 + [*] @primes[0..$_]}, 0..*;
say @euclids.first(not *.is-prime);

which prints 30031 (which is not prime as it is the product 59 × 509).

Note that we don't really need to populate an intermediate temporary array with Euclid's numbers and can find directly the first such number that is not prime:

use v6;

my @primes = grep {.is-prime}, 1..*;
say (map {1 + [*] @primes[0..$_]}, 0..*).first(not *.is-prime);

But it probably wouldn't make much sense to also try to get rid of the @primes array, because we are in fact using it many times in the process of computing Euclid's numbers, so it is probably better to cache the primes.

Euclid's Numbers in Perl 5

For this challenge, I reused the find_primes and is_prime subroutines that I described in some details in my previous blog post about Perl Weekly Challenge 8 on perfect numbers (and some other earlier posts). Please refer to that blog if you need explanations on these subroutines. Once you have these subroutines to generate a list of prime numbers, generating a list of Euclid's numbers and checking whether each generated Euclid's number is prime is straight forward:

#!/usr/bin/perl
use strict;
use warnings;
use feature "say";
use constant largest_num => 1000;

sub find_primes {
    my $num = 3;
    my @primes = (2, 3);
    while (1) {
        $num += 2;     # check only odd numbers
        last if $num > largest_num;
        my $limit = int $num ** 0.5;
        my $num_is_prime = 1;
        for my $prime (@primes) {
            last if $prime > $limit;
            if ($num % $prime == 0) {
                # $num evenly divided by $prime, exit the for loop
                $num_is_prime = 0;
                last;
            }
        }
        push @primes, $num if $num_is_prime;
    }
    return @primes;
}

my @prime_numbers = find_primes;  

sub is_prime {
    my $num = shift;
    my $limit = 1 + int $num ** 0.5;
    for my $p (@prime_numbers) {
        return 1 if $p > $limit;
        return 0 if $num % $p == 0;
    }
    warn "Something got wrong (primes list too small)\n";
    return 0; # If we've reached this point, then our list of 
              # primes is too small, we don't know if the argument
              # is prime, issue a warning and return a false 
              # value to be on the safe side of things
}

for my $i (0..20) {
    my $euclid_1 = 1;
    $euclid_1 *= $prime_numbers[$_] for 0..$i;
    my $euclid = $euclid_1 + 1;
    say $euclid and last unless is_prime $euclid;   
}

The program displays the following output:

$ perl euclid.pl
30031

Common Directory Paths

Write a script that finds the common directory path, given a collection of paths and directory separator. For example, if the following paths are supplied:

/a/b/c/d
/a/b/cd
/a/b/cc
/a/b/c/d/e

and the path separator is /. Your script should return /a/b as common directory path.

Common Directory Paths in Perl 6

For this, I created the compare-paths subroutine to compare two paths, and then use the reduce built-in function to apply compare-paths to the whole list of paths:

use v6;
sub compare-paths ($a, $b) {
    join $*sep, 
        gather for $a.split($*sep) Z $b.split($*sep) -> ($p, $q) {
            last unless $p eq $q;
            take $p;
        }
}
my $*sep = '/';
my @paths = </a/b/c /a/b/c/e /a/b/c/d/e /a/b/c/f>;
say reduce &compare-paths, @paths;

which duly displays /a/b/c.

The compare-paths subroutine splits both paths on the separator, uses the "zip" operator to create pairs of path parts and checks which parts are equal. The gather/take construct picks up the parts that are the same and returns the corresponding path.

Another way to solve the challenge would be to create a new compare-paths operator and use the [] reduction meta-operator to generate the result:

use v6;
sub infix:<compare-paths> ($a, $b) {
    join $*sep, 
        gather for $a.split($*sep) Z $b.split($*sep) -> ($p, $q) {
            last unless $p eq $q;
            take $p;
        }
}
my $*sep = '/';
my @paths = </a/b/c /a/b/c/e /a/b/c/d/e /a/b/c/f>;
say [compare-paths] @paths;

Common Directory Paths in Perl 5

Here is a way to do it in Perl 5:

#!/usr/bin/perl
use strict;
use warnings;
use feature "say";

die "This program needs a separator and at least 2 paths\n" 
    if @ARGV < 3;
my ($separator, @paths) = @ARGV;
chomp @paths;
my @common_path = split $separator, shift @paths;
for my $new_path (@paths) {
    my @new_path_pieces = split $separator, $new_path;
    my $min_length = @new_path_pieces < @common_path ? 
        @new_path_pieces : @common_path;
    for my $i (0..$min_length - 1) {
        if ($common_path[$i] ne $new_path_pieces[$i]) {
            @common_path = @common_path[0..$i-1];
            last;
        }
    }
}
say join $separator, @common_path;

Note, however, that the List::Util core module also provides a reduce subroutine making it possible to create a solution similar to the P6 solution:

#!/usr/bin/perl
use strict;
use warnings;
use feature "say";
use List::Util qw/reduce/;

sub compare {
    my ($sep, $p1, $p2) = @_;
    my @path1 = split /$sep/, $p1;
    my @path2 = split /$sep/, $p2;
    my $min_length = @path1 < @path2 ? @path1 : @path2;
    for my $i (0..$min_length - 1) {
        if ($path1[$i] ne $path2[$i]) {
            return join $sep, @path1[0..$i-1];
        }
    }
    return join $sep, @path1[0..$min_length - 1];
}

die "This program needs a separator and at least 2 paths\n" 
    if @ARGV < 3;
my ($separator, @paths) = @ARGV;
chomp @paths;
say reduce {compare($separator, $a, $b)} @paths;

The Perl 5 solution is still much less concise than the Perl 6 solution.

Wrapping up

The next week Perl Weekly Challenge is due to start soon. If you want to participate to this challenge, please check https://perlweeklychallenge.org/ and make sure you answer the challenge before 6 p.m. BST (British summer time) on Sunday, June 23. And, please, also spread the word about the Perl Weekly Challenge if you can.