RabbitFarm

The examples used here are from the weekly challenge problem statement and demonstrate the working solution.

Part 1

You are given an array of words made up of alphabets only. Write a script to find the number of pairs of similar words. Two words are similar if they consist of the same characters.

Solution

use v5.38;
use boolean;

sub is_similar{
    my($s0, $s1) = @_;
    my(%h0, %h1);
    do { $h0{$_} = undef } for split //, $s0; 
    do { $h1{$_} = undef } for split //, $s1; 
    return false if keys %h0 != keys %h1;
    do { return false if !exists $h1{$_} } for keys %h0;
    return true;
}

sub similar_words_pairs_count{
    my @words = @_;
    my @similar;
    do{
        my $word_index = $_;
        my @similar_temp = grep { $words[$word_index] ne $words[$_] && 
                                  is_similar $words[$word_index], $words[$_] } $word_index + 1 .. @words - 1;
        push @similar, @words[@similar_temp] if @similar_temp > 0;
    } for 0 .. @words - 1;
    return @similar + 0;
}

MAIN:{
    say similar_words_pairs_count qw/aba aabb abcd bac aabc/;
    say similar_words_pairs_count qw/aabb ab ba/;
    say similar_words_pairs_count qw/nba cba dba/;
}

Sample Run

$ perl perl/ch-1.pl 
2
3
0

Notes

The core of this problem is to count up the number of pairs of similar words. A clearly good use of grep, but how to do that exactly? Well, here we define a subroutine is_similar that returns a true/false value depending on if the words meet the definition of similar given in the problem. That's done by expanding the words into arrays of characters, stuffing those characters into hash key slots in order to force uniqueness, and then seeing if the two key sets are equal.

Once we have the logic to determine similarity worked out we can then use it in grep and count up the results.

Part 2

You are given an array of integers. Write a script to sort the given array in increasing order based on the frequency of the values. If multiple values have the same frequency then sort them in decreasing order.

Solution

use v5.38;
sub frequency_sort{
    my(@numbers) = @_;
    my %frequency;
    do{$frequency{$_}++} for @numbers;
    my $frequency_sorter = sub{
        my $c = $frequency{$a} <=> $frequency{$b};
        return $c unless !$c;
        return $b <=> $a;

    };
    return sort $frequency_sorter @numbers;
}

MAIN:{
    say join q/, /, frequency_sort 1, 1, 2, 2, 2, 3;
    say join q/, /, frequency_sort 2, 3, 1, 3, 2;
    say join q/, /, frequency_sort -1, 1, -6, 4, 5, -6, 1, 4, 1
}

Sample Run

$ perl perl/ch-2.pl 
3, 1, 1, 2, 2, 2
1, 3, 3, 2, 2
5, -1, 4, 4, -6, -6, 1, 1, 1

Notes

This problem ended up being a bit more complex than it seemed after the first reading. Perl makes this sort of complexity easy to manage though! sort can take a custom sorting subroutine as an argument. That is what is done here, with the requirements of the frequency sort for this problem implemented within the subroutine referenced by $frequency_sorter. This is written as an anonymous subroutine in order to obtain a closure around %frequency. Finally, observe that we can use the scalar reference directly with sort. sort is flexible enough to know how to use the reference.

References

Challenge 233

What's the Frequency, Kenneth?