Merge pull request #4985 from jo-37/contrib

Solutions to challenge 133

2 files changed, 148 insertions, 0 deletions

diff --git a/challenge-133/jo-37/perl/ch-1.pl b/challenge-133/jo-37/perl/ch-1.pl
new file mode 100755
index 0000000000..263116b17b
--- /dev/null
+++ b/challenge-133/jo-37/perl/ch-1.pl
@@ -0,0 +1,72 @@
+#!/usr/bin/perl -s
+
+use v5.16;
+use integer;
+use Test2::V0;
+use experimental 'signatures';
+
+our ($tests, $examples);
+
+run_tests() if $tests || $examples;	# does not return
+
+die <<EOS unless @ARGV;
+usage: $0 [-examples] [-tests] [N]
+
+-examples
+    run the examples from the challenge
+ 
+-tests
+    run some tests
+
+N
+    calculate integer square root of N
+
+EOS
+
+
+### Input and Output
+
+say int_sqrt(shift);
+
+
+### Implementation
+
+# Following the formulae in
+# https://en.wikipedia.org/wiki/Integer_square_root#Using_only_integer_division
+
+sub int_sqrt ($n) {
+    my $prev = $n;
+    while () {
+        my $next = ($prev + $n / $prev) / 2;
+        return $prev if $next >= $prev;
+        $prev = $next;
+    }
+}
+
+
+### Examples and tests
+
+use Math::Prime::Util ();
+
+sub run_tests {
+    SKIP: {
+        skip "examples" unless $examples;
+
+        is int_sqrt(10), 3, 'example 1';
+        is int_sqrt(27), 5, 'example 2';
+        is int_sqrt(85), 9, 'example 3';
+        is int_sqrt(101), 10, 'example 4';
+    }
+
+    SKIP: {
+        skip "tests" unless $tests;
+
+        my $mpu_sqrtint = \&Math::Prime::Util::sqrtint;
+        grep {
+            int_sqrt($_) != $mpu_sqrtint->($_) and !fail "$_ failed";
+        } 1 .. 1e5 or pass 'cross check';
+	}
+
+    done_testing;
+    exit;
+}
diff --git a/challenge-133/jo-37/perl/ch-2.pl b/challenge-133/jo-37/perl/ch-2.pl
new file mode 100755
index 0000000000..76f65ebfdc
--- /dev/null
+++ b/challenge-133/jo-37/perl/ch-2.pl
@@ -0,0 +1,76 @@
+#!/usr/bin/perl -s
+
+use v5.16;
+use Test2::V0;
+use Math::Prime::Util qw(factor_exp vecsum todigits);
+use Coro::Generator;
+use experimental 'signatures';
+
+our ($tests, $base);
+$base //= 10;
+die "invalid base: $base" unless $base > 1;
+
+run_tests() if $tests;	# does not return
+
+die <<EOS unless @ARGV == 1;
+usage: $0 [-tests] [-base=B] [N]
+
+-tests
+    run some tests
+
+-base=B
+    find Smith numbers for base B. Default: 10
+
+N
+    print the first N Smith numbers.
+   
+EOS
+
+
+### Input and Output
+
+main: {
+    # Create a generator for Smith numbers.
+    my $smith = generator {
+        for (my $n = 1;; $n++) {
+            yield $n if is_smith($n, $base);
+        }
+    };
+
+    say join ', ', map $smith->(), 1 .. shift;
+}
+
+
+### Implementation
+
+# Math::Prime::Util has everything we need to solve this task:
+# - convert a number into its representation for a given base
+# - find all factors (and their multiplicity) of a number 
+# - sum the elements of a list
+# Excluding primes as trivial cases of Smith numbers.
+#
+# See http://oeis.org/A006753
+
+sub is_smith ($n, $base=10) {
+    vecsum(todigits $n, $base) ==
+        vecsum map {$_->[1] * vecsum todigits $_->[0], $base}
+        grep {$_->[0] != $n} factor_exp $n;
+}
+
+
+### Examples and tests
+
+sub run_tests {
+    is is_smith(4937775), T(), 'Smith\'s phone number'; 
+    is is_smith(22), T(), '22(10)';
+    is is_smith(0x22, 16), T(), '22(16)';
+    is is_smith(24), F(), 'counter example';
+    is is_smith(29), F(), 'excluded prime';
+
+    # This takes about 25 s:
+    is scalar(grep is_smith($_), 1e6 .. 1e7 - 1),
+        248483, 'number of 7-digit Smith numbers according to OEIS';
+
+    done_testing;
+    exit;
+}