diff options
| author | Thomas Köhler <jean-luc@picard.franken.de> | 2025-10-07 21:28:32 +0200 |
|---|---|---|
| committer | Thomas Köhler <jean-luc@picard.franken.de> | 2025-10-07 21:28:32 +0200 |
| commit | 804bb1571fa4e5bf6cbf661b21cbb3235d5afb53 (patch) | |
| tree | bbd5347e9ca8b232248b4abc1381112cfa193075 | |
| parent | 37c0883e30e10f19f82ff9aa980fd4c347fb8601 (diff) | |
| download | perlweeklychallenge-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.txt | 1 | ||||
| -rw-r--r-- | challenge-342/jeanluc2020/blog-2.txt | 1 | ||||
| -rwxr-xr-x | challenge-342/jeanluc2020/perl/ch-1.pl | 94 | ||||
| -rwxr-xr-x | challenge-342/jeanluc2020/perl/ch-2.pl | 108 |
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; +} |
