aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--challenge-189/bob-lied/README4
-rw-r--r--challenge-189/bob-lied/ch-1.pl59
-rw-r--r--challenge-189/bob-lied/ch-2.pl82
-rw-r--r--challenge-189/bob-lied/perl/ch-1.pl59
-rw-r--r--challenge-189/bob-lied/perl/ch-2.pl82
5 files changed, 284 insertions, 2 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/ch-1.pl b/challenge-189/bob-lied/ch-1.pl
new file mode 100644
index 0000000000..4cf5031b20
--- /dev/null
+++ b/challenge-189/bob-lied/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/ch-2.pl b/challenge-189/bob-lied/ch-2.pl
new file mode 100644
index 0000000000..5ae2d2d162
--- /dev/null
+++ b/challenge-189/bob-lied/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-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;
+}
+
generated by cgit (git 2.34.1) at 2026-07-04 19:04:29 +0000