Merge pull request #8408 from jacoby/master

DAJ #226

3 files changed, 62 insertions, 0 deletions

diff --git a/challenge-226/dave-jacoby/blog.txt b/challenge-226/dave-jacoby/blog.txt
new file mode 100644
index 0000000000..d41ec6bbd1
--- /dev/null
+++ b/challenge-226/dave-jacoby/blog.txt
@@ -0,0 +1 @@
+https://jacoby.github.io/2023/07/18/shuffle-off-to-buffalo-weekly-challenge-226.html
diff --git a/challenge-226/dave-jacoby/perl/ch-1.pl b/challenge-226/dave-jacoby/perl/ch-1.pl
new file mode 100644
index 0000000000..b2288357f6
--- /dev/null
+++ b/challenge-226/dave-jacoby/perl/ch-1.pl
@@ -0,0 +1,30 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+use experimental qw{ say postderef signatures state };
+
+my @examples = (
+    [ 'lacelengh', [ 3, 2, 0, 5, 4, 8, 6, 7, 1 ] ],
+    [ 'rulepark',  [ 4, 7, 3, 1, 0, 5, 2, 6 ] ]
+);
+
+for my $example (@examples) {
+    my $string = $example->[0];
+    my $indices = join ',', $example->[1]->@*;
+    my $output = reorder_string( $example->[0], $example->[1] );
+    say <<~"END";
+    Input:  \$string = '$string', \@indices = ($indices)
+    Output: '$output'
+    END
+}
+
+sub reorder_string ( $input, $indices ) {
+    my $output = ' ' x length $input;
+    my $c = 0;
+    for my $i ( $indices->@* ) {
+        substr( $output, $i, 1 ) = substr( $input, $c, 1 );
+        $c++;
+    }
+    return $output;
+}
diff --git a/challenge-226/dave-jacoby/perl/ch-2.pl b/challenge-226/dave-jacoby/perl/ch-2.pl
new file mode 100644
index 0000000000..ac9dfe74a5
--- /dev/null
+++ b/challenge-226/dave-jacoby/perl/ch-2.pl
@@ -0,0 +1,31 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+use experimental qw{ say postderef signatures state };
+
+use List::Util qw{ sum sum0 min max };
+
+my @examples = ( [ 1, 5, 0, 3, 5 ], [0], [ 2, 1, 4, 0, 3 ], );
+
+for my $e (@examples) {
+    my $input  = join ',', $e->@*;
+    my $output = zero_array( $e->@* );
+    say <<~"END";
+    Input:  \@ints = ($input)
+    Output: $output
+    END
+}
+
+sub zero_array( @ints ) {
+    my $c = -1;
+    while (1) {
+        $c++;
+        my $min = min grep { $_ > 0 } @ints;
+        $min //= 0;
+        @ints = map { $_ - $min > 0 ? $_ - $min : 0 } @ints;
+        last if $min == 0;
+        last if $c > 10;
+    }
+    return $c;
+}