From 719f3312f68de8fea734f85a157fbf202e9539e2 Mon Sep 17 00:00:00 2001 From: PerlMonk-Athanasius Date: Sun, 10 Mar 2024 23:19:39 +1000 Subject: Perl & Raku solutions to Task 1, & Perl solution to Task 2, for Week 259 --- challenge-259/athanasius/perl/ch-1.pl | 277 +++++++++++++++++++++++++ challenge-259/athanasius/perl/ch-2.pl | 347 ++++++++++++++++++++++++++++++++ challenge-259/athanasius/raku/ch-1.raku | 247 +++++++++++++++++++++++ 3 files changed, 871 insertions(+) create mode 100644 challenge-259/athanasius/perl/ch-1.pl create mode 100644 challenge-259/athanasius/perl/ch-2.pl create mode 100644 challenge-259/athanasius/raku/ch-1.raku diff --git a/challenge-259/athanasius/perl/ch-1.pl b/challenge-259/athanasius/perl/ch-1.pl new file mode 100644 index 0000000000..b7fad8f390 --- /dev/null +++ b/challenge-259/athanasius/perl/ch-1.pl @@ -0,0 +1,277 @@ +#!perl + +################################################################################ +=comment + +Perl Weekly Challenge 259 +========================= + +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' + +=cut +################################################################################ + +#--------------------------------------# +# Copyright © 2024 PerlMonk Athanasius # +#--------------------------------------# + +#=============================================================================== +=comment + +Assumptions +----------- +1. Offsets are non-negative. +2. If the start date is a non-banking day, offset 0 is the first banking day + after the start date. + +Interface +--------- +1. If no command-line arguments are given, the test suite is run. Otherwise: +2. The first command-line argument is a starting date, represented by a string + in the format "YYYY-MM-DD" (ISO 8601). +3. The second command-line argument is an unsigned integer offset. +4. The third command-line argument is optional. If present, it is a string com- + prising "YYYY-MM-DD" strings representing the dates of bank holidays. These + date strings are separated by whitespace and/or commas. + +=cut +#=============================================================================== + +use v5.32.1; # Enables strictures +use warnings; +use Const::Fast; +use DateTime; +use List::Util qw( none ); +use Regexp::Common qw( number ); +use Test::More; +use Try::Tiny; + +const my $SATURDAY => 6; +const my $USAGE => < [] + perl $0 + + Start date in 'YYYY-MM-DD' format + Non-negative offset in days + [] Optional string: list of bank holiday dates +END + +#------------------------------------------------------------------------------- +BEGIN +#------------------------------------------------------------------------------- +{ + $| = 1; + print "\nChallenge 259, Task #1: Banking Day Offset (Perl)\n\n"; +} + +#=============================================================================== +MAIN: +#=============================================================================== +{ + my $argc = scalar @ARGV; + + if ($argc == 0) + { + run_tests(); + } + elsif ($argc == 1) + { + error( 'Expected 0, 2, or 3 command-line arguments, found 1' ); + } + elsif (2 <= $argc <= 3) + { + command_line_main(); + } + else + { + error( "Expected 0, 2, or 3 command-line arguments, found $argc" ); + } +} + +#------------------------------------------------------------------------------- +sub command_line_main +#------------------------------------------------------------------------------- +{ + my ($start_date, $offset, $bank_holidays) = @ARGV; + my @holiday_strs; + + if (defined $bank_holidays) + { + @holiday_strs = split / [,\s]+ /x, $bank_holidays; + + printf "Input: \$start_date = '$start_date'\n" . + " \$offset = $offset\n" . + " \@bank_holidays = [%s]\n\n", + join ', ', map { "'$_'" } @holiday_strs; + } + else + { + print "Input: \$start_date = '$start_date'\n" . + " \$offset = $offset\n\n"; + } + + my ($start, $holiday_dates) = + parse_command_line( $start_date, $offset, $bank_holidays ); + + my $day = find_banking_day( $start, $offset, $holiday_dates ); + + printf "Output: '%s'\n", $day->ymd; +} + +#------------------------------------------------------------------------------- +sub find_banking_day +#------------------------------------------------------------------------------- +{ + my ($start_date, $offset, $bank_holidays) = @_; + + my $day = $start_date; + + # 1. Advance, if necessary, to the first banking day ("day zero") + + $day->add( days => 1 ) until is_banking_day( $day, $bank_holidays ); + + # 2. Advance (a further) $offset number of banking days + + for (my $count = $offset; $count > 0;) + { + --$count if is_banking_day( $day->add( days => 1 ), $bank_holidays ); + } + + return $day; +} + +#------------------------------------------------------------------------------- +sub is_banking_day +#------------------------------------------------------------------------------- +{ + my ($date, $bank_holidays) = @_; + + return $date->day_of_week < $SATURDAY && # Monday to Friday + none { $_->ymd eq $date->ymd } @$bank_holidays; # Not a bank holiday +} + +#------------------------------------------------------------------------------- +sub parse_command_line +#------------------------------------------------------------------------------- +{ + my ($start_date_str, $offset, $bank_holidays) = @_; + + my $start_date = parse_date( $start_date_str ); + + $offset =~ / ^ $RE{num}{int} $ /x + or error( qq["$offset" is not a valid integer] ); + + $offset >= 0 or error( 'Offset is negative' ); + + my @holidays; + + for (split / [,\s]+ /x, $bank_holidays // '') + { + push @holidays, parse_date( $_ ); + } + + return ($start_date, \@holidays); +} + +#------------------------------------------------------------------------------- +sub parse_date +#------------------------------------------------------------------------------- +{ + my ($date_str) = @_; + my $date; + + $date_str =~ / ^ (\d{4}) - (\d{2}) - (\d{2}) $ /x + or error( qq[Invalid date string "$date_str"] ); + + try + { + $date = DateTime->new( year => $1, month => $2, day => $3 ); + } + catch + { + error( qq[Date validation failed for "$date_str"] ); + }; # <-- The semicolon is required by Try::Tiny + + return $date; +} + +#------------------------------------------------------------------------------- +sub run_tests +#------------------------------------------------------------------------------- +{ + print "Running the test suite\n"; + + while (my $line = ) + { + chomp $line; + + my ($test_name, $start_str, $offset, $holidays_str, $expected_str) = + split / \| /x, $line; + + for ($test_name, $start_str, $offset, $holidays_str, $expected_str) + { + s/ ^ \s+ //x; + s/ \s+ $ //x; + } + + my ($start, $holidays) = + parse_command_line( $start_str, $offset, $holidays_str ); + + my $day = find_banking_day( $start, $offset, $holidays ); + my $expected = parse_date( $expected_str ); + + is $day, $expected, $test_name; + } + + done_testing; +} + +#------------------------------------------------------------------------------- +sub error +#------------------------------------------------------------------------------- +{ + my ($message) = @_; + + die "ERROR: $message\n$USAGE"; +} + +################################################################################ + +__DATA__ +Example 1 |2018-06-28|3|2018-07-03 |2018-07-04 +Example 2 |2018-06-28|3| |2018-07-03 +2 holidays |2018-06-28|3|2018-07-03 2018-07-04|2018-07-05 +Zero offset 1|2018-06-28|0| |2018-06-28 +Zero offset 2|2018-06-28|0|2018-06-28 |2018-06-29 +Zero offset 3|2018-06-30|0| |2018-07-02 +Weekend start|2018-06-30|1| |2018-07-03 +Holiday start|2018-06-28|1|2018-06-28 |2018-07-02 diff --git a/challenge-259/athanasius/perl/ch-2.pl b/challenge-259/athanasius/perl/ch-2.pl new file mode 100644 index 0000000000..18ac96c7e4 --- /dev/null +++ b/challenge-259/athanasius/perl/ch-2.pl @@ -0,0 +1,347 @@ +#!perl + +################################################################################ +=comment + +Perl Weekly Challenge 259 +========================= + +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 + } + +=cut +################################################################################ + +#--------------------------------------# +# Copyright © 2024 PerlMonk Athanasius # +#--------------------------------------# + +#=============================================================================== +=comment + +Interface +--------- +1. If no command-line arguments are given, the test suite is run. Otherwise: +2. A single command-line argument specifies the (path and) filename of the file + from which the input data is to be read. + +Assumptions and Notes +--------------------- +1. Within fields, "number" values are integers. +2. Within fields, "string" values do not contain control codes. +3. Non-record lines are silently ignored. +4. The BONUS has not been attempted. + +=cut +#=============================================================================== + +use v5.32.1; # Enables strictures +use warnings; +use Const::Fast; +use Regexp::Common qw( number ); +use Test::More; + +use Data::Dump; + +const my $BS_CODE => chr 1; +const my $QU_CODE => chr 2; +const my $USAGE => < + perl $0 + + Filename of the input data +END + +#------------------------------------------------------------------------------- +BEGIN +#------------------------------------------------------------------------------- +{ + $| = 1; + print "\nChallenge 259, Task #2: Line Parser (Perl)\n\n"; +} + +#=============================================================================== +MAIN: +#=============================================================================== +{ + my $argc = scalar @ARGV; + + if ($argc == 0) + { + run_tests(); + } + elsif ($argc == 1) + { + my $file = $ARGV[ 0 ]; + + open( my $fh, '<', $file ) + or error( qq[Can't open file "$file" for reading] ); + + my $records = parse_lines( $fh ); + my $number = 1; + + for my $record (@$records) + { + if (defined $record) + { + print "\n" if $number > 1; + print "Record $number\n"; + print_record( $record ); + ++$number; + } + } + + close $fh or die qq[Can't close file "$file"\n]; + } + else + { + error( "Expected 0 or 1 command-line arguments, found $argc" ); + } +} + +#------------------------------------------------------------------------------- +sub parse_lines +#------------------------------------------------------------------------------- +{ + my ($fh) = @_; + my @records; + + while (my $line = <$fh>) + { + if ($line =~ / ^ \s* \{ \% \s+ (\w+) (?: \s+ (.*) )? \s+ \% \} \s* $ /x) + { + my %record; + + $record{ name } = $1; + + if (my $fields = $2) + { + $fields =~ s/ \\ \\ /$BS_CODE/gx; + $fields =~ s/ \\ \" /$QU_CODE/gx; + + while ($fields) + { + $fields = parse_field( $fields, \%record ); + $fields =~ s/ ^ \s+ //gx; + } + } + + push @records, { %record }; + } + else + { + push @records, undef; # Required for testing + } + } + + return \@records; +} + +#------------------------------------------------------------------------------- +sub parse_field +#------------------------------------------------------------------------------- +{ + my ($fields, $record) = @_; + my $field_length = 0; + + if ($fields =~ / ^ (\w+) \= ($RE{num}{int}) /x) + { + my ($name, $number) = ($1, $2); + + push $record->{ fields }->@*, [ $name => $number ]; + + $field_length = length "$name=$number"; + } + elsif ($fields =~ / ^ (\w+) \= \" (.*?) \" /x) + { + my ($name, $string) = ($1, $2); + + $string =~ s/ $BS_CODE /\\/gx; + $string =~ s/ $QU_CODE /"/gx; + + push $record->{ fields }->@*, [ $name => $string ]; + + $field_length = length qq[$name="$string"]; + } + else + { + die qq[Invalid field in "$fields"]; + } + + substr $fields, 0, $field_length, ''; + + return $fields; +} + +#------------------------------------------------------------------------------- +sub print_record +#------------------------------------------------------------------------------- +{ + my ($record) = @_; + + print "{\n"; + printf " name => %s\n", $record->{ name }; + print " fields =>\n"; + print " {\n"; + + for my $field (@{ $record->{ fields } }) + { + my $key = $field->[ 0 ]; + my $value = $field->[ 1 ]; + + if ($value =~ / ^ $RE{num}{int} $ /x) + { + print qq[ $key => $value\n]; + } + else + { + print qq[ $key => "$value"\n]; + } + } + + print " }\n"; + print "}\n"; +} + +#------------------------------------------------------------------------------- +sub run_tests +#------------------------------------------------------------------------------- +{ + print "Running the test suite\n"; + + my $records = parse_lines( *DATA ); + + for my $i (1 .. 6) + { + my $expected = get_expected( $i ); + + is_deeply $records->[ $i - 1 ], $expected, "Test $i"; + } + + done_testing; +} + +#------------------------------------------------------------------------------- +sub error +#------------------------------------------------------------------------------- +{ + my ($message) = @_; + + die "ERROR: $message\n$USAGE"; +} + +#------------------------------------------------------------------------------- +sub get_expected +#------------------------------------------------------------------------------- +{ + my ($num) = @_; + + if ($num == 1) + { + return { + name => 'id', + fields => + [ + [ field1 => 'value1' ], + [ field2 => 'value2' ], + [ field3 => 42 ] + ] + } + } + elsif ($num == 2) + { + return { + name => 'youtube', + fields => [ [ title => 'Title "quoted" done' ] ] + } + } + elsif ($num == 3) + { + return { + name => 'youtube', + fields => [ [ title => 'Title with escaped backslash \\' ] ] + } + } + elsif ($num == 4) + { + return { + name => 'empty' + } + } + elsif ($num == 5) + { + return; + } + elsif ($num == 6) + { + return { + name => 'id', + fields => [ [ filed1 => 'value1' ] ], + } + } + + die "The expected result for test $num is missing"; +} + +################################################################################ + +__DATA__ +{% id field1="value1" field2="value2" field3=42 %} +{% youtube title="Title \"quoted\" done" %} +{% youtube title="Title with escaped backslash \\" %} +{% empty %} +Non-record line +{% id filed1="value1" %} diff --git a/challenge-259/athanasius/raku/ch-1.raku b/challenge-259/athanasius/raku/ch-1.raku new file mode 100644 index 0000000000..0e6a19ddf7 --- /dev/null +++ b/challenge-259/athanasius/raku/ch-1.raku @@ -0,0 +1,247 @@ +use v6d; + +################################################################################ +=begin comment + +Perl Weekly Challenge 259 +========================= + +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' + +=end comment +################################################################################ + +#--------------------------------------# +# Copyright © 2024 PerlMonk Athanasius # +#--------------------------------------# + +#=============================================================================== +=begin comment + +Assumptions +----------- +1. Offsets are non-negative. +2. If the start date is a non-banking day, offset 0 is the first banking day + after the start date. + +Interface +--------- +1. If no command-line arguments are given, the test suite is run. Otherwise: +2. The first command-line argument is a starting date, represented by a string + in the format "YYYY-MM-DD" (ISO 8601). +3. The second command-line argument is an unsigned integer offset. +4. The third command-line argument is optional. If present, it is a string com- + prising "YYYY-MM-DD" strings representing the dates of bank holidays. These + date strings are separated by whitespace and/or commas. + +=end comment +#=============================================================================== + +use Test; + +my UInt constant SATURDAY = 6; + +#------------------------------------------------------------------------------- +BEGIN +#------------------------------------------------------------------------------- +{ + "\nChallenge 259, Task #1: Banking Day Offset (Raku)\n".put; +} + +#=============================================================================== +multi sub MAIN +( + Str:D $start-date, #= Start date in 'YYYY-MM-DD' format + UInt:D $offset, #= Non-negative offset in days + Str:_ $bank-holidays? #= Optional string: list of bank holiday dates +) +#=============================================================================== +{ + my Str @holiday-strs; + + if $bank-holidays.defined + { + @holiday-strs = $bank-holidays.split: / <[ \s \, ]>+ /, :skip-empty; + + ("Input: \$start-date = '$start-date'\n" ~ + " \$offset = $offset\n" ~ + " \@bank-holidays = [%s]\n\n").printf: + @holiday-strs.map( { "'$_'" } ).join: ', '; + } + else + { + ("Input: \$start-date = '$start-date'\n" ~ + " \$offset = $offset\n").put; + } + + my (Date $start, Set[Date] $holidays) = + parse-date-strings( $start-date, @holiday-strs ); + + my Date $day = find-banking-day( $start, $offset, $holidays ); + + "Output: '%s'\n".printf: $day.Str; +} + +#=============================================================================== +multi sub MAIN() # No input: run the test suite +#=============================================================================== +{ + run-tests(); +} + +#------------------------------------------------------------------------------- +sub find-banking-day +( + Date:D $start-date, + UInt:D $offset, + Set:D[Date:D] $bank-holidays +--> Date:D +) +#------------------------------------------------------------------------------- +{ + my Date $day = $start-date; + + # 1. Advance, if necessary, to the first banking day ("day zero") + + ++$day until is-banking-day( $day, $bank-holidays ); + + # 2. Advance (a further) $offset number of banking days + + loop (my UInt $count = $offset; $count > 0;) + { + --$count if is-banking-day( ++$day, $bank-holidays ); + } + + return $day; +} + +#------------------------------------------------------------------------------- +sub is-banking-day( Date:D $date, Set:D[Date:D] $bank-holidays --> Bool:D ) +#------------------------------------------------------------------------------- +{ + return $date.day-of-week < SATURDAY && # Monday to Friday + $date ∉ $bank-holidays; # Not a bank holiday +} + +#------------------------------------------------------------------------------- +sub parse-date-strings +( + Str:D $start-date-str, + List:D[Str:D] $bank-holiday-strs +--> List:D[Date:D, Set:D[Date:D]] +) +#------------------------------------------------------------------------------- +{ + CATCH + { + when X::Temporal { error( .message ); } + } + + my Date $start-date = Date.new: $start-date-str; + my Set[Date] $bank-holidays = Set[Date].new: + $bank-holiday-strs.map: { Date.new: $_ }; + + return $start-date, $bank-holidays; +} + +#------------------------------------------------------------------------------- +sub run-tests() +#------------------------------------------------------------------------------- +{ + 'Running the test suite'.put; + + for test-data.lines -> Str $line + { + my Str ($test-name, $start-str, $offset, $holidays-str, $expected-str) = + $line.split: / \| /; + + for $test-name, $start-str, $offset, $holidays-str, $expected-str + { + s/ ^ \s+ //; + s/ \s+ $ //; + } + + my Str @holiday-strs = + $holidays-str.split: / <[ \s \, ]>+ /, :skip-empty; + + my (Date $start, Set[Date] $holidays) = + parse-date-strings( $start-str, @holiday-strs ); + + my Date $day = find-banking-day( $start, $offset.Int, $holidays ); + my Date $expected = Date.new: $expected-str; + + is $day, $expected, $test-name; + } + + done-testing; +} + +#------------------------------------------------------------------------------- +sub error( Str:D $message ) +#------------------------------------------------------------------------------- +{ + "ERROR: $message".put; + + USAGE(); + + exit 0; +} + +#------------------------------------------------------------------------------- +sub USAGE() +#------------------------------------------------------------------------------- +{ + my Str $usage = $*USAGE; + + $usage ~~ s:g/ ($*PROGRAM-NAME) /raku $0/; + + $usage.put; +} + +#------------------------------------------------------------------------------- +sub test-data( --> Str:D ) +#------------------------------------------------------------------------------- +{ + # 28 June 2018 was a Thursday + + return q:to/END/; + Example 1 |2018-06-28|3|2018-07-03 |2018-07-04 + Example 2 |2018-06-28|3| |2018-07-03 + 2 holidays |2018-06-28|3|2018-07-03 2018-07-04|2018-07-05 + Zero offset 1|2018-06-28|0| |2018-06-28 + Zero offset 2|2018-06-28|0|2018-06-28 |2018-06-29 + Zero offset 3|2018-06-30|0| |2018-07-02 + Weekend start|2018-06-30|1| |2018-07-03 + Holiday start|2018-06-28|1|2018-06-28 |2018-07-02 + END +} + +################################################################################ -- cgit From fcdc388bf0341a9d082259b2ba8957996b010290 Mon Sep 17 00:00:00 2001 From: PerlMonk-Athanasius Date: Sun, 10 Mar 2024 23:23:28 +1000 Subject: Remove Data::Dump --- challenge-259/athanasius/perl/ch-2.pl | 2 -- 1 file changed, 2 deletions(-) diff --git a/challenge-259/athanasius/perl/ch-2.pl b/challenge-259/athanasius/perl/ch-2.pl index 18ac96c7e4..f158f27bb1 100644 --- a/challenge-259/athanasius/perl/ch-2.pl +++ b/challenge-259/athanasius/perl/ch-2.pl @@ -93,8 +93,6 @@ use Const::Fast; use Regexp::Common qw( number ); use Test::More; -use Data::Dump; - const my $BS_CODE => chr 1; const my $QU_CODE => chr 2; const my $USAGE => <