Merge pull request #6274 from jacoby/master

169 - done but not blogged

2 files changed, 124 insertions, 0 deletions

diff --git a/challenge-169/dave-jacoby/perl/ch-1.pl b/challenge-169/dave-jacoby/perl/ch-1.pl
new file mode 100644
index 0000000000..5d6764590c
--- /dev/null
+++ b/challenge-169/dave-jacoby/perl/ch-1.pl
@@ -0,0 +1,53 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+use experimental qw{ say postderef signatures state };
+
+my $iter = make_iterator(2);
+my @brilliant;
+
+while ( my $i = $iter->() ) {
+    push @brilliant, $i if is_brilliant($i);
+    last if scalar @brilliant >= 20;
+}
+say join ', ', @brilliant;
+
+sub is_brilliant( $n ) {
+    my @factors = get_factors($n);
+
+    # two prime factors
+    return 0 unless scalar @factors == 2;
+
+    # same length
+    return 0 unless length $factors[0] == length $factors[1];
+    return 1;
+}
+
+sub is_prime ($n) {
+    die "Bad number $n" unless length $n;
+    return 0 if $n == 0;
+    return 0 if $n == 1;
+    for ( 2 .. sqrt $n ) { return 0 unless $n % $_ }
+    return 1;
+}
+
+sub get_factors( $n ) {
+    my @factors;
+    for my $i ( 2 .. $n ) {
+        next unless $n % $i == 0;
+        while ( $n % $i == 0 ) {
+            push @factors, $i;
+            $n = $n / $i;
+        }
+    }
+    return @factors;
+}
+
+sub make_iterator($n) {
+    return sub {
+        state $v = $n;
+        return $v++;
+    }
+}
+
diff --git a/challenge-169/dave-jacoby/perl/ch-2.pl b/challenge-169/dave-jacoby/perl/ch-2.pl
new file mode 100644
index 0000000000..8c31e12b8f
--- /dev/null
+++ b/challenge-169/dave-jacoby/perl/ch-2.pl
@@ -0,0 +1,71 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+use experimental qw{ say postderef signatures state };
+
+my $iter = make_iterator(2);
+my @achilles;
+
+while ( my $i = $iter->() ) {
+    next if is_achilles($i) == 0;
+    push @achilles, $i;
+    last if scalar @achilles >= 20;
+}
+
+say join ', ', @achilles;
+exit;
+
+sub is_achilles( $n ) {
+    return 0 if is_prime($n);
+    return 0 if !is_powerful($n);
+    return 0 if is_perfect($n);
+    return 1;
+}
+
+sub is_perfect( $n ) {
+    for my $i ( 2 .. $n ) {
+        my $j = $n**( 1 / $i );
+        return 1 if ( $j =~ /^-?\d+$/ ) ;
+    }
+    return 0;
+}
+
+sub is_powerful($n) {
+    my @factors = get_factors($n);
+    my %factors;
+    map { $factors{$_}++ } @factors;
+    for my $f ( keys %factors ) {
+        return 0 if $factors{$f} < 2;
+    }
+    return 1;
+
+}
+
+sub is_prime ($n) {
+    die "Bad number $n" unless length $n;
+    return 0 if $n == 0;
+    return 0 if $n == 1;
+    for ( 2 .. sqrt $n ) { return 0 unless $n % $_ }
+    return 1;
+}
+
+sub get_factors( $n ) {
+    my @factors;
+    for my $i ( 2 .. $n ) {
+        next unless $n % $i == 0;
+        while ( $n % $i == 0 ) {
+            push @factors, $i;
+            $n = $n / $i;
+        }
+    }
+    return @factors;
+}
+
+sub make_iterator($n) {
+    return sub {
+        state $v = $n;
+        return $v++;
+    }
+}
+