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;

(Full code on Github.)

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;

(Full code on Github.)

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.


Finally @output is joined back together into a string and printed.


(Full code on Github.)

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;

(Full code on Github.)