From eed490f2597a01a5fe4b85eee31bb0205d68f8e4 Mon Sep 17 00:00:00 2001
From: Adam Russell <ac.russell@live.com>
Date: Sun, 10 Jul 2022 18:23:11 -0400
Subject: initial commit

---
 challenge-172/adam-russell/blog.txt     |  1 +
 challenge-172/adam-russell/perl/ch-1.pl | 83 +++++++++++++++++++++++++++++++++
 challenge-172/adam-russell/perl/ch-2.pl | 65 ++++++++++++++++++++++++++
 3 files changed, 149 insertions(+)
 create mode 100644 challenge-172/adam-russell/blog.txt
 create mode 100644 challenge-172/adam-russell/perl/ch-1.pl
 create mode 100644 challenge-172/adam-russell/perl/ch-2.pl

diff --git a/challenge-172/adam-russell/blog.txt b/challenge-172/adam-russell/blog.txt
new file mode 100644
index 0000000000..19c05e95de
--- /dev/null
+++ b/challenge-172/adam-russell/blog.txt
@@ -0,0 +1 @@
+http://www.rabbitfarm.com/cgi-bin/blosxom/perl/2022/07/10
\ No newline at end of file
diff --git a/challenge-172/adam-russell/perl/ch-1.pl b/challenge-172/adam-russell/perl/ch-1.pl
new file mode 100644
index 0000000000..d9a419af61
--- /dev/null
+++ b/challenge-172/adam-russell/perl/ch-1.pl
@@ -0,0 +1,83 @@
+use strict;
+use warnings;
+##
+# 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.
+##
+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);
+}
\ No newline at end of file
diff --git a/challenge-172/adam-russell/perl/ch-2.pl b/challenge-172/adam-russell/perl/ch-2.pl
new file mode 100644
index 0000000000..2a4f07af3a
--- /dev/null
+++ b/challenge-172/adam-russell/perl/ch-2.pl
@@ -0,0 +1,65 @@
+use strict;
+use warnings;
+##
+# You are given an array of integers. Write a script to compute the five-number summary 
+# of the given set of integers.
+##
+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};
+}
+
+
-- 
cgit