From a7bdd1cc2d8aca66c3a8cd6dbe3ecacde81ab7f4 Mon Sep 17 00:00:00 2001 From: PerlMonk-Athanasius Date: Sun, 24 Dec 2023 22:24:01 +1000 Subject: Perl & Raku solutions to Tasks 1 & 2 for Week 248 --- challenge-248/athanasius/perl/ch-1.pl | 199 ++++++++++++++++++++++++ challenge-248/athanasius/perl/ch-2.pl | 251 ++++++++++++++++++++++++++++++ challenge-248/athanasius/raku/ch-1.raku | 202 +++++++++++++++++++++++++ challenge-248/athanasius/raku/ch-2.raku | 260 ++++++++++++++++++++++++++++++++ 4 files changed, 912 insertions(+) create mode 100644 challenge-248/athanasius/perl/ch-1.pl create mode 100644 challenge-248/athanasius/perl/ch-2.pl create mode 100644 challenge-248/athanasius/raku/ch-1.raku create mode 100644 challenge-248/athanasius/raku/ch-2.raku diff --git a/challenge-248/athanasius/perl/ch-1.pl b/challenge-248/athanasius/perl/ch-1.pl new file mode 100644 index 0000000000..18ce5983e7 --- /dev/null +++ b/challenge-248/athanasius/perl/ch-1.pl @@ -0,0 +1,199 @@ +#!perl + +################################################################################ +=comment + +Perl Weekly Challenge 248 +========================= + +TASK #1 +------- +*Shortest Distance* + +Submitted by: Mohammad S Anwar + +You are given a string and a character in the given string. + +Write a script to return an array of integers of size same as length of the +given string such that: + + distance[i] is the distance from index i to the closest occurence of + the given character in the given string. + + The distance between two indices i and j is abs(i - j). + +Example 1 + + Input: $str = "loveleetcode", $char = "e" + Output: (3,2,1,0,1,0,0,1,2,2,1,0) + + The character 'e' appears at indices 3, 5, 6, and 11 (0-indexed). + The closest occurrence of 'e' for index 0 is at index 3, so the distance is + abs(0 - 3) = 3. + The closest occurrence of 'e' for index 1 is at index 3, so the distance is + abs(1 - 3) = 2. + For index 4, there is a tie between the 'e' at index 3 and the 'e' at index 5, + but the distance is still the same: abs(4 - 3) == abs(4 - 5) = 1. + The closest occurrence of 'e' for index 8 is at index 6, so the distance is + abs(8 - 6) = 2. + +Example 2 + + Input: $str = "aaab", $char = "b" + Output: (3,2,1,0) + +=cut +################################################################################ + +#--------------------------------------# +# Copyright © 2023 PerlMonk Athanasius # +#--------------------------------------# + +#=============================================================================== +=comment + +Interface +--------- +If no command-line arguments are given, the test suite is run. + +Algorithm +--------- +1. Create an array @min_dist of shortest distances, initially all empty. +2. Assign 0 to each element of @min_dist corresponding to the target character. +3. Assign 1 to each *empty* element of @min_dist that is immediately adjacent to + an element containing 0. +4. Assign 2 to each *empty* element of @min_dist that is immediately adjacent to + an element containing 1. +5. Repeat for 3, 4, 5, ... until no elements of @min_dist are empty. + +Note: this algorithm does not require any measurement of distances + +=cut +#=============================================================================== + +use v5.32.1; # Enables strictures +use warnings; +use Const::Fast; +use List::Util qw( all min ); +use Test::More; + +const my $USAGE => +"Usage: + perl $0 + perl $0 + + A string of one or more characters + A character in the given string\n"; + +#------------------------------------------------------------------------------- +BEGIN +#------------------------------------------------------------------------------- +{ + $| = 1; + print "\nChallenge 248, Task #1: Shortest Distance (Perl)\n\n"; +} + +#=============================================================================== +MAIN: +#=============================================================================== +{ + my $argc = scalar @ARGV; + + if ($argc == 0) + { + run_tests(); + } + elsif ($argc == 2) + { + my ($str, $char) = @ARGV; + + $str =~ /$char/ or error( qq[The given character "$char" does not ] . + 'appear in the given string' ); + + print qq[Input: \$str = "$str", \$char = "$char"\n]; + + my ($min_dist) = find_shortest_distances( $str, $char ); + + printf "Output: (%s)\n", join ',', @$min_dist; + } + else + { + error( "Expected 0 or 2 command-line arguments, found $argc" ); + } +} + +#------------------------------------------------------------------------------- +sub find_shortest_distances +#------------------------------------------------------------------------------- +{ + my ($str, $char) = @_; + my @str_char = split //, $str; + my @min_dist = (undef) x scalar @str_char; + + for my $i (0 .. $#str_char) + { + $min_dist[ $i ] = 0 if $str_char[ $i ] eq $char; + } + + my $target = 0; + + until (all { defined $_ } @min_dist) + { + for my $i (0 .. $#str_char) + { + next unless defined $min_dist[ $i ] && $target == $min_dist[ $i ]; + + $min_dist[ $i - 1 ] = $target + 1 + if $i > 0 && !defined $min_dist[ $i - 1 ]; + + $min_dist[ $i + 1 ] = $target + 1 + if $i < $#str_char && !defined $min_dist[ $i + 1 ]; + } + + ++$target; + } + + return \@min_dist; +} + +#------------------------------------------------------------------------------- +sub run_tests +#------------------------------------------------------------------------------- +{ + print "Running the test suite\n"; + + while (my $line = ) + { + chomp $line; + + my ($test_name, $str, $char, $exp_str) = split / \| /x, $line; + + for ($test_name, $str, $char, $exp_str) + { + s/ ^ \s+ //x; + s/ \s+ $ //x; + } + + my ($sd) = find_shortest_distances( $str, $char ); + my @exp = split / \s+ /x, $exp_str; + + is_deeply $sd, \@exp, $test_name; + } + + done_testing; +} + +#------------------------------------------------------------------------------- +sub error +#------------------------------------------------------------------------------- +{ + my ($message) = @_; + + die "ERROR: $message\n$USAGE"; +} + +################################################################################ + +__DATA__ +Example 1|loveleetcode|e|3 2 1 0 1 0 0 1 2 2 1 0 +Example 2|aaab |b|3 2 1 0 diff --git a/challenge-248/athanasius/perl/ch-2.pl b/challenge-248/athanasius/perl/ch-2.pl new file mode 100644 index 0000000000..71f5743167 --- /dev/null +++ b/challenge-248/athanasius/perl/ch-2.pl @@ -0,0 +1,251 @@ +#!perl + +################################################################################ +=comment + +Perl Weekly Challenge 248 +========================= + +TASK #2 +------- +*Submatrix Sum* + +Submitted by: Jorg Sommrey + +You are given a NxM matrix A of integers. + +Write a script to construct a (N-1)x(M-1) matrix B having elements that are the +sum over the 2x2 submatrices of A, + + b[i,k] = a[i,k] + a[i,k+1] + a[i+1,k] + a[i+1,k+1] + +Example 1 + + Input: $a = [ + [1, 2, 3, 4], + [5, 6, 7, 8], + [9, 10, 11, 12] + ] + + Output: $b = [ + [14, 18, 22], + [30, 34, 38] + ] + +Example 2 + + Input: $a = [ + [1, 0, 0, 0], + [0, 1, 0, 0], + [0, 0, 1, 0], + [0, 0, 0, 1] + ] + + Output: $b = [ + [2, 1, 0], + [1, 2, 1], + [0, 1, 2] + ] + +=cut +################################################################################ + +#--------------------------------------# +# Copyright © 2023 PerlMonk Athanasius # +#--------------------------------------# + +#=============================================================================== +=comment + +Interface +--------- +If no command-line arguments are given, the test suite is run. + +=cut +#=============================================================================== + +use v5.32.1; # Enables strictures +use warnings; +use Const::Fast; +use Regexp::Common qw( number ); +use Test::More; + +const my $USAGE => +"Usage: + perl $0 [ ...] + perl $0 + + [ ...] An N x M matrix of integers (N, M >= 2)\n"; + +#------------------------------------------------------------------------------- +BEGIN +#------------------------------------------------------------------------------- +{ + $| = 1; + print "\nChallenge 248, Task #2: Submatrix Sum (Perl)\n\n"; +} + +#=============================================================================== +MAIN: +#=============================================================================== +{ + if (scalar @ARGV == 0) + { + run_tests(); + } + else + { + my $matrix_a = parse_matrix( \@ARGV ); + + print_matrix( 'Input: $a = ', $matrix_a ); + + my $matrix_b = submatrix_sum( $matrix_a ); + + print "\n"; + print_matrix( 'Output: $b = ', $matrix_b ); + } +} + +#------------------------------------------------------------------------------- +sub submatrix_sum +#------------------------------------------------------------------------------- +{ + my ($matrix_a) = @_; + my @matrix_b; + + for my $i (0 .. $#$matrix_a - 1) + { + for my $k (0 .. $#{ $matrix_a->[ 0 ] } - 1) + { + # b[i,k] = a[i,k] + a[i,k+1] + a[i+1,k] + a[i+1,k+1] + + $matrix_b[ $i ][ $k ] = $matrix_a->[ $i ][ $k ] + + $matrix_a->[ $i ][ $k + 1 ] + + $matrix_a->[ $i + 1 ][ $k ] + + $matrix_a->[ $i + 1 ][ $k + 1 ]; + } + } + + return \@matrix_b; +} + +#------------------------------------------------------------------------------- +sub parse_matrix +#------------------------------------------------------------------------------- +{ + my ($a) = @_; + my (@matrix, $num_cols); + + for my $row_str (@$a) + { + my @row; + + for my $elem (grep { / \S /x } split / \s+ /x, $row_str) + { + if ($elem =~ / ^ $RE{num}{int} $ /x) + { + push @row, $elem; + } + else + { + error( qq[Element "$elem" is not a valid integer] ); + } + } + + push @matrix, \@row; + + if (defined $num_cols) + { + scalar @row == $num_cols + or error( 'The input matrix is not rectangular' ); + } + else + { + $num_cols = scalar @row; + $num_cols >= 2 or error( 'M is too small' ); + } + } + + return \@matrix; +} + +#------------------------------------------------------------------------------- +sub print_matrix +#------------------------------------------------------------------------------- +{ + my ($prefix, $matrix) = @_; + my $tab = ' ' x length $prefix; + my @width = (1) x scalar @{ $matrix->[ 0 ] }; + + for my $row (@$matrix) + { + for my $i (0 .. $#$row) + { + my $w = length $row->[ $i ]; + + $width[ $i ] = $w if $w > $width[ $i ]; + } + } + + print "$prefix\[\n"; + + for my $row (@$matrix) + { + my @row_str; + + for my $i (0 .. $#$row) + { + push @row_str, sprintf '%*d', $width[ $i ], $row->[ $i ]; + } + + printf "%s [%s]\n", $tab, join ', ', @row_str; + } + + print "$tab]\n"; +} + +#------------------------------------------------------------------------------- +sub run_tests +#------------------------------------------------------------------------------- +{ + print "Running the test suite\n"; + + while (my $line = ) + { + chomp $line; + + my ($test_name, $matrix_str, $expected_str) = split / \| /x, $line; + + for ($test_name, $matrix_str, $expected_str) + { + s/ ^ \s+ //x; + s/ \s+ $ //x; + } + + my @a = split / \; /x, $matrix_str; + my @b = split / \; /x, $expected_str; + + my $matrix_a = parse_matrix( \@a ); + my $expected = parse_matrix( \@b ); + my $matrix_b = submatrix_sum( $matrix_a ); + + is_deeply $matrix_b, $expected, $test_name; + } + + done_testing; +} + +#------------------------------------------------------------------------------- +sub error +#------------------------------------------------------------------------------- +{ + my ($message) = @_; + + die "ERROR: $message\n$USAGE"; +} + +################################################################################ + +__DATA__ +Example 1|1 2 3 4; 5 6 7 8; 9 10 11 12|14 18 22; 30 34 38 +Example 2|1 0 0 0; 0 1 0 0; 0 0 1 0; 0 0 0 1|2 1 0; 1 2 1; 0 1 2 diff --git a/challenge-248/athanasius/raku/ch-1.raku b/challenge-248/athanasius/raku/ch-1.raku new file mode 100644 index 0000000000..4dc6c89aa3 --- /dev/null +++ b/challenge-248/athanasius/raku/ch-1.raku @@ -0,0 +1,202 @@ +use v6d; + +################################################################################ +=begin comment + +Perl Weekly Challenge 248 +========================= + +TASK #1 +------- +*Shortest Distance* + +Submitted by: Mohammad S Anwar + +You are given a string and a character in the given string. + +Write a script to return an array of integers of size same as length of the +given string such that: + + distance[i] is the distance from index i to the closest occurence of + the given character in the given string. + + The distance between two indices i and j is abs(i - j). + +Example 1 + + Input: $str = "loveleetcode", $char = "e" + Output: (3,2,1,0,1,0,0,1,2,2,1,0) + + The character 'e' appears at indices 3, 5, 6, and 11 (0-indexed). + The closest occurrence of 'e' for index 0 is at index 3, so the distance is + abs(0 - 3) = 3. + The closest occurrence of 'e' for index 1 is at index 3, so the distance is + abs(1 - 3) = 2. + For index 4, there is a tie between the 'e' at index 3 and the 'e' at index 5, + but the distance is still the same: abs(4 - 3) == abs(4 - 5) = 1. + The closest occurrence of 'e' for index 8 is at index 6, so the distance is + abs(8 - 6) = 2. + +Example 2 + + Input: $str = "aaab", $char = "b" + Output: (3,2,1,0) + +=end comment +################################################################################ + +#--------------------------------------# +# Copyright © 2023 PerlMonk Athanasius # +#--------------------------------------# + +#=============================================================================== +=begin comment + +Interface +--------- +If no command-line arguments are given, the test suite is run. + +Algorithm +--------- +1. Create an array @min-dist of shortest distances, initially all empty. +2. Assign 0 to each element of @min-dist corresponding to the target character. +3. Assign 1 to each *empty* element of @min-dist that is immediately adjacent to + an element containing 0. +4. Assign 2 to each *empty* element of @min-dist that is immediately adjacent to + an element containing 1. +5. Repeat for 3, 4, 5, ... until no elements of @min-dist are empty. + +Note: this algorithm does not require any measurement of distances. + +=end comment +#=============================================================================== + +use Test; + +#------------------------------------------------------------------------------- +BEGIN +#------------------------------------------------------------------------------- +{ + "\nChallenge 248, Task #1: Shortest Distance (Raku)\n".put; +} + +#=============================================================================== +multi sub MAIN +( + Str:D $str where { .chars >= 1 }, #= A string of one or more characters + Str:D $char where { .chars == 1 && $str ~~ / $char / } + #= A character in the given string +) +#=============================================================================== +{ + qq[Input: \$str = "$str", \$char = "$char"].put; + + my UInt @min-dist = find-shortest-distances( $str, $char ); + + "Output: (%s)\n".printf: @min-dist.join: ','; +} + +#=============================================================================== +multi sub MAIN() # No input: run the test suite +#=============================================================================== +{ + run-tests(); +} + +#------------------------------------------------------------------------------- +sub find-shortest-distances +( + Str:D $str where { .chars >= 1 }, #= A string of one or more characters + Str:D $char where { .chars == 1 && $str ~~ / $char / } + #= A character in the given string +--> List:D[UInt:D] +) +#------------------------------------------------------------------------------- +{ + my Str @str-char = $str.split: '', :skip-empty; + my UInt @min-dist = Int xx @str-char.elems; + + for 0 .. @str-char.end -> UInt $i + { + @min-dist[ $i ] = 0 if @str-char[ $i ] eq $char; + } + + my UInt $target = 0; + + until @min-dist.all.defined + { + for 0 .. @str-char.end -> UInt $i + { + next unless @min-dist[ $i ].defined && $target == @min-dist[ $i ]; + + @min-dist[ $i - 1 ] = $target + 1 + if $i > 0 && !@min-dist[ $i - 1 ].defined; + + @min-dist[ $i + 1 ] = $target + 1 + if $i < @str-char.end && !@min-dist[ $i + 1 ].defined; + } + + ++$target; + } + + return @min-dist; +} + +#------------------------------------------------------------------------------- +sub run-tests() +#------------------------------------------------------------------------------- +{ + 'Running the test suite'.put; + + for test-data.lines -> Str $line + { + my Str ($test-name, $str, $char, $expected-str) = $line.split: / \| /; + + for $test-name, $str, $char, $expected-str + { + s/ ^ \s+ //; + s/ \s+ $ //; + } + + my UInt @min-dist = find-shortest-distances( $str, $char ); + my UInt @expected = $expected-str.split( / \s+ / ).map: { .Int }; + + is-deeply @min-dist, @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 ) +#------------------------------------------------------------------------------- +{ + return q:to/END/; + Example 1|loveleetcode|e|3 2 1 0 1 0 0 1 2 2 1 0 + Example 2|aaab |b|3 2 1 0 + END +} + +################################################################################ diff --git a/challenge-248/athanasius/raku/ch-2.raku b/challenge-248/athanasius/raku/ch-2.raku new file mode 100644 index 0000000000..94651468a7 --- /dev/null +++ b/challenge-248/athanasius/raku/ch-2.raku @@ -0,0 +1,260 @@ +use v6d; + +################################################################################ +=begin comment + +Perl Weekly Challenge 248 +========================= + +TASK #2 +------- +*Submatrix Sum* + +Submitted by: Jorg Sommrey + +You are given a NxM matrix A of integers. + +Write a script to construct a (N-1)x(M-1) matrix B having elements that are the +sum over the 2x2 submatrices of A, + + b[i,k] = a[i,k] + a[i,k+1] + a[i+1,k] + a[i+1,k+1] + +Example 1 + + Input: $a = [ + [1, 2, 3, 4], + [5, 6, 7, 8], + [9, 10, 11, 12] + ] + + Output: $b = [ + [14, 18, 22], + [30, 34, 38] + ] + +Example 2 + + Input: $a = [ + [1, 0, 0, 0], + [0, 1, 0, 0], + [0, 0, 1, 0], + [0, 0, 0, 1] + ] + + Output: $b = [ + [2, 1, 0], + [1, 2, 1], + [0, 1, 2] + ] + +=end comment +################################################################################ + +#--------------------------------------# +# Copyright © 2023 PerlMonk Athanasius # +#--------------------------------------# + +#=============================================================================== +=begin comment + +Interface +--------- +If no command-line arguments are given, the test suite is run. + +=end comment +#=============================================================================== + +use Test; + +#------------------------------------------------------------------------------- +BEGIN +#------------------------------------------------------------------------------- +{ + "\nChallenge 248, Task #2: Submatrix Sum (Raku)\n".put; +} + +#=============================================================================== +multi sub MAIN +( + #| An N x M matrix of integers (N, M >= 2) + + *@a where { .all ~~ Str:D && .elems >= 2 } +) +#=============================================================================== +{ + my Array[Array[Int]] $matrix-a = parse-matrix( @a ); + + print-matrix( 'Input: $a = ', $matrix-a ); + + my Array[Array[Int]] $matrix-b = submatrix-sum( $matrix-a ); + + put(); + print-matrix( 'Output: $b = ', $matrix-b ); +} + +#=============================================================================== +multi sub MAIN() # No input: run the test suite +#=============================================================================== +{ + run-tests(); +} + +#------------------------------------------------------------------------------- +sub submatrix-sum( List:D[List:D[Int:D]] $matrix-a --> List:D[List:D[Int:D]] ) +#------------------------------------------------------------------------------- +{ + my Array[Int] @matrix-b; + + for 0 .. $matrix-a.end - 1 -> UInt $i + { + @matrix-b[ $i ] = Array[Int].new; + + for 0 .. $matrix-a[ 0 ].end - 1 -> UInt $k + { + # b[i,k] = a[i,k] + a[i,k+1] + a[i+1,k] + a[i+1,k+1] + + @matrix-b[ $i; $k ] = $matrix-a[ $i; $k ] + + $matrix-a[ $i; $k + 1 ] + + $matrix-a[ $i + 1; $k ] + + $matrix-a[ $i + 1; $k + 1 ]; + } + } + + return @matrix-b; +} + +#------------------------------------------------------------------------------- +sub parse-matrix( List:D[Str:D] $a --> List:D[List:D[Int:D]] ) +#------------------------------------------------------------------------------- +{ + my Array[Int] @matrix; + my UInt $num-cols; + + for @$a -> Str $row-str + { + my Int @row; + + for $row-str.split( / \s+ /, :skip-empty ) -> Str $elem + { + if +$elem ~~ Int:D + { + @row.push: +$elem; + } + else + { + error( qq[Element "$elem" is not a valid integer] ); + } + } + + @matrix.push: @row; + + if $num-cols.defined + { + @row.elems == $num-cols + or error( 'The input matrix is not rectangular' ); + } + else + { + ($num-cols = @row.elems) >= 2 or error( 'M is too small' ); + } + } + + return @matrix; +} + +#------------------------------------------------------------------------------- +sub print-matrix( Str:D $prefix, List:D[List:D[Int:D]] $matrix ) +#------------------------------------------------------------------------------- +{ + my Str $tab = ' ' x $prefix.chars; + my UInt @width = 1 xx $matrix[ 0 ].elems; + + for @$matrix -> Int @row + { + for 0 .. @row.end -> UInt $i + { + my UInt $w = @row[ $i ].chars; + + @width[ $i ] = $w if $w > @width[ $i ]; + } + } + + "$prefix\[".put; + + for @$matrix -> Int @row + { + my Str @row-str; + + for 0 .. @row.end -> UInt $i + { + @row-str.push: '%*d'.sprintf: @width[ $i ], @row[ $i ]; + } + + "%s [%s]\n".printf: $tab, @row-str.join: ', '; + } + + "$tab]".put; +} + +#------------------------------------------------------------------------------- +sub run-tests() +#------------------------------------------------------------------------------- +{ + 'Running the test suite'.put; + + for test-data.lines -> Str $line + { + my Str ($test-name, $matrix-str, $expected-str) = $line.split: / \| /; + + for $test-name, $matrix-str, $expected-str + { + s/ ^ \s+ //; + s/ \s+ $ //; + } + + my Str @a = $matrix-str\ .split: / \; /; + my Str @b = $expected-str.split: / \; /; + + my Array[Array[Int]] $matrix-a = parse-matrix( @a ); + my Array[Array[Int]] $expected = parse-matrix( @b ); + my Array[Array[Int]] $matrix-b = submatrix-sum( $matrix-a ); + + is-deeply $matrix-b, $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 ) +#------------------------------------------------------------------------------- +{ + return q:to/END/; + Example 1|1 2 3 4; 5 6 7 8; 9 10 11 12|14 18 22; 30 34 38 + Example 2|1 0 0 0; 0 1 0 0; 0 0 1 0; 0 0 0 1|2 1 0; 1 2 1; 0 1 2 + END +} + +################################################################################ -- cgit From 7e1c1b471d7602a848cd71cd265b0e0a78ceacd9 Mon Sep 17 00:00:00 2001 From: CY Fung Date: Sun, 24 Dec 2023 21:15:32 +0800 Subject: Week 248 --- challenge-248/cheok-yin-fung/perl/ch-1.pl | 30 ++++++++++++++++++++++ challenge-248/cheok-yin-fung/perl/ch-2.pl | 42 +++++++++++++++++++++++++++++++ 2 files changed, 72 insertions(+) create mode 100644 challenge-248/cheok-yin-fung/perl/ch-1.pl create mode 100644 challenge-248/cheok-yin-fung/perl/ch-2.pl diff --git a/challenge-248/cheok-yin-fung/perl/ch-1.pl b/challenge-248/cheok-yin-fung/perl/ch-1.pl new file mode 100644 index 0000000000..d322be06e6 --- /dev/null +++ b/challenge-248/cheok-yin-fung/perl/ch-1.pl @@ -0,0 +1,30 @@ +# The Weekly Challenge 248 +# Task 1 Shortest Distance +use v5.30.0; +use warnings; +use List::Util qw/min/; + +sub sd { + my $str = $_[0]; + my $chr = $_[1]; + my @arr; + my $pre_k = 0; + my $k = index($str,$chr,$pre_k); + while ($k != -1 && $k < length $str) { + $arr[$k] = 0; + my $nxt_k = index($str,$chr,$k+1); + $nxt_k = length $str if $nxt_k == -1; + for my $j ($pre_k..$nxt_k-1) { + $arr[$j] = defined($arr[$j]) ? min($arr[$j], $k-$j): abs($k-$j); + } + $pre_k = $k; + $k = $nxt_k; + } + return [@arr]; +} + +use Test2::V0; +is sd("loveleetcode", "e"), [3,2,1,0,1,0,0,1,2,2,1,0]; +is sd("aaab","b"), [3,2,1,0]; +is sd("baaa","b"), [0,1,2,3]; +done_testing(); diff --git a/challenge-248/cheok-yin-fung/perl/ch-2.pl b/challenge-248/cheok-yin-fung/perl/ch-2.pl new file mode 100644 index 0000000000..d32fa9f6d1 --- /dev/null +++ b/challenge-248/cheok-yin-fung/perl/ch-2.pl @@ -0,0 +1,42 @@ +# The Weekly Challenge 248 +# Task 2 Submatrix Sum +use v5.30.0; +use warnings; + +sub ss { + my @mat = $_[0]->@*; + my $b; + for my $i (0..$#mat-1) { + for my $k (0..$mat[0]->$#*-1) { + $b->[$i][$k] = $mat[$i][$k]+$mat[$i][$k+1] + + $mat[$i+1][$k]+$mat[$i+1][$k+1]; + } + } + return $b; +} + +use Test2::V0; +is(ss([ + [1, 2, 3, 4], + [5, 6, 7, 8], + [9, 10, 11, 12] + ]), + [ + [14, 18, 22], + [30, 34, 38] + ] +); + +is(ss( [ + [1, 0, 0, 0], + [0, 1, 0, 0], + [0, 0, 1, 0], + [0, 0, 0, 1] + ]), + [ + [2, 1, 0], + [1, 2, 1], + [0, 1, 2] + ] +); +done_testing(); -- cgit From b73457a3770a7f9fbce8dba955e60abcf0c26f5d Mon Sep 17 00:00:00 2001 From: BarrOff <58253563+BarrOff@users.noreply.github.com> Date: Sun, 24 Dec 2023 21:17:39 +0100 Subject: feat: add solutions for challenge 248 from BarrOff --- challenge-248/barroff/perl/ch-1.pl | 40 ++++++++++++++++++++++++++++++++++++++ challenge-248/barroff/raku/ch-1.p6 | 34 ++++++++++++++++++++++++++++++++ 2 files changed, 74 insertions(+) create mode 100644 challenge-248/barroff/perl/ch-1.pl create mode 100644 challenge-248/barroff/raku/ch-1.p6 diff --git a/challenge-248/barroff/perl/ch-1.pl b/challenge-248/barroff/perl/ch-1.pl new file mode 100644 index 0000000000..b9868b1df6 --- /dev/null +++ b/challenge-248/barroff/perl/ch-1.pl @@ -0,0 +1,40 @@ +#!/usr/bin/env perl + +use v5.38; + +sub minimal_distance ( $start, @positions ) { + use List::Util qw / min /; + min( map( { abs( $start - $_ ) } @positions ) ); +} + +sub shortest_distance ( $str, $char ) { + my @split_str = split( //, $str ); + my %indices; + $indices{$_}++ for grep( { $split_str[$_] eq $char } 0 .. $#split_str ); + return () unless %indices; + my @result = + map( { exists $indices{$_} ? 0 : minimal_distance( $_, keys %indices ) } + 0 .. $#split_str ); + return \@result; +} + +sub MAIN() { + if (@ARGV) { + + #| Run on command line argument + say shortest_distance( $ARGV[0], @ARGV[ 1 .. -1 ] ); + } + else { + #| Run test cases + use Test2::V0 qw( is plan ); + plan 2; + + is shortest_distance( 'loveleetcode', 'e' ), + [ 3, 2, 1, 0, 1, 0, 0, 1, 2, 2, 1, 0 ], + "works for ('loveleetcode', 'e')"; + is shortest_distance( 'aaab', 'b' ), [ 3, 2, 1, 0 ], + "works for ('aaab', 'b')"; + } +} + +MAIN(); diff --git a/challenge-248/barroff/raku/ch-1.p6 b/challenge-248/barroff/raku/ch-1.p6 new file mode 100644 index 0000000000..2d741d95dd --- /dev/null +++ b/challenge-248/barroff/raku/ch-1.p6 @@ -0,0 +1,34 @@ +#!/usr/bin/env raku + +use v6.d; + +sub minimal-distance(Int:D $start, @positions --> Int:D) { + min(map({ abs($start - $_) }, @positions)); +} + +sub sd(Str:D $str, Str:D $char where $char.chars == 1 --> List) { + my @indices = $str.indices($char); + # return empty list if string does not contain searched character + return () unless @indices; + map({ $_ (elem) @indices + ?? 0 # index is character + !! minimal-distance($_, @indices) # find closest index + }, 0..$str.chars - 1 + ).list; +} + +#| Run test cases +multi sub MAIN('test') { + use Test; + plan 2; + + is sd('loveleetcode', 'e'), [3,2,1,0,1,0,0,1,2,2,1,0], + 'works for "e" in "loveleetcode"'; + is sd('aaab', 'b'), [3, 2, 1, 0], + 'works for "b" in "aaab"'; +} + +#| Take user provided list like aba aabb abcd bac aabc +multi sub MAIN(Str:D $str, Str:D $char) { + say sd($str, $char); +} -- cgit From a59e10181050c2e29cb70c4b29c7506f4c21e90b Mon Sep 17 00:00:00 2001 From: Roger Bell_West Date: Sun, 24 Dec 2023 21:14:18 +0000 Subject: RogerBW blog post for challenge no. 248 --- challenge-248/roger-bell-west/blog.txt | 1 + 1 file changed, 1 insertion(+) create mode 100644 challenge-248/roger-bell-west/blog.txt diff --git a/challenge-248/roger-bell-west/blog.txt b/challenge-248/roger-bell-west/blog.txt new file mode 100644 index 0000000000..24a9168a19 --- /dev/null +++ b/challenge-248/roger-bell-west/blog.txt @@ -0,0 +1 @@ +https://blog.firedrake.org/archive/2023/12/The_Weekly_Challenge_248__Shortest_Submatrix.html -- cgit From ac2065960a56ab824b6c15c6092cee8c8340d586 Mon Sep 17 00:00:00 2001 From: Util Date: Sun, 24 Dec 2023 17:13:53 -0500 Subject: Add TWC 248 solutions by Bruce Gray (in Raku only). --- challenge-248/bruce-gray/raku/ch-1.raku | 104 ++++++++++++++++++++++++++++++++ challenge-248/bruce-gray/raku/ch-2.raku | 26 ++++++++ 2 files changed, 130 insertions(+) create mode 100644 challenge-248/bruce-gray/raku/ch-1.raku create mode 100644 challenge-248/bruce-gray/raku/ch-2.raku diff --git a/challenge-248/bruce-gray/raku/ch-1.raku b/challenge-248/bruce-gray/raku/ch-1.raku new file mode 100644 index 0000000000..7077ef3fec --- /dev/null +++ b/challenge-248/bruce-gray/raku/ch-1.raku @@ -0,0 +1,104 @@ +# Distance from nearest Left, from nearest Right, minimum of the two. +# O(3N), but something about it is slowing it down. +sub task1_three_linear_scans ( Str $letter, Str $s ) { + my @sc = $s.comb; + + my $distance; # Used for side effects within two .map()'s. + my &f = { $distance = 0 if $_ eq $letter; $distance++ }; + + $distance = Inf; my @L = @sc.map(&f); + $distance = Inf; my @R = @sc.reverse.map(&f).reverse; + + return @L »min« @R; +} + +# Lots of participants used variations of this algorithm. +# It is potentially a poor performer, O(N²)?, depending on the +# number of times the letter occurs; 1K string with +# 10% $letter would be 100K comparisons. +multi sub infix: (\a, \b) { ( a - b ).abs } +sub task1_compare_to_all ( Str $letter, Str $s ) { + my @pos = $s.indices($letter); + + return map { [min] $_ «absdiff« @pos }, ^$s.chars; +} + +# More intricate, but could be wildly more efficient. +# Directly generates the whole result in a continuous single Seq. +sub task1_pyramid ( Str $letter, Str $s ) { + # Except for the head&tail, distances always form a pyramid, + # either flat-top (1 2 3 4 4 3 2 1) or pointy (1 2 3 4 3 2 1). + sub pyramid ( (Int $z1, Int $z2) ) { + my $n = $z2 - $z1 - 1; + my $m = $n div 2; + my @c = 1 .. $m; + return |0, |@c, |($m + 1 if $n !%% 2), |@c.reverse; + } + + my @pos = $s.indices($letter) + or return Inf xx $s.chars; + + # Looks faster, but that big last flatten kills performance, + # and limits us to 65K array. + # return map |*, + # (1..@pos.head).reverse, + # |@pos.rotor(2 => -1).map(&pyramid), + # 0, (1 .. ($s.chars - @pos.tail - 1)); + + return gather { + .take for reverse 1..@pos.head; + .take for |@pos.rotor(2 => -1).map({ |.&pyramid }); + .take for 0 .. ($s.chars - @pos.tail - 1); + } +} + + +constant $hamlet = 'What a piece of work is a man! how noble in reason! how infinite in faculties! in form and moving how express and admirable! in action how like an angel! in apprehension how like a god! the beauty of the world, the paragon of animals!'; +constant @tests = + ( 'e', 'loveleetcode' , [3,2,1,0,1,0,0,1,2,2,1,0] ), + ( 'b', 'aaab' , [3,2,1,0] ), + + ( 'c', 'aaab' , [Inf xx 4] ), + + # Extra tests from mark-anderson + ( 'e', 'eabcde' , [0,1,2,2,1,0] ), + ( 'e', 'eabcdf' , [0,1,2,3,4,5] ), + ( 'e', 'abecd' , [2,1,0,1,2] ), + ( 'e', 'abcefg' , [3,2,1,0,1,2] ), + ( 'e', 'eeeabecefeeg' , [0,0,0,1,1,0,1,0,1,0,0,1] ), + + ( 'a', $hamlet , [2,1,0,1,1,0,1,2,3,4,5,6,7,8,9,9,8,7,6,5,4,3,2,1,0,1,1,0,1,2,3,4,5,6,7,8,9,9,8,7,6,5,4,3,2,1,0,1,2,3,4,5,6,7,8,9,10,11,11,10,9,8,7,6,5,4,3,2,1,0,1,2,3,4,5,6,7,8,9,8,7,6,5,4,3,2,1,0,1,2,3,4,5,6,7,8,9,10,11,11,10,9,8,7,6,5,4,3,2,1,0,1,2,1,0,1,2,2,1,0,1,2,3,4,4,3,2,1,0,1,2,3,4,5,6,7,8,7,6,5,4,3,2,1,0,1,1,0,1,2,3,4,5,4,3,2,1,0,1,2,3,4,5,6,7,8,9,10,11,10,9,8,7,6,5,4,3,2,1,0,1,2,3,4,5,6,6,5,4,3,2,1,0,1,2,3,4,5,6,7,8,9,10,11,12,11,10,9,8,7,6,5,4,3,2,1,0,1,0,1,2,3,4,3,2,1,0,1,2,1,0,1,2,3] ), + ( 'e', $hamlet , [9,8,7,6,5,4,3,2,1,0,1,0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,13,12,11,10,9,8,7,6,5,4,3,2,1,0,1,2,3,2,1,0,1,2,3,4,5,6,7,8,9,8,7,6,5,4,3,2,1,0,1,2,3,4,5,6,5,4,3,2,1,0,1,2,3,4,5,6,7,8,9,10,11,12,13,13,12,11,10,9,8,7,6,5,4,3,2,1,0,1,2,1,0,1,2,3,4,5,6,7,8,7,6,5,4,3,2,1,0,1,2,3,4,5,6,7,8,9,10,9,8,7,6,5,4,3,2,1,0,1,2,3,4,3,2,1,0,1,2,3,4,5,5,4,3,2,1,0,1,0,1,2,3,4,5,6,7,6,5,4,3,2,1,0,1,2,3,4,5,5,4,3,2,1,0,1,1,0,1,2,3,4,5,5,4,3,2,1,0,1,2,3,4,5,5,4,3,2,1,0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20] ), + ( 'i', $hamlet , [8,7,6,5,4,3,2,1,0,1,2,3,4,5,6,6,5,4,3,2,1,0,1,2,3,4,5,6,7,8,9,10,9,8,7,6,5,4,3,2,1,0,1,2,3,4,5,6,7,7,6,5,4,3,2,1,0,1,1,0,1,0,1,2,1,0,1,2,3,4,4,3,2,1,0,1,2,2,1,0,1,2,3,4,5,6,7,7,6,5,4,3,2,1,0,1,2,3,4,5,6,7,8,9,10,11,11,10,9,8,7,6,5,4,3,2,1,0,1,2,3,4,3,2,1,0,1,2,3,2,1,0,1,2,3,4,4,3,2,1,0,1,2,3,4,5,6,7,6,5,4,3,2,1,0,1,2,3,4,5,6,5,4,3,2,1,0,1,2,3,4,4,3,2,1,0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,26,25,24,23,22,21,20,19,18,17,16,15,14,13,12,11,10,9,8,7,6,5,4,3,2,1,0,1,2,3,4,5] ), + ( 'o', $hamlet , [13,12,11,10,9,8,7,6,5,4,3,2,1,0,1,2,1,0,1,2,3,4,5,6,7,7,6,5,4,3,2,1,0,1,2,1,0,1,2,3,4,5,6,5,4,3,2,1,0,1,2,2,1,0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,14,13,12,11,10,9,8,7,6,5,4,3,2,1,0,1,2,3,4,4,3,2,1,0,1,2,3,3,2,1,0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,16,15,14,13,12,11,10,9,8,7,6,5,4,3,2,1,0,1,2,1,0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,15,14,13,12,11,10,9,8,7,6,5,4,3,2,1,0,1,2,1,0,1,2,3,4,5,5,4,3,2,1,0,1,2,3,4,5,6,7,7,6,5,4,3,2,1,0,1,2,3,4,3,2,1,0,1,2,3,4,5,6,7,7,6,5,4,3,2,1,0,1,1,0,1,2,3,4,5,6,7,8,9,10] ), + ( 'u', $hamlet , [71,70,69,68,67,66,65,64,63,62,61,60,59,58,57,56,55,54,53,52,51,50,49,48,47,46,45,44,43,42,41,40,39,38,37,36,35,34,33,32,31,30,29,28,27,26,25,24,23,22,21,20,19,18,17,16,15,14,13,12,11,10,9,8,7,6,5,4,3,2,1,0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31,32,33,34,35,36,37,38,39,40,41,42,43,44,45,46,47,48,49,50,51,52,53,54,55,56,57,58,59,60,61,60,59,58,57,56,55,54,53,52,51,50,49,48,47,46,45,44,43,42,41,40,39,38,37,36,35,34,33,32,31,30,29,28,27,26,25,24,23,22,21,20,19,18,17,16,15,14,13,12,11,10,9,8,7,6,5,4,3,2,1,0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31,32,33,34,35,36,37,38,39,40] ), + ( 'W', $hamlet , [0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31,32,33,34,35,36,37,38,39,40,41,42,43,44,45,46,47,48,49,50,51,52,53,54,55,56,57,58,59,60,61,62,63,64,65,66,67,68,69,70,71,72,73,74,75,76,77,78,79,80,81,82,83,84,85,86,87,88,89,90,91,92,93,94,95,96,97,98,99,100,101,102,103,104,105,106,107,108,109,110,111,112,113,114,115,116,117,118,119,120,121,122,123,124,125,126,127,128,129,130,131,132,133,134,135,136,137,138,139,140,141,142,143,144,145,146,147,148,149,150,151,152,153,154,155,156,157,158,159,160,161,162,163,164,165,166,167,168,169,170,171,172,173,174,175,176,177,178,179,180,181,182,183,184,185,186,187,188,189,190,191,192,193,194,195,196,197,198,199,200,201,202,203,204,205,206,207,208,209,210,211,212,213,214,215,216,217,218,219,220,221,222,223,224,225,226,227,228,229,230,231,232,233] ), + ( 'h', $hamlet , [1,0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,14,13,12,11,10,9,8,7,6,5,4,3,2,1,0,1,2,3,4,5,6,7,8,9,10,10,9,8,7,6,5,4,3,2,1,0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,22,21,20,19,18,17,16,15,14,13,12,11,10,9,8,7,6,5,4,3,2,1,0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,18,17,16,15,14,13,12,11,10,9,8,7,6,5,4,3,2,1,0,1,2,3,4,5,6,7,8,9,10,11,12,13,13,12,11,10,9,8,7,6,5,4,3,2,1,0,1,2,3,4,3,2,1,0,1,2,3,4,5,6,7,8,8,7,6,5,4,3,2,1,0,1,2,3,4,5,6,7,6,5,4,3,2,1,0,1,2,3,4,5,5,4,3,2,1,0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21] ), + ( 's', $hamlet , [22,21,20,19,18,17,16,15,14,13,12,11,10,9,8,7,6,5,4,3,2,1,0,1,2,3,4,5,6,7,8,9,10,11,12,12,11,10,9,8,7,6,5,4,3,2,1,0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,14,13,12,11,10,9,8,7,6,5,4,3,2,1,0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,15,14,13,12,11,10,9,8,7,6,5,4,3,2,1,0,0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,28,27,26,25,24,23,22,21,20,19,18,17,16,15,14,13,12,11,10,9,8,7,6,5,4,3,2,1,0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31,32,33,33,32,31,30,29,28,27,26,25,24,23,22,21,20,19,18,17,16,15,14,13,12,11,10,9,8,7,6,5,4,3,2,1,0,1] ), + ( '!', $hamlet , [29,28,27,26,25,24,23,22,21,20,19,18,17,16,15,14,13,12,11,10,9,8,7,6,5,4,3,2,1,0,1,2,3,4,5,6,7,8,9,10,10,9,8,7,6,5,4,3,2,1,0,1,2,3,4,5,6,7,8,9,10,11,12,13,13,12,11,10,9,8,7,6,5,4,3,2,1,0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,22,21,20,19,18,17,16,15,14,13,12,11,10,9,8,7,6,5,4,3,2,1,0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,14,13,12,11,10,9,8,7,6,5,4,3,2,1,0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,15,14,13,12,11,10,9,8,7,6,5,4,3,2,1,0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,24,23,22,21,20,19,18,17,16,15,14,13,12,11,10,9,8,7,6,5,4,3,2,1,0] ), + ( ' ', $hamlet , [4,3,2,1,0,1,0,1,2,3,2,1,0,1,1,0,1,2,2,1,0,1,1,0,1,0,1,2,2,1,0,1,2,1,0,1,2,3,2,1,0,1,1,0,1,2,3,4,3,2,1,0,1,2,1,0,1,2,3,4,4,3,2,1,0,1,1,0,1,2,3,4,5,5,4,3,2,1,0,1,1,0,1,2,2,1,0,1,2,1,0,1,2,3,3,2,1,0,1,2,1,0,1,2,3,4,3,2,1,0,1,2,1,0,1,2,3,4,5,5,4,3,2,1,0,1,1,0,1,2,3,3,2,1,0,1,2,1,0,1,2,2,1,0,1,1,0,1,2,3,3,2,1,0,1,1,0,1,2,3,4,5,6,6,5,4,3,2,1,0,1,2,1,0,1,2,2,1,0,1,0,1,2,2,1,0,1,2,1,0,1,2,3,3,2,1,0,1,1,0,1,2,1,0,1,2,3,3,2,1,0,1,2,1,0,1,2,3,4,3,2,1,0,1,1,0,1,2,3,4,5,6,7,8] ), +; +my @subs = + :&task1_three_linear_scans, + :&task1_compare_to_all, + :&task1_pyramid, +; +use Test; plan @tests * @subs; +for @subs -> ( :key($sub_name), :value(&task1) ) { + for @tests -> ( $in_letter, $in_str, @expected ) { + my @got = task1($in_letter, $in_str); + is-deeply @got, @expected, "$sub_name - $in_letter, {$in_str.substr(0,4)}"; + } +} + +my $huge = $hamlet x 10_000; +for @subs -> ( :key($sub_name), :value(&task1) ) { + my $t = now; + + my $junk = task1( ' ', $huge ) for ^10; + + say now - $t, ' ', $sub_name; +} +# 33.797148952 task1_three_linear_scans +# 8.153342333 task1_compare_to_all +# 0.915972521 task1_pyramid diff --git a/challenge-248/bruce-gray/raku/ch-2.raku b/challenge-248/bruce-gray/raku/ch-2.raku new file mode 100644 index 0000000000..8e0744aa1b --- /dev/null +++ b/challenge-248/bruce-gray/raku/ch-2.raku @@ -0,0 +1,26 @@ +sub task2_semicolon ( @m ) { + return @m.keys.skip.map: -> \r { + @m[0].keys.skip.map: -> \c { + @m[r-1,r ; c-1,c].sum + } + } +} +sub task2_stream ( @m ) { + return @m.map( *.rotor(2 => -1)».sum ) + .rotor(2 => -1) + .map: { [»+«] .list }; +} + + +my @tests = + ( ((1,2,3,4),(5,6,7,8),(9,10,11,12)) , ((14,18,22),(30,34,38)) ), + ( ((1,0,0,0),(0,1,0,0),(0,0,1,0),(0,0,0,1)) , ((2,1,0),(1,2,1),(0,1,2)) ), +; +my @subs = :&task2_semicolon, :&task2_stream; +use Test; plan @tests * @subs; +for @subs -> ( :key($sub_name), :value(&task2) ) { + for @tests -> ( @in, @expected ) { + my @got = task2(@in); + is-deeply @got».List, @expected, "$sub_name - @in[0]"; + } +} -- cgit