Merge pull request #5574 from jacoby/master

149

4 files changed, 112 insertions, 0 deletions

diff --git a/challenge-149/dave-jacoby/blog1.txt b/challenge-149/dave-jacoby/blog1.txt
new file mode 100644
index 0000000000..0a39b52da7
--- /dev/null
+++ b/challenge-149/dave-jacoby/blog1.txt
@@ -0,0 +1 @@
+https://jacoby.github.io/2022/01/27/weekly-challenge-149-and-a-fix-maybe-to-148.html
diff --git a/challenge-149/dave-jacoby/blog2.txt b/challenge-149/dave-jacoby/blog2.txt
new file mode 100644
index 0000000000..4e1552370c
--- /dev/null
+++ b/challenge-149/dave-jacoby/blog2.txt
@@ -0,0 +1 @@
+https://jacoby.github.io/2022/01/27/weekly-challenge-149-task-2-the-terror-of-the-largest-square.html
diff --git a/challenge-149/dave-jacoby/perl/ch-1.pl b/challenge-149/dave-jacoby/perl/ch-1.pl
new file mode 100644
index 0000000000..3be997a486
--- /dev/null
+++ b/challenge-149/dave-jacoby/perl/ch-1.pl
@@ -0,0 +1,39 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+use feature qw{ say postderef signatures state };
+no warnings qw{ experimental };
+
+use Getopt::Long;
+use List::Util qw{ sum0 max };
+
+my $N = 20;
+GetOptions( 'n=i' => \$N, );
+
+my @fib = first_60_fib();
+my %fib = map { $_ => 1 } @fib;
+my @x;
+
+my $n = 0;
+while ( scalar @x < $N ) {
+    my $sd = sum_of_digits($n);
+    my $f  = $fib{$sd} || 0;
+    push @x, $n if $f;
+    $n++;
+}
+say join ' ', @x;
+
+sub first_60_fib() {
+    my @n;
+    push @n, 0;
+    push @n, 1;
+    while ( scalar @n < 60 ) {
+        push @n, $n[-1] + $n[-2];
+    }
+    return @n;
+}
+
+sub sum_of_digits ( $n ) {
+    return sum0 split //, $n;
+}
diff --git a/challenge-149/dave-jacoby/perl/ch-2.pl b/challenge-149/dave-jacoby/perl/ch-2.pl
new file mode 100644
index 0000000000..76186c9f0d
--- /dev/null
+++ b/challenge-149/dave-jacoby/perl/ch-2.pl
@@ -0,0 +1,71 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+use feature qw{ say postderef signatures state };
+no warnings qw{ experimental };
+
+use Math::BaseCalc;
+use List::Util qw{uniq};
+
+my @range = ( 0 .. 9, 'A' .. 'Z' );
+
+OUTER: for my $base ( 2 .. 20 ) {
+    my $t      = $base - 1;
+    my @digits = map { $range[$_] } ( 0 .. $t );
+    my $digits = join '', @digits;
+    my $max    = join '', reverse @digits;
+    my $n      = convert_from( $max, $digits );
+    my $sn     = int sqrt $n;
+    while ( $sn > 0 ) {
+        my $n   = $sn**2;
+        my $x   = convert_to( $n, $digits );
+        my $has = has_dupes($x);
+        if ( !$has ) {
+            say qq{f($base) = "$x"};
+            next OUTER ;
+        }
+        $sn--;
+    }
+}
+
+exit;
+
+sub has_dupes ( $number ) {
+    for my $d ( uniq split //, $number ) {
+        my $d = () = grep { $_ eq $d } split //, $number;
+        return 1 if $d > 1;
+    }
+    return 0;
+}
+
+{
+    state $base = {};
+
+    sub convert_from ( $number, $digits ) {
+        state $table_from = {};
+        my @digits = split //, $digits;
+        if ( !defined $base->{$digits} ) {
+            $base->{$digits} = Math::BaseCalc->new( digits => [@digits] );
+        }
+        if ( !$table_from->{$digits}{$number} ) {
+            my $from = $base->{$digits}->from_base($number);
+            $table_from->{$digits}{$number} = $from;
+        }
+        return $table_from->{$digits}{$number};
+    }
+
+    sub convert_to ( $number, $digits ) {
+        state $table_to = {};
+        my @digits = split //, $digits;
+        if ( !defined $base->{$digits} ) {
+            $base->{$digits} = Math::BaseCalc->new( digits => [@digits] );
+        }
+        if ( !$table_to->{$digits}{$number} ) {
+            my $to = $base->{$digits}->to_base($number);
+            $table_to->{$digits}{$number} = $to;
+        }
+        return $table_to->{$digits}{$number};
+    }
+}
+