From fd536aaa0a1df5ba426dc02b9d46f33a5503c68a Mon Sep 17 00:00:00 2001
From: Matthias Muth <matthias.muth@gmx.de>
Date: Mon, 20 Jan 2025 00:59:03 +0100
Subject: Challenge 304 Task 1 and 2 solutions in Perl by Matthias Muth

---
 challenge-304/matthias-muth/README.md    | 11 +++---
 challenge-304/matthias-muth/blog.txt     |  1 +
 challenge-304/matthias-muth/perl/ch-1.pl | 58 ++++++++++++++++++++++++++++++++
 challenge-304/matthias-muth/perl/ch-2.pl | 30 +++++++++++++++++
 4 files changed, 96 insertions(+), 4 deletions(-)
 create mode 100644 challenge-304/matthias-muth/blog.txt
 create mode 100755 challenge-304/matthias-muth/perl/ch-1.pl
 create mode 100755 challenge-304/matthias-muth/perl/ch-2.pl

diff --git a/challenge-304/matthias-muth/README.md b/challenge-304/matthias-muth/README.md
index c2c529d879..db806db41a 100644
--- a/challenge-304/matthias-muth/README.md
+++ b/challenge-304/matthias-muth/README.md
@@ -1,5 +1,8 @@
-**Challenge 303 solutions in Perl by Matthias Muth**
-<br/>
-(sorry, no blog post this week...)
+## The Weekly Challenge
+#### Week 304 solutions in Perl by Matthias Muth
 
-**Thank you for the challenge!**
+See my blog post
+[**Arrange Any Aligned Average (PWC 304)**](https://dev.to/muthm/arrange-any-aligned-average-34j2)
+describing my solutions for this week.
+
+#### Thank you for the challenge!
diff --git a/challenge-304/matthias-muth/blog.txt b/challenge-304/matthias-muth/blog.txt
new file mode 100644
index 0000000000..fbf7dcdf0a
--- /dev/null
+++ b/challenge-304/matthias-muth/blog.txt
@@ -0,0 +1 @@
+https://dev.to/muthm/arrange-any-aligned-average-34j2
diff --git a/challenge-304/matthias-muth/perl/ch-1.pl b/challenge-304/matthias-muth/perl/ch-1.pl
new file mode 100755
index 0000000000..afba70e22c
--- /dev/null
+++ b/challenge-304/matthias-muth/perl/ch-1.pl
@@ -0,0 +1,58 @@
+#!/usr/bin/env perl
+#
+#       The Weekly Challenge - Perl & Raku
+#       (https://theweeklychallenge.org)
+#
+#       Challenge 304 Task 1: Arrange Binary
+#
+#       Perl solution by Matthias Muth.
+#
+
+use v5.36;
+
+use Dsay;
+
+sub arrange_binary( $digits, $n ) {
+    my $string = join "", $digits->@*;
+    while ( $string =~ s/ (?<!1) 0 (?!1) /1/x ) {
+	--$n;
+    }
+    return $n <= 0;
+}
+
+use Test2::V0 qw( -no_srand );
+
+is arrange_binary( [1, 0, 0, 0, 1], 1 ), T,
+    'Example 1: arrange_binary( [1, 0, 0, 0, 1], 1 ) is true';
+is arrange_binary( [1, 0, 0, 0, 1], 2 ), F,
+    'Example 2: arrange_binary( [1, 0, 0, 0, 1], 2 ) is false';
+is arrange_binary( [], 0 ), T,
+    'Test 1: arrange_binary( [], 0 ) is true';
+is arrange_binary( [], 1 ), F,
+    'Test 2: arrange_binary( [], 1 ) is false';
+is arrange_binary( [ 0 ], 1 ), T,
+    'Test 3: arrange_binary( [ 0 ], 1 ) is true';
+is arrange_binary( [ 1 ], 1 ), F,
+    'Test 4: arrange_binary( [ 1 ], 1 ) is false';
+is arrange_binary( [ 0 ], 2 ), F,
+    'Test 5: arrange_binary( [ 0 ], 2 ) is false';
+is arrange_binary( [0, 0], 1 ), T,
+    'Test 6: arrange_binary( [0, 0], 1 ) is true';
+is arrange_binary( [0, 0], 2 ), F,
+    'Test 7: arrange_binary( [0, 0], 2 ) is false';
+is arrange_binary( [0, 1], 1 ), F,
+    'Test 8: arrange_binary( [0, 1], 1 ) is false';
+is arrange_binary( [0, 0, 0], 2 ), T,
+    'Test 9: arrange_binary( [0, 0, 0], 2 ) is true';
+is arrange_binary( [1, 0, 0], 1 ), T,
+    'Test 10: arrange_binary( [1, 0, 0], 1 ) is true';
+is arrange_binary( [0, 1, 0], 1 ), F,
+    'Test 11: arrange_binary( [0, 1, 0], 1 ) is false';
+is arrange_binary( [0, 0, 1], 1 ), T,
+    'Test 12: arrange_binary( [0, 0, 1], 1 ) is true';
+is arrange_binary( [0, 0, 0, 0, 0, 0], 3 ), T,
+    'Test 13: arrange_binary( [0, 0, 0, 0, 0], 3 ) is true';
+is arrange_binary( [0, 0, 0, 0, 0, 0], 4 ), F,
+    'Test 14: arrange_binary( [0, 0, 0, 0, 0], 4 ) is false';
+
+done_testing;
diff --git a/challenge-304/matthias-muth/perl/ch-2.pl b/challenge-304/matthias-muth/perl/ch-2.pl
new file mode 100755
index 0000000000..564b3d8ecf
--- /dev/null
+++ b/challenge-304/matthias-muth/perl/ch-2.pl
@@ -0,0 +1,30 @@
+#!/usr/bin/env perl
+#
+#       The Weekly Challenge - Perl & Raku
+#       (https://theweeklychallenge.org)
+#
+#       Challenge 304 Task 2: Maximum Average
+#
+#       Perl solution by Matthias Muth.
+#
+
+use v5.36;
+
+use List::Util qw( sum max );
+
+sub maximum_average( $ints, $n ) {
+    return max(
+	map sum( $ints->@[ $_ .. ( $_ + $n - 1 ) ] ),
+	    0 .. ( $ints->$#* - ( $n - 1 )  )
+    ) / $n;
+}
+
+use Test2::V0 qw( -no_srand );
+use Data::Dump qw( pp );
+
+is maximum_average( [1, 12, -5, -6, 50, 3], 4 ), 12.75,
+    'Example 1: maximum_average( [1, 12, -5, -6, 50, 3], 4 ) == 12.75';
+is maximum_average( [5], 1 ), 5,
+    'Example 2: maximum_average( [5], 1 ) == 5';
+
+done_testing;
-- 
cgit