Merge pull request #4173 from PerlBoy1967/branch-for-challenge-115

Task 1 & 2

2 files changed, 100 insertions, 0 deletions

diff --git a/challenge-115/perlboy1967/perl/ch-1.pl b/challenge-115/perlboy1967/perl/ch-1.pl
new file mode 100755
index 0000000000..55ceac0064
--- /dev/null
+++ b/challenge-115/perlboy1967/perl/ch-1.pl
@@ -0,0 +1,45 @@
+#!/usr/bin/perl
+
+# Perl Weekly Challenge - 115
+# - https://perlweeklychallenge.org/blog/perl-weekly-challenge-115/#TASK1
+#
+# Task 1 - String Chain
+#
+# Author: Niels 'PerlBoy' van Dijke
+
+use v5.16;
+use strict;
+use warnings;
+
+use Algorithm::Combinatorics qw(permutations);
+
+use Test::More;
+
+is(isStringChain(qw(abc dea cd )), 1);
+is(isStringChain(qw(ade cbd fgh)), 0);
+is(isStringChain(qw(ab bc ca bb)), 1);
+is(isStringChain(qw(ab cd da bd)), 0);
+is(isStringChain(qw(abba adda acca axxa)), 1);
+is(isStringChain(qw(the weekly challenge)), 0);
+
+done_testing;
+
+sub isStringChain {
+  my (@l) = @_;
+
+  # We only need the first and last char
+  map { s/^(.).*?(.)$/$1$2/ } @l;
+
+  # Build regexp
+  my $re = qr '^(.)'.join('',map {"(.)\\$_"} (2 .. scalar @l)).'\\1$';
+
+  my $iter = permutations(\@l);
+  while (my $ar = $iter->next()) {
+    if (join('',@$ar) =~ m#$re#) {
+      return 1;
+    }
+  }
+
+  return 0;
+}
+
diff --git a/challenge-115/perlboy1967/perl/ch-2.pl b/challenge-115/perlboy1967/perl/ch-2.pl
new file mode 100755
index 0000000000..0479a67e23
--- /dev/null
+++ b/challenge-115/perlboy1967/perl/ch-2.pl
@@ -0,0 +1,55 @@
+#!/usr/bin/perl
+
+# Perl Weekly Challenge - 115
+# - https://perlweeklychallenge.org/blog/perl-weekly-challenge-115/#TASK2
+#
+# Task 2 - Largest Multiple
+#
+# Author: Niels 'PerlBoy' van Dijke
+
+use v5.16;
+use strict;
+use warnings;
+
+use List::MoreUtils qw(firstidx);
+
+use Test::More;
+
+# Prototype(s)
+sub largestMultiple(\@);
+
+my %tests = (
+    6210 => [1, 0, 2, 6],
+    8412 => [1, 4, 2, 8],
+    7614 => [4, 1, 7, 6], 
+      -1 => [1, 3, 5, 7], 
+  872112 => [1, 1, 2, 2, 8, 7], 
+);
+
+foreach my $test (sort keys %tests) {
+  is(largestMultiple(@{$tests{$test}}), $test);
+}
+
+done_testing;
+
+sub largestMultiple(\@) {
+  my ($ar) = @_;
+
+  my @d = sort @$ar;
+
+  # Smallest digit is odd?
+  if ($d[0] % 2 == 1) {
+    # find index of smallest even digit
+    my $sEidx = firstidx { $_ % 2 == 0 } @d;
+    # Can we swap?
+    if ($sEidx >= 0) {
+      ($d[0],$d[$sEidx]) = ($d[$sEidx], $d[0]);
+    } else {
+      # wrong input delivered
+      return -1;
+    }
+  }
+
+  return join('',reverse @d);
+}
+