From ef4e86518bc03c0948d8f5bc4245676269ce0c5b Mon Sep 17 00:00:00 2001
From: "E. Choroba" <choroba@matfyz.cz>
Date: Mon, 6 Oct 2025 11:46:02 +0200
Subject: Add solutions to 342: Balance String & Max Score by E. Choroba

---
 challenge-342/e-choroba/perl/ch-1.pl | 30 ++++++++++++++++++++++
 challenge-342/e-choroba/perl/ch-2.pl | 49 ++++++++++++++++++++++++++++++++++++
 2 files changed, 79 insertions(+)
 create mode 100755 challenge-342/e-choroba/perl/ch-1.pl
 create mode 100755 challenge-342/e-choroba/perl/ch-2.pl

diff --git a/challenge-342/e-choroba/perl/ch-1.pl b/challenge-342/e-choroba/perl/ch-1.pl
new file mode 100755
index 0000000000..88bbaf35dd
--- /dev/null
+++ b/challenge-342/e-choroba/perl/ch-1.pl
@@ -0,0 +1,30 @@
+#!/usr/bin/perl
+use warnings;
+use strict;
+use experimental qw( signatures );
+
+use List::MoreUtils qw{ part mesh };
+
+sub balance_string($str) {
+    my ($letters, $digits) = map [sort @{ $_ // [] }],
+                             part { tr/0-9// }
+                             split //, $str;
+    $_ //= [] for $letters, $digits;
+    return "" if abs(@$letters - @$digits) > 1;
+
+    my $cmp = @$letters <=> @$digits;
+    return join "", grep defined, 1 == $cmp ? mesh(@$letters, @$digits)
+                                            : mesh(@$digits, @$letters)
+}
+
+use Test::More tests => 5 + 3;
+
+is balance_string('a0b1c2'), '0a1b2c', 'Example 1';
+is balance_string('abc12'), 'a1b2c', 'Example 2';
+is balance_string('0a2b1c3'), '0a1b2c3', 'Example 3';
+is balance_string('1a23'), "", 'Example 4';
+is balance_string('ab123'), '1a2b3', 'Example 5';
+
+is balance_string(""), "", 'Empty input';
+is balance_string('1'), '1', 'Single digit';
+is balance_string('a'), 'a', 'Single char';
diff --git a/challenge-342/e-choroba/perl/ch-2.pl b/challenge-342/e-choroba/perl/ch-2.pl
new file mode 100755
index 0000000000..1eca7ba0ab
--- /dev/null
+++ b/challenge-342/e-choroba/perl/ch-2.pl
@@ -0,0 +1,49 @@
+#!/usr/bin/perl
+use warnings;
+use strict;
+use experimental qw( signatures );
+
+sub max_score($str) {
+    my $score = ('0' eq substr $str, 0, 1) + substr($str, 1) =~ tr/1//;
+    my $max_score = $score;
+    for my $char (split //, substr $str, 1, -1) {
+        $score += $char eq '0' ? 1 : -1;
+        $max_score = $score if $score > $max_score;
+    }
+    return $max_score
+}
+
+sub max_score_naive($str) {
+    my $max = 0;
+    for my $i (1 .. length($str) - 1) {
+        my $score = substr($str, 0, $i) =~ tr/0// + substr($str, $i) =~ tr/1//;
+        $max = $score if $score > $max;
+    }
+    return $max
+}
+
+use Test::More tests => 2 * 5 + 1;
+
+for my $max_score (\&max_score, \&max_score_naive) {
+    is $max_score->('0011'), 4, 'Example 1';
+    is $max_score->('0000'), 3, 'Example 2';
+    is $max_score->('1111'), 3, 'Example 3';
+    is $max_score->('0101'), 3, 'Example 4';
+    is $max_score->('011101'), 5, 'Example 5';
+}
+
+use Benchmark qw{ cmpthese };
+
+my $str = '101010101010001110101111';
+is max_score($str), max_score_naive($str), 'Same';
+
+cmpthese(-3, {
+    naive => sub { max_score_naive($str) },
+    opt   => sub { max_score($str) },
+});
+
+__END__
+
+          Rate naive   opt
+naive 189740/s    --  -42%
+opt   324620/s   71%    --
-- 
cgit