Tonight’s music doesn’t have anything to do with the tasks; it’s just the soundtrack while I was writing up, as my wife calls it, “my cooking blog”.
Onward to the solutions for Perl Weekly Challenge 262!
Task 1: Max Positive Negative
You are given an array of integers, @ints.
Write a script to return the maximum number of either positive or negative integers in the given array.
Example 1
Input: @ints = (-3, 1, 2, -1, 3, -2, 4)
Output: 4
Count of positive integers: 4
Count of negative integers: 3
Maximum of count of positive and negative integers: 4
Example 2
Input: @ints = (-1, -2, -3, 1)
Output: 3
Count of positive integers: 1
Count of negative integers: 3
Maximum of count of positive and negative integers: 3
Example 3
Input: @ints = (1,2)
Output: 2
Count of positive integers: 2
Count of negative integers: 0
Maximum of count of positive and negative integers: 2
Approach
Really, this is two loops over the array of integers. One to count positive ints, one to count negative ints. If I do a map of the array each time and return 1 for each int I want to count and 0 for each int I don’t want to count, I can do the counting with a sum operator.
Raku
Like last week, we use Raku’s Reduction Metaoperator with addition ([+]) for the summation, and the max routine on the Any class to pick the maximum.
sub maxPosNeg(@ints) {
my $pos = [+] @ints.map({ $_ > 0 ?? 1 !! 0 });
my $neg = [+] @ints.map({ $_ < 0 ?? 1 !! 0 });
my $max = max $pos, $neg;
return (
$max,
(
"Count of positive integers: $pos",
"Count of negative integers: $neg",
"Maximum of count of positive and " ~
"negative integers: $max"
).join("\n")
);
}
Yes, it looks like Perl.
$ raku/ch-1.raku
Example 1:
Input: @arr = (-3, 1, 2, -1, 3, -2, 4)
Output: 4
Count of positive integers: 4
Count of negative integers: 3
Maximum of count of positive and negative integers: 4
Example 2:
Input: @arr = (-1, -2, -3, 1)
Output: 3
Count of positive integers: 1
Count of negative integers: 3
Maximum of count of positive and negative integers: 3
Example 3:
Input: @arr = (1, 2)
Output: 2
Count of positive integers: 2
Count of negative integers: 0
Maximum of count of positive and negative integers: 2
View the entire Raku script for this task on GitHub.
Perl
In Perl, we can get max and sum from List::Util.
sub maxPosNeg(@ints) {
my $pos = sum map { $_ > 0 ? 1 : 0 } @ints;
my $neg = sum map { $_ < 0 ? 1 : 0 } @ints;
my $max = max $pos, $neg;
return (
$max,
join("\n",
"Count of positive integers: $pos",
"Count of negative integers: $neg",
"Maximum of count of positive and " .
"negative integers: $max"
)
);
}
View the entire Perl script for this task on GitHub.
Python
For Python, sum and max are built in and don’t need to be pulled in from a library.
def maxPosNeg(ints):
pos = sum([1 for i in ints if i > 0])
neg = sum([1 for i in ints if i < 0])
maxCount = max(pos, neg)
return (
maxCount,
"\n".join([
f"Count of positive integers: {pos}",
f"Count of negative integers: {neg}",
f"Maximum of count of positive and " +
f"negative integers: {maxCount}"
])
)
View the entire Python script for this task on GitHub.
Task 2: Count Equal Divisible
You are given an array of integers, @ints and an integer $k.
Write a script to return the number of pairs (i, j) where
a) 0 <= i < j < size of @ints
b) ints[i] == ints[j]
c) i x j is divisible by k
Example 1
Input: @ints = (3,1,2,2,2,1,3) and $k = 2
Output: 4
(0, 6) => ints[0] == ints[6] and 0 x 6 is divisible by 2
(2, 3) => ints[2] == ints[3] and 2 x 3 is divisible by 2
(2, 4) => ints[2] == ints[4] and 2 x 4 is divisible by 2
(3, 4) => ints[3] == ints[4] and 3 x 4 is divisible by 2
Example 2
Input: @ints = (1,2,3) and $k = 1
Output: 0
Approach
Ok, let’s look at these criteria:
0 <= i < j < size of @ints. For a 0-indexed array, it means that both i and j are indices of the array (the 0 <= and < size of @ints parts) and that i < j. Not a big deal.
ints[i] == ints[j] means the numbers at these indices are the same. So Example 2 fails this criteria because none of the numbers are the same.
i x j is divisible by k. Really, this is the big condition.
As with the last task, we’re counting.
Raku
Here I’m leaning into the Raku looking like Perl.
sub countEquDiv($k, @ints) {
my @explain;
my $cnt = 0;
for 0 .. @ints.end - 1 -> $i {
for $i + 1 .. @ints.end -> $j {
# does ints[i] == ints[j]?
next unless @ints[$i] == @ints[$j];
# is i x j divisible by k?
next unless ( ($i * $j) mod $k ) == 0;
# count the pair and explain why
$cnt++;
@explain.push(
"($i, $j) => ints[$i] == ints[$j] " ~
"and $i x $j is divisible by $k"
);
}
}
return($cnt, @explain.join("\n"));
}
$ raku/ch-2.raku
Example 1:
Input: @arr = (3, 1, 2, 2, 2, 1, 3) and $k = 2
Output: 4
(0, 6) => ints[0] == ints[6] and 0 x 6 is divisible by 2
(2, 3) => ints[2] == ints[3] and 2 x 3 is divisible by 2
(2, 4) => ints[2] == ints[4] and 2 x 4 is divisible by 2
(3, 4) => ints[3] == ints[4] and 3 x 4 is divisible by 2
Example 2:
Input: @arr = (1, 2, 3) and $k = 1
Output: 0
View the entire Raku script for this task on GitHub.
Perl
sub countEquDiv($k, @ints) {
my @explain;
my $cnt = 0;
foreach my $i ( 0 .. $#ints - 1 ) {
foreach my $j ( $i + 1 .. $#ints ) {
# does ints[i] == ints[j]?
next unless $ints[$i] == $ints[$j];
# is i x j divisible by k?
next unless ( ($i * $j) % $k ) == 0;
# count the pair and explain why
$cnt++;
push @explain,
"($i, $j) => ints[$i] == ints[$j] " .
"and $i x $j is divisible by $k";
}
}
return($cnt, join("\n", @explain));
}
View the entire Perl script for this task on GitHub.
Python
Here I’m leaning into the Python looking like Perl. I mean, except for the lack of block delimiters and sigils, how can you NOT think this looks like perl?
def countEquDiv(k, ints):
explain = []
cnt = 0
for i in range(len(ints) - 1):
for j in range(i+1, len(ints)):
# does ints[i] == ints[j]?
if not ints[i] == ints[j]: break
# is i x j divisible by k?
if not ( (i * j) % k ) == 0: break
# count the pair and explain why
cnt += 1
explain.append(
f"({i}, {j}) => ints[{i}] == ints[{j}] " +
f"and {i} x {j} is divisible by {k}"
)
return(cnt, "\n".join(explain))
View the entire Python script for this task on GitHub.
Here’s all my solutions in GItHub: https://github.com/packy/perlweeklychallenge-club/tree/master/challenge-262/packy-anderson