RabbitFarm

2022-07-10

Partition the Summary

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

posted at: 20:39 by: Adam Russell | path: /perl | permanent link to this entry