RabbitFarm

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

Part 1

You are given an array (3 or more members) of integers in increasing order and a positive integer. Write a script to find out the number of unique Arithmetic Triplets satisfying the given rules.

Solution

use v5.38;
sub arithmetic_triplets{
    my $counter = 0;
    my $difference = shift;
    arithmetic_triplets_r($difference, \$counter, [@_[0 .. @_ -1]], [@_[1 .. @_ -1]], [@_[2 .. @_ -1]]);   
    return $counter;
} 

sub arithmetic_triplets_r{
    my $difference = $_[0]; 
    my $counter = $_[1]; 
    my @i = @{$_[2]};         
    my @j = @{$_[3]};         
    my @k = @{$_[4]};        
    if(@i > 0 && @j > 0 && @k > 0){
        $$counter++ if $j[0] - $i[0] == $difference && $k[0] - $j[0] == $difference;   
        arithmetic_triplets_r($difference, $counter, [@i], [@j], [@k[1 .. @k - 1]]);   
    }
    elsif(@i > 0 && @k == 0 && @j > 0){
        arithmetic_triplets_r($difference, $counter, [@i], [@j[1 .. @j - 1]], [@j[2 .. @j - 1]]);   
    }
    elsif(@i > 0 && @k == 0 && @j == 0){
        arithmetic_triplets_r($difference, $counter, [@i[1 .. @i - 1]], [@i[2 .. @i - 1]], [@i[3 .. @i - 1]]);   
    }
}

MAIN:{
    my $difference;
    $difference = 3;
    say arithmetic_triplets $difference, 0, 1, 4, 6, 7, 10;
    $difference = 2;
    say arithmetic_triplets $difference, 4, 5, 6, 7, 8, 9;  
}

Sample Run

$ perl perl/ch-1.pl 
2
2

Notes

The rules for arithmetic triples are a) i < j < k b) nums[j] - nums[i] == diff and c) nums[k] - nums[j] == diff, where diff is a provided parameter. The code above implements these rules somewhat in the obvious way, looping thricely over the list, but recursively.

Part 2

You are given an array of unique positive integers greater than 2. Write a script to sort them in ascending order of the count of their prime factors, tie-breaking by ascending value.

Solution

use v5.38;
sub prime_factor{
    my $x = shift(@_); 
    my @factors;    
    for (my $y = 2; $y <= $x; $y++){
        next if $x % $y;
        $x /= $y;
        push @factors, $y;
        redo;
    }
    return @factors;  
}

sub prime_order{
    my %factor_i = map{($_, 0 + prime_factor($_))} @_;
    my $factor_sorter = sub{
        my $c = $factor_i{$a} <=> $factor_i{$b};
        return $c unless !$c;
        return $a <=> $b;
    };
    return sort $factor_sorter @_;
}

MAIN:{
     say join q/, /, prime_order 11, 8, 27, 4;
}

Sample Run

$ perl perl/ch-2.pl 
11, 4, 8, 27

Notes

This code borrows from two previous challenges: The prime factor code has been used several times, but in this case I referred to the Attractive Number challenge from TWC 041. The sorting is a variant of the frequency sort from TWC 233. If you write enough code you don't need GitHub Copilot, you can just re-use your own work!

References

Challenge 241