- Added solutions by Colin Crain.

5 files changed, 283 insertions, 0 deletions

diff --git a/challenge-149/colin-crain/blog1.txt b/challenge-149/colin-crain/blog1.txt
new file mode 100644
index 0000000000..563eb7702e
--- /dev/null
+++ b/challenge-149/colin-crain/blog1.txt
@@ -0,0 +1 @@
+https://colincrain.com/2022/01/30/that-big-ol-squarell-be-just-perfect
diff --git a/challenge-149/colin-crain/perl/ch-1.pl b/challenge-149/colin-crain/perl/ch-1.pl
new file mode 100755
index 0000000000..8bc3c45c2f
--- /dev/null
+++ b/challenge-149/colin-crain/perl/ch-1.pl
@@ -0,0 +1,60 @@
+#!/Users/colincrain/perl5/perlbrew/perls/perl-5.32.0/bin/perl

+#

+#       fib-sums.pl

+#

+#       Fibonacci Digit Sum

+# 

+#         Submitted by: Roger Bell_West

+# 

+#         Given an input $N, generate the first $N numbers for which the

+#         sum of their digits is a Fibonacci number.

+# 

+#         Example

+#         f(20)=[0, 1, 2, 3, 5, 8, 10, 11, 12, 14, 17, 20, 21, 23, 26, 30, 32, 35, 41, 44]

+

+#           6591     <-- 1,000th value

+#           13380892 <-- 1,000,000th value

+#

+#

+#       © 2022 colin crain

+## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ##

+

+

+

+use warnings;

+use strict;

+use utf8;

+use feature ":5.26";

+use feature qw(signatures);

+no warnings 'experimental::signatures';

+

+my $N = shift // 1081;

+my $candidate;

+my @out = (0);

+

+while ( ++$candidate ) {

+    push @out, $candidate if is_fib( digisum($candidate) );

+    last if @out == $N;

+}

+

+local $" = ', ';

+say "@out";

+

+sub digisum ( $num ) {

+    my $sum;

+    $sum += substr $num, $_-1, 1 for (1..length $num);

+    return $sum;   

+}

+

+sub is_fib ( $num ) {

+    state @fibs = ( 0, 1 );

+    state %fhash = map { $_ => undef } @fibs;

+    while ( $fibs[-1]+$fibs[-2] <= $num ) {

+        my $next = $fibs[-1]+$fibs[-2];

+        push @fibs, $next;

+        $fhash{$next} = undef;

+    }

+    return 1 if exists $fhash{$num};

+    return 0;

+}

+

diff --git a/challenge-149/colin-crain/perl/ch-2.pl b/challenge-149/colin-crain/perl/ch-2.pl
new file mode 100755
index 0000000000..839e27e003
--- /dev/null
+++ b/challenge-149/colin-crain/perl/ch-2.pl
@@ -0,0 +1,154 @@
+#!/Users/colincrain/perl5/perlbrew/perls/perl-5.32.0/bin/perl

+#

+#       big-ole-p-square.pl

+#

+#         Largest Square

+#         Submitted by: Roger Bell_West

+# 

+#         Given a number base, derive the largest perfect square with no

+#         repeated digits and return it as a string. 

+#         (For base>10, use ‘A’..‘Z’.)

+# 

+#         Example:

+#             f(2)="1"

+#             f(4)="3201"

+#             f(10)="9814072356"

+#             f(12)="B8750A649321"

+#

+#     in base 13: CC5244 squared is CBA504216873

+

+#     found 198003269696 squared is: 3.92052948103069e+22

+#     in base 18: HH79A9GDE squared is HGF1937D5B4E06A8C2

+#     real	22m8.960s

+#     user	16m5.258s

+#     sys	3m7.834s

+

+#     found 1404376502502 squared is: 1.97227336077975e+24

+#     in base 19: 46D2400C25 squared is IHGD2B086517E3ACF94

+#     real	82m49.393s

+#     user	82m38.563s

+#     sys	0m2.744s

+

+

+#       © 2022 colin crain

+## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ##

+

+

+

+use warnings;

+use strict;

+use utf8;

+use feature ":5.26";

+use feature qw(signatures);

+no warnings 'experimental::signatures';

+

+my $base = shift // 12;

+

+decrements ( $base );

+# constructive( $base );  <-- to call the constructive permutations method

+

+

+## decrementing solution:

+## from the square root of the largest base-digit number

+## square and check for repeating digits pass/fail

