I dunno. I saw “DI string” and thought of Lady Di. It’s Christmas. I’m full of yummy Christmas food and not firing on all cylinders.
Onward to Perl Weekly Challenge 249!
Task 1: Equal Pairs
You are given an array of integers with even number of elements.
Write a script to divide the given array into equal pairs such that:
a) Each element belongs to exactly one pair.
b) The elements present in a pair are equal.
Example 1
Input: @ints = (3, 2, 3, 2, 2, 2)
Output: (2, 2), (3, 3), (2, 2)
There are 6 elements in @ints.
They should be divided into 6 / 2 = 3 pairs.
@ints is divided into the pairs (2, 2), (3, 3), and (2, 2) satisfying all the conditions.
Example 2
Input: @ints = (1, 2, 3, 4)
Output: ()
There is no way to divide @ints 2 pairs such that the pairs satisfy every condition.
Approach
Ok, this reminds me of PWC 237’s Task 2, where we wound up counting the integers in our input list and subtracting them from that count instead of pulling them off a list. In this case, I think a similar approach would work: loop over the input list and count up how many of each integer we have. If we don’t have an even number of each integer, we can fail immediately because we can’t satisfy condition b. Then we pull integers off the count by twos.
Raku
sub equalPairs(@ints) {
my @pairs;
my %num_count;
# count how many of each int we have
for @ints -> $num {
%num_count{$num}++;
}
# first, make sure we have even numbers of each integer
for %num_count.kv -> $k, $v {
next if $v % 2 == 0; # it's even, we can make pairs
return @pairs; # we have an odd number, can't make pairs
}
# now make pairs from those integers
for %num_count.kv -> $k, $v {
my $count = $v; # the values $k, $v are read-only
while ($count > 0) {
@pairs.push( [$k, $k] );
$count -= 2;
}
}
return @pairs;
}
View the entire Raku script for this task on GitHub.
Perl
sub equalPairs(@ints) {
my @pairs;
my %num_count;
# count how many of each int we have
foreach my $num ( @ints ) {
$num_count{$num}++;
}
# first, make sure we have even numbers of each integer
foreach my $k ( keys %num_count ) {
my $v = $num_count{$k};
next if $v % 2 == 0; # it's even, we can make pairs
return @pairs; # we have an odd number, can't make pairs
}
# now make pairs from those integers
foreach my $k ( keys %num_count ) {
my $count = $num_count{$k};
while ($count > 0) {
push @pairs, [$k, $k];
$count -= 2;
}
}
return @pairs;
}
View the entire Perl script for this task on GitHub.
Python
from collections import Counter
def equalPairs(nums):
pairs = []
num_count = Counter()
# count how many of each int we have
for num in nums:
num_count[num] += 1
# first, make sure we have even numbers of each integer
for k, v in dict(num_count).items():
if v % 2 == 0: # it's even, we can make pairs
continue
else:
return pairs # we have an odd number, no pairs
# now make pairs from those integers
for k, v in dict(num_count).items():
count = v # the values k, v are read-only
while count > 0:
pairs.append( [k, k] )
count -= 2
return pairs
View the entire Python script for this task on GitHub.
Task 2: DI String Match
You are given a string s, consisting of only the characters "D" and "I".
Find a permutation of the integers [0 .. length(s)] such that for each character s[i] in the string:
s[i] == 'I' ⇒ perm[i] < perm[i + 1]
s[i] == 'D' ⇒ perm[i] > perm[i + 1]
Example 1
Input: $str = "IDID"
Output: (0, 4, 1, 3, 2)
Example 2
Input: $str = "III"
Output: (0, 1, 2, 3)
Example 3
Input: $str = "DDI"
Output: (3, 2, 0, 1)
Approach
Again, this reminds me of PWC 237’s Task 2, this time because we sorted the integers so we could pull maximum and minimum integers off a list. In this case, the range 0 .. length(s) is sorted already, but we would take a similar approach to building the output permutation list: if the letter is D, we pull the maximum number off the end of the list, guaranteeing that it will be greater than anything that could come after it. If the letter is I, we pull the minimum number off the beginning of the list, guaranteeing that it will be less than anything that could come after it.
Raku
sub diStringMatch($str) {
my @permutation;
# first, generate the list of integers
# we're making permutations of
my @nums = 0 .. $str.chars;
# now let's generate our permutation
for $str.split('', :skip-empty) -> $c {
if ($c eq 'D') {
# take the largest number available
@permutation.push( @nums.pop() );
}
else {
# take the smallest number available
@permutation.push( @nums.shift() );
}
}
# add last remaining number
@permutation.push( @nums[0] );
return @permutation;
}
View the entire Raku script for this task on GitHub.
Perl
sub diStringMatch($str) {
my @permutation;
# first, generate the list of integers
# we're making permutations of
my @nums = 0 .. length($str);
# now let's generate our permutation
foreach my $c ( split(//, $str) ) {
if ($c eq 'D') {
# take the largest number available
push @permutation, pop(@nums);
}
else {
# take the smallest number available
push @permutation, shift(@nums);
}
}
# add last remaining number
push @permutation, $nums[0];
return @permutation;
}
View the entire Perl script for this task on GitHub.
Python
def diStringMatch(str):
permutation = []
# first, generate the list of integers
# we're making permutations of
nums = list(range(len(str)+1))
# now let's generate our permutation
for c in str:
if c == 'D':
# take the largest number available
permutation.append( nums.pop(-1) )
else:
# take the smallest number available
permutation.append( nums.pop(0) )
# add last remaining number
permutation.append( nums[0] )
return permutation
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-249/packy-anderson