RabbitFarm

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

Part 1

You are given two positive integers, $n and $k. Write a script to find out the Prime Partition of the given number. No duplicates are allowed.

Solution

use strict;
use warnings;
use boolean;
use Math::Combinatorics;

sub sieve_atkin{
    my($upper_bound) = @_;
    my @primes = (2, 3, 5);
    my @atkin = (false) x $upper_bound;    
    my @sieve = (1, 7, 11, 13, 17, 19, 23, 29, 31, 37, 41, 43, 47, 49, 53, 59);
    for my $x (1 .. sqrt($upper_bound)){
        for(my $y = 1; $y <= sqrt($upper_bound); $y+=2){
            my $m = (4 * $x ** 2) + ($y ** 2);
            my @remainders;  
            @remainders = grep {$m % 60 == $_} (1, 13, 17, 29, 37, 41, 49, 53) if $m <= $upper_bound; 
            $atkin[$m] = !$atkin[$m] if @remainders; 
        }          
    } 
    for(my $x = 1; $x <= sqrt($upper_bound); $x += 2){
        for(my $y = 2; $y <= sqrt($upper_bound); $y += 2){
            my $m = (3 * $x ** 2) + ($y ** 2);
            my @remainders;  
            @remainders = grep {$m % 60 == $_} (7, 19, 31, 43) if $m <= $upper_bound; 
            $atkin[$m] = !$atkin[$m] if @remainders; 
        }          
    }   
    for(my $x = 2; $x <= sqrt($upper_bound); $x++){
        for(my $y = $x - 1; $y >= 1; $y -= 2){
            my $m = (3 * $x ** 2) - ($y ** 2);
            my @remainders;  
            @remainders = grep {$m % 60 == $_} (11, 23, 47, 59) if $m <= $upper_bound; 
            $atkin[$m] = !$atkin[$m] if @remainders; 
        }          
    } 
    my @m;
    for my $w (0 .. ($upper_bound / 60)){
        for my $s (@sieve){
            push @m, 60 * $w + $s;  
        }
    }
    for my $m (@m){
        last if $upper_bound < ($m ** 2);
        my $mm = $m ** 2;
        if($atkin[$m]){
            for my $m2 (@m){
                my $c = $mm * $m2;
                last if $c > $upper_bound;
                $atkin[$c] = false;
            }
        }
    }
    map{ push @primes, $_ if $atkin[$_] } 0 .. @atkin - 1;
    return @primes; 
}

sub prime_partition{
    my($n, $k) = @_;
    my @partitions;
    my @primes = sieve_atkin($n);
    my $combinations = Math::Combinatorics->new(count => $k, data => [@primes]);
    while(my @combination = $combinations->next_combination()){
        push @partitions, [@combination] if unpack("%32I*", pack("I*", @combination)) == $n;
    }
    return @partitions;
}

MAIN:{
    my($n, $k);
    $n = 18, $k = 2;
    map{ 
        print "$n = " . join(", ", @{$_}) . "\n"
    } prime_partition($n, $k);
    print"\n\n";
    $n = 19, $k = 3;
    map{ 
        print "$n = " . join(", ", @{$_}) . "\n"
    } prime_partition($n, $k);
}

Sample Run

$ perl perl/ch-1.pl
18 = 7, 11
18 = 5, 13


19 = 3, 11, 5

Notes

Only when writing this short blog did I realize there is a far more efficient way of doing this!

Here we see a brute force exhaustion of all possible combinations. This works alright for when $n and $k are relatively small. For larger values a procedure like this would be better,

1. Obtain all primes $p < $n
2. Start with $n and compute $m = $n - $p for all $p
3. If $m is prime and $k = 2 DONE
4. Else set $n = $m and repeat, computing a new $m with all $p < $m stopping with the same criteria if $m is prime and $k is satisfied

This procedure would be a natural fit for recursion, if you were in the mood for that sort of thing.

Part 2

You are given an array of integers. Write a script to compute the five-number summary of the given set of integers.

Solution

use strict;
use warnings;
sub five_number_summary{
    my @numbers = @_;
    my($minimum, $maximum, $first_quartile, $median, $third_quartile);
    my @sorted = sort {$a <=> $b} @numbers;
    $minimum = $sorted[0];
    $maximum = $sorted[@sorted - 1];
    if(@sorted % 2 == 0){
        my $median_0 = $sorted[int(@sorted / 2) - 1];
        my $median_1 = $sorted[int(@sorted / 2)];
        $median = ($median_0 + $median_1) / 2;
        my @lower_half = @sorted[0 .. int(@sorted / 2)];
        my $median_lower_0 = $lower_half[int(@lower_half / 2) - 1];
        my $median_lower_1 = $lower_half[int(@lower_half / 2)];
        $first_quartile = ($median_lower_0 + $median_lower_1) / 2;       
        my @upper_half = @sorted[int(@sorted / 2) .. @sorted];
        my $median_upper_0 = $upper_half[int(@upper_half / 2) - 1];
        my $median_upper_1 = $upper_half[int(@upper_half / 2)];
        $third_quartile = ($median_upper_0 + $median_upper_1) / 2;
    }
    else{
        $median = $sorted[int(@sorted / 2)];
        $first_quartile = [@sorted[0 .. int(@sorted / 2)]]->[int(@sorted / 2) / 2];
        $third_quartile = [@sorted[int(@sorted / 2) .. @sorted]]->[(@sorted - int(@sorted / 2)) / 2];
    }
    return {
        minimum => $minimum, 
        maximum => $maximum, 
        first_quartile => $first_quartile, 
        median => $median, 
        third_quartile => $third_quartile
    };
}

MAIN:{
    my @numbers;
    my $five_number_summary;
    @numbers = (6, 3, 7, 8, 1, 3, 9);
    print join(", ", @numbers) . "\n";
    $five_number_summary = five_number_summary(@numbers);
    map{
        print "$_: $five_number_summary->{$_}\n";
    } keys %{$five_number_summary};
    print "\n\n";
    @numbers = (2, 6, 3, 8, 1, 5, 9, 4);
    print join(", ", @numbers) . "\n";    
    $five_number_summary = five_number_summary(@numbers);
    map{
        print "$_: $five_number_summary->{$_}\n";
    } keys %{$five_number_summary};
    print "\n\n";
    @numbers = (1, 2, 2, 3, 4, 6, 6, 7, 7, 7, 8, 11, 12, 15, 15, 15, 17, 17, 18, 20);
    print join(", ", @numbers) . "\n";      
    $five_number_summary = five_number_summary(@numbers);
    map{
        print "$_: $five_number_summary->{$_}\n";
    } keys %{$five_number_summary};
}

Sample Run

$ perl perl/ch-2.pl
6, 3, 7, 8, 1, 3, 9
third_quartile: 8
maximum: 9
minimum: 1
first_quartile: 3
median: 6


2, 6, 3, 8, 1, 5, 9, 4
median: 4.5
first_quartile: 2.5
minimum: 1
maximum: 9
third_quartile: 7


1, 2, 2, 3, 4, 6, 6, 7, 7, 7, 8, 11, 12, 15, 15, 15, 17, 17, 18, 20
maximum: 20
third_quartile: 15
first_quartile: 5
median: 7.5
minimum: 1

Notes

Note that the case of an even or odd number of elements of the list (and sublists) requires slightly special handling.

References

Challenge 172