When Majority Rule Plays Finders Keepers

Wherein we explore the plurality controlling the common culture and the unique qualities that define character amongst the avant guard, leading the pack…

THE WEEKLY CHALLENGE – PERL & RAKU #74

TASK #1 › Majority Element

Submitted by: Mohammad S Anwar

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).

---

Method

The “Majority Element“, as defined, is a value found in the plurality of positions in the array. If the array is more than half “2”s, then 2 is the Majority Element. Because our definition is for more than half, obviously no other element can share that distinction, so there can be, much like the Noble Integer, “only one“. I will refer interested readers to this aforementioned discussion for pop culture references to The Highlander, as I have already extensively covered that ground previously.

Let’s begin with a tautology: to determine the count of elements it seems reasonable to count them. By iterating our array into an incrementing hash we can easily access this count information later.

What we wish to determine is whether the maximum count of the values is greater than than half the list size. If so, that element is the majority, if not, there is no such element. The cutoff is determined by a formula given in the definition:

C_max > ⎣S/2⎦ where S ≔ elements in list

When the list length is even, this will be one half, if the length is odd, it will be 0.5 less that fraction. In either case this the last cardinal number less that the plurality, so exceeding it ensures the definition has been met.

The easiest way to accomplish this is to sort the array descending according to each element’s count. This will place the element with the highest count first; we can then take that element, compare its count to a calculated value and output the result.

But there are other ways to do it. Alternately we could let the indexing itself decide for us, by sorting the list as before and determining whether the first element and the element immediately to the far side of center are the same. That element will be at index int(@A/2). If so, we have established a nice visual confirmation that the element is the majority.

Or even, if we can conclude the value of the highest count is larger than those of all the others combined, then that element is in the majority. These different approaches are interesting, but all are still sort of logically dancing around the same maypole. I do however find a certain elegance in the third version, I must say. I love all my children, but I may love that one most of all.

Perl Solution

Unable to decide in the end, I have included all three versions for your perusal.

[colincrain:~/PWC]$  perl 74_1_majority_ruler.pl 4 1 3 4 4 9 4 2 4 
input: 4 1 3 4 4 9 4 2 4
ver 1: 4
ver 2: 4
ver 3: 4

use warnings;
use strict;
use feature ":5.26";

## ## ## ## ## MAIN:

my @A = @ARGV;
@A = (1, 2, 2, 3, 3, 4, 2, 2, 2) if @A = 0;
say "input: @A";

my %count;
$count{$_}++ for @A;

# version 1:
# is first elem count larger than half list size?
my $max = ( sort { $count{$b} <=> $count{$a} } keys %count )[0];
say "ver 1: ", $count{$max} > int(@A/2) ? $max : -1;

## version 2:
## if first elem same at far side of center?
my @sorted = sort {$count{$b} <=> $count{$a}} @A;
say "ver 2: ", $sorted[0] eq $sorted[int(@A/2)] ? $sorted[0] : -1;

## version 3:
## is maximum count greater than the sum for all other values?
use List::Util qw(sum);
my ($candidate, $count) = ($sorted[0], $count{$sorted[0]});
delete $count{$sorted[0]};
my $others = sum values %count;
say "ver 3: ", $count > $others ? $candidate : -1;

Raku Solution

In Raku, we get max built in, which simplifies things a bit, and we can even further include an &by routine to apply over the array in making the determination. I love this functionality; it makes things quite simplified and straightforward. So we’re going to go with short and sweet and clean for this version.

unit sub MAIN (*@A);

@A = 1, 2, 2, 3, 2, 4, 2 if @A.elems == 0;  #default
my %count;
%count{$_}++ for @A;

# is count of first elem count larger than half list size?
my $max = @A.max({%count{$_}});
say %count{$max} > (@A.elems/2).Int ?? $max !! -1 ;

---

TASK #2 › FNR Character

Submitted by: Mohammad S Anwar

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 ‘#’

---

Method

Again I find the name of this challenge a bit misleading. Wouldn’t “last” non-repeating character be more apt? “First non-repeating character looking backwards from a given point in a string?”. Bit wordy, that one. But we’re compiling a string of these, so how about “First non-repeating character looking backwards from each character in a string“. Well there’s a mouthful. But I don’t mind. In a sense, I like how figuring out what the task really is becomes part of the puzzle. In this sense the challenges mimic the real world. As I seem to say repeatedly, life is messy and what people are asking of you is very often not what they want to know, or even what they need to know. Asking the right question is key.

