aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--challenge-189/bob-lied/README4
-rw-r--r--challenge-189/bob-lied/perl/ch-1.pl59
-rw-r--r--challenge-189/bob-lied/perl/ch-2.pl82
-rw-r--r--challenge-190/bob-lied/README2
-rw-r--r--challenge-190/bob-lied/perl/ch-1.pl53
-rw-r--r--challenge-190/bob-lied/perl/ch-2.pl97
6 files changed, 294 insertions, 3 deletions
diff --git a/challenge-189/bob-lied/README b/challenge-189/bob-lied/README
index c231e3a589..36e62e182d 100644
--- a/challenge-189/bob-lied/README
+++ b/challenge-189/bob-lied/README
@@ -1,3 +1,3 @@
-Solutions to weekly challenge 138 by Bob Lied
+Solutions to weekly challenge 189 by Bob Lied
-https://perlweeklychallenge.org/blog/perl-weekly-challenge-138/
+https://perlweeklychallenge.org/blog/perl-weekly-challenge-189/
diff --git a/challenge-189/bob-lied/perl/ch-1.pl b/challenge-189/bob-lied/perl/ch-1.pl
new file mode 100644
index 0000000000..4cf5031b20
--- /dev/null
+++ b/challenge-189/bob-lied/perl/ch-1.pl
@@ -0,0 +1,59 @@
+#!/usr/bin/env perl
+# vim:set ts=4 sw=4 sts=4 et ai wm=0 nu:
+#=============================================================================
+# ch-1.pl Perl Weekly Challenge Week 189 Task 1 Greater Character
+#=============================================================================
+# Copyright (c) 2023, Bob Lied
+#=============================================================================
+# You are given an array of characters (a..z) and a target character.
+# Write a script to find out the smallest character in the given array
+# lexicographically greater than the target character.
+# Example 1 Input: @array = qw/e m u g/, $target = 'b' Output: e
+# Example 2 Input: @array = qw/d c e f/, $target = 'a' Output: c
+# Example 3 Input: @array = qw/j a r/, $target = 'o' Output: r
+# Example 4 Input: @array = qw/d c a f/, $target = 'a' Output: c
+# Example 5 Input: @array = qw/t g a l/, $target = 'v' Output: v
+#=============================================================================
+
+use v5.36;
+
+use List::Util qw/min/;
+
+use Getopt::Long;
+my $Verbose = 0;
+my $DoTest = 0;
+
+GetOptions("test" => \$DoTest, "verbose" => \$Verbose);
+exit(!runTest()) if $DoTest;
+
+sub usage() { "$0 a b c ... target" }
+
+my @array = @ARGV;
+my $target = pop @array;
+
+say greaterCharacter(\@array, $target);
+
+sub greaterCharacter($array, $target)
+{
+ # map -- make a list of differences from target
+ # grep -- select only those that are greater
+ # min -- take the smallest difference
+ my $d = min grep { $_ > 0 } map { ord($_) - ord($target) } $array->@*;
+
+ # If target is the greatest, return it, otherwise convert the
+ # difference back to a character
+ return ($d ? chr( ord($target) + $d) : $target);
+}
+
+sub runTest
+{
+ use Test2::V0;
+
+ is( greaterCharacter( [ qw/e m u g/ ], 'b'), 'e', "Example 1");
+ is( greaterCharacter( [ qw/d c e f/ ], 'a'), 'c', "Example 2");
+ is( greaterCharacter( [ qw/j a r / ], 'o'), 'r', "Example 3");
+ is( greaterCharacter( [ qw/d c a f/ ], 'a'), 'c', "Example 4");
+ is( greaterCharacter( [ qw/t g a l/ ], 'v'), 'v', "Example 5");
+
+ done_testing;
+}
diff --git a/challenge-189/bob-lied/perl/ch-2.pl b/challenge-189/bob-lied/perl/ch-2.pl
new file mode 100644
index 0000000000..5ae2d2d162
--- /dev/null
+++ b/challenge-189/bob-lied/perl/ch-2.pl
@@ -0,0 +1,82 @@
+#!/usr/bin/env perl
+# vim:set ts=4 sw=4 sts=4 et ai wm=0 nu:
+#=============================================================================
+# ch-2.pl Perl Weekly Challenge Week 189 Array Degree
+#=============================================================================
+# Copyright (c) 2023, Bob Lied
+#=============================================================================
+# You are given an array of 2 or more non-negative integers.
+# Write a script to find out the smallest slice, i.e. contiguous subarray of
+# the original array, having the degree of the given array.
+# The degree of an array is the maximum frequency of an element in the array.
+#
+# Example 1 Input: @array = (1, 3, 3, 2) Output: (3, 3)
+# The degree of the given array is 2.
+# The possible subarrays having the degree 2 are as below:
+# (3, 3)
+# (1, 3, 3)
+# (3, 3, 2)
+# (1, 3, 3, 2)
+# And the smallest of all is (3, 3).
+#
+# Example 2 Input: @array = (1, 2, 1, 3) Output: (1, 2, 1)
+# Example 3 Input: @array = (1, 3, 2, 1, 2) Output: (2, 1, 2)
+# Example 4 Input: @array = (1, 1, 2, 3, 2) Output: (1, 1)
+# Example 5 Input: @array = (2, 1, 2, 1, 1) Output: (1, 2, 1, 1)
+#=============================================================================
+
+use v5.36;
+
+use List::Util qw/min/;
+use List::MoreUtils qw/frequency indexes/;
+
+use Getopt::Long;
+my $Verbose = 0;
+my $DoTest = 0;
+
+GetOptions("test" => \$DoTest, "verbose" => \$Verbose);
+exit(!runTest()) if $DoTest;
+
+sub arrayDegree($array)
+{
+ my %f = frequency($array->@*);
+ my $degree = ( sort { $b <=> $a } values %f )[0];
+
+ my $smallest = scalar(@$array);
+ my @slice = ( 0, scalar(@$array)-1 );
+
+ # For every possible value that has that degree
+ for my $v ( grep { $f{$_} == $degree } keys %f )
+ {
+ # The slice will have that value as its first and last index,
+ # so find every index where that value exists in the array.
+ my @idx = List::MoreUtils::indexes { $_ == $v } $array->@*;
+
+ # There must be $degree occurrences of the value, so take that
+ # group of indexes at a time
+ for ( my $i = 0 ; $i <= (@idx - $degree) ; $i++ )
+ {
+ my $span = $idx[$i + $degree - 1] - $idx[$i];
+ if ( $span < $smallest )
+ {
+ $smallest = $span;
+ @slice = ( $idx[$i], $idx[$i] + $span );
+ }
+ }
+ }
+ return [ $array->@[$slice[0] .. $slice[1]] ];
+}
+
+sub runTest
+{
+ use Test2::V0;
+
+ is( arrayDegree( [1,3,3,2] ), [3,3], "Example 1");
+ is( arrayDegree( [1,2,1,3] ), [1,2,1], "Example 2");
+ is( arrayDegree( [1,3,2,1,2] ), [2,1,2], "Example 3");
+ is( arrayDegree( [1,1,2,3,2] ), [1,1], "Example 4");
+ is( arrayDegree( [2,1,2,1,1] ), [1,2,1,1], "Example 5");
+
+ done_testing;
+}
+
diff --git a/challenge-190/bob-lied/README b/challenge-190/bob-lied/README
index c231e3a589..2776164929 100644
--- a/challenge-190/bob-lied/README
+++ b/challenge-190/bob-lied/README
@@ -1,3 +1,3 @@
-Solutions to weekly challenge 138 by Bob Lied
+Solutions to weekly challenge 190 by Bob Lied
https://perlweeklychallenge.org/blog/perl-weekly-challenge-138/
diff --git a/challenge-190/bob-lied/perl/ch-1.pl b/challenge-190/bob-lied/perl/ch-1.pl
new file mode 100644
index 0000000000..e77cc2ea31
--- /dev/null
+++ b/challenge-190/bob-lied/perl/ch-1.pl
@@ -0,0 +1,53 @@
+#!/usr/bin/env perl
+# vim:set ts=4 sw=4 sts=4 et ai wm=0 nu:
+#=============================================================================
+# ch-1.pl Perl Weekly Challenge Week 190 Task 1 Capital Detection
+#=============================================================================
+# Copyright (c) 2023, Bob Lied
+#=============================================================================
+# You are given a string with alphabetic characters only: A..Z and a..z.
+# Write a script to find out if the usage of Capital is appropriate if it
+# satisfies at least one of the following rules:
+# 1) Only first letter is capital and all others are small.
+# 2) Every letter is small.
+# 3) Every letter is capital.
+#
+# Example 1 Input: $s = 'Perl' Output: 1
+# Example 2 Input: $s = 'TPF' Output: 1
+# Example 3 Input: $s = 'PyThon' Output: 0
+# Example 4 Input: $s = 'raku' Output: 1
+#
+#=============================================================================
+
+use v5.36;
+
+use Getopt::Long;
+my $Verbose = 0;
+my $DoTest = 0;
+
+GetOptions("test" => \$DoTest, "verbose" => \$Verbose);
+exit(!runTest()) if $DoTest;
+
+sub capitalDetection($s)
+{
+ return 1 if $s =~ m/ \A [[:lower:]]+ \z
+ | \A [[:upper:]]+ \z
+ | \A [[:upper:]][[:lower:]]+ \z
+ /x;
+ return 0;
+}
+
+say capitalDetection($_) for @ARGV;
+
+sub runTest
+{
+ use Test2::V0;
+
+ is( capitalDetection("Perl"), 1, "Example 1 Perl");
+ is( capitalDetection("TPF"), 1, "Example 2 TPF");
+ is( capitalDetection("PyThon"), 0, "Example 3 PyThon");
+ is( capitalDetection("raku"), 1, "Example 4 raku");
+
+ done_testing;
+}
+
diff --git a/challenge-190/bob-lied/perl/ch-2.pl b/challenge-190/bob-lied/perl/ch-2.pl
new file mode 100644
index 0000000000..d5a561296f
--- /dev/null
+++ b/challenge-190/bob-lied/perl/ch-2.pl
@@ -0,0 +1,97 @@
+#!/usr/bin/env perl
+# vim:set ts=4 sw=4 sts=4 et ai wm=0 nu:
+#=============================================================================
+# ch-2.pl Perl Weekly challenge Week 190 Task 2 Decoded List
+#=============================================================================
+# Copyright (c) 2023, Bob Lied
+#=============================================================================
+# You are given an encoded string consisting of a sequence of numeric
+# characters: 0..9, $s.
+# Write a script to find the all valid different decodings in sorted order.
+# Encoding is simply done by mapping A,B,C,D,… to 1,2,3,4,… etc.
+# Example 1 Input: $s = 11 Output: AA, K
+# 11 can be decoded as (1 1) or (11) i.e. AA or K
+# Example 2 Input: $s = 1115 Output: AAAE, AAO, AKE, KAE, KO
+# Possible decoded data are:
+# (1 1 1 5) => (AAAE)
+# (1 1 15) => (AAO)
+# (1 11 5) => (AKE)
+# (11 1 5) => (KAE)
+# (11 15) => (KO)
+# Example 3 Input: $s = 127 Output: ABG, LG
+# Possible decoded data are:
+# (1 2 7) => (ABG)
+# (12 7) => (LG)
+#=============================================================================
+
+use v5.36;
+
+use Getopt::Long;
+my $Verbose = 0;
+my $DoTest = 0;
+
+GetOptions("test" => \$DoTest, "verbose" => \$Verbose);
+exit(!runTest()) if $DoTest;
+
+foreach (@ARGV )
+{
+ if ( ! m/\A[[:digit:]]+\z/ )
+ {
+ warn "Not numeric ($_)";
+ next;
+ }
+
+ say join(", ", decode($_)->@*);
+}
+
+sub decode($s)
+{
+ my @result;
+ my @stack; # Stack of possible numeric arrays
+ _split($s, [], \@stack, "");
+
+ for my $word ( @stack )
+ {
+ push @result, join("", map { chr(ord("A") + $_ - 1) } $word->@* );
+ }
+
+ return \@result;
+}
+
+sub _split($s, $sofar, $stack, $indent)
+{
+ say "${indent}Enter _split s='$s' sofar=[@$sofar] " if $Verbose;
+ my $len = length($s);
+ if ( $len == 0 )
+ {
+ say "${indent}Pushing [@$sofar]" if $Verbose;
+ push @$stack, [ @$sofar ];
+ return;
+ }
+ if ( length($s) == 1 )
+ {
+ say "${indent}Pushing [@$sofar $s]" if $Verbose;
+ push @$stack, [ @$sofar, 0+$s ];
+ return;
+ }
+ # length must be at least two, take each possibility
+ _split(substr($s,1), [ @$sofar, 0+substr($s,0,1) ], $stack, " $indent");
+
+ my $twoDigits = 0+substr($s,0,2);
+ if ( $twoDigits <= 26 )
+ {
+ _split(substr($s,2), [ @$sofar, $twoDigits ], $stack, " $indent");
+ }
+}
+
+sub runTest
+{
+ use Test2::V0;
+
+ is( decode("11"), [ qw(AA K) ], "Example 1 11");
+ is( decode("1115"), [ qw(AAAE AAO AKE KAE KO) ], "Example 2 1115");
+ is( decode("127"), [ qw(ABG LG) ], "Example 3 127");
+ is( (grep /BOBLIED/, decode("215212954")->@*), 1, "Bob");
+ done_testing;
+}
+
generated by cgit (git 2.34.1) at 2026-07-03 21:38:01 +0000