PERL WEEKLY CHALLENGE – 074

This is my 44th week participating into the weekly challenge.



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

For the first challenge I just stored the number of times the number appears in a hash ($counts) and then sorted the hash. If the hash meet the min requirements output the number and if not output -1

Perl 5 solution

#!/usr/bin/perl
# Test: ./ch-1.pl
use Modern::Perl;
use POSIX qw/ floor /;
use Test::More;

is majority_element(1, 2, 2, 3, 2, 4, 2), 2, '(1, 2, 2, 3, 2, 4, 2)';
is majority_element(1, 3, 1, 2, 4, 5), -1, '(1, 3, 1, 2, 4, 5)';
done_testing;

sub majority_element {
	my %counts;
	map { $counts{$_}++ } @_;

	# Majority element
	my ($m) = sort { $counts{$b} <=> $counts{$a} }
	          keys %counts;

	return ($counts{$m} > floor(scalar(@_)/2)) ?
		$m : -1;
}

Output: perl ./ch-1.pl

(0, 0, 0,ok 1 - (1, 2, 2, 3, 2, 4, 2)
ok 2 - (1, 3, 1, 2, 4, 5)
1..2

Raku solution

# Test: perl6 ch-1.p6
use Test;

sub MAIN() {
	is majority_element((1, 2, 2, 3, 2, 4, 2)), 2, '(1, 2, 2, 3, 2, 4, 2)';
	is majority_element((1, 3, 1, 2, 4, 5)), -1, '(1, 3, 1, 2, 4, 5)';
	done-testing();
}

sub majority_element(@A) {
	my %counts;
	@A.map({ %counts{$_}++ });

	# Majority element
	my $m = %counts.keys
	               .sort({ %counts{$^b} <=> %counts{$^a} })
	               .first;


	return (%counts{$m} > floor(@A.elems/2)) ??
		$m !! -1;
}

Output perl6 ch-1.p6

ok 1 - (1, 2, 2, 3, 2, 4, 2)
ok 2 - (1, 3, 1, 2, 4, 5)
1..2


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

For this task I just iterated through the array and checked if the letter was unique. If the letter was not unique, I would iterate through the array a second time to find a unique letter. If no unique letters were found display the #


Perl 5 solution

#!/usr/bin/perl
# Test: ./ch-2.pl
use Modern::Perl;
use Test::More;

is fnr('ababc'),  'abb#c', 'ababc';
is fnr('xyzzyx'), 'xyzyx#', 'xyzzyx';
done_testing;

sub fnr {
	my @S = split('', shift);
	my %counts;
	my $output;

	for (my $i = 0; $i < scalar(@S); $i++) {
		my $c = $S[$i]; #character
		my $fnr;

		# If this is the first time the
		# letter exists use it
		$fnr = $c
			if (not defined($counts{$c}));

		# Increment counts
		$counts{$c}++;

		# Use the first non repeating
		# if there is no duplicate
		unless ($fnr) {
			for (my $j = $i - 1; $j >= 0; $j--) {
				my $c2 = $S[$j];
				if ( defined($counts{$c2}) &&
				     $counts{$c2} == 1 ) {
					$fnr = $c2;
					last;
				}
			}
		}

		# If we didn't find a possible
		# frn use a #
		$fnr = '#' unless($fnr);

		$output .= $fnr;
	}

	return $output
}

Output ./ch-2.pl

ok 1 - ababc
ok 2 - xyzzyx
1..2

Raku solution

# Test: perl6 ch-2.p6
use Test;

sub MAIN() {
	is fnr('ababc'),  'abb#c', 'ababc';
	is fnr('xyzzyx'), 'xyzyx#', 'xyzzyx';
	done-testing();
}

sub fnr(Str $S) {
	my @S = $S.comb;
	my %counts;
	my $output;

	loop (my $i = 0; $i < @S.elems; $i++) {
		my $c = @S[$i]; #character
		my $fnr;

		# If this is the first time the
		# letter exists use it
		$fnr = $c
			if (not defined(%counts{$c}));

		# Increment counts
		%counts{$c}++;

		# Use the first non repeating
		# if there is no duplicate
		unless ($fnr) {
			loop (my $j = $i - 1; $j >= 0; $j--) {
				my $c2 = @S[$j];
				if ( defined(%counts{$c2}) &&
				     %counts{$c2} == 1 ) {
					$fnr = $c2;
					last;
				}
			}
		}

		# If we didn't find a possible
		# frn use a #
		$fnr = '#' unless ($fnr);

		$output ~= $fnr;
	}

	return $output
}

Output perl6 ch-2.p6

ok 1 - ababc
ok 2 - xyzzyx
1..2

2 thoughts on “PERL WEEKLY CHALLENGE – 074

Leave a Reply

Fill in your details below or click an icon to log in:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out /  Change )

Google photo

You are commenting using your Google account. Log Out /  Change )

Twitter picture

You are commenting using your Twitter account. Log Out /  Change )

Facebook photo

You are commenting using your Facebook account. Log Out /  Change )

Connecting to %s