+sub decrements  ( $base ) {

+    my @alpha   = ( 0..9, "A".."Z" );

+    my $maxbase = join '', reverse @alpha[0..$base-1];

+    my $max     = int sqrt(base2dec( $maxbase, $base));

+    say "decrementing from $max";

+

+    my %h;

+    MAX: while ($max--) {

+        %h = ();

+        ## inlined convert square to base and detect repeats code

+        my $num = $max * $max;

+        while ( $num > 0  ) {

+            ++$h{$num % $base} > 1 and next MAX ;

+            $num = int( $num/$base ); 

+        }

+        

+        ## print result found

+        say "found $max squared is: ", $max * $max;

+        my $bout   = dec2base( $max, $base );

+        my $bsqout = dec2base( $max * $max, $base );

+        say "in base $base: $bout squared is $bsqout";

+        last;

+    }

+}

+

+

+sub repeats ( $num ) {

+## checks for repeating digits pass/fail

+    my %h;

+    ++$h{$_} > 1 and return 1 for split //, $num ;

+    return 0;

+}

+

+sub dec2base ( $num, $base ) {

+## converts from base-10 to base-n : n = 2..36

+    my @alpha = ( 0..9, "A".."Z" );

+    my $rem; 

+    my $val = '';

+    while ( $num > 0  ) {

+        ($num, $rem) = (int( $num/$base ), $num % $base);   

+        $val = $alpha[$rem] . $val;

+    }

+    return $val;

+}

+

+sub repeats_in_base ( $num, $base ) {

+## combined dec2base + repeats code, pass/fail

+    my %h;

+    while ( $num > 0  ) {

+        ++$h{$num % $base} > 1 and return 1 ;

+        $num = int( $num/$base ); 

+    }

+}

+

+sub base2dec( $num, $base ) {

+    my %alpha;

+    my $n ;

+    $alpha{$_} = $n++ for ( 0..9, "A".."Z" );

+    my $out;

+    my $pos = 0;

+    for ( reverse split //, $num ) {

+        $out += $alpha{$_} * $base ** $pos++;

+    }

+    return $out;

+}

+

+

+### constructing complete solutions from all digits in base 

+### and testing for squareness

+

+sub constructive ( $base ) {

+    use Algorithm::Combinatorics qw( permutations );

+

+    my @arr = reverse (0..$base-1);

+    my $iter = permutations( \@arr );

+    my $c;

+    my $dec;

+    say "permuting @arr";

+

+    while (my $p = $iter->next) {

+        $dec = perm2dec( $p, $base );

+        my $sq = int sqrt $dec;

+        last if $sq * $sq == $dec;    

+    }

+    

+    say "constructive:";

+    say "found $dec" ;

+    my $bout = dec2base( $dec, $base );

+    say "in base $base: $bout";

+}

+

+sub perm2dec ( $arr, $base ) {

+    my $out;

+    my $pos = 0;

+    for ( reverse $arr->@* ) {

+        $out += $_ * $base ** $pos++;

+    }

+    return $out;

+}

+

+

diff --git a/challenge-149/colin-crain/raku/ch-1.raku b/challenge-149/colin-crain/raku/ch-1.raku
new file mode 100755
index 0000000000..e765e25ce3
--- /dev/null
+++ b/challenge-149/colin-crain/raku/ch-1.raku
@@ -0,0 +1,30 @@
+#!/usr/bin/env perl6
+#
+#
+#       fib-sums.raku
+#
+#
+#
+#       © 2022 colin crain
+## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ##
+
+
+
+unit sub MAIN ( $N = 25 ) ;
+
+sub is_fib ( $num ) {
+    state @fibs = (0, 1, 1, * + * ... *);
+    state %fh;
+    state $n = 0;
+    while @fibs[$n] < $num  {
+        %fh{ @fibs[++$n] } = 1; 
+    }
+
+    return %fh{$num}:exists
+        ?? 1
+        !! 0
+}
+
+my  @out = (0, | grep { is_fib( $_.comb.sum ) }, (0..*) )[0..$N-1];
+say @out;
+
diff --git a/challenge-149/colin-crain/raku/ch-2.raku b/challenge-149/colin-crain/raku/ch-2.raku
new file mode 100755
index 0000000000..001dd97105
--- /dev/null
+++ b/challenge-149/colin-crain/raku/ch-2.raku
@@ -0,0 +1,38 @@
+#!/usr/bin/env perl6
+#
+#
+#       big-ole-p-square.raku
+#
+#
+#
+#       © 2022 colin crain
+## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ##
+
+
+
+unit sub MAIN ( $base = 8 ) ;
+
+
+my $max = (1 ~ 0 x $base).parse-base($base)
+                         .sqrt
+                         .Int ;
+            
+repeat { $max-- } while repeats-in-base( $max², $base );
+    
+say qq:to/END/;     
+    found $max squared is {$max²}
+    in base $base: {$max.base($base)} squared is {$max².base($base)}
+    END
+    
+
+sub repeats-in-base ( $num, $base ) {
+
+    return ($num.base($base)
+                .comb
+                .Bag 
+                .values
+                .sort)[*-1] > 1
+        ?? 1
+        !! 0 ;
+}
+