Perl Weekly Challenge: Week 74
Challenge 1:
Majority Element
You are given an array of integers of size $N.
Write a script to find the majority element. If none found then print -1.
Majority element in the list is the one that appears more than floor(size_of_list/2).
Example 1
Input: @A = (1, 2, 2, 3, 2, 4, 2)
Output: 2, as 2 appears 4 times in the list which is more than floor(7/2).
Example 2
Input: @A = (1, 3, 1, 2, 4, 5)
Output: -1 as none of the elements appears more than floor(6/2).
In order to solve this challenge, we need to know two things; how many instances of each number there are in the array and what the floor of half the length of the array is.
Raku arrays have a very useful method called .classify() which transform the array into a hash based on
criteria you provide. In this case, we are assigning each number to a key in the hash %count which has the same
name as that number. I.e. %count{1} will contain all the 1's in @A, %count{2} will contain all the 2's and so on.
my %count = @A.classify({ $_; });
$N is straightforwardly set to the floor of half the length of @A.
my $N = (@A.elems / 2).floor;
Now all we have to do is go through the keys of %count and make a list of the ones which have more than $N values or (the ||
operator) the list (-1) if there were no keys like that. And then we print the list out.
(%count.keys.grep({ %count{$_} > $N; }) || (-1)).join(q{ }).say;
As usual translating Raku into Perl involves working around missing features.
my %count;
In lieu of .classify() we can use map() to count the number of occurrences of each number in the array and add it to the %count
hash.
map { $count{$_}++; } @A;
I could have sworn that Perl has a standard floor function but apparantly it doesn't. (There is one in the non-core Math::Utils
module.) Typically in these challenges, I don't use modules though I definitely would in production code so instead I worked around
it by using int() instead. I think strictly speaking int() returns the integer part of a number whereas floor() returns the integer closest to 0. They are only equivalent for positive numbers so this code will possibly give wrong answers for negative numbers. Maybe. I don't know. Maths is hard so I close my eyes and try not to think about it.
my $N = int (scalar @A / 2);
Another problem is determining if there have been any majority elements or not. In scalar context, grep() only returns
true or false and there seems to be no way of forcing a list context short of assigning to an array which I did. Now I can
count how many matches were made and set the array to (-1) if there were 0.
my @majority = grep { $count{$_} > $N; } keys %count;
if (!scalar @majority) {
@majority = (-1);
}
say join q{ }, @majority;
Challenge 2:
FNR Character
You are given a string
$S.Write a script to print the series of first non-repeating character (left -> right) for the given string. Print
#if none found.Example 1
Input: $S = ‘ababc’
Output: ‘abb#c’
Pass 1: “a”, the FNR character is ‘a’
Pass 2: “ab”, the FNR character is ‘b’
Pass 3: “aba”, the FNR character is ‘b’
Pass 4: “abab”, no FNR found, hence ‘#’
Pass 5: “ababc” the FNR character is ‘c’
Example 2
Input: $S = ‘xyzzyx’
Output: ‘xyzyx#’
Pass 1: “x”, the FNR character is “x”
Pass 2: “xy”, the FNR character is “y”
Pass 3: “xyz”, the FNR character is “z”
Pass 4: “xyzz”, the FNR character is “y”
Pass 5: “xyzzy”, the FNR character is “x”
Pass 6: “xyzzyx”, no FNR found, hence ‘#’
This challenge confused me no end because it seems according to the examples we actually need to find the last non-repeating character or am I misunderstanding something? Anyway this is how I did it in Raku.
my @output;
For each pass we take a slice of the string, starting one character long in the first pass and extending it by one each subsequent
pass. $fnr, the first (last?) non-recurring character is initially set to #.
for (1 .. $S.chars) -> $i {
my $slice = $S.substr(0, $i);
my $fnr = '#';
Then we split that slice into an array of characters and for each character see how many times it occurs in the slice. If it
only occurs once, make it the new $fnr. There is room for optimization here. For instance we examine each character even if
it has already been seen before. In a very long string, this could be a major performance hit. Caching the number of times a character has been seen and using that cached value on second and further occurrence would be a big win. However I haven't bothered
implementing anything like that for this version.
for $slice.comb -> $c {
if ($slice ~~ m:g/ $c / == 1) {
$fnr = $c;
}
}
Whatever we end up with in $fnr (which could be # if there was no non-recurring character) is added to the @output array.
@output.push($fnr);
}
Finally @output is joined back together into a string and printed.
@output.join(q{}).say;
This is Perl:
my @output;
for my $i (1 .. length $S) {
my $slice = substr $S, 0, $i;
my $fnr = '#';
for my $c (split //, $slice) {
Here, once again, I ran into context problems. And once again I had to assign to an array in order to be able to count the matches.
my @matches = ($slice =~ /$c/g);
if (scalar @matches == 1) {
$fnr = $c;
}
}
push @output, $fnr;
}
say join q{}, @output;