Solve 203: Special Quadruplets & Copy Directory by E. Choroba

2 files changed, 79 insertions, 0 deletions

diff --git a/challenge-203/e-choroba/perl/ch-1.pl b/challenge-203/e-choroba/perl/ch-1.pl
new file mode 100755
index 0000000000..26c454c30a
--- /dev/null
+++ b/challenge-203/e-choroba/perl/ch-1.pl
@@ -0,0 +1,32 @@
+#!/usr/bin/perl
+use warnings;
+use strict;
+use experimental 'signatures';
+
+sub special_quadruplets(@arr) {
+    my $tally = 0;
+    for my $i (0 .. $#arr - 3) {
+        for my $j ($i + 1 .. $#arr - 2) {
+            for my $k ($j + 1 .. $#arr - 1) {
+                for my $l ($k + 1 .. $#arr) {
+                    next unless $arr[$i] + $arr[$j] + $arr[$k] == $arr[$l];
+                    ++$tally
+                }
+            }
+        }
+    }
+    return $tally
+}
+
+use Test::More tests => 3 + 1;
+
+is special_quadruplets(1, 2, 3, 6), 1, 'Example 1';
+is special_quadruplets(1, 1, 1, 3, 5), 4, 'Example 2';
+is special_quadruplets(3, 3, 6, 4, 5), 0, 'Example 3';
+
+is special_quadruplets(2, 13, 19, 16, 0, 9, 11, 1, 14, 17, 9, 18, 18,
+                       2, 5, 9, 7, 7, 3, 7, 10, 17, 1, 19, 10, 12, 13,
+                       14, 1, 3, 16, 15, 9, 15, 3, 9, 16, 15, 10, 2,
+                       12, 0, 0, 2, 14, 18, 11, 2, 5, 6),
+    1795,
+    'Long list';
diff --git a/challenge-203/e-choroba/perl/ch-2.pl b/challenge-203/e-choroba/perl/ch-2.pl
new file mode 100755
index 0000000000..fd3200db37
--- /dev/null
+++ b/challenge-203/e-choroba/perl/ch-2.pl
@@ -0,0 +1,47 @@
+#!/usr/bin/perl
+use warnings;
+use strict;
+use experimental qw{ signatures };
+
+use File::Find qw{ find };
+
+sub copy_directory($source, $target) {
+    my @dirs;
+    find({no_chdir => 1,
+          wanted   => sub {
+              push @dirs, $target . $_ =~ s/^$source//r
+                  if $_ ne $source && -d $_ }},
+         $source);
+    mkdir for @dirs;
+}
+
+sub prepare_env {
+    mkdir for qw( a a/b a/b/c x x/y ), map "a/b/c/$_", 1 .. 5;
+    open my $touch, '>', "a/b/c/$_/$_.txt" for qw( 1 2 3 5 );
+}
+
+sub cleanup {
+    0 == system 'rm -rf a x' or die $!;
+}
+
+use Test2::V0;
+plan 2;
+
+{   prepare_env();
+    copy_directory('a/b/c', 'x/y');
+    my @found;
+    find({wanted => sub { push @found, $_ unless /^\.{1,2}$/; }}, 'x/y');
+    is \@found, bag { item $_ for 1 .. 5 }, 'Example 1';
+    cleanup();
+}
+
+{   prepare_env();
+    copy_directory('a', 'x/y');
+    my @found;
+    find({no_chdir => 1,
+          wanted => sub { push @found, $_ }}, 'x/y/b/c');
+    is \@found, bag { item "x/y/b/c/$_" for 1 .. 5;
+                      item 'x/y/b/c'; },
+        'Recursion';
+    cleanup();
+}