Add Perl solution to challenge 062

6 files changed, 234 insertions, 0 deletions

diff --git a/challenge-062/paulo-custodio/Makefile b/challenge-062/paulo-custodio/Makefile
new file mode 100644
index 0000000000..c3c762d746
--- /dev/null
+++ b/challenge-062/paulo-custodio/Makefile
@@ -0,0 +1,2 @@
+all:
+	perl ../../challenge-001/paulo-custodio/test.pl
diff --git a/challenge-062/paulo-custodio/README b/challenge-062/paulo-custodio/README
new file mode 100644
index 0000000000..87dc0b2fbd
--- /dev/null
+++ b/challenge-062/paulo-custodio/README
@@ -0,0 +1 @@
+Solution by Paulo Custodio
diff --git a/challenge-062/paulo-custodio/perl/ch-1.pl b/challenge-062/paulo-custodio/perl/ch-1.pl
new file mode 100644
index 0000000000..e6cb2d6ece
--- /dev/null
+++ b/challenge-062/paulo-custodio/perl/ch-1.pl
@@ -0,0 +1,71 @@
+#!/usr/bin/env perl
+
+# Challenge 062
+#
+# TASK #1 › Sort Email Addresses
+# Submitted by: Neil Bowers
+# Reviewed by: Ryan Thompson
+#
+# Write a script that takes a list of email addresses (one per line) and sorts
+# them first by the domain part of the email address, and then by the part to
+# the left of the @ (known as the mailbox).
+#
+# Note that the domain is case-insensitive, while the mailbox part is case
+# sensitive. (Some email providers choose to ignore case, but that’s another
+# matter entirely.)
+#
+# If your script is invoked with arguments, it should treat them as file names
+# and read them in order, otherwise your script should read email addresses from
+# standard input.
+#
+# Bonus
+# Add a -u option which only includes unique email addresses in the output, just
+# like sort -u.
+#
+# Example
+# If given the following list:
+#
+# name@example.org
+# rjt@cpan.org
+# Name@example.org
+# rjt@CPAN.org
+# user@alpha.example.org
+# Your script (without -u) would return:
+#
+# user@alpha.example.org
+# rjt@cpan.org
+# rjt@CPAN.org
+# Name@example.org
+# name@example.org
+# With -u, the script would return:
+#
+# user@alpha.example.org
+# rjt@CPAN.org
+# Name@example.org
+# name@example.org
+
+use Modern::Perl;
+use Getopt::Std;
+
+our $opt_u;
+getopts('u');
+chomp(my @mails = <>);
+
+my @sorted =
+    map {join '@', @$_}                     # join mailbox and domain
+    sort {lc($a->[1]) cmp lc($b->[1])}      # sort domain case insensitive
+    sort {$a->[0] cmp $b->[0]}              # sort mailbox
+    map {[split '@', $_]}                   # split mailbox and domain
+    @mails;
+
+if ($opt_u) {
+    my %seen;
+    @sorted =
+        map {join '@', @$_}                 # join mailbox and domain
+        grep {my $key = $_->[0].'@'.lc($_->[1]);
+              !$seen{$key}++}               # filter only not seen
+        map {[split '@', $_]}               # split mailbox and domain
+        @sorted;
+}
+
+say join("\n", @sorted);
diff --git a/challenge-062/paulo-custodio/perl/ch-2.pl b/challenge-062/paulo-custodio/perl/ch-2.pl
new file mode 100644
index 0000000000..2db5a3e870
--- /dev/null
+++ b/challenge-062/paulo-custodio/perl/ch-2.pl
@@ -0,0 +1,122 @@
+#!/usr/bin/env perl
+
+# Challenge 062
+#
+# TASK #2 › N Queens
+# Submitted by: Ryan Thompson
+#
+# A standard 8×8 chessboard has 64 squares. The Queen is a chesspiece that can
+# attack in 8 directions, as shown by the green shaded squares below:
+#
+#
+#
+# It is possible to place 8 queens on to a single chessboard such that none of
+# the queens can attack each other (i.e., their shaded squares would not
+# overlap). In fact, there are multiple ways to do so, and this is a favourite
+# undergraduate assignment in computer science.
+#
+# But here at PWC, we’re going to take it into the next dimension!
+#
+# Your job is to write a script to work with a three dimensional chess cube,
+# M×M×M in size, and find a solution that maximizes the number of queens that
+# can be placed in that cube without attacking each other. Output one possible
+# solution.
+#
+# Example
+# A trivial 2×2×2 solution might look like this (1 = queen, 0 = empty):
+#
+# [
+#     [[1,0],     # Layer 1
+#      [0,0]],
+#
+#     [[0,0],     # Layer 2
+#      [0,0]],
+# ]
+
+use Modern::Perl;
+use Clone 'clone';
+use constant M => 2;
+use Data::Dump 'dump';
+
+my @board;
+for my $l (0..M-1) {
+    $board[$l] = [];
+    for my $r (0..M-1) {
+        push @{$board[$l]}, [(0) x M];
+    }
+}
+
+my $max_board = clone(\@board);
+my $max_queens = 0;
+
+place_queens(0, \@board);
+say dump($max_board);
+
+sub place_queens {
+    my($queens, $board) = @_;
+
+    # check for empty spaces
+    my $full = 1;
+    for my $l (0..M-1) {
+        for my $r (0..M-1) {
+            for my $c (0..M-1) {
+                if ($board->[$l][$r][$c] eq 0) {
+                    $full = 0;
+                    # empty, place queen
+                    my $copy = clone($board);
+                    # fill atack positions
+                    for my $i (0..M-1) {
+                        set($copy, $i, $r, $c);
+                        set($copy, $l, $i, $c);
+                        set($copy, $l, $r, $i);
+
+                        set($copy, $l, $r-$i, $c-$i);
+                        set($copy, $l, $r-$i, $c+$i);
+                        set($copy, $l, $r+$i, $c-$i);
+                        set($copy, $l, $r+$i, $c+$i);
+
+                        set($copy, $l-$i, $r, $c-$i);
+                        set($copy, $l-$i, $r, $c+$i);
+                        set($copy, $l+$i, $r, $c-$i);
+                        set($copy, $l+$i, $r, $c+$i);
+
+                        set($copy, $l-$i, $r-$i, $c);
+                        set($copy, $l-$i, $r+$i, $c);
+                        set($copy, $l+$i, $r-$i, $c);
+                        set($copy, $l+$i, $r+$i, $c);
+
+                        set($copy, $l-$i, $r-$i, $c-$i);
+                        set($copy, $l-$i, $r-$i, $c+$i);
+                        set($copy, $l-$i, $r+$i, $c-$i);
+                        set($copy, $l-$i, $r+$i, $c+$i);
+
+                        set($copy, $l+$i, $r-$i, $c-$i);
+                        set($copy, $l+$i, $r-$i, $c+$i);
+                        set($copy, $l+$i, $r+$i, $c-$i);
+                        set($copy, $l+$i, $r+$i, $c+$i);
+                    }
+                    # fill queen position
+                    $copy->[$l][$r][$c] = 'Q';
+                    #die dump($copy);
+                    # recurse
+                    place_queens($queens+1, $copy);
+                }
+            }
+        }
+    }
+    if ($full) {
+        if ($queens > $max_queens) {
+            $max_queens = $queens;
+            $max_board = clone($board);
+        }
+    }
+}
+
+sub set {
+    my($board, $l, $r, $c) = @_;
+    if ($l>=0 && $l<M &&
+        $r>=0 && $r<M &&
+        $c>=0 && $c<M) {
+        $board->[$l][$r][$c] = 1;
+    }
+}
diff --git a/challenge-062/paulo-custodio/t/test-1.yaml b/challenge-062/paulo-custodio/t/test-1.yaml
new file mode 100644
index 0000000000..c7b0d0efa9
--- /dev/null
+++ b/challenge-062/paulo-custodio/t/test-1.yaml
@@ -0,0 +1,33 @@
+- setup:
+  cleanup:
+  args:
+  input:    |
+            |name@example.org
+            |rjt@cpan.org
+            |abc@cpan.org
+            |Name@example.org
+            |rjt@CPAN.org
+            |user@alpha.example.org
+  output:   |
+            |user@alpha.example.org
+            |abc@cpan.org
+            |rjt@cpan.org
+            |rjt@CPAN.org
+            |Name@example.org
+            |name@example.org
+- setup:
+  cleanup:
+  args:     -u
+  input:    |
+            |name@example.org
+            |rjt@cpan.org
+            |abc@cpan.org
+            |Name@example.org
+            |rjt@CPAN.org
+            |user@alpha.example.org
+  output:   |
+            |user@alpha.example.org
+            |abc@cpan.org
+            |rjt@cpan.org
+            |Name@example.org
+            |name@example.org
diff --git a/challenge-062/paulo-custodio/t/test-2.yaml b/challenge-062/paulo-custodio/t/test-2.yaml
new file mode 100644
index 0000000000..0b213dc503
--- /dev/null
+++ b/challenge-062/paulo-custodio/t/test-2.yaml
@@ -0,0 +1,5 @@
+- setup:
+  cleanup:
+  args:
+  input:
+  output:   [[["Q", 1], [1, 1]], [[1, 1], [1, 1]]]