Merge pull request #259 from PerlMonk-Athanasius/branch-for-challenge-012

Perl5 and Perl6 solutions to Challenges 1 and 2 of Perl Weekly Challe…

8 files changed, 467 insertions, 0 deletions

diff --git a/challenge-012/athanasius/perl5/ch-1.pl b/challenge-012/athanasius/perl5/ch-1.pl
new file mode 100644
index 0000000000..306785ae4c
--- /dev/null
+++ b/challenge-012/athanasius/perl5/ch-1.pl
@@ -0,0 +1,59 @@
+#!perl
+
+################################################################################
+=comment
+
+Perl Weekly Challenge 012
+=========================
+
+Challenge #1
+------------
+
+The numbers formed by adding one to the products of the smallest primes are
+called the Euclid Numbers (see [ https://en.wikipedia.org/wiki/Euclid_number 
+|wiki]). Write a script that finds the smallest *Euclid Number* that is not
+prime. This challenge was proposed by Laurent Rosenfeld.
+
+=cut
+################################################################################
+
+#--------------------------------------#
+# Copyright © 2019 Perlmonk Athanasius #
+#--------------------------------------#
+
+use strict;
+use warnings;
+use Math::Prime::Util qw( factor is_prime pn_primorial );
+
+$| = 1;
+
+MAIN:
+{
+    for (my $n = 1; ; ++$n)
+    {
+        my $euclid = pn_primorial($n) + 1;
+
+        # is_prime() "Returns 0 is the number is composite,
+        #                     1 if it is probably prime,
+        #                 and 2 if it is definitely prime."
+
+        if (is_prime($euclid) == 0)
+        {
+            printf "\nThe smallest composite Euclid number E_n is:\n" .
+                     "  E_%d = (%d# + 1) = %s = %s\n",
+                      $n, $n, commify($euclid), join(' * ', factor($euclid));
+            last;
+        }
+    }
+}
+
+sub commify
+{
+    my ($number) = @_;
+
+    # Regex from perlfaq5: "How can I output my numbers with commas added?"
+
+    return $number =~ s/(^\d+?(?=(?>(?:\d{3})+)(?!\d))|\G\d{3}(?=\d))/$1,/gr;
+}
+
+################################################################################
diff --git a/challenge-012/athanasius/perl5/ch-2.pl b/challenge-012/athanasius/perl5/ch-2.pl
new file mode 100644
index 0000000000..b9e3cf8644
--- /dev/null
+++ b/challenge-012/athanasius/perl5/ch-2.pl
@@ -0,0 +1,195 @@
+#!perl
+
+################################################################################
+=comment
+
+Perl Weekly Challenge 012
+=========================
+
+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.
+
+=cut
+################################################################################
+
+#--------------------------------------#
+# Copyright © 2019 Perlmonk Athanasius #
+#--------------------------------------#
+
+#===============================================================================
+#
+# Assumptions:
+#
+# 1. All directories exist within the same rooted tree
+# 2. Only absolute paths should be considered; relative paths are discarded with
+#    a warning message
+# 3. Each input file consists of a list of paths, one path per line; blank lines
+#    are ignored
+#
+#===============================================================================
+
+use strict;
+use warnings;
+use Const::Fast;
+use Getopt::Long;
+
+const my $SEPARATOR => '/';
+const my $USAGE     => "\nUSAGE: perl $0  --help\n" .
+                         "or     perl $0 [--sep <separator>] <filename>\n";
+
+$| = 1;
+
+MAIN:
+{
+    my ($help, $sep, $paths) = read_paths();
+
+    if ($help)
+    {
+        print $USAGE;
+    }
+    elsif (my $num_paths = scalar @$paths)
+    {
+        print  "\nSeparator: $sep\n";
+        printf "\nInput path%s:\n", ($num_paths == 1) ? '' : 's';
+        print    "  $_\n" for @$paths;
+
+        my $dirs = parse_paths($sep, $paths);
+
+        if (my $num_dirs = scalar @$dirs)
+        {
+            printf "\nAbsolute path%s:\n", ($num_dirs == 1) ? '' : 's';
+            printf   "  %s%s\n", $sep, join($sep, @$_) for @$dirs;
+
+            printf "\nCommon directory path:\n  %s\n",
+                   ($num_dirs == 1) ? $paths->[0] :
+                                      get_common_path($sep, $dirs);
+        }
+        else
+        {
+            print "\nNo absolute paths found\n";
+        }
+    }
+    else
+    {
+        print "\nNo paths found\n";
+    }
+}
+
+sub read_paths
+{
+    my $help = '';
+    my $sep  = $SEPARATOR;
+
+    GetOptions
+    (
+        'help'   => \$help,     # Show usage?: flag
+        'sep:s'  => \$sep,      # Separator:   optional string
+
+    ) or die $USAGE;
+
+    my @paths;
+
+    unless ($help)
+    {
+        my $file = $ARGV[0]
+            or die $USAGE;
+
+        open(my $fh, '<', $file)
+            or die "Cannot open file '$file' for reading, stopped";
+
+        while (my $line = <$fh>)
+        {
+            chomp $line;
+            push  @paths, $line if $line;
+        }
+
+        close $fh
+            or die "Cannot close file '$file', stopped";
+    }
+
+    return ($help, $sep, \@paths);
+}
+
+sub parse_paths
+{
+    my ($sep,  $paths) = @_;
+    my (@dirs, @disc);
+
+    for my $path (@$paths)
+    {
+        # Look for an absolute path
+
+        my ($init, $rest) = $path =~ / ^ (\Q$sep\E) (.*) $ /x;
+
+        if (defined $init)          # Path is absolute
+        {
+            # Remove the initial separator
+
+            push @dirs, [ split m{ \Q$sep\E }x, $rest ];
+        }
+        else                        # Path is relative
+        {
+            push @disc, $path;
+        }
+    }
+
+    if (my $discards = scalar @disc)
+    {
+        printf "\nDiscarded relative path%s:\n", ($discards == 1) ? '' : 's';
+        print    "  $_\n" for @disc;
+    }
+
+    return \@dirs;
+}
+
+sub get_common_path
+{
+    my ($sep, $dirs) = @_;
+    my  $common      = $sep;
+    my  $max_depth   = get_max_common_dir_index($dirs);
+
+    OUTER:
+    for my $depth (0 .. $max_depth)
+    {
+        my $dir = $dirs->[0][$depth];
+
+        for my $dir_idx (1 .. $#$dirs)
+        {
+            last OUTER if $dirs->[$dir_idx][$depth] ne $dir;
+        }
+
+        $common .= $dir . $sep;
+    }
+
+    # Remove trailing separator
+
+    $common =~ s{ \Q$sep\E $ }{}x if $common ne $sep;
+
+    return $common;
+}
+
+sub get_max_common_dir_index
+{
+    my ($dirs) = @_;
+    my  $index = scalar( $dirs->[0]->@* ) - 1;
+
+    for my $path ( @{ $dirs }[1 .. $#$dirs] )
+    {
+        $index = $#$path if $#$path < $index;
+    }
+
+    return $index;
+}
+
+################################################################################
diff --git a/challenge-012/athanasius/perl5/paths1.txt b/challenge-012/athanasius/perl5/paths1.txt
new file mode 100644
index 0000000000..704ed48070
--- /dev/null
+++ b/challenge-012/athanasius/perl5/paths1.txt
@@ -0,0 +1,6 @@
+/aardvark/bison/camel/dromedary
+/aardvark/bison/cameldromedary
+aardvark/bison/elephant/hyena
+aardvark/bison/elephant
+/aardvark/bison/camelcamel
+/aardvark/bison/camel/dromedary/elephant
diff --git a/challenge-012/athanasius/perl5/paths_win.txt b/challenge-012/athanasius/perl5/paths_win.txt
new file mode 100644
index 0000000000..d138e22c40
--- /dev/null
+++ b/challenge-012/athanasius/perl5/paths_win.txt
@@ -0,0 +1,6 @@
+\a\b\c\d
+\a\b\cd
+a\b\e\f
+a\b\e
+\a\b\cc
+\a\b\c\d\e
diff --git a/challenge-012/athanasius/perl6/ch-1.p6 b/challenge-012/athanasius/perl6/ch-1.p6
new file mode 100644
index 0000000000..6f4afabb9f
--- /dev/null
+++ b/challenge-012/athanasius/perl6/ch-1.p6
@@ -0,0 +1,62 @@
+use v6;
+
+################################################################################
+=begin comment
+
+Perl Weekly Challenge 012
+=========================
+
+Challenge #1
+------------
+
+The numbers formed by adding one to the products of the smallest primes are
+called the Euclid Numbers (see [ https://en.wikipedia.org/wiki/Euclid_number
+|wiki]). Write a script that finds the smallest *Euclid Number* that is not
+prime. This challenge was proposed by Laurent Rosenfeld.
+
+=end comment
+################################################################################
+
+#--------------------------------------#
+# Copyright © 2019 PerlMonk Athanasius #
+#--------------------------------------#
+
+use Math::Prime::Util:from<Perl5> < factor pn_primorial >;
+
+my Sub $factor       := &Math::Prime::Util::factor;
+my Sub $pn-primorial := &Math::Prime::Util::pn_primorial;
+my Str constant $FMT := "\nThe smallest composite Euclid number E_n is:\n" ~
+                          "  E_%d = (%d# + 1) = %s = %s\n";
+
+sub MAIN()
+{
+    for 1 ... Inf -> Int $n
+    {
+        unless (my Int $euclid = $pn-primorial($n) + 1).is-prime
+        {
+            $FMT.printf($n, $n, commify($euclid), $factor($euclid).join(' * '));
+            last;
+        }
+    }
+}
+
+sub commify(Int:D $n --> Str:D)
+{
+    return "$n" if $n.abs < 1e3;
+
+    my @reversed  = $n.split('', :skip-empty).reverse;
+    my @commified = @reversed.head;
+
+    for 1 .. @reversed.end - 1 -> Int $index
+    {
+        @commified.push: @reversed[$index];
+        my $next = $index + 1;
+        @commified.push: ',' if $next % 3 == 0 && @reversed[$next] ne '-';
+    }
+
+    @commified.push: @reversed.tail;
+
+    return @commified.reverse.join('');
+}
+
+################################################################################
diff --git a/challenge-012/athanasius/perl6/ch-2.p6 b/challenge-012/athanasius/perl6/ch-2.p6
new file mode 100644
index 0000000000..c3ffbb94ed
--- /dev/null
+++ b/challenge-012/athanasius/perl6/ch-2.p6
@@ -0,0 +1,127 @@
+use v6;
+
+################################################################################
+=begin comment
+
+Perl Weekly Challenge 012
+=========================
+
+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.
+
+=end comment
+################################################################################
+
+#--------------------------------------#
+# Copyright © 2019 PerlMonk Athanasius #
+#--------------------------------------#
+
+#===============================================================================
+#
+# Assumptions:
+#
+# 1. All directories exist within the same rooted tree
+# 2. Only absolute paths should be considered; relative paths are discarded with
+#    a warning message
+# 3. Each input file consists of a list of paths, one path per line; blank lines
+#    are ignored
+#
+#===============================================================================
+
+my Str constant $SEPARATOR := '/';
+
+sub MAIN(Str:D $file, Str:D :$sep = $SEPARATOR)
+{
+    my @paths = $file.IO.lines.grep(*.chars > 0);
+
+    if @paths.elems > 0
+    {
+        say "\nSeparator: $sep";
+        say "\nInput path", (@paths.elems == 1 ?? ':' !! 's:');
+        say   "  $_" for @paths;
+
+        my @dirs = parse-paths($sep, @paths);
+
+        if @dirs.elems > 0
+        {
+            my Bool $single = @dirs.elems == 1;
+
+            say "\nAbsolute path", $single ?? ':' !! 's:';
+            say   '  ', $sep, $_.join($sep) for @dirs;
+
+            say "\nCommon directory path:\n  ",
+                $single ?? @paths[0] !! get-common-path($sep, @dirs);
+        }
+        else
+        {
+            say "\nNo absolute paths found";
+        }
+    }
+    else
+    {
+        say "\nNo paths found";
+    }
+}
+
+sub parse-paths(Str:D $sep, @paths)
+{
+    my (@dirs, @disc);
+
+    for @paths -> Str $path
+    {
+        if $path.substr(0 .. 0) eq $sep               # Path is absolute
+        {
+            @dirs.push: $path.substr(1).split($sep);  # Remove initial separator
+        }
+        else                                          # Path is relative
+        {
+            @disc.push: $path;
+        }
+    }
+
+    if @disc.elems > 0
+    {
+        say "\nDiscarded relative path", (@disc.elems == 1 ?? '' !! 's'), ':';
+        say   "  $_" for @disc;
+    }
+
+    @dirs.perl;         # Force cache of @dirs contents
+
+    return @dirs;
+}
+
+sub get-common-path(Str:D $sep, @dirs)
+{
+    my Str $common    = $sep;
+    my Int $max-depth = @dirs.map(*.elems).min;
+
+    BY-DEPTH:
+    for 0 .. $max-depth -> Int $depth
+    {
+        my $dir = @dirs[0; $depth];
+
+        for 1 .. @dirs.end -> Int $dir-idx
+        {
+            last BY-DEPTH if @dirs[$dir-idx; $depth] ne $dir;
+        }
+
+        $common ~= $dir ~ $sep;
+    }
+
+    $common ~~ s/ $sep $ // if $common ne $sep;      # Remove trailing separator
+
+    return $common;
+}
+
+################################################################################
diff --git a/challenge-012/athanasius/perl6/paths1.txt b/challenge-012/athanasius/perl6/paths1.txt
new file mode 100644
index 0000000000..704ed48070
--- /dev/null
+++ b/challenge-012/athanasius/perl6/paths1.txt
@@ -0,0 +1,6 @@
+/aardvark/bison/camel/dromedary
+/aardvark/bison/cameldromedary
+aardvark/bison/elephant/hyena
+aardvark/bison/elephant
+/aardvark/bison/camelcamel
+/aardvark/bison/camel/dromedary/elephant
diff --git a/challenge-012/athanasius/perl6/paths_win.txt b/challenge-012/athanasius/perl6/paths_win.txt
new file mode 100644
index 0000000000..d138e22c40
--- /dev/null
+++ b/challenge-012/athanasius/perl6/paths_win.txt
@@ -0,0 +1,6 @@
+\a\b\c\d
+\a\b\cd
+a\b\e\f
+a\b\e
+\a\b\cc
+\a\b\c\d\e