Perl Weekly Challenge: Week 156
Challenge 1:
Pernicious Numbers
Write a script to permute first
10 Pernicious Numbers.A pernicious number is a positive integer which has prime number of ones in its binary representation.
The first pernicious number is 3 since binary representation of 3 = (11) and 1 + 1 = 2, which is a prime.
Expected Output
3, 5, 6, 7, 9, 10, 11, 12, 13, 14
Raku has all the components you need to make solving this challenge easy.
I started by setting up an array to hold the results and a scalar to hold the number we are checking for perniciousness. It is initiallized to as that is the first prime number but I now realize that is wrong. We can start at the first number which has a prime number of 1's in its' binary representation which is 3. I mean it says so right in the spec so I don't know how I missed that but somehow I did.
my @pernicious;
my $count = 2;
Now until we have 10 results in our @pernicious array...
while @pernicious.elems < 10 {
- we convert
$countto binary with.base() - split that binary number into individual digits with
.comb() - find which of those digits are 1's with
.grep() - count how many 1's we found with
.elems() see if that amount is a prime number with
.is-prime()if $count.base(2).comb.grep({ $_ eq '1'; }).elems.is-prime {
If after all that we do have a prime number, $count is a pernicious number so we add it to the results.
@pernicious.push($count);
}
If we are not done, we move on to the next number.
$count++;
}
When we have all the results we can print them out nicely separated by commas.
@pernicious.join(q{, }).say;
The Perl version works the same way except I used sprintf() for binary conversion, split() to replace .comb()
and I reused my isPrime() function from previous challenges.
my @pernicious;
my $count = 2;
while (scalar @pernicious < 10) {
my @binary = split //, sprintf '%b', $count;
if (isPrime( scalar grep { $_ eq '1'} @binary)) {
push @pernicious, $count;
}
$count++;
}
say join q{, }, @pernicious;
Challenge 2:
Weird Number
You are given number,
$n > 0.Write a script to find out if the given number is a
Weird Number.According to Wikipedia, it is defined as:
The sum of the proper divisors (divisors including 1 but not itself) of the number is greater than the number, but no subset of those divisors sums to the number itself.
Example 1:
Input: $n = 12
Output: 0
Since the proper divisors of 12 are 1, 2, 3, 4, and 6, which sum to 16; but 2 + 4 + 6 = 12.
Example 2:
Input: $n = 70
Output: 1
As the proper divisors of 70 are 1, 2, 5, 7, 10, 14, and 35; these sum to 74, but no subset of these sums to 70.
This is the Raku solution.
The issue of finding proper divisors had come up before in challenge 142 so I just reused the code from there.
my @divisors = (1 ..^ $n).grep({ $n %% $_; });
The first test we should apply according to the spec is to see if the sum of the divisors is greater than the number. If it is less or equal, we print a 0 and bail out of the program.
if ([+] @divisors) <= $n {
say 0;
exit;
}
Now we need to check each combination of divisors to make sure it is not equal to the number. The code below does that If a combination is equal to the number, once again we print 0 and quit.
for @divisors.combinations -> $combo {
if ([+] $combo) == $n {
say 0;
exit;
}
}
If after all that we reach here, we know we have a weird number so this time we print 1.
say 1;
I had to reuse code from previous weeks in the Perl solution for this challenge too. This time it was
combinations() and sum(). One annoyance about combinations() I haven't got around to fixing yet is that
is only produces combinations of a fixed length. So to get all combinations, an extra for loop is needed. Other
than this, the code works exactly the same as the Raku version.
my @divisors = grep { $n % $_ == 0 } 1 .. $n - 1;
if (sum(\@divisors) <= $n) {
say 0;
exit;
}
for my $i (1 .. scalar @divisors - 1) {
for my $combo (combinations(\@divisors, $i)) {
if (sum($combo) == $n) {
say 0;
exit;
}
}
}
say 1;