Merge pull request #10911 from jacoby/master

286 (late) and 288 (incomplete) DAJ

4 files changed, 185 insertions, 0 deletions

diff --git a/challenge-286/dave-jacoby/perl/ch-1.pl b/challenge-286/dave-jacoby/perl/ch-1.pl
new file mode 100644
index 0000000000..8cc7bda72d
--- /dev/null
+++ b/challenge-286/dave-jacoby/perl/ch-1.pl
@@ -0,0 +1,14 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+use experimental qw{ postderef say signatures state };
+
+my $name = $0;
+my $file = '';
+if ( open my $fh, '<', $name ) {
+    $file = join '', <$fh>;
+    my @file = split /\s+/, $file;
+    say $file[ rand scalar @file ] ;
+}
+else { exit }
diff --git a/challenge-286/dave-jacoby/perl/ch-2.pl b/challenge-286/dave-jacoby/perl/ch-2.pl
new file mode 100644
index 0000000000..dda5e3b848
--- /dev/null
+++ b/challenge-286/dave-jacoby/perl/ch-2.pl
@@ -0,0 +1,49 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+use experimental qw{ say state postderef signatures };
+
+use List::Util qw{ min max };
+
+my @examples = (
+
+    [ 2, 1, 4, 5, 6, 3, 0, 2 ],
+    [ 0, 5, 3, 2 ],
+    [ 9, 2, 1, 4, 5, 6, 0, 7, 3, 1, 3, 5, 7, 9, 0, 8 ],
+
+);
+
+for my $example (@examples) {
+    my $output = order_game($example);
+    my $input  = join ', ', $example->@*;
+    say <<"END";
+    Input:  \$ints = ($input)
+    Output: $output
+END
+}
+
+sub order_game ($ref) {
+    my @ints = $ref->@*;
+    my @output;
+
+    while ( scalar @ints > 1 ) {
+        if ( scalar @ints ) {
+            my @cmp;
+            push @cmp,    shift @ints;
+            push @cmp,    shift @ints;
+            push @output, min @cmp;
+        }
+        if ( scalar @ints ) {
+            my @cmp;
+            push @cmp,    shift @ints;
+            push @cmp,    shift @ints;
+            push @output, max @cmp;
+        }
+        if ( scalar @ints == 0  && scalar @output > 1 ) {
+            @ints =  @output;
+            @output = ();
+        }
+    }
+    return shift @output;
+}
diff --git a/challenge-288/dave-jacoby/blog.txt b/challenge-288/dave-jacoby/blog.txt
new file mode 100644
index 0000000000..72277adb0b
--- /dev/null
+++ b/challenge-288/dave-jacoby/blog.txt
@@ -0,0 +1 @@
+https://jacoby-lpwk.onrender.com/2024/09/26/return-of-the-son-of-this-looks-like-a-job-for-recursion-weekly-challenge-288.html
diff --git a/challenge-288/dave-jacoby/perl/ch-2.pl b/challenge-288/dave-jacoby/perl/ch-2.pl
new file mode 100644
index 0000000000..c89d570bc2
--- /dev/null
+++ b/challenge-288/dave-jacoby/perl/ch-2.pl
@@ -0,0 +1,121 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+use experimental qw{ say state postderef signatures };
+
+use List::Util qw{ min max };
+
+my @examples = (
+
+    [
+        [ 'x', 'x', 'x', 'x', 'o' ],
+        [ 'x', 'o', 'o', 'o', 'o' ],
+        [ 'x', 'o', 'o', 'o', 'o' ],
+        [ 'x', 'x', 'x', 'o', 'o' ],
+    ],
+    [
+        [ 'x', 'x', 'x', 'x', 'x' ],
+        [ 'x', 'o', 'o', 'o', 'o' ],
+        [ 'x', 'x', 'x', 'x', 'o' ],
+        [ 'x', 'o', 'o', 'o', 'o' ],
+    ],
+    [
+        [ 'x', 'x', 'x', 'o', 'o' ],
+        [ 'o', 'o', 'o', 'x', 'x' ],
+        [ 'o', 'x', 'x', 'o', 'o' ],
+        [ 'o', 'o', 'o', 'x', 'x' ],
+    ]
+
+);
+
+# create a larger random matrix
+my $random;
+for my $i ( 0 .. 9 ) {
+    for my $j ( 0 .. 9 ) {
+        $random->[$i][$j] = int rand 2 ? 'x' : 'o';
+    }
+}
+push @examples, $random;
+
+for my $example (@examples) {
+    my $input  = display_matrix($example);
+    my $output = contiguous_block($example);
+    say <<"END";
+    Input:  \$matrix = [
+          $input
+        ]
+    Output: $output
+END
+}
+
+sub contiguous_block ($matrix) {
+    my @list;
+    for my $x ( 0 .. -1 + scalar $matrix->@* ) {
+        for my $y ( 0 .. -1 + scalar $matrix->[$x]->@* ) {
+            my $array = [];
+            push $array->@*, [ $x, $y ];
+            push @list,      _contiguous_block( $matrix, $array );
+        }
+    }
+    return max @list;
+}
+
+sub _contiguous_block ( $matrix, $array ) {
+    my $maxx   = scalar $matrix->@*;
+    my $maxy   = scalar $matrix->[0]->@*;
+    my $firstx = $array->[0][0];
+    my $firsty = $array->[0][1];
+    my $firstv = $matrix->[$firstx][$firsty];
+    my @output;
+    my ( $x, $y ) = $array->[-1]->@*;
+    my @map;
+    map { $map[ $_->[0] ][ $_->[1] ] = 1 } $array->@*;
+
+    #  no diagonals, only left right up and down
+    my @ij = ( [ 0, 1 ], [ 0, -1 ], [ 1, 0 ], [ -1, 0 ], );
+    for my $ij (@ij) {
+        my ( $i, $j ) = @$ij;
+        my $xx = $i + $x;
+        my $yy = $j + $y;
+
+        # keep X in bounds
+        next if $xx < 0;
+        next if $xx >= $maxx;
+
+        # keep Y in bounds
+        next if $yy < 0;
+        next if $yy >= $maxy;
+
+        # don't double-count
+        next if defined $map[$xx][$yy];
+
+        # make sure we're following the right character
+        my $kk = defined $map[$xx][$yy] ? 1 : 0;
+        my $vv = $matrix->[$xx][$yy];
+        next if $vv ne $firstv;
+
+        my $new_array = [];
+        push $new_array->@*, $array->@*;
+        push $new_array->@*, [ $xx, $yy ];
+        push @output,        _contiguous_block( $matrix, $new_array );
+    }
+
+    # if there are functions that returned, meaning this
+    # isn't a final position
+    if ( scalar @output ) {
+        return @output;
+    }
+
+    # if there are no returning functions, meaning this
+    # IS a final position
+    else {
+        return scalar @$array;
+    }
+}
+
+sub display_matrix ($matrix) {
+    return join ",\n          ", map {
+        join ' ', '[', ( join ', ', map { qq{'$_'} } $_->@* ), ']'
+    } $matrix->@*;
+}