PWC 199

Our good host has again given us an easy set of challenges, which works for me as I am busy at work. Again, I eschewed the guest language Julia this time, and have done the challenges only in Perl 5 and Raku.

Challenge 1 (Good pairs)

We are given a list of integers, and asked to count the number of pairs of items in the list say list[i] and list[j] where (i < j) and list[i]==list[j].

This is a one-liner in Raku using the combinations operator.

raku -e '(0..@*ARGS-1).combinations(2).grep({@*ARGS[@_[0]]==@*ARGS[@_[1]]}).elems.say' $@

From the indices of the given list (command line argument), take all pairs of indices using the combinations operator, then use grep to extract the pairs of indices that satisfy the condition. The i < j condition is automatically taken care of by the combinations operator.

I translated this to a Perl 5 one-liner using the combinations operator from Algorithm::Combinatorics. Similar logic to my Raku one-liner, but the steps are stacked from right to left.

perl -MAlgorithm::Combinatorics=combinations -wl -e 'print scalar( grep { $ARGV[$_->[0]]==$ARGV[$_->[1]] } combinations [0 .. @ARGV-1], 2)' $@

Challenge 2 (Good triplets)

This is a related problem to Challenge 1, and the same approach comes in handy.

We are given a list of integers (presumably with more than three elements) say @list, and also, a set of  three integers, x, y, and z. We are asked to count the number of triples list[i], list[j], list[k] from the list where i < j < k that satisfy:

abs(list[i] - list[j]) <= x

abs(list[j] - list[k]) <= y

abs(list[i] - list[k]) <= z

 

This is an extension of the good pairs problem. It could be a one-liner, but the complicated input requirements would make this a bit painful. I settle for a one-line subroutine. As with the good pairs, I first do it in Raku and then back port it to Perl 5.

 

Raku:

 

sub good-triplets( @array,$x,$y,$z ) {
    (0 .. @array-1)
        .combinations(3)
        .grep({abs(@array[@_[0]]-@array[@_[1]]) <= $x})
        .grep({abs(@array[@_[1]]-@array[@_[2]]) <= $y})
        .grep({abs(@array[@_[0]]-@array[@_[1]]) <= $z})
        .elems
}

Perl 5 (the same thing, but right to left; combinations from Algorithm::Combinatorics)

sub good_triplets {
    my ($x,$y,$z,@array)=@_;

    scalar(
    grep {abs($array[$_->[0]]-$array[$_->[2]]) <= $z}
    grep {abs($array[$_->[1]]-$array[$_->[2]]) <= $y}
    grep {abs($array[$_->[0]]-$array[$_->[1]]) <= $x}
    combinations [0 .. @array-1], 3 );    
}