diff options
| -rw-r--r-- | challenge-248/bob-lied/README | 6 | ||||
| -rw-r--r-- | challenge-248/bob-lied/perl/ch-1.pl | 141 | ||||
| -rw-r--r-- | challenge-248/bob-lied/perl/ch-2.pl | 75 |
3 files changed, 219 insertions, 3 deletions
diff --git a/challenge-248/bob-lied/README b/challenge-248/bob-lied/README index ddf6e99243..882a98a265 100644 --- a/challenge-248/bob-lied/README +++ b/challenge-248/bob-lied/README @@ -1,4 +1,4 @@ -Solutions to weekly challenge 247 by Bob Lied +Solutions to weekly challenge 248 by Bob Lied -https://perlweeklychallenge.org/blog/perl-weekly-challenge-247/ -https://github.com/boblied/perlweeklychallenge-club/tree/master/challenge-247/bob-lied +https://perlweeklychallenge.org/blog/perl-weekly-challenge-248/ +https://github.com/boblied/perlweeklychallenge-club/tree/master/challenge-248/bob-lied diff --git a/challenge-248/bob-lied/perl/ch-1.pl b/challenge-248/bob-lied/perl/ch-1.pl new file mode 100644 index 0000000000..e202a54191 --- /dev/null +++ b/challenge-248/bob-lied/perl/ch-1.pl @@ -0,0 +1,141 @@ +#!/usr/bin/env perl +# vim:set ts=4 sw=4 sts=4 et ai wm=0 nu: +#============================================================================= +# Copyright (c) 2023, Bob Lied +#============================================================================= +# ch-1.pl Perl Weekly Challenge 248 Task 1 Shortest Distance +#============================================================================= +# 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 '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) +#============================================================================= + +use v5.38; + +use builtin qw/true false ceil floor/; no warnings "experimental::builtin"; + +use List::Util qw/min/; + +use Getopt::Long; +my $Verbose = 0; +my $DoTest = 0; + +GetOptions("test" => \$DoTest, "verbose" => \$Verbose); +exit(!runTest()) if $DoTest; + +say "(", join(",", shortest(@ARGV)->@*), ")"; + +sub shortest($str, $char) +{ + my @dist; + my @s = split //, $str; # str as vector of characters + + # List of indexes where char appears + my @cloc = grep { $s[$_] eq $char } 0 .. $#s; + + # Potentially a lot of useless array operations, math + # and comparisons if char appears a lot. + for my $i ( 0 .. $#s ) # For each letter in str + { + # List of location differences + # vvvvvvvvvvvvvvvvvvvvvvvvvvvv + push @dist, min map { abs($_ - $i) } @cloc; + } + return \@dist; +} + +# Only two location differences really matter: the next one +# ahead or the last one behind. Alternate implementation +# looks only for those two. Potentially a lot of string +# scanning if there are very few occurences of char in a +# long string. +sub sd2($str, $char) +{ + my @dist; + for my $i ( 0 .. length($str)-1 ) + { + my $ahead = index($str, "$char", $i); + my $behind = rindex($str, "$char", $i); + + if ( $ahead < 0 && $behind < 0 ) + { + push @dist, undef; + } + else + { + $behind = $ahead if $behind == -1; + $ahead = $behind if $ahead == -1; + push @dist, min abs($i - $behind), abs($ahead - $i); + } + } + return \@dist; +} + +# We don't really need to calculate the differences for each +# letter. The distance counts down until we see the first occurence, +# then up until half way to the next occurrence, then down again. +# Given the locations of the character, we can generate the sequences. +sub sd3($str, $char) +{ + return [ (undef) x length($str) ] if index($str, $char) < 0; + my @s = split //, $str; # str as vector of characters + + # List of indexes where char appears + my @cloc = grep { $s[$_] eq $char } 0 .. $#s; + + my @dist; + my $loc = shift @cloc; + push @dist, reverse 0 .. $loc; + while ( defined(my $next = shift @cloc) ) + { + my $diff = $next - $loc -1; + push @dist, (1 .. ceil($diff/2)), reverse( 0 .. floor($diff/2)); + $loc = $next; + } + if ( $loc < $#s ) + { + push @dist, 1 .. ($#s - $loc); + } + return \@dist; +} + +sub runTest +{ + use Test2::V0; + + is( shortest("loveleetcode", 'e'), [3,2,1,0,1,0,0,1,2,2,1,0], "Example 1"); + is( shortest("aaab", 'b'), [3,2,1,0], "Example 2"); + + is( shortest("ab", 'x'), [undef, undef], "no x in str"); + is( shortest("", 'x'), [], "empty string"); + + is( sd2("loveleetcode", 'e'), [3,2,1,0,1,0,0,1,2,2,1,0], "sd2 Example 1"); + is( sd2("aaab", 'b'), [3,2,1,0], "sd2 Example 2"); + + is( sd2("ab", 'x'), [undef, undef], "sd2 no x in str"); + is( sd2("", 'x'), [], "sd2 empty string"); + + is( sd3("loveleetcode", 'e'), [3,2,1,0,1,0,0,1,2,2,1,0], "sd3 Example 1"); + is( sd3("aaab", 'b'), [3,2,1,0], "sd3 Example 2"); + + is( sd3("ab", 'x'), [undef, undef], "sd3 no x in str"); + is( sd3("", 'x'), [], "sd3 empty string"); + + done_testing; +} diff --git a/challenge-248/bob-lied/perl/ch-2.pl b/challenge-248/bob-lied/perl/ch-2.pl new file mode 100644 index 0000000000..dc98c4d1aa --- /dev/null +++ b/challenge-248/bob-lied/perl/ch-2.pl @@ -0,0 +1,75 @@ +#!/usr/bin/env perl +# vim:set ts=4 sw=4 sts=4 et ai wm=0 nu: +#============================================================================= +# Copyright (c) 2023, Bob Lied +#============================================================================= +# +# ch-2.pl Perl Weekly Challenge 248 Task 2 Submatrix Sum +#============================================================================= +# 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] ] +#============================================================================= + +use v5.38; + +use builtin qw/true false/; no warnings "experimental::builtin"; + +use Getopt::Long; +my $Verbose = 0; +my $DoTest = 0; + +GetOptions("test" => \$DoTest, "verbose" => \$Verbose); +exit(!runTest()) if $DoTest; + +sub sms($m) +{ + my $height = $m->$#*; + my $width = $m->[0]->$#*; + + my @output; + push @output, [ (0) x $width ] for 0 .. $height -1; + + for my $i ( 0 .. $height-1 ) + { + for my $k ( 0 .. $width-1 ) + { + $output[$i][$k] = $m->[$i ][$k] + $m->[$i ][$k+1] + + $m->[$i+1][$k] + $m->[$i+1][$k+1]; + } + } + return \@output; +} + +sub runTest +{ + use Test2::V0; + + is( sms( [ [1, 2, 3, 4], + [5, 6, 7, 8], + [9, 10, 11, 12] ]), + [ [14, 18, 22], [30, 34, 38] ] , "Example 1"); + + is( sms( [ [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] ], "Example 2"); + + done_testing; +} |