Challenge 109 solutions in Perl (translated from Raku)

2 files changed, 61 insertions, 0 deletions

diff --git a/challenge-109/brtastic/perl/ch-1.pl b/challenge-109/brtastic/perl/ch-1.pl
new file mode 100644
index 0000000000..5e39abfbe3
--- /dev/null
+++ b/challenge-109/brtastic/perl/ch-1.pl
@@ -0,0 +1,9 @@
+use v5.30;
+use warnings;
+use List::Util qw(sum0);
+
+for my $num (1 .. 20) {
+	say sum0 grep {
+		$num % $_ == 0
+	} 2 .. int($num / 2);
+}
diff --git a/challenge-109/brtastic/perl/ch-2.pl b/challenge-109/brtastic/perl/ch-2.pl
new file mode 100644
index 0000000000..d777e956b5
--- /dev/null
+++ b/challenge-109/brtastic/perl/ch-2.pl
@@ -0,0 +1,52 @@
+use v5.30;
+use warnings;
+use List::Util qw(all sum0);
+
+use constant EL_COUNT => 7;
+
+sub permute
+{
+	my (@what) = @_;
+
+	return [@what] if @what == 1;
+
+	my @options;
+
+	for my $el (@what) {
+		my $seen = 0;
+		push @options, map {
+			[$el, @$_]
+		} permute(grep {
+			$_ != $el || $seen++
+		} @what);
+	}
+
+	return @options;
+}
+
+sub four_squares
+{
+	my (@input) = @_;
+	my @results;
+
+	return @results if @input != EL_COUNT;
+
+	for my $case (permute @input) {
+		my @real_case = (0, @$case, 0);
+		my @summed_groups = map {
+			sum0 map { $real_case[$_] } $_ .. $_ + 2
+		} grep {
+			$_ % 2 == 0 && $_ <= @real_case - 2
+		} keys @real_case;
+
+		my $letter = 'a';
+		push @results, {map { $letter++, $_ } @$case}
+			if all { $_ == @summed_groups[0] } @summed_groups;
+	}
+
+	return @results;
+}
+
+use Data::Dumper;
+say Dumper([four_squares 1 .. 7]);
+