In any case the first order of business is to plot out the action:

We can then rephrase these steps in pseudoperl:

list -> char:
    uniq{char}++
if uniq{char} == 1: 
    push stack, fnr unless fnr == '#'
    fnr = char
    next
if uniq{fnr} == 2:      ## match to fnr
    stack = grep { uniq == 1 } stack
    if stack has elements:
        fnr = pop stack
    else 
        fnr = '#'

Pretty straightforward. Now, before we begin in earnest, let’s talk about ‘#’. The octothorpe, or call it what you will, is of course a character. The challenge only specifies with the word ‘character’, suggesting any character. However, there is a default action, which is to write # to the list when there are no non-repeating characters. See the problem? If we allow # as valid input, our default behavior pollutes the data should a “real” pound sign be present anywhere. We have a dichotomy between “real” and “default” #s. This is similar to the problem of terminating characters, as one needs to ensure the termination signal cannot randomly appear unbidden, although perhaps this situation is less dire and more tolerable. In the absence of clarification and context, it is impossible to say.

The simplest, and most sensible, solution is to not allow the # character in our data stream. We filter it out and call it a day. It’s not a bad way of dealing with this problem, really. For example, you can’t use # in a Wikipedia article title. You just can’t: the C# programming language is under “C sharp”. Life continues.

Or put another way, pick a null token that doesn’t collide with real data so the two can never conflict.

On the other hand, this doesn’t mean we can’t do it, only that we perhaps shouldn’t.

Perl Solution

For the Perl solution we follow the flow of the pseudocode. We will take the plunge and make a small alteration to allow #, in turn opening the door to weird data, under the presumption we otherwise don’t care. So now we will produce a # if that is in fact the FNR character, but also produce a # should there be no non-repeating characters to pick. Again, not sure this is a good idea, but it’s only mission-critical medical equipment, what could possibly go wrong? Hey! Where’s everybody going? Why are you looking at me like that?

[colincrain:~/PWC]$  perl 74_2_finders_keepers.pl xyzyxz#wxuvvuw
xyzzz##wwuvuw#

use warnings;
use strict;
use feature ":5.26";

## ## ## ## ## MAIN:

my $str = shift @ARGV // '#yzzy#w';
my %uniq;
my $fnr = undef;
my @prev;
my $output;

while (my $char = substr $str, 0, 1, '') {
    $uniq{$char}++;
    
    if ($uniq{$char} == 1) {
        push @prev, $fnr unless not defined $fnr;
        $fnr = $char;
    }    
    elsif ($uniq{$fnr} == 2) {
        @prev = grep { $uniq{$_} == 1 } @prev;
        $fnr = @prev ? pop @prev : undef;
    }
    $output .= $fnr // '#';
}

say $output;

Raku Solution

Unable to leave well enough alone, I hacked in a way here too for the octothorpes to run free, unfettered. “I still don’t know about this” he said, slowly shaking his head. “It ain’t right. Those things are dangerous.” Well we’ll just have to see, no won’t we?

Note because $fnr can now be Nil, of type Any, we will need to use the === operator to check equality in the middle to avoid a stern talking-to from the complier.

[colincrain:~/PWC]$  raku 74-2-finders-keepers.raku xyzyxz#wxuvvuw
xyzyxz#wxuvvuw
xyzzz##wwuvuw#

unit sub MAIN (Str $str = 'xyzzyxwvuvu');

## because of dynamic conditions, we need to 
## recheck uniqueness as individual chars are added 
## we will use a hash to keep track of char counts
my %unique;
my $fnr;
my @prev;
my $output;

## 1. divide str
## 2. apply function over characters to determine fnr
## 3. return either fnr or '#' if Nil
## 4. join back into single string
$output = $str.comb
              .map({ %unique{$_}++;  
                     $fnr = do {
                          when %unique{$_} == 1 {
                              @prev.push($fnr) if $fnr.defined;
                              $_;                       
                          }
                          when $_ === $fnr {
                              ## recheck for uniqueness
                              @prev .= grep({ %unique{$_} == 1 });
                              @prev.pop // Nil;
                          }
                          $fnr;  
                     }
                     (defined $fnr) ?? $fnr !! '#';              
                })
              .join('');

$str   .say;
$output.say;