Merge pull request #7900 from jo-37/contrib

Solutions to challenge 212

2 files changed, 136 insertions, 0 deletions

diff --git a/challenge-212/jo-37/perl/ch-1.pl b/challenge-212/jo-37/perl/ch-1.pl
new file mode 100755
index 0000000000..7a0874a083
--- /dev/null
+++ b/challenge-212/jo-37/perl/ch-1.pl
@@ -0,0 +1,60 @@
+#!/usr/bin/perl -s
+
+use v5.20;
+use Test2::V0;
+use List::MoreUtils qw(zip6);
+use experimental qw(signatures);
+
+our ($tests, $examples);
+
+run_tests() if $tests || $examples;	# does not return
+
+die <<EOS unless @ARGV;
+usage: $0 [-examples] [-tests] [WORD J1 J2...]
+
+-examples
+    run the examples from the challenge
+ 
+-tests
+    run some tests
+
+WORD
+    base word
+
+J1 J2...
+    jump steps for each letter in WORD
+
+EOS
+
+
+### Input and Output
+
+say jump_letters(@ARGV);
+
+
+### Implementation
+
+sub jump_letters ($word, @jump) {
+	join '', map {
+        my $base = ord($_->[0] ge 'a' ? 'a' : 'A');
+        chr($base + (ord($_->[0]) - $base + $_->[1]) % 26)
+    } &zip6([split //, $word], \@jump);
+}
+
+
+### Examples and tests
+
+sub run_tests {
+    SKIP: {
+        skip "examples" unless $examples;
+        is jump_letters('Perl', 2, 22, 19, 9), 'Raku', 'example 1';
+        is jump_letters('Raku', 24, 4, 7, 17), 'Perl', 'example 2';
+    }
+
+    SKIP: {
+        skip "tests" unless $tests;
+	}
+
+    done_testing;
+    exit;
+}
diff --git a/challenge-212/jo-37/perl/ch-2.pl b/challenge-212/jo-37/perl/ch-2.pl
new file mode 100755
index 0000000000..2b6efb6728
--- /dev/null
+++ b/challenge-212/jo-37/perl/ch-2.pl
@@ -0,0 +1,76 @@
+#!/usr/bin/perl -s
+
+use v5.24;
+use Test2::V0;
+use List::Util 'min';
+use List::UtilsBy 'extract_first_by';
+
+our ($tests, $examples);
+
+run_tests() if $tests || $examples;	# does not return
+
+die <<EOS unless @ARGV;
+usage: $0 [-examples] [-tests] [SIZE N...]
+
+-examples
+    run the examples from the challenge
+ 
+-tests
+    run some tests
+
+SIZE
+    subgroup size
+
+N...
+    list of numbers
+
+EOS
+
+
+### Input and Output
+
+main: {
+    my $r = rearrange(@ARGV);
+    local $" = ',';
+    local $, = ',';
+    say $r ? map "(@$_)", @$r : -1;
+}
+
+
+### Implementation
+
+sub rearrange {
+    my $size = shift;
+    my @res;
+    while (@_) {
+        push @res, [];
+        my $min = min @_;
+        for my $i ($min .. $min + $size - 1) {
+            push $res[-1]->@*, extract_first_by {$_ == $i} @_;
+        }
+        return if $res[-1]->@* != $size;
+    }
+    \@res;
+}
+
+
+### Examples and tests
+
+sub run_tests {
+    SKIP: {
+        skip "examples" unless $examples;
+
+        is rearrange(3, 1,2,3,5,1,2,7,6,3), [[1, 2, 3], [1, 2, 3], [5, 6, 7]],
+            'example 1';
+        is rearrange(2, 1,2,3), U(), 'example 2';
+        is rearrange(3, 1,2,4,3,5,3), [[1, 2, 3], [3, 4, 5]], 'example 3';
+        is rearrange(3, 1,5,2,6,4,7), U(), 'example 4';
+    }
+
+    SKIP: {
+        skip "tests" unless $tests;
+	}
+
+    done_testing;
+    exit;
+}