aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorThomas Köhler <jean-luc@picard.franken.de>2025-10-07 21:28:32 +0200
committerThomas Köhler <jean-luc@picard.franken.de>2025-10-07 21:28:32 +0200
commit804bb1571fa4e5bf6cbf661b21cbb3235d5afb53 (patch)
treebbd5347e9ca8b232248b4abc1381112cfa193075
parent37c0883e30e10f19f82ff9aa980fd4c347fb8601 (diff)
downloadperlweeklychallenge-club-804bb1571fa4e5bf6cbf661b21cbb3235d5afb53.tar.gz
perlweeklychallenge-club-804bb1571fa4e5bf6cbf661b21cbb3235d5afb53.tar.bz2
perlweeklychallenge-club-804bb1571fa4e5bf6cbf661b21cbb3235d5afb53.zip
Add solution 342
Signed-off-by: Thomas Köhler <jean-luc@picard.franken.de>
-rw-r--r--challenge-342/jeanluc2020/blog-1.txt1
-rw-r--r--challenge-342/jeanluc2020/blog-2.txt1
-rwxr-xr-xchallenge-342/jeanluc2020/perl/ch-1.pl94
-rwxr-xr-xchallenge-342/jeanluc2020/perl/ch-2.pl108
4 files changed, 204 insertions, 0 deletions
diff --git a/challenge-342/jeanluc2020/blog-1.txt b/challenge-342/jeanluc2020/blog-1.txt
new file mode 100644
index 0000000000..14859145a1
--- /dev/null
+++ b/challenge-342/jeanluc2020/blog-1.txt
@@ -0,0 +1 @@
+http://gott-gehabt.de/800_wer_wir_sind/thomas/Homepage/Computer/perl/theweeklychallenge-342-1.html
diff --git a/challenge-342/jeanluc2020/blog-2.txt b/challenge-342/jeanluc2020/blog-2.txt
new file mode 100644
index 0000000000..81973e60a5
--- /dev/null
+++ b/challenge-342/jeanluc2020/blog-2.txt
@@ -0,0 +1 @@
+http://gott-gehabt.de/800_wer_wir_sind/thomas/Homepage/Computer/perl/theweeklychallenge-342-2.html
diff --git a/challenge-342/jeanluc2020/perl/ch-1.pl b/challenge-342/jeanluc2020/perl/ch-1.pl
new file mode 100755
index 0000000000..c2841e3463
--- /dev/null
+++ b/challenge-342/jeanluc2020/perl/ch-1.pl
@@ -0,0 +1,94 @@
+#!/usr/bin/env perl
+# https://theweeklychallenge.org/blog/perl-weekly-challenge-342/#TASK1
+#
+# Task 1: Balance String
+# ======================
+#
+# You are given a string made up of lowercase English letters and digits only.
+#
+# Write a script to format the give string where no letter is followed by
+# another letter and no digit is followed by another digit. If there are
+# multiple valid rearrangements, always return the lexicographically smallest
+# one. Return empty string if it is impossible to format the string.
+#
+## Example 1
+##
+## Input: $str = "a0b1c2"
+## Output: "0a1b2c"
+#
+#
+## Example 2
+##
+## Input: $str = "abc12"
+## Output: "a1b2c"
+#
+#
+## Example 3
+##
+## Input: $str = "0a2b1c3"
+## Output: "0a1b2c3"
+#
+#
+## Example 4
+##
+## Input: $str = "1a23"
+## Output: ""
+#
+#
+## Example 5
+##
+## Input: $str = "ab123"
+## Output: "1a2b3"
+#
+############################################################
+##
+## discussion
+##
+############################################################
+#
+# First, we split $str into its parts. Then we pick all the digits
+# into one array and all characters into another one - both of these
+# arrays sorted. If one of the arrays is longer by more than 1 than
+# the other array, there is no solution, so we return the empty
+# string. Otherwise we take turns picking elements from each array.
+
+use v5.36;
+
+balance_string("a0b1c2");
+balance_string("abc12");
+balance_string("0a2b1c3");
+balance_string("1a23");
+balance_string("ab123");
+
+sub balance_string($str) {
+ say "Input: $str";
+
+ my @parts = split //, $str;
+ my @digits = sort grep { m/\d/ } @parts;
+ my @chars = sort grep { ! m/\d/ } @parts;
+ my (@first, @second);
+
+ my $d = scalar @digits;
+ my $c = scalar @chars;
+ my $result = "";
+
+ return say "Output: \"\"" if abs($d - $c) > 1;
+
+ # We pick the first element from the longer array first,
+ # or a digit if the arrays share the same length
+ if($d >= $c) {
+ @first = @digits;
+ @second = @chars;
+ } else {
+ @first = @chars;
+ @second = @digits;
+ }
+
+ # pick one element from each array
+ while(@first) {
+ $result .= shift @first;
+ $result .= shift @second if @second;
+ }
+
+ say "Output: $result";
+}
diff --git a/challenge-342/jeanluc2020/perl/ch-2.pl b/challenge-342/jeanluc2020/perl/ch-2.pl
new file mode 100755
index 0000000000..6db5b3734b
--- /dev/null
+++ b/challenge-342/jeanluc2020/perl/ch-2.pl
@@ -0,0 +1,108 @@
+#!/usr/bin/env perl
+# https://theweeklychallenge.org/blog/perl-weekly-challenge-342/#TASK2
+#
+# Task 2: Max Score
+# =================
+#
+# You are given a string, $str, containing 0 and 1 only.
+#
+# Write a script to return the max score after splitting the string into two
+# non-empty substrings. The score after splitting a string is the number of
+# zeros in the left substring plus the number of ones in the right substring.
+#
+## Example 1
+##
+## Input: $str = "0011"
+## Output: 4
+##
+## 1: left = "0", right = "011" => 1 + 2 => 3
+## 2: left = "00", right = "11" => 2 + 2 => 4
+## 3: left = "001", right = "1" => 2 + 1 => 3
+#
+#
+## Example 2
+##
+## Input: $str = "0000"
+## Output: 3
+##
+## 1: left = "0", right = "000" => 1 + 0 => 1
+## 2: left = "00", right = "00" => 2 + 0 => 2
+## 3: left = "000", right = "0" => 3 + 0 => 3
+#
+#
+## Example 3
+##
+## Input: $str = "1111"
+## Output: 3
+##
+## 1: left = "1", right = "111" => 0 + 3 => 3
+## 2: left = "11", right = "11" => 0 + 2 => 2
+## 3: left = "111", right = "1" => 0 + 1 => 1
+#
+#
+## Example 4
+##
+## Input: $str = "0101"
+## Output: 3
+##
+## 1: left = "0", right = "101" => 1 + 2 => 3
+## 2: left = "01", right = "01" => 1 + 1 => 2
+## 3: left = "010", right = "1" => 2 + 1 => 3
+#
+#
+## Example 5
+##
+## Input: $str = "011101"
+## Output: 5
+##
+## 1: left = "0", right = "11101" => 1 + 4 => 5
+## 2: left = "01", right = "1101" => 1 + 3 => 4
+## 3: left = "011", right = "101" => 1 + 2 => 3
+## 4: left = "0111", right = "01" => 1 + 1 => 2
+## 5: left = "01110", right = "1" => 2 + 1 => 3
+#
+############################################################
+##
+## discussion
+##
+############################################################
+#
+# We turn the string into an array of digits. Then we move
+# one digit after another to a second array, using these as
+# the left and right substrings. We calculate the score in
+# each step and keep the maximum.
+
+use v5.36;
+
+max_score("0011");
+max_score("0000");
+max_score("1111");
+max_score("0101");
+max_score("011101");
+
+sub max_score($str) {
+ say "Input: \"$str\"";
+ my $max = 0;
+ my @right = split //, $str;
+ my @left = ();
+
+ push @left, shift @right;
+ while(@right) {
+ my $s = score( \@left, \@right );
+ $max = $s if $s > $max;
+ push @left, shift @right;
+ }
+
+ say "Output: $max";
+}
+
+sub score ( $left, $right ) {
+ my $score = 0;
+ foreach my $elem (@$left) {
+ $score ++ if $elem == 0;
+ }
+ foreach my $elem (@$right) {
+ $score ++ if $elem == 1;
+ }
+ return $score;
+}