DAJ 321 blogged

3 files changed, 88 insertions, 0 deletions

diff --git a/challenge-321/dave-jacoby/blog.txt b/challenge-321/dave-jacoby/blog.txt
new file mode 100644
index 0000000000..e379140866
--- /dev/null
+++ b/challenge-321/dave-jacoby/blog.txt
@@ -0,0 +1 @@
+https://jacoby-lpwk.onrender.com/2025/05/15/decreasing-order-oddly-weekly-challenge-321.html
diff --git a/challenge-321/dave-jacoby/perl/ch-1.pl b/challenge-321/dave-jacoby/perl/ch-1.pl
new file mode 100644
index 0000000000..7248522cd8
--- /dev/null
+++ b/challenge-321/dave-jacoby/perl/ch-1.pl
@@ -0,0 +1,40 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+use experimental qw{ say state postderef signatures };
+
+my @examples = (
+
+    [ 1, 2, 4, 3, 5, 6 ],
+    [ 0, 2, 4, 8, 3, 5 ],
+    [ 7, 3, 1, 0, 5, 9 ],
+);
+
+for my $example (@examples) {
+    my $str    = join ', ', $example->@*;
+    my $output = distinct_average( $example->@* );
+    say <<"END";
+    Input:  \$str = ($str)
+    Output: $output
+END
+}
+
+sub distinct_average(@ints) {
+    # we're given an unsorted array but sorted would be more useful
+    # and we lose nothing 
+    @ints = sort { $a <=> $b } @ints;
+    my %output;
+    # we remove the highest and lowest (first and last)
+    # elements from a list, average them, and add the values 
+    # to a hash
+    while ( @ints ) {
+        my $min = shift @ints;
+        my $max = pop @ints;
+        my $avg = ( $min + $max ) / 2;
+        $output{$avg}++;
+    }
+    # we don't care about how many times each get used, 
+    # merely the count
+    return scalar keys %output;
+}
diff --git a/challenge-321/dave-jacoby/perl/ch-2.pl b/challenge-321/dave-jacoby/perl/ch-2.pl
new file mode 100644
index 0000000000..e6425f2fb8
--- /dev/null
+++ b/challenge-321/dave-jacoby/perl/ch-2.pl
@@ -0,0 +1,47 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+use experimental qw{ say state postderef signatures };
+
+use List::Util qw{ sum0 };
+
+my @examples = (
+
+    {
+        str1 => "ab#c",
+        str2 => "ad#c"
+    },
+    {
+        str1 => "ab##",
+        str2 => "a#b#"
+    },
+    {
+        str1 => "a#b",
+        str2 => "c"
+    },
+);
+
+for my $example (@examples) {
+    my $output = backspace_compare( $example );
+    say <<"END";
+    Input:  \$str1 = "$example->{str1}"
+            \$str2 = "$example->{str2}"
+    Output: $output
+END
+}
+
+sub backspace_compare ($obj) {
+    my $str1 = $obj->{str1};
+    my $str2 = $obj->{str2};
+    my $back1 = remove_backspaces($str1);
+    my $back2 = remove_backspaces($str2);
+    return $back1 eq $back2 ? 'true' : 'false';
+}
+
+sub remove_backspaces ( $str ) {
+    while ( $str =~ /\w\#/mx ){
+        $str =~ s/(\w\#)//mx;
+    }
+    return $str;
+}
\ No newline at end of file