aboutsummaryrefslogtreecommitdiff
path: root/challenge-149/dave-jacoby
diff options
context:
space:
mode:
authorDave Jacoby <jacoby.david@gmail.com>2022-01-27 13:36:35 -0500
committerDave Jacoby <jacoby.david@gmail.com>2022-01-27 13:36:35 -0500
commit6b33194e5a9ccb5ee44e0057aa120d8eba4cfe95 (patch)
treebb2a25638b8b9cd64bb3538b40c5ebbb1ed8d005 /challenge-149/dave-jacoby
parenta45f9ee806d0c8e84c84175ea6910cbf738f551c (diff)
downloadperlweeklychallenge-club-6b33194e5a9ccb5ee44e0057aa120d8eba4cfe95.tar.gz
perlweeklychallenge-club-6b33194e5a9ccb5ee44e0057aa120d8eba4cfe95.tar.bz2
perlweeklychallenge-club-6b33194e5a9ccb5ee44e0057aa120d8eba4cfe95.zip
149 Pt 2
Diffstat (limited to 'challenge-149/dave-jacoby')
-rw-r--r--challenge-149/dave-jacoby/blog2.txt1
-rw-r--r--challenge-149/dave-jacoby/perl/ch-2.pl71
2 files changed, 72 insertions, 0 deletions
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-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};
+ }
+}
+