Merge pull request #8478 from jacoby/master

Late PR

8 files changed, 245 insertions, 0 deletions

diff --git a/challenge-211/dave-jacoby/perl/ch-1.pl b/challenge-211/dave-jacoby/perl/ch-1.pl
new file mode 100644
index 0000000000..7d11487056
--- /dev/null
+++ b/challenge-211/dave-jacoby/perl/ch-1.pl
@@ -0,0 +1,44 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+use experimental qw{ say postderef signatures state };
+
+use List::Util qw{ max sum uniq };
+
+my @examples = (
+
+    [ [ 4, 3, 2, 1 ], [ 5, 4, 3, 2 ], [ 6, 5, 4, 3 ], ],
+    [ [ 1, 2, 3 ], [ 3, 2, 1 ], ]
+);
+
+for my $e (@examples) {
+    my $pad    = ' ' x 26;
+    my $matrix = join "\n$pad", map { qq{[$_],} } map { join ', ', $_->@* }
+        grep { scalar $_->@* } $e->@*;
+    my $o = toeplitz($e);
+
+    say <<"END";
+    Input:  \@matrix =   [ $matrix 
+                        ]
+    Output: $o
+END
+}
+
+sub toeplitz ($array) {
+    for my $i ( 0 .. -1 + scalar $array->@* ) {
+        my $t = _toeplitz( $array, $i, 0, $array->[$i][0] );
+        return 'false' unless $t;
+    }
+    for my $i ( 1 .. -1 + scalar $array->[0]->@* ) {
+        my $t = _toeplitz( $array, 0, $i, $array->[0][$i] );
+        return 'false' unless $t;
+    }
+    return 'true';
+}
+
+sub _toeplitz ( $array, $x = 0, $y = 0, $v = 0 ) {
+    if ( !defined $array->[$x][$y] ) { return 1 }
+    if ( $array->[$x][$y] ne $v )    { return 0 }
+    return _toeplitz( $array, $x + 1, $y + 1, $v );
+}
diff --git a/challenge-211/dave-jacoby/perl/ch-2.pl b/challenge-211/dave-jacoby/perl/ch-2.pl
new file mode 100644
index 0000000000..1ba9d7ce26
--- /dev/null
+++ b/challenge-211/dave-jacoby/perl/ch-2.pl
@@ -0,0 +1,46 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+use experimental qw{ say postderef signatures state };
+
+use Algorithm::Permute;
+use Getopt::Long;
+use List::Util qw{ sum };
+
+my @examples = (
+
+    [ 1, 2, 3, 4, 5, 6, 7, 8 ],
+    [ 1, 3 ],
+
+);
+
+my $v = 0;
+GetOptions( 'verbose' => \$v, );
+
+for my $e (@examples) {
+    my $o = sse( $e->@* );
+    my $i = join ', ', $e->@*;
+
+    say <<"END";
+    Input:  \@list = ($i)
+    Output: $o
+END
+}
+
+sub sse (@array) {
+    my $permute = Algorithm::Permute->new( \@array );
+    while ( my @result = $permute->next ) {
+        for my $i ( 0 .. -2 + scalar @result ) {
+            my @a1  = @result[ 0 .. $i ];
+            my @a2  = @result[ $i + 1 .. -1 + scalar @result ];
+            my $av1 = ( sum @a1 ) / ( scalar @a1 );
+            my $av2 = ( sum @a2 ) / ( scalar @a2 );
+            say join "    ", $i, ( join ',', @a1 ), ( join ',', @a2 ), $av1,
+                $av2
+                if $v;
+            return 'true' if $av1 == $av2;
+        }
+    }
+    return 'false';
+}
diff --git a/challenge-227/dave-jacoby/blog.txt b/challenge-227/dave-jacoby/blog.txt
new file mode 100644
index 0000000000..0e391a293c
--- /dev/null
+++ b/challenge-227/dave-jacoby/blog.txt
@@ -0,0 +1 @@
+https://jacoby.github.io/2023/07/24/if-sept-seven-why-is-it-the-ninth-month-weekly-challenge-ccxxvii.html
diff --git a/challenge-227/dave-jacoby/perl/ch-1.pl b/challenge-227/dave-jacoby/perl/ch-1.pl
new file mode 100644
index 0000000000..bf3f29e656
--- /dev/null
+++ b/challenge-227/dave-jacoby/perl/ch-1.pl
@@ -0,0 +1,44 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+use experimental qw{ say postderef signatures state };
+
+use DateTime;
+
+my @examples = (
+    1753,
+    1800,
+    1900,
+    2000,
+    2009, 
+    2023,
+    2100,
+    3000,
+    4000,
+    9000,
+    9999
+);
+
+for my $year (@examples) {
+    my $count = find_friday13s($year);
+    say <<~"END";
+    Input:  \$year = $year
+    Output: $count
+    END
+}
+
+sub find_friday13s ($year) {
+    my $count = 0;
+    my @months;
+    for my $month ( 1 .. 12 ) {
+        my $dt = DateTime->now();
+        $dt->set_year($year);
+        $dt->set_day(13);
+        $dt->set_month($month);
+        $count++ if $dt->day_of_week == 5;
+        push @months, $month if $dt->day_of_week == 5;
+
+    }
+    return $count;
+}
diff --git a/challenge-227/dave-jacoby/perl/ch-2.pl b/challenge-227/dave-jacoby/perl/ch-2.pl
new file mode 100644
index 0000000000..5a1c3617f7
--- /dev/null
+++ b/challenge-227/dave-jacoby/perl/ch-2.pl
@@ -0,0 +1,38 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+use experimental qw{ say postderef signatures state };
+
+use Roman;
+
+my @examples = (
+    "IV + V",
+    "M - I",
+    "X / II",
+    "XI * VI",
+    "VII ** III",
+    "V - V",
+    "V / II",
+    "MMM + M",
+    "V - X",
+);
+
+for my $e (@examples) {
+    my $pad = ' ' x (10 - length $e);
+    my $output = roman_maths($e);
+    print <<~"END";
+    $e $pad => $output
+    END
+}
+
+sub roman_maths ($equation) {
+    my ( $first, $expression, $second ) = split /\s+/mx, $equation;
+    my ( $f, $s ) = map { arabic($_) } $first, $second;
+    my $arabic = eval( join ' ', $f, $expression, $s );
+    my $roman = Roman($arabic);
+    $roman = undef if $arabic =~ /\./mx;
+    return $roman if defined $roman && $arabic > 0;
+    return 'nulla' if $arabic == 0;
+    return 'non potest' ;
+}
diff --git a/challenge-228/dave-jacoby/blog.txt b/challenge-228/dave-jacoby/blog.txt
new file mode 100644
index 0000000000..2b1a2630d8
--- /dev/null
+++ b/challenge-228/dave-jacoby/blog.txt
@@ -0,0 +1 @@
+https://jacoby.github.io/2023/07/31/get-sum-weekly-challenge-228.html
diff --git a/challenge-228/dave-jacoby/perl/ch-1.pl b/challenge-228/dave-jacoby/perl/ch-1.pl
new file mode 100644
index 0000000000..4996d31312
--- /dev/null
+++ b/challenge-228/dave-jacoby/perl/ch-1.pl
@@ -0,0 +1,32 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+use experimental qw{ say postderef signatures state };
+
+use List::Util qw( sum0 );
+
+my @examples = (
+
+    [ 2, 1, 3, 2 ],
+    [ 1, 1, 1, 1 ],
+    [ 2, 1, 3, 4 ],
+);
+
+for my $e (@examples) {
+    my @array = $e->@*;
+    my $array = join ', ', @array;
+    my $sum   = uniq_sum(@array);
+    say <<~"END";
+    Input:  \@int = ($array)
+    Output: $sum
+    END
+}
+
+sub uniq_sum (@array) {
+    my %hash;
+    for my $int (@array) {
+        $hash{$int}++;
+    }
+    return sum0 grep { $hash{$_} == 1 } keys %hash;
+}
diff --git a/challenge-228/dave-jacoby/perl/ch-2.pl b/challenge-228/dave-jacoby/perl/ch-2.pl
new file mode 100644
index 0000000000..512108a149
--- /dev/null
+++ b/challenge-228/dave-jacoby/perl/ch-2.pl
@@ -0,0 +1,39 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+use experimental qw{ say postderef signatures state };
+
+use List::Util qw( min );
+
+my @examples = (
+
+    [ 3, 4, 2 ],
+    [ 1, 2, 3 ],
+
+);
+
+for my $e (@examples) {
+    my @array  = $e->@*;
+    my $array  = join ', ', @array;
+    my $output = empty_array(@array);
+    say <<~"END";
+    Input:  \@int = ($array)
+    Output: $output
+    END
+}
+
+# if the first element is the smallest
+#     then remove it
+# else
+#     move it to the end
+sub empty_array (@array) {
+    my $c = 0;
+    while ( scalar @array ) {
+        my $min  = min @array;
+        my $next = shift @array;
+        if ( $min != $next ) { push @array, $next; }
+        $c++;
+    }
+    return $c;
+}