Merge pull request #4988 from choroba/ech133

E. Choroba's solutions to 133: Integer Square Root & Smith Numbers

2 files changed, 104 insertions, 0 deletions

diff --git a/challenge-133/e-choroba/perl/ch-1.pl b/challenge-133/e-choroba/perl/ch-1.pl
new file mode 100755
index 0000000000..f245b685f5
--- /dev/null
+++ b/challenge-133/e-choroba/perl/ch-1.pl
@@ -0,0 +1,54 @@
+#!/usr/bin/perl
+use warnings;
+use strict;
+
+sub naive_isqr {
+    my ($n) = @_;
+    my $i = 0;
+    1 while ++$i ** 2 <= $n;
+    return $i - 1
+}
+
+sub newton_isqr {
+    my ($n) = @_;
+    my $x0 = $n >> 1;
+    return $n unless $x0;
+
+    my $x1 = ( $x0 + $n / $x0 ) >> 1;
+    while ($x1 < $x0) {
+        $x0 = $x1;
+        $x1 = ($x0 + $n / $x0 ) >> 1;
+    }
+    return $x0
+}
+
+use Test2::V0;
+plan 13;
+
+is newton_isqr(10), 3, 'Example 1';
+is newton_isqr(27), 5, 'Example 2';
+is newton_isqr(85), 9, 'Example 3';
+is newton_isqr(101), 10, 'Example 4';
+
+is newton_isqr(25), 5, 'Exact';
+is newton_isqr(24), 4, 'One below';
+
+for my $n (10, 27, 85, 101, 25, 24, 123456) {
+    is naive_isqr($n), newton_isqr($n), "Same $n";
+}
+
+use Benchmark qw{ cmpthese };
+cmpthese(-3, {
+    naive  => sub {  naive_isqr(123456) },
+    newton => sub { newton_isqr(123456) },
+});
+
+=begin Benchmark
+
+           Rate  naive newton
+naive   82453/s     --   -92%
+newton 998832/s  1111%     --
+
+=end Benchmark
+
+=cut
diff --git a/challenge-133/e-choroba/perl/ch-2.pl b/challenge-133/e-choroba/perl/ch-2.pl
new file mode 100755
index 0000000000..5744ce336b
--- /dev/null
+++ b/challenge-133/e-choroba/perl/ch-2.pl
@@ -0,0 +1,50 @@
+#!/usr/bin/perl
+use warnings;
+use strict;
+use feature qw{ say };
+
+use List::Util qw{ sum };
+
+my @primes = (2, 3, 5);
+
+sub prime_factors {
+    my ($n) = @_;
+
+    my $p = $primes[-1] + 2;
+    while ($p < 1 + $n / 2) {
+        push @primes, $p unless grep 0 == $p % $_, @primes;
+        $p += 2;
+    }
+
+    my $m = $n;
+    my @factors;
+    for my $p (@primes) {
+        if (0 == $m % $p) {
+            $m /= $p;
+            push @factors, $p;
+            redo
+        }
+    }
+    return @factors
+}
+
+sub smith_numbers {
+    my ($count) = @_;
+    my @smith;
+    my $n = 4;
+    while (@smith < $count) {
+        my @factors = prime_factors($n);
+        next unless @factors > 1;
+
+        push @smith, $n
+            if sum(split //, join "", @factors) == sum(split //, $n);
+    } continue {
+        ++$n;
+    }
+    return @smith
+}
+
+use Test2::V0;
+plan 1;
+
+is [smith_numbers(10)], [4, 22, 27, 58, 85, 94, 121, 166, 202, 265];