Merge pull request #7935 from MatthiasMuth/muthm-212

Challenge 212 solutions in Perl by Matthias Muth

3 files changed, 102 insertions, 1 deletions

diff --git a/challenge-212/matthias-muth/README.md b/challenge-212/matthias-muth/README.md
index fe15f8d3d3..92c38a2191 100644
--- a/challenge-212/matthias-muth/README.md
+++ b/challenge-212/matthias-muth/README.md
@@ -1,4 +1,4 @@
-**Challenge 211 solutions in Perl by Matthias Muth**
+**Challenge 212 solutions in Perl by Matthias Muth**
 <br/>
 (no blog post this time...)
 
diff --git a/challenge-212/matthias-muth/perl/ch-1.pl b/challenge-212/matthias-muth/perl/ch-1.pl
new file mode 100755
index 0000000000..c4585b7002
--- /dev/null
+++ b/challenge-212/matthias-muth/perl/ch-1.pl
@@ -0,0 +1,37 @@
+#!/usr/bin/env perl
+#
+#       The Weekly Challenge - Perl & Raku
+#       (https://theweeklychallenge.org)
+#
+#       Challenge 212 Task 1: Jumping Letters
+#
+#       Perl solution by Matthias Muth.
+#
+
+use strict;
+use warnings;
+
+sub jumping_letters {
+    my ( $word, $jump ) = @_;
+
+    my $i = 0;
+    $word =~ s{([A-Z])|[a-z]}{
+        my $base = ord( $1 ? 'A' : 'a' );
+        chr( $base + ( ( ord( $& ) - $base ) + $jump->[$i++] ) % 26 );
+    }eg;
+    return $word;
+}
+
+
+use Test::More;
+use Data::Dump qw( pp );
+
+do {
+    is jumping_letters( @{$_->{INPUT}} ), $_->{EXPECTED},
+        "jumping_letters( " . pp( $_->{INPUT} ) . " ) == " . pp( $_->{EXPECTED} );
+} for (
+    { INPUT => [ "Perl", [ 2,22,19,9 ] ], EXPECTED => "Raku" },
+    { INPUT => [ "Raku", [ 24,4,7,17 ] ], EXPECTED => "Perl" },
+);
+
+done_testing;
diff --git a/challenge-212/matthias-muth/perl/ch-2.pl b/challenge-212/matthias-muth/perl/ch-2.pl
new file mode 100755
index 0000000000..9b5b26f2d0
--- /dev/null
+++ b/challenge-212/matthias-muth/perl/ch-2.pl
@@ -0,0 +1,64 @@
+#!/usr/bin/env perl
+#
+#       The Weekly Challenge - Perl & Raku
+#       (https://theweeklychallenge.org)
+#
+#       Challenge 212 Task 2: Rearrange Groups
+#
+#       Perl solution by Matthias Muth.
+#
+
+use strict;
+use warnings;
+use feature 'say';
+
+use Data::Dump qw( pp );
+use List::Util qw( min );
+
+sub rearrange_groups {
+    my ( $list, $size ) = @_;
+    my %available;
+
+    return -1
+        if @$list % $size != 0;
+
+    $available{$_}++
+        for @$list;
+
+    my @groups;
+    while ( %available ) {
+        push @groups, [];
+        my $first_element = min( keys %available );
+        for ( $first_element .. $first_element + $size - 1 ) {
+            return -1
+                unless $available{$_};
+            push @{$groups[-1]}, $_;
+            delete $available{$_}
+                if --$available{$_} == 0;
+        }
+    }
+    return \@groups;
+}
+
+use Test::More;
+
+do {
+    is_deeply rearrange_groups( @{$_->{INPUT}} ), $_->{EXPECTED},
+        "rearrange_groups(" . pp( @{$_->{INPUT}} )
+            . ") == " . pp( $_->{EXPECTED} );
+} for (
+    { TEST => "Example 1",
+      INPUT => [ [ 1,2,3,5,1,2,7,6,3 ], 3 ],
+      EXPECTED => [ [ 1,2,3 ], [ 1,2,3 ], [ 5,6,7 ] ] },
+    { TEST => "Example 2",
+      INPUT => [ [ 1,2,3 ], 2 ],
+      EXPECTED => -1 },
+    { TEST => "Example 3",
+      INPUT => [ [ 1,2,4,3,5,3 ], 3 ],
+      EXPECTED => [ [ 1,2,3 ], [ 3,4,5 ] ] },
+    { TEST => "Example 4",
+      INPUT => [ [ 1,5,2,6,4,7 ], 3 ],
+      EXPECTED => -1 },
+);
+
+done_testing;