Perl Weekly Challenge 283: Unique Number
These are some answers to the Week 283, Task 1, of the Perl Weekly Challenge organized by Mohammad S. Anwar.
Spoiler Alert: This weekly challenge deadline is due in a few days from now (on August 25, 2024, at 23:59). This blog post provides some solutions to this challenge. Please don’t read on if you intend to complete the challenge on your own.
Task 1: Unique Number
You are given an array of integers, @ints
, where every element appears more than once except one element.
`
Write a script to find the one element that appears exactly one time.
Example 1
Input: @ints = (3, 3, 1)
Output: 1
Example 2
Input: @ints = (3, 2, 4, 2, 4)
Output: 3
Example 3
Input: @ints = (1)
Output: 1
Example 4
Input: @ints = (4, 3, 1, 1, 1, 4)
Output: 3
We will assume that the input array of integers is valid in accordance with the specification above, i.e. that every element appears more than once except one element. Therefore, we will not try to validate the input array (although this would be quite easy).
Unique Number in Raku
We first use a Bag to create the count
histogram of frequencies. Then we return the Bag
's key for which the value is 1.
sub find-unique-number (@in) {
my $count = @in.Bag;
return (grep { $count{$_ } == 1}, $count.keys).first;
}
my @tests = <3 3 1>, <3 2 4 2 4>, (1,), <4 3 1 1 1 4>;
for @tests -> @test {
printf "%-12s => ", "@test[]";
say find-unique-number @test;
}
This program displays the following output:
$ raku ./unique-number.raku
3 3 1 => 1
3 2 4 2 4 => 3
1 => 1
4 3 1 1 1 4 => 3
Unique Number in Perl
This is a port to Perl of the above Raku program. Note that we use a hash (%count
) instead of a Bag
to host the histogram of frequencies.
use strict;
use warnings;
use feature 'say';
sub find_unique_number {
my %count;
$count{$_}++ for @_;
return (grep { $count{$_ } == 1} keys %count)[0];
}
my @tests = ([<3 3 1>], [<3 2 4 2 4>], [1,], [<4 3 1 1 1 4>]);
for my $test (@tests) {
printf "%-12s => ", "@$test";
say find_unique_number @$test;
}
This program displays the following output:
$ perl ./unique-number.pl
3 3 1 => 1
3 2 4 2 4 => 3
1 => 1
4 3 1 1 1 4 => 3
Wrapping up
The next week Perl Weekly Challenge will start soon. If you want to participate in this challenge, please check https://perlweeklychallenge.org/ and make sure you answer the challenge before 23:59 BST (British summer time) on September 1, 2024. And, please, also spread the word about the Perl Weekly Challenge if you can.
Leave a comment