Perl Weekly Challenge # 12: Euclid's Numbers and Directories

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 {.isprime}, 1..*; my @euclids = map {1 + [*] @primes[0..$_]}, 0..*; say @euclids.first(not *.isprime);
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 {.isprime}, 1..*; say (map {1 + [*] @primes[0..$_]}, 0..*).first(not *.isprime);
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
andis_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; # Add $num to the array of primes } 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
comparepaths
subroutine to compare two paths, and then use thereduce
builtin function to applycomparepaths
to the whole list of paths:use v6; sub comparepaths ($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 &comparepaths, @paths;
which duly displays
/a/b/c
.The
comparepaths
subroutine splits both paths on the separator, uses the "zip" operator to create pairs of path parts and checks which parts are equal. Thegather/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
comparepaths
operator and use the[]
reduction metaoperator to generate the result:use v6; sub infix:<comparepaths> ($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 [comparepaths] @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..$i1]; last; } } } say join $separator, @common_path;
Note, however, that the
List::Util
core module also provides areduce
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..$i1]; } } 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 thyat the Perl 6 solution.
Wrapping up
The next week Perl Weekly Challenge is due to start soon. If you're interested in participating in 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.
http://blogs.perl.org/users/laurent_r/2019/06/perlweeklychallenge12euclidsnumbersanddirectories.html
© Lightnetics 2020