Merge pull request #9722 from MatthiasMuth/muthm-259

Challenge 256 Perl Solutions by Matthias Muth

6 files changed, 510 insertions, 87 deletions

diff --git a/challenge-259/matthias-muth/README.md b/challenge-259/matthias-muth/README.md
index 05da216c90..e5cbc4eea2 100644
--- a/challenge-259/matthias-muth/README.md
+++ b/challenge-259/matthias-muth/README.md
@@ -1,89 +1,6 @@
-# You Only Grep Twice
+## The Weekly Challenge
+## Solutions in Perl by Matthias Muth
 
-**Challenge 258 solutions in Perl by Matthias Muth**
-
-## Task 1: Count Even Digits Number
-
-> You are given a array of positive integers, @ints.<br/>
-> Write a script to find out how many integers have even number of digits.<br/>
-> <br/>
-> Example 1<br/>
-> Input: @ints = (10, 1, 111, 24, 1000)<br/>
-> Output: 3<br/>
-> There are 3 integers having even digits i.e. 10, 24 and 1000.<br/>
-> <br/>
-> Example 2<br/>
-> Input: @ints = (111, 1, 11111)<br/>
-> Output: 0<br/>
-> <br/>
-> Example 3<br/>
-> Input: @ints = (2, 8, 1024, 256)<br/>
-> Output: 1<br/>
-
-This is a small exercise for using `grep`.<br/>
-We go through all values in the `@ints` array. For each value, we get the number of digits using the `length` function. Perl's type flexibility and implicit type conversion helps us here, in that the `length` returns the number of characters of the current value *as a string*.
-
-We then check whether this number is even, using this as a filter for `grep`. 
-
-When called in scalar context,  `grep` returns the number of values that fulfill the criteria, not the list of values itself. As we are only interested in this number, we call  `grep` in scalar context explicitly, and we are done.
-
-Long explanation, short code:
-
-```perl
-use v5.36;
-sub count_even_digits_number( @ints ) {
-    return scalar grep length( $_ ) % 2 == 0, @ints;
-}
-```
-
-## Task 2: Sum of Values
-
-> You are given an array of integers, @int and an integer \$k.<br/>
-> Write a script to find the sum of values whose index binary representation has exactly \$k number of 1-bit set.<br/>
-> <br/>
-> Example 1<br/>
-> Input: @ints = (2, 5, 9, 11, 3), \$k = 1<br/>
-> Output: 17<br/>
-> Binary representation of index 0 = 0<br/>
-> Binary representation of index 1 = 1<br/>
-> Binary representation of index 2 = 10<br/>
-> Binary representation of index 3 = 11<br/>
-> Binary representation of index 4 = 100<br/>
-> So the indices 1, 2 and 4 have total one 1-bit sets.<br/>
-> Therefore the sum, \$ints[1] + \$ints[2] + \$ints[3] = 17<br/>
-> <br/>
-> Example 2<br/>
-> Input: @ints = (2, 5, 9, 11, 3), \$k = 2<br/>
-> Output: 11<br/>
-> <br/>
-> Example 3<br/>
-> Input: @ints = (2, 5, 9, 11, 3), \$k = 0<br/>
-> Output: 2<br/>
-
-This looks very similar. We also can use `grep`to select the values that we process further.<br/>
-But after reading the task again, and also checking the examples, we notice that in the filter, we don't use the numbers in the array, but the *index* of the numbers.
-
-So what we do is to use `grep` again, but this time, we go through all indexes instead of the values, filtering on the number of 1-bits that the index has, and then `map`the filtered indexes back to their array values. Then we can `sum` up those values.
-
-For getting the number of 1-bits in an integer number, probably the most efficient way is to use `unpack` with a `'%'` field prefix to do a checksum of the packed binary representation of our number (see examples in [perldoc](https://perldoc.perl.org/functions/unpack)). So for numbers at least up to 32 bits, this function does a marvelous job:
-
-```perl
-use v5.36;
-sub n_bits( $n ) {
-    return unpack "%b*", pack "i", $n;
-}
-```
-
-(`use v5.36;` is the shortest way to get function prototypes, which I don't want to miss.)
-
-The rest is straightforward:
-
-```perl
-use List::Util qw( sum );
-sub sum_of_values( $ints, $k ) {
-    return sum map $ints->[$_], grep n_bits( $_ ) == $k, 0..$ints->$#*;
-}
-```
-
-#### **Thank you for the challenge!**
+See [here](perl/#readme) for a blog post describing this week's solutions.
 
+#### Thank you for the challenge!
diff --git a/challenge-259/matthias-muth/blog.txt b/challenge-259/matthias-muth/blog.txt
new file mode 100644
index 0000000000..2921b9f3d9
--- /dev/null
+++ b/challenge-259/matthias-muth/blog.txt
@@ -0,0 +1 @@
+https://github.com/MatthiasMuth/perlweeklychallenge-club/tree/muthm-259/challenge-259/matthias-muth/perl/#readme
diff --git a/challenge-259/matthias-muth/perl/README.md b/challenge-259/matthias-muth/perl/README.md
new file mode 100644
index 0000000000..90a3471b4d
--- /dev/null
+++ b/challenge-259/matthias-muth/perl/README.md
@@ -0,0 +1,236 @@
+# I Have a Date With a Parser
+
+**Challenge 259 solutions in Perl by Matthias Muth**
+
+Aha!<br/>This week's challenges are quite a bit more 'challenging' than many other recent ones!<br/>
+Very nice!
+
+Let's see!
+
+## Task 1: Banking Day Offset
+
+> You are given a start date and offset counter. Optionally you also get bank holiday date list.<br/>
+> Given a number (of days) and a start date, return the number (of days) adjusted to take into account non-banking days. In other words: convert a banking day offset to a calendar day offset.<br/>
+> Non-banking days are:<br/>
+> a) Weekends<br/>
+> b) Bank holidays<br/>
+> <br/>
+> Example 1<br/>
+> Input: \$start_date = '2018-06-28', \$offset = 3, \$bank_holidays = ['2018-07-03']<br/>
+> Output: '2018-07-04'<br/>
+> Thursday bumped to Wednesday (3 day offset, with Monday a bank holiday)<br/>
+><br/>
+> Example 2<br/>
+> Input: \$start_date = '2018-06-28', \$offset = 3<br/>
+> Output: '2018-07-03'<br/>
+
+I am going to use the `Time::Piece` module here, which is a core module,
+and which gives me easy access to weekday information for the dates we will be working with.
+I will also use `Time::Seconds`,
+for using constants like `ONE_DAY` (actually only for that one).
+
+So we start like this: 
+
+```perl
+#!/usr/bin/env perl
+use v5.36;
+use Time::Piece;
+use Time::Seconds;
+```
+The reason I use Perl 5.36 explicitly is to have all the nice things like
+`strict`, `warnings`, and `feature signatures`
+without needing to list all of them. In this challenge, I also find good use of 'chained comparisons', which have been available since Perl 5.32.
+
+I declare some own constants, so that I can refer to some selected `Time::Piece::wday` weekday numbers symbolically:
+
+```perl
+# Time::Piece::wday starts with 1 == Sunday.
+use constant { WDAY_SUNDAY => 1, WDAY_MONDAY => 2, WDAY_FRIDAY => 6,
+               WDAY_SATURDAY => 7 };
+```
+
+Now let's go pushing dates around.<br/>
+If the original starting date is on a Saturday or Sunday, we move it back to
+Friday. This avoids jumping too far when we skip over Saturdays and
+Sundays later.
+We don't need to adjust `$offset` when we do that, because for any of Friday,
+Saturday and Sunday, an offset of 1 (for example) will result in the same following Monday.
+
+```perl
+    $start_date -=
+        $start_date->wday == WDAY_SATURDAY ? 1 * ONE_DAY :
+        $start_date->wday == WDAY_SUNDAY   ? 2 * ONE_DAY : 0;
+```
+
+Now we calculate the Monday of the working week that our starting date is in.
+Doing this so that later,
+we can increment week-wise by seven calendar days
+for every five banking days in `$offset`
+to skip over weekends.<br/>
+To compensate for this shift backwards,
+here we do need to increase the 'offset' by the number of days we shifted.
+
+```perl
+    my $days_from_monday = $start_date->wday - WDAY_MONDAY;
+    my $start_monday = $start_date - $days_from_monday * ONE_DAY;
+    $offset += $days_from_monday;
+```
+Now we can do the end date calculation.<br/>
+We don't loop over each single day, but we skip over `$offset` days in one go,
+plus two weekend days for every full five banking days:
+
+```perl
+    my $end_date = $start_monday
+        + $offset * ONE_DAY
+        + int( $offset / 5 ) * 2 * ONE_DAY;
+```
+
+We still need to shift by one day for each banking holiday between the starting and ending date.
+
+We can ignore banking holidays that are on weekends, because we have skipped over the weekends already.
+So we only consider banking holidays that are on Monday to Friday.
+
+We need to be careful not to end on the weekend when we move the ending date forward.
+We therefore add three days instead of one when the current ending date is on a Friday, to end up on the following Monday.
+
+We go through the bank holidays one by one.
+Assuming that they are ordered, we are safe even when
+there are several of them in a row at the end of our time period,
+because we push the end date forward *before* considering the next bank holiday to be within our time span.
+
+```perl
+    for ( $bank_holidays->@* ) {
+        my $bank_holiday = Time::Piece->strptime( $_, "%Y-%m-%d" );
+        if ( $start_date <= $bank_holiday <= $end_date
+            && WDAY_MONDAY <= $bank_holiday->wday <= WDAY_FRIDAY )
+        {
+            $end_date += ( $end_date->wday == WDAY_FRIDAY ? 3 : 1 ) * ONE_DAY;
+        }
+    }
+```
+Now that this is done we are good to return the computed end date, in ISO (YYYY-MM-DD) text form.
+```perl
+    return $end_date->ymd;
+}
+```
+
+Nice challenge!
+
+## Task 2: Line Parser
+
+> You are given a line like below:
+>
+> ```
+> {%  id   field1="value1"    field2="value2"  field3=42 %}
+> ```
+>
+> Where
+>
+> ```
+> a) "id" can be \w+.
+> b) There can be 0  or more field-value pairs.
+> c) The name of the fields are \w+.
+> b) The values are either number in which case we don't need double quotes or string in
+>    which case we need double quotes around them.
+> ```
+>
+> The line parser should return structure like below:
+>
+> ```
+> {
+>        name => id,
+>        fields => {
+>            field1 => value1,
+>            field2 => value2,
+>            field3 => value3,
+>        }
+> }
+> ```
+>
+> It should be able to parse the following edge cases too:
+>
+> ```
+> {%  youtube title="Title \"quoted\" done" %}
+> ```
+>
+> **and**
+>
+> ```
+> {%  youtube title="Title with escaped backslash \\" %}
+> ```
+>
+> **BONUS**: Extend it to be able to handle multiline tags:
+>
+> ```
+> {% id  filed1="value1" ... %}
+> LINES
+> {% endid %}
+> ```
+>
+> You should expect the following structure from your line parser:
+>
+> ```
+> {
+>        name => id,
+>        fields => {
+>            field1 => value1,
+>            field2 => value2,
+>            field3 => value3,
+>        }
+>        text => LINES
+> }
+> ```
+
+Now this is a good challenge, too!
+
+One reason why I love Perl is that regular expressions are an integral part of the language. Happy to use regular expressions here!
+
+Let's start by defining some regexes for the input tokens that we will encounter.<br/>I will make use of 'named captures' to refer to recognized parts of the input by name, not just by the capture group numbers.
+Hoping that this helps to make the code less cryptic.
+
+I built the captures right into the token regexes, mainly because when we read 'quoted text', we only want the contents of the quoted strings, without the quotes. So the capturing parentheses have to be somewhere *inside* the regex.
+
+I use the same capture name `<value>` for both numbers and the text from a 'quoted text' token, because in the end, for assigning the value to the resulting structure, it doesn't matter whether it's a number or a text. (Hail Perl's dynamic typing!)
+
+The 'quoted text' regex takes care for accepting escaped backslashes, escaped double quotes, or any other character that is not the (closing) double quote.
+
+The regex for the whole structure captures all field assignments into one capture, which will then be split up and processed separately.<br/>It optionally accepts multi-line text and an end tag.<br/>The multi-line text uses a negative lookahead to end when the start of a tag (`{%`)  is encountered.<br/>The end tag has to contain 'end' and the same id that was used in the opening tag, using a named back-reference (`\g{name}`) .
+
+```perlcounting the 
+my $id_re          = qr/ (?<id>    \w+ ) /x;
+my $number_re      = qr/ (?<value> \d+ ) /x;
+my $quoted_text_re = qr/ " (?<value> (?: \\\\ | \\" | [^"] )* ) " /x;
+my $value_re       = qr/ ${number_re} | ${quoted_text_re} /x;
+my $structure_re   = qr/
+        {% \s* (?<name> $id_re )
+            (?<fields> (?: \s* $id_re = $value_re )* )
+        \s* %}
+        (?: \s* (?<text> (?: (?! {% ) . )*? )
+            \s* {% \s* end\g{name} \s* %} )?
+    /xs;
+
+```
+
+Having these tokens, the `line_parser`function simply can use the 'structure' regex to scan the input, and if it successfully matches, create the structure from the captured parts and return it.
+
+Part of this is looping through the variable number of field assignments, and turning quoted backslashes and quoted double quotes in the values into their unquoted equivalents.
+
+```perl
+sub line_parser( $text ) {
+    $text =~ /$structure_re/
+        or return;
+    my %structure = ( name => $+{name} );
+    $structure{text} = $+{text}
+        if defined $+{text};
+    my $fields = $+{fields};
+    while ( $fields =~ /$id_re=$value_re/g ) {
+        my ( $id, $value ) = @+{ qw( id value ) };
+        # Revert quoted backslashes or double quotes.
+        $value =~ s/\\([\\"])/$1/g;
+        $structure{fields}{$id} = $value;
+    }
+    return \%structure;
+}
+```
+
+#### **Thank you for the challenge!**
diff --git a/challenge-259/matthias-muth/perl/ch-1.pl b/challenge-259/matthias-muth/perl/ch-1.pl
new file mode 100755
index 0000000000..93b5861fa0
--- /dev/null
+++ b/challenge-259/matthias-muth/perl/ch-1.pl
@@ -0,0 +1,107 @@
+#!/usr/bin/env perl
+#
+#       The Weekly Challenge - Perl & Raku
+#       (https://theweeklychallenge.org)
+#
+#       Challenge 259 Task 1: Banking Day Offset
+#
+#       Perl solution by Matthias Muth.
+#
+
+use v5.36;
+use Data::Dump qw( pp );
+
+use Time::Piece;
+use Time::Seconds;
+
+# Time::Piece::wday starts with 1 == Sunday.
+use constant { WDAY_SUNDAY => 1, WDAY_MONDAY => 2, WDAY_FRIDAY => 6,
+	       WDAY_SATURDAY => 7 };
+
+sub banking_day_offset( $start_date, $offset, $bank_holidays = [] ) {
+    # Turn start date into a Time::Piece object.
+    $start_date = Time::Piece->strptime( $start_date, "%Y-%m-%d" );
+    say "start_date: ", $start_date->ymd, " (", $start_date->wdayname, ")",
+	" offset: $offset";
+
+    # If the original starting date is a Saturday or Sunday, we move it back to
+    # Friday. This avoids jumping too far when we skip over Saturdays and
+    # Sundays later.
+    # This is not relevant for the 'offset' (because for all of Friday,
+    # Saturday and Sunday, an offset of 1 (for example) will result in the
+    # following Monday).
+    $start_date -=
+	$start_date->wday == WDAY_SATURDAY ? 1 * ONE_DAY :
+	$start_date->wday == WDAY_SUNDAY   ? 2 * ONE_DAY : 0;
+
+    # Now we calculate the beginning of the working week (Monday), so that
+    # later, we can increment weekwise by seven calendar days for every five
+    # banking days in 'offset', skipping over the weekends.
+    # Of course we need to increase the 'offset' by the number of days we
+    # shifted to compensate for this.
+    my $days_from_monday = $start_date->wday - WDAY_MONDAY;
+    my $start_monday = $start_date - $days_from_monday * ONE_DAY;
+    $offset += $days_from_monday;
+
+    # For getting the (preliminary) resulting date we add 'offset' number of
+    # days, plus 2 weekend days for every full 5 banking days.
+    my $end_date = $start_monday
+	+ $offset * ONE_DAY
+	+ int( $offset / 5 ) * 2 * ONE_DAY;
+    say "end_date: ", $end_date->ymd;
+
+    # We still need to add days for the bank holidays that occur between the
+    # original start date and the end date, if they are not on a Saturday or
+    # Sunday.
+    # We add one day for each relevant bank holiday, or three days if we are
+    # on a Friday, for skipping over the weekend.
+    # Assuming that the bank holidays are ordered, we are safe even when
+    # there are several of them in a row at the end of our time period,
+    # because we push the end date forward *before* processing the next bank
+    # holiday.
+    for ( $bank_holidays->@* ) {
+	my $bank_holiday = Time::Piece->strptime( $_, "%Y-%m-%d" );
+	if ( $start_date <= $bank_holiday <= $end_date
+	    && WDAY_MONDAY <= $bank_holiday->wday <= WDAY_FRIDAY )
+	{
+	    say "skipping over ", $bank_holiday->ymd, " bank holiday";
+	    $end_date += ( $end_date->wday == WDAY_FRIDAY ? 3 : 1 ) * ONE_DAY;
+	    say "end_date: ", $end_date->ymd;
+	}
+    }
+
+    return $end_date->ymd;
+}
+
+use Test2::V0 qw( -no_srand );
+
+# My own tests:
+my @tests = (
+    [ "2018-06-30", 1, [], "2018-07-02" ],
+    [ "2018-06-31", 1, [], "2018-07-02" ],
+    [ "2018-07-01", 1, [], "2018-07-02" ],
+    [ "2018-06-28", 0, [], "2018-06-28" ],
+    [ "2018-06-28", 1, [], "2018-06-29" ],
+    [ "2018-06-28", 2, [], "2018-07-02" ],
+    [ "2018-06-28", 3, [], "2018-07-03" ],
+    [ "2018-06-28", 4, [], "2018-07-04" ],
+    [ "2018-06-28", 5, [], "2018-07-05" ],
+    [ "2018-06-28", 6, [], "2018-07-06" ],
+    [ "2018-06-28", 7, [], "2018-07-09" ],
+    [ "2018-06-28", 8, [], "2018-07-10" ],
+    [ "2018-06-28", 9, [], "2018-07-11" ],
+    [ "2018-06-28", 1, [ "2018-06-29" ], "2018-07-02" ],
+);
+for ( 0..$#tests ) {
+    my ( $start_date, $offset, $bank_holidays, $expected ) = $tests[$_]->@*;
+    is banking_day_offset( $start_date, $offset, $bank_holidays ), $expected,
+	"Test $_: banking_day_offset( \"$start_date.', $offset, "
+	    . pp( $bank_holidays ) . " ) => \"$expected\"";
+}
+
+# Examples from the challenge:
+is banking_day_offset( "2018-06-28", 3, ["2018-07-03"] ), "2018-07-04",
+    'Example 1: banking_day_offset( "2018-06-28", 3, ["2018-07-03"] ) => "2018-07-04"';
+is banking_day_offset( "2018-06-28", 3 ), "2018-07-03",
+    'Example 2: banking_day_offset( "2018-06-28", 3 ) => "2018-07-03"';
+done_testing;
diff --git a/challenge-259/matthias-muth/perl/ch-2.pl b/challenge-259/matthias-muth/perl/ch-2.pl
new file mode 100755
index 0000000000..b58a23878f
--- /dev/null
+++ b/challenge-259/matthias-muth/perl/ch-2.pl
@@ -0,0 +1,77 @@
+#!/usr/bin/env perl
+#
+#       The Weekly Challenge - Perl & Raku
+#       (https://theweeklychallenge.org)
+#
+#       Challenge 259 Task 2: Line Parser
+#
+#       Perl solution by Matthias Muth.
+#
+
+use v5.36;
+
+my $id_re          = qr/ (?<id>    \w+ ) /x;
+my $number_re      = qr/ (?<value> \d+ ) /x;
+my $quoted_text_re = qr/ " (?<value> (?: \\\\ | \\" | [^"] )* ) " /x;
+my $value_re       = qr/ ${number_re} | ${quoted_text_re} /x;
+my $structure_re   = qr/
+        {% \s* (?<name> $id_re )
+            (?<fields> (?: \s* $id_re = $value_re )* )
+        \s* %}
+        (?: \s* (?<text> (?: (?! {% ) . )*? )
+            \s* {% \s* end\g{name} \s* %} )?
+    /xs;
+
+sub line_parser( $text ) {
+    $text =~ /$structure_re/
+        or return;
+    my %structure = ( name => $+{name} );
+    $structure{text} = $+{text}
+        if defined $+{text};
+    my $fields = $+{fields};
+    while ( $fields =~ /$id_re=$value_re/g ) {
+        my ( $id, $value ) = @+{ qw( id value ) };
+        # Revert quoted backslashes or double quotes.
+        $value =~ s/\\([\\"])/$1/g;
+        $structure{fields}{$id} = $value;
+    }
+    return \%structure;
+}
+
+use Test2::V0 -no_srand => 1;
+is line_parser( '{%  id   field1="value1"    field2="value2"  field3=42 %}' ),
+    {
+      name => "id",
+      fields => {
+          field1 => "value1",
+          field2 => "value2",
+          field3 => 42
+      },
+    },
+    "Example 1";
+is line_parser( '{%  youtube title="Title \"quoted\" done" %}' ),
+    {
+      name => "youtube",
+      fields => {
+          title => "Title \"quoted\" done",
+      },
+    },
+    "Example 2";
+is line_parser( '{%  youtube title="Title with escaped backslash \\" %}' ),
+    {
+      name => "youtube",
+      fields => {
+          title => "Title with escaped backslash \\",
+      },
+    },
+    "Example 3";
+is line_parser( "{% id  filed1=\"value1\" %}\nLINES\n{% endid %}" ),
+    {
+      name => "id",
+      fields => {
+          filed1 => "value1",
+      },
+      text => "LINES",
+    },
+    "Multiline example";
+done_testing;
diff --git a/challenge-259/matthias-muth/perl/challenge-259.txt b/challenge-259/matthias-muth/perl/challenge-259.txt
new file mode 100644
index 0000000000..1b9547249b
--- /dev/null
+++ b/challenge-259/matthias-muth/perl/challenge-259.txt
@@ -0,0 +1,85 @@
+The Weekly Challenge - 259
+Monday, Mar 4, 2024
+
+
+Task 1: Banking Day Offset
+Submitted by: Lee Johnson
+
+You are given a start date and offset counter. Optionally you also get bank holiday date list.
+Given a number (of days) and a start date, return the number (of days) adjusted to take into account non-banking days. In other words: convert a banking day offset to a calendar day offset.
+Non-banking days are:
+a) Weekends
+b) Bank holidays
+
+Example 1
+
+Input: $start_date = '2018-06-28', $offset = 3, $bank_holidays = ['2018-07-03']
+Output: '2018-07-04'
+
+Thursday bumped to Wednesday (3 day offset, with Monday a bank holiday)
+
+Example 2
+
+Input: $start_date = '2018-06-28', $offset = 3
+Output: '2018-07-03'
+
+
+Task 2: Line Parser
+Submitted by: Gabor Szabo
+
+You are given a line like below:
+
+{%  id   field1="value1"    field2="value2"  field3=42 %}
+
+
+Where
+a) "id" can be \w+.
+b) There can be 0  or more field-value pairs.
+c) The name of the fields are \w+.
+b) The values are either number in which case we don't need double quotes or string in
+   which case we need double quotes around them.
+
+
+The line parser should return structure like below:
+
+{
+       name => id,
+       fields => {
+           field1 => value1,
+           field2 => value2,
+           field3 => value3,
+       }
+}
+
+
+It should be able to parse the following edge cases too:
+
+{%  youtube title="Title \"quoted\" done" %}
+
+
+and
+
+{%  youtube title="Title with escaped backslash \\" %}
+
+
+BONUS: Extend it to be able to handle multiline tags:
+
+{% id  filed1="value1" ... %}
+LINES
+{% endid %}
+
+
+You should expect the following structure from your line parser:
+
+{
+       name => id,
+       fields => {
+           field1 => value1,
+           field2 => value2,
+           field3 => value3,
+       }
+       text => LINES
+}
+
+
+Last date to submit the solution 23:59 (UK Time) Sunday 10th March 2024.