Perl Weekly Challenge: Week 12

Challenge 1:

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.

Perl 5 first this time. The "products of the smallest primes" refered to in the spec are known as primorials. Adding 1 to a primorial gives a Euclid number.

So we start counting from 1, storing the count in the variable $n.

my $n = 1;

1 is a primorial so we start counting those from 1.

my $primorial = 1;

Now every time we increment $n...

while (++$n) {

...we check if it is a prime number with isPrime() (described below.)

    if (isPrime($n)) {

If it is prime, $primorial is multiplied by that amount to become the next primorial.

        $primorial *= $n;

Adding 1 makes it the next Euclid number.

        my  $euclidNumber = $primorial + 1;

If that Euclid number is not prime, we have found our answer. We print it and exit the script.

        if (!isPrime($euclidNumber)) {
            say $euclidNumber;
            last;
        }
    }

Otherwise, we continue on to the next value of $n.

}

isPrime() checks if a given integer $n is a prime number.

sub isPrime {
    my ($n) = @_;

Because Perl at that time had no explicit false value we return undef for numbers less than 2, since primes are greater than 1.

    if ($n < 2) {
        return undef;
    }

There is no true either so if $n is exactly 2, it returns 1, as 2 is the smallest prime.

    if ($n == 2) {
        return 1;
    }

For other numbers, it checks divisibility by all integers from 2 up to the square root of $n. If any divisor is found, the function returns undef; otherwise, it returns 1, confirming the number is prime.

    for my $i (2 .. sqrt($n)) {
        if ($n % $i == 0) {
            return undef;
        }
    }

    return 1;
}

(Full code on Github.)

For Raku/Perl 6, I wrote an isPrime() much like that in Perl. Perhaps at that time I wrote this I was not aware that it has an is-prime() method in its' standard library.

multi sub MAIN() {
    my $primorial = 1;

The rest works the same as in Perl 5.

    for 1 .. * -> $n {
        if isPrime($n) {
            $primorial *= $n;
            my  $euclidNumber = $primorial + 1;
            if !isPrime($euclidNumber) {
                say $euclidNumber;
                return;
            }
        }
    }
}

(Full code on Github.)

The answer to the problem is 30011.

Challenge 2:

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.

We take the file paths from the command-line arguments making sure each one begins with a /.

multi sub MAIN(
+@args where { $_.elems && $_.all ~~ /^\// }  #= File paths.
) {

First, we .sort() and .reverse() the list of paths, then .split() each path into its directory components using / as the delimiter. This results in an array of arrays, where each sub-array contains the segments of a path. The arguments are sorted so that the shortest is first because the common directory path cannot be longer than the shortest path.

    my @paths = @args
                .sort
                .reverse
                .map({ $_.split('/') });

Storage is setup to hold the common directory path.

    my @commonDirectoryPath;

Then we iterate over the indices of the first path's segments. For each segment index, we check if all paths have the same directory name at that position. If they do, it adds that segment to the list of common directory components. If a mismatch is found, the loop stops.

    for 0 .. @paths[0].elems - 1 -> $segment {
        my $dir = @paths.first()[$segment];
        if @paths.map({ $_[$segment] }).all eq $dir {
            push @commonDirectoryPath, $dir;
        } else {
            last;
        }
    }

After all the file paths are processed, if our list of common directory segments has more than one element, we .join() them with /s to make up a full path again. If there is only 1 or 0 segments, the common directory path is /. In either case we print it.

    say @commonDirectoryPath.elems > 1 ?? @commonDirectoryPath.join('/') !! '/';
}

(Full code on Github.)

This is the Perl 5 version.

my @paths = map { [ split q{/} ] } reverse sort @ARGV;

my @commonDirectoryPath;
for my $segment (0 .. scalar @{$paths[0]} - 1) {
    my $dir = @{$paths[0]}[$segment];
    if (!scalar grep { !/$dir/ } map { @{$_}[$segment] } @paths) {
        push @commonDirectoryPath, $dir;
    } else {
        last;
    }
}

say scalar @commonDirectoryPath > 1 ? join q{/}, @commonDirectoryPath : q{/};

(Full code on Github.)