Another week, time for another Weekly Perl Challenge!
Task 1: Lexicographic Order
You are given an array of strings.
Write a script to delete element which is not lexicographically sorted (forwards or backwards) and return the count of deletions.
Example 1
Input: @str = ("abc", "bce", "cae")
Output: 1
In the given array "cae" is the only element which is not lexicographically sorted.
Example 2
Input: @str = ("yxz", "cba", "mon")
Output: 2
In the given array "yxz" and "mon" are not lexicographically sorted.
I had to look up when “Lexicographic Order” was on the off chance that it wasn’t what I thought it was. Essentially, it means it’s sorted alphabetically. That was pretty obvious from the examples, so I just dove in:
#!/usr/bin/env perl
use v5.38;
sub quoted_list {
# given a list, quote the elements and join them with commas
my @quoted = map { qq{"$_"} } @_;
return join q{, }, @quoted;
}
sub quoted_english_list {
# given a list, quote the elements and join them
# in a way that makes sense to english speakers
my @quoted = map { qq{"$_"} } @_;
my $last = pop @quoted; # last element in array
if (@quoted == 0) {
# using an array in a scalar context returns
# the number of elements in the array
# there was only one element in the list
return $last;
}
my $joined = join q{, }, @quoted;
if (@quoted > 1) {
# if there's more than element, add an Oxford comma
$joined .= q{,};
}
return "$joined and $last";
}
sub is_lexically_sorted {
my $input = shift @_;
# get the characters in the input string
my @characters = split //, $input;
# generate a string of the characters sorted ascending
# (with case folding)
my $forwards = join q{}, sort {
fc($a) cmp fc($b)
} @characters;
# generate a string of the characters sorted descending
# (with case folding)
my $backwards = join q{}, sort {
fc($b) cmp fc($a)
} @characters;
# if the input string is matches either sorted string,
# then return true
return( $input eq $forwards || $input eq $backwards );
}
sub solution {
my @str = @_;
say "Input: \@str = (" . quoted_list(@str) . ")";
my @not_lexically_sorted = grep {
! is_lexically_sorted($_)
} @str;
say "Output: " . scalar(@not_lexically_sorted);
say "";
if (@not_lexically_sorted == 0) {
say "In the given array all elements are"
. " lexicographically sorted.";
}
elsif (@not_lexically_sorted == 1) {
say "In the given array "
. quoted_list(@not_lexically_sorted)
. " is the only element which is not"
. " lexicographically sorted.";
}
else {
say "In the given array "
. quoted_english_list(@not_lexically_sorted)
. " are not lexicographically sorted.";
}
}
say "Example 1:";
solution("abc", "bce", "cae");
say "";
say "Example 2:";
solution("yxz", "cba", "mon");
I added a bunch of extra subroutines to make the code more readable: quoted_list and quoted_english_list let me just say how I want to display the list, rather than repeating the code every time I want to display it. And the is_lexically_sorted function make the grep that I’m using to determine which array elements aren’t lexicographically sorted more readable as well. Whether it’s Perl or not, sometimes it’s just good coding practice to pull out pieces of your code that represent a concept and make them their own function, even if they’re only being used in only one place, because it just makes the code conceptually easier to understand.
The Raku version
#!/usr/bin/env raku
use v6;
sub quoted_list ( *@list ) {
# given a list, quote the elements and join them with commas
my @quoted = @list.map: { qq{"$_"} };
return @quoted.join(q{, });
}
sub quoted_english_list ( *@list ) {
# given a list, quote the elements and join them
# in a way that makes sense to english speakers
my @quoted = @list.map: { qq{"$_"} };
my $last = @quoted.pop(); # last element in array
if (@quoted == 0) {
# using an array in a scalar context returns
# the number of elements in the array
# there was only one element in the list
return $last;
}
my $joined = join q{, }, @quoted;
if (@quoted > 1) {
# if there's more than element, add an Oxford comma
$joined ~= q{,};
}
return "$joined and $last";
}
sub is_lexically_sorted ($input) {
# get the characters in the input string
# putting $input in quotes casts it as a Str
my @characters = "$input".split("", :skip-empty);
# sort the characters ascending
my @forwards = @characters.sort: { $^a.fc cmp $^b.fc };
# sort the characters descending
my @backwards = @characters.sort: { $^b.fc cmp $^a.fc };
# if the input string is matches either sorted string,
# then return true
return( $input eq @forwards.join("")
||
$input eq @backwards.join("") );
}
sub solution (*@str) {
say "Input: \@str = (" ~ quoted_list(@str) ~ ")";
my @not_lexically_sorted = @str.grep({
!is_lexically_sorted($_)
});
say "Output: " ~ @not_lexically_sorted.elems;
say "";
if (@not_lexically_sorted.elems == 0) {
say "In the given array all elements are"
~ " lexicographically sorted.";
}
elsif (@not_lexically_sorted.elems == 1) {
say "In the given array "
~ quoted_list(@not_lexically_sorted)
~ " is the only element which is not"
~ " lexicographically sorted.";
}
else {
say "In the given array "
~ quoted_english_list(@not_lexically_sorted)
~ " are not lexicographically sorted.";
}
}
say "Example 1:";
solution("abc", "bce", "cae");
say "";
say "Example 2:";
solution("yxz", "cba", "mon");
This is mostly like the Perl solution above, but I decided to play around a little with slurpy parameters in my function signatures.
Task 2: Two out of Three
You are given three array of integers.
Write a script to return all the elements that are present in at least 2 out of 3 given arrays.
Example 1
Input: @array1 = (1, 1, 2, 4)
@array2 = (2, 4)
@array3 = (4)
Ouput: (2, 4)
Example 2
Input: @array1 = (4, 1)
@array2 = (2, 4)
@array3 = (1, 2)
Ouput: (1, 2, 4)
Perl version:
#!/usr/bin/env perl
use v5.38;
# function to return unique elements in array
use List::Util qw( uniq );
sub display_array {
return "(" . join(q{, }, @_) . ")";
}
sub solution {
my @arrays = @_;
say "Input: \@array1 = " . display_array( @{ $arrays[0] } );
say " \@array2 = " . display_array( @{ $arrays[1] } );
say " \@array3 = " . display_array( @{ $arrays[2] } );
# Return all the elements that are present in at least 2 out
# of 3 given arrays. In the sample input, there are arrays
# where there elements appear multiple times in a given
# array, so we want to examine only UNIQUE elements
my @unique;
foreach my $arrayref ( @arrays ) {
push @unique, [ uniq @$arrayref ];
}
# now that we have arrays of only unique elements, let's find
# elements that occur in more than one array using a hash
my %occurrences;
foreach my $arrayref ( @unique ) {
foreach my $element ( @$arrayref ) {
$occurrences{$element}++;
}
}
say "Output: " . display_array(
sort # sort the resulting array of elements numerically
grep {
# only include elements that were counted more than once
$occurrences{$_} > 1;
} keys %occurrences
);
}
say "Example 1:";
solution(
[1, 1, 2, 4],
[2, 4],
[4]
);
say "";
say "Example 2:";
solution(
[4, 1],
[2, 4],
[1, 2]
);
Raku version
#!/usr/bin/env raku
use v6;
sub display_array (@array) {
return "(" ~ @array.join(q{, }) ~ ")";
}
sub solution (@array1, @array2, @array3) {
say "Input: \@array1 = " ~ display_array(@array1);
say " \@array2 = " ~ display_array(@array2);
say " \@array3 = " ~ display_array(@array3);
# Return all the elements that are present in at least 2 out
# of 3 given arrays. In the sample input, there are arrays
# where there elements appear multiple times in a given
# array, so we want to examine only UNIQUE elements, then
# find elements that occur in more than one array using
# a hash
my %occurrences;
for ( @array1.unique,
@array2.unique,
@array3.unique ).flat -> $element {
%occurrences{$element}++;
}
say "Output: " ~ display_array(
# only include elements that were counted more than once
%occurrences.keys().grep: { %occurrences{$_} > 1 }
).sort; # sort the resulting array of elements numerically
}
say "Example 1:";
solution(
(1, 1, 2, 4),
(2, 4),
(4,)
);
say "";
say "Example 2:";
solution(
(4, 1),
(2, 4),
(1, 2)
);
I want to point out my discovering the .flat method for Arrays.
Note that in the Perl version, I’m passing around array references to keep the three lists, separate, but in Raku, I’m able to make the three different parameters full-on arrays. Also, in Perl I had to pull in a function from a core module to get a list of unique elements in an array, but in Raku, the .unique method is provide on the base class Any.
Here’s my solutions in GitHub: https://github.com/manwar/perlweeklychallenge-club/tree/master/challenge-229/packy-anderson
