Challenge 116

2 files changed, 81 insertions, 0 deletions

diff --git a/challenge-116/dave-jacoby/perl/ch-1.pl b/challenge-116/dave-jacoby/perl/ch-1.pl
new file mode 100644
index 0000000000..de98873f64
--- /dev/null
+++ b/challenge-116/dave-jacoby/perl/ch-1.pl
@@ -0,0 +1,60 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+use feature qw{ postderef say signatures state };
+no warnings qw{ experimental };
+
+my @numbers = qw{ 1234 91011 10203 };
+
+for my $n (@numbers) {
+    say base($n);
+}
+
+# we are asked to return the sequence 
+# or the given number, and accounting 
+# for that makes recursion difficult,
+# so we pass to base to determine that
+
+sub base ( $n ) {
+    my $s = get_sequence($n);
+    return $s//$n;
+}
+
+# test for success and return if successful
+# then add commas within (a copy of) the 
+# string
+
+sub get_sequence ( $n ) {
+    my $t = test($n);
+    return $n if $t;
+
+    my $output;
+    my @n = split /,/, $n;
+    my $flag = 0;
+    map { $flag += 1 if $_ > 10 } @n;
+    if ( $flag > 0 ) {
+        for my $i ( 0 .. length $n ) {
+            my $cp = $n;
+            my $l = substr( $cp, $i, 1 );
+            substr( $cp, $i, 1 ) = ',' . $l;
+            next if $cp =~ m{^\,|\,\,|\,$};
+            my $x = get_sequence($cp);
+            return $x if $x;
+        }
+    }
+    return undef;
+}
+
+sub test ( $n ) {
+    my $t = 1;
+    my @n = split /,/, $n;
+    $t = 0 if $n[0] =~ m{^0}mx;
+    $t = 0 if scalar @n < 2;
+    for my $i ( 1 .. -1 + scalar @n ) {
+        my $h = $i - 1;
+        $t = 0 if $n[$i] =~ m{^0}mx;
+        $t = 0 unless $n[$h] + 1 == $n[$i];
+    }
+    return $t;
+}
diff --git a/challenge-116/dave-jacoby/perl/ch-2.pl b/challenge-116/dave-jacoby/perl/ch-2.pl
new file mode 100644
index 0000000000..af368b69ca
--- /dev/null
+++ b/challenge-116/dave-jacoby/perl/ch-2.pl
@@ -0,0 +1,21 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+use feature qw{ postderef say signatures state };
+no warnings qw{ experimental };
+
+use List::Util qw{sum0};
+
+my @numbers = sort (34, 50, 52, 10 );
+
+for my $n ( @numbers ) {
+    my $b = sum_of_squares($n);
+    say join "\t", $n,$b?'Yes':'No';
+}
+
+sub sum_of_squares ( $n ) {
+    my $sum = sum0 map { $_ ** 2 } split //, $n;
+    my $root = sqrt $sum;
+    return int $root == $root ? 1 : 0 ;
+}
\ No newline at end of file