diff options
| -rw-r--r-- | challenge-217/matthias-muth/README.md | 31 | ||||
| -rw-r--r-- | challenge-217/matthias-muth/blog.txt | 1 | ||||
| -rwxr-xr-x | challenge-217/matthias-muth/perl/TestExtractor.pm | 196 | ||||
| -rwxr-xr-x | challenge-217/matthias-muth/perl/ch-1.pl | 23 | ||||
| -rwxr-xr-x | challenge-217/matthias-muth/perl/ch-2.pl | 53 | ||||
| -rw-r--r-- | challenge-217/matthias-muth/perl/challenge-217.txt | 66 |
6 files changed, 362 insertions, 8 deletions
diff --git a/challenge-217/matthias-muth/README.md b/challenge-217/matthias-muth/README.md index d1de0dad3f..bf504c1bb5 100644 --- a/challenge-217/matthias-muth/README.md +++ b/challenge-217/matthias-muth/README.md @@ -1,10 +1,25 @@ -**Challenge 216 solutions in Perl by Matthias Muth** -<br/> -I have created a 'TestExtractor.pm' module that extracts and runs the -test cases from the challenge description in 'challenge.txt'. -This makes the weekly task of setting up the enviroment for the new challenge -much easier. - -(no blog post this time...) +**Challenge 217 solutions in Perl by Matthias Muth** + +Apart from the two solutions that I have implemented this week +I have written a script that extracts the new task descriptions +from the +[Weekly Challenge web site](https://theweeklychallenge.org/blog/perl-weekly-challenge-217/) +and writes them into `challenge-<NN>/<USER>/perl/challenge-<NN>.txt`. <br/> +(I will publish that in one of the coming weeks.) + +It also writes template files `perl/ch-1.pl` and `perl/ch-2-pl`, with +the challenge number and name, task number and name, +the subroutine name derived from the task name, +and even the input variable names and types, derived from the test data, already filled in. + +I have a cron job that runs this every beginning of the week, so whenever there is a new +challenge, I can start coding right away! + +The 'TestExtractor.pm' module extracts the test cases from that +task description file, and runs the tests for me, +without any editing of test data or test runs anymore. + +I am sure that the effort of automating all of this will pay off very soon, +with every new challenge! **Thank you for the challenge!** diff --git a/challenge-217/matthias-muth/blog.txt b/challenge-217/matthias-muth/blog.txt new file mode 100644 index 0000000000..515c03bff2 --- /dev/null +++ b/challenge-217/matthias-muth/blog.txt @@ -0,0 +1 @@ +https://github.com/MatthiasMuth/perlweeklychallenge-club/tree/muthm-217/challenge-217/matthias-muth#readme diff --git a/challenge-217/matthias-muth/perl/TestExtractor.pm b/challenge-217/matthias-muth/perl/TestExtractor.pm new file mode 100755 index 0000000000..c9a6646db4 --- /dev/null +++ b/challenge-217/matthias-muth/perl/TestExtractor.pm @@ -0,0 +1,196 @@ +#!/usr/bin/env perl +# +# The Weekly Challenge - Perl & Raku +# (https://theweeklychallenge.org) +# +# The Test Data Extraction Machine (tm). +# +# Perl solution by Matthias Muth. +# + +use strict; +use warnings; +use feature 'say'; +use feature 'signatures'; +no warnings 'experimental::signatures'; + +package TestExtractor; +use Exporter 'import'; +our @EXPORT = qw( run_tests $verbose %options vsay pp ); + +use Data::Dump qw( pp ); +use Getopt::Long; +use Cwd qw( abs_path ); +use File::Basename; +use Test2::V0; +no warnings 'experimental::signatures'; + +our ( $verbose, %options ); +sub vsay { say @_ if $verbose }; + +sub run_tests { + + $| = 1; + + GetOptions( + "v|verbose!" => \$verbose, + ) or do { say "usage!"; exit 2 }; + + my $dir = dirname abs_path $0; + my ( $challenge, $task ) = + abs_path( $0 ) =~ m{challenge-(\d+) .* (\d+)[^[/\\]*$}x; + unless ( $challenge && $task ) { + say STDERR "ERROR: ", + "Cannot determine challenge number or task number. Exiting."; + exit 1; + } + + my $local_tests; + ( undef, $local_tests ) = read_task( *::DATA ) + if fileno *::DATA; + + my ( $task_title, $task_description ) = + read_task( "$dir/challenge-${challenge}.txt", $task ); + vsay $task_title; + + my @tests = ( + $local_tests ? extract_tests( $local_tests ) : (), + $task_description ? extract_tests( $task_description ) : (), + ); + vsay pp( @tests ); + + ( my $sub_name = lc $task_title ) =~ s/\W+/_/g; + my $sub = \&{"::$sub_name"}; + + do { + my @input_params = + @{$_->{INPUT}} == 1 + ? ( ref $_->{INPUT}[0] eq 'ARRAY' + && ! grep( ref $_, @{$_->{INPUT}[0]} ) ) + ? @{$_->{INPUT}[0]} + : $_->{INPUT}[0] + : @{$_->{INPUT}}; + my $expected = $_->{OUTPUT}; + my $description = + "$_->{TEST}: $sub_name( " . pp( @input_params ) . " ) == " + . pp( + ref $_->{OUTPUT} eq 'ARRAY' && @{$_->{OUTPUT}} == 1 + ? @{$_->{OUTPUT}} + : $_->{OUTPUT} ); + my $output = + ref $_->{OUTPUT} eq 'ARRAY' + ? [ $sub->( @input_params ) ] + : $sub->( @input_params ); + + is $output, $expected, $description; + + } for @tests; + + done_testing; +} + +sub read_task( $fd_or_filename, $wanted_task = undef ) { + + my $fd; + if ( ref \$fd_or_filename eq 'SCALAR' ) { + open $fd, "<", $fd_or_filename + or die "ERROR: cannot open '$fd_or_filename': $!\n"; + } + else { + # non-SCALARs, like __DATA__ GLOB. + $fd = $fd_or_filename; + } + + my ( $task, $task_title, $task_text ) = ( -1, undef ); + while ( <$fd> ) { + /^Task (\d+):\s*(.*?)\s*$/ and do { + $task = $1; + $task_title = $2 + if $wanted_task && $task == $wanted_task; + next; + }; + + next + if $wanted_task && $task != $wanted_task; + + $task_text .= $_; + } + + return $task_title, $task_text; +} + +sub extract_tests( $task_text ) { + # vsay "extract_tests( ", pp( $task_text ), " )"; + + # These regular expressions are used for extracting input or output + # test data. + my $var_name = qr/ [\@\$]\w+ /x; + my $literal = qr/ ".*?" | '.*?' | [+-]?\d+ /x; + my $bracketed = qr/ \[ [^\[]*? \] /xs; + my $entry = qr/ $literal | $bracketed /x; + my $list = qr/ $entry (?: \s*,\s* $entry )* /xs; + + # The combination of what we expect as input or output data. + # Capture unparenthesized lists for special handling. + my $data_re = qr/ (?<lit> $literal ) + | (?<list> \[ \s* (?:$list)? \s* \] ) + | (?<no_paren> $list ) /x; + + my @tests; + while ( $task_text =~ + /^((?:Example|Test).*?)\s*:?\s*$ .*? + ^Input: \s* ( .*? ) \s* + ^Output: \s* ( .*? ) \s*?$ (?=(?: ^$ | \Z )) + /xmsg ) + { + my ( $test, $input, $output) = ( $1, $2, $3 ); + + push @tests, { TEST => $test }; + + for ( $input, $output ) { + # To avoid misinterpretations of '@' or '$' when the data is + # 'eval'ed, we turn all double quotes into single quotes. + s/"/'/g; + + # We convert 'barewords' into quoted strings. + # We search for these patterns, but we just skip them without + # changing them: + # * 'Input:', 'Output:' at the beginning of the string, + # * quoted strings, + # * variable names having a $ or @ sigil. + # After we are sure it's none of those, we also check unquoted + # 'barewords' (here: combinations of letters, digits or underscores, + # starting with a letter) and enclose them in single quotes. + my $bareword = qr/[a-z_][a-z0-9_]*/i; + while ( / ^Input: | ^Output: | '.*?' | [\$\@]$bareword + | ( $bareword ) /xg ) + { + if ( $1 ) { + my $p = pos(); + substr $_, $p - length( $1 ), length( $1 ), "'$1'"; + pos = $p + 2; + } + } + + # As all arrays will be stored as array references, so we just + # convert parentheses (...) to angle brackets [...]. + s/\(/\[/g; + s/\)/\]/g; + + # Add missing commas between literals. + while ( s/($literal)\s+($literal)/$1, $2/ ) {} + } + + while ( $input =~ / ($var_name) \s* = \s* ($data_re) /xg ) { + push @{$tests[-1]{VARIABLE_NAMES}}, $1; + push @{$tests[-1]{INPUT}}, eval( $+{no_paren} ? "[ $2 ]" : $2 ); + }; + + while ( $output =~ /^\s* ($data_re) $/xg ) { + $tests[-1]{OUTPUT} = eval( $+{no_paren} ? "[ $1 ]" : $1 ); + }; + } + return @tests; +} + +1; diff --git a/challenge-217/matthias-muth/perl/ch-1.pl b/challenge-217/matthias-muth/perl/ch-1.pl new file mode 100755 index 0000000000..ac14aada46 --- /dev/null +++ b/challenge-217/matthias-muth/perl/ch-1.pl @@ -0,0 +1,23 @@ +#!/usr/bin/env perl +# +# The Weekly Challenge - Perl & Raku +# (https://theweeklychallenge.org) +# +# Challenge 217 Task 1: Sorted Matrix +# +# Perl solution by Matthias Muth. +# + +use strict; +use warnings; +use feature 'say'; + +sub sorted_matrix { + my ( $matrix ) = @_; + my @all_values = sort { $a <=> $b } map @$_, @$matrix; + return $all_values[2]; +} + +use lib '.'; +use TestExtractor; +run_tests(); diff --git a/challenge-217/matthias-muth/perl/ch-2.pl b/challenge-217/matthias-muth/perl/ch-2.pl new file mode 100755 index 0000000000..5f3ee66b31 --- /dev/null +++ b/challenge-217/matthias-muth/perl/ch-2.pl @@ -0,0 +1,53 @@ +#!/usr/bin/env perl +# +# The Weekly Challenge - Perl & Raku +# (https://theweeklychallenge.org) +# +# Challenge 217 Task 2: Max Number +# +# Perl solution by Matthias Muth. +# + +use strict; +use warnings; +use feature 'say'; + +use Data::Dump qw( pp ); +use List::Util qw( reduce ); + +sub max_number { + my ( @list ) = @_; + # say "max_number( ", pp( @list ), " )"; + return $list[0] + if @list == 1; + + my ( $best, $max ) = ( undef, 0 ); + for ( 0..$#list ) { + my @sub_list = @list; + splice @sub_list, $_, 1, (); + my $try = $list[$_] . max_number( @sub_list ); + ( $best, $max ) = ( $_, $try ) + if $try > $max; + } + return $max; +} + + +use lib '.'; +use TestExtractor; +run_tests(); + + +__DATA__ + +Test 1: +Input: @list = ( 53 52 5 4 ) +Output: 553524 + +Test 2: +Input: @list = ( 53 52 5 1 ) +Output: 553521 + +Test 3: +Input: @list = ( 53 52 5 6 ) +Output: 655352 diff --git a/challenge-217/matthias-muth/perl/challenge-217.txt b/challenge-217/matthias-muth/perl/challenge-217.txt new file mode 100644 index 0000000000..abce39f527 --- /dev/null +++ b/challenge-217/matthias-muth/perl/challenge-217.txt @@ -0,0 +1,66 @@ +The Weekly Challenge - 217 +Monday, May 15, 2023 + + +Task 1: Sorted Matrix +Submitted by: Mohammad S Anwar + +You are given a n x n matrix where n >= 2. +Write a script to find 3rd smallest element in the sorted matrix. +Example 1 + +Input: @matrix = ([3, 1, 2], [5, 2, 4], [0, 1, 3]) +Output: 1 + +The sorted list of the given matrix: 0, 1, 1, 2, 2, 3, 3, 4, 5. +The 3rd smallest of the sorted list is 1. + +Example 2 + +Input: @matrix = ([2, 1], [4, 5]) +Output: 4 + +The sorted list of the given matrix: 1, 2, 4, 5. +The 3rd smallest of the sorted list is 4. + +Example 3 + +Input: @matrix = ([1, 0, 3], [0, 0, 0], [1, 2, 1]) +Output: 0 + +The sorted list of the given matrix: 0, 0, 0, 0, 1, 1, 1, 2, 3. +The 3rd smallest of the sorted list is 0. + + +Task 2: Max Number +Submitted by: Mohammad S Anwar + +You are given a list of positive integers. +Write a script to concatenate the integers to form the highest possible value. +Example 1: + +Input: @list = (1, 23) +Output: 231 + +Example 2: + +Input: @list = (10, 3, 2) +Output: 3210 + +Example 3: + +Input: @list = (31, 2, 4, 10) +Output: 431210 + +Example 4: + +Input: @list = (5, 11, 4, 1, 2) +Output: 542111 + +Example 5: + +Input: @list = (1, 10) +Output: 110 + + +Last date to submit the solution 23:59 (UK Time) Sunday 21st May 2023. |