From df545bf172e608cbd75c56ac972029da916b0cb0 Mon Sep 17 00:00:00 2001
From: Alexander Pankoff <ccntrq@screenri.de>
Date: Tue, 25 Jan 2022 13:34:22 +0100
Subject: Add solution for challenge-149 part 1

---
 challenge-149/alexander-pankoff/perl/ch-1.pl | 79 ++++++++++++++++++++++++++++
 1 file changed, 79 insertions(+)
 create mode 100755 challenge-149/alexander-pankoff/perl/ch-1.pl

diff --git a/challenge-149/alexander-pankoff/perl/ch-1.pl b/challenge-149/alexander-pankoff/perl/ch-1.pl
new file mode 100755
index 0000000000..1adf2557f1
--- /dev/null
+++ b/challenge-149/alexander-pankoff/perl/ch-1.pl
@@ -0,0 +1,79 @@
+#!/usr/bin/env perl
+use strict;
+use warnings;
+use feature qw'say state signatures';
+no warnings qw'experimental::signatures';
+
+# TASK #1 › 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]
+
+use List::Util qw(sum0 first);
+
+run() unless caller();
+
+sub run() {
+    my ($N) = @ARGV;
+
+    if ( !$N || $N !~ m/^\d+$/ || $N < 1 ) {
+        die <<EOF;
+  Usage:
+
+    $0 N
+
+  Options:
+
+    N - a positive integer
+EOF
+    }
+
+    my @numbers = fibonacci_digit_sum($N);
+
+    say "f($N) = [" . join( ', ', @numbers ) . ']';
+
+}
+
+sub fibonacci_digit_sum($n) {
+    my @found;
+    for ( my $i = 0 ; @found < $n ; $i++ ) {
+        push @found, $i if is_fib( digit_sum($i) );
+    }
+    return @found;
+
+}
+
+sub is_fib($x) {
+    state $fibs = {
+        0 => 1,
+        1 => 1,
+
+    };
+    state $cur  = 1;
+    state $prev = 0;
+
+    while ( $x > $cur ) {
+        my $next = next_fib( $cur, $prev );
+        $prev = $cur;
+        $cur  = $next;
+
+        $fibs->{$next} = 1;
+    }
+
+    return $fibs->{$x};
+}
+
+sub digit_sum($x) {
+    my $sum = sum0 split( '', $x );
+
+    return $sum;
+}
+
+sub next_fib ( $prev, $cur ) {
+    my $next = $cur + $prev;
+
+    return $next;
+}
-- 
cgit 


From d52a62e76494ca56a9a50189f5c2751885f96d5e Mon Sep 17 00:00:00 2001
From: Alexander Pankoff <ccntrq@screenri.de>
Date: Tue, 25 Jan 2022 15:15:34 +0100
Subject: Add solution for challenge 149 task 2

---
 challenge-149/alexander-pankoff/perl/ch-2.pl | 65 ++++++++++++++++++++++++++++
 1 file changed, 65 insertions(+)
 create mode 100755 challenge-149/alexander-pankoff/perl/ch-2.pl

diff --git a/challenge-149/alexander-pankoff/perl/ch-2.pl b/challenge-149/alexander-pankoff/perl/ch-2.pl
new file mode 100755
index 0000000000..fc0116d720
--- /dev/null
+++ b/challenge-149/alexander-pankoff/perl/ch-2.pl
@@ -0,0 +1,65 @@
+#!/usr/bin/env perl
+use strict;
+use warnings;
+use feature qw'say state signatures';
+use bignum;
+no warnings qw'experimental::signatures';
+
+# TASK #2 › 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"
+
+use List::Util qw(sum0 first uniq);
+
+run() unless caller();
+
+sub run() {
+
+    my ($N) = @ARGV;
+
+    if ( !$N || $N !~ m/^\d+$/ || $N < 2 || $N > 36 ) {
+        die <<EOF;
+  Usage:
+
+    $0 N
+
+  Options:
+
+    N - a number base (between 2 and 36)
+EOF
+    }
+
+    say "f($N) = " . largest_perfet_square_without_repeated_digits_in_base($N);
+
+}
+
+sub largest_perfet_square_without_repeated_digits_in_base($base) {
+    my $x = first {
+        my $perfect_square = dec_to_base( $base, $_**2 );
+
+        my @digits = split( '', $perfect_square );
+
+        scalar uniq(@digits) == scalar @digits;
+    }
+    reverse( 0 .. int( sqrt( $base**$base - 1 ) ) );
+
+    return dec_to_base( $base, $x**2 );
+}
+
+sub dec_to_base ( $base, $n ) {
+    my @digits = ( 0 .. 9, 'A' .. 'Z' );
+
+    return $digits[$n] if $n <= $base - 1;
+
+    my $rem  = $n % $base;
+    my $next = int( $n / $base );
+
+    dec_to_base( $base, $next ) . $digits[$rem];
+}
-- 
cgit 


From 1dbff28836d9cca2100e974793e6af81ab8834c9 Mon Sep 17 00:00:00 2001
From: Alexander Pankoff <ccntrq@screenri.de>
Date: Tue, 25 Jan 2022 16:01:57 +0100
Subject: Improve solution for challenge 149 task 2

---
 challenge-149/alexander-pankoff/perl/ch-2.pl | 47 +++++++++++++++++++++++-----
 1 file changed, 40 insertions(+), 7 deletions(-)

diff --git a/challenge-149/alexander-pankoff/perl/ch-2.pl b/challenge-149/alexander-pankoff/perl/ch-2.pl
index fc0116d720..d140f7e92a 100755
--- a/challenge-149/alexander-pankoff/perl/ch-2.pl
+++ b/challenge-149/alexander-pankoff/perl/ch-2.pl
@@ -16,7 +16,7 @@ no warnings qw'experimental::signatures';
 #     f(10)="9814072356"
 #     f(12)="B8750A649321"
 
-use List::Util qw(sum0 first uniq);
+use List::Util qw(uniq);
 
 run() unless caller();
 
@@ -41,16 +41,22 @@ EOF
 }
 
 sub largest_perfet_square_without_repeated_digits_in_base($base) {
-    my $x = first {
-        my $perfect_square = dec_to_base( $base, $_**2 );
+    my @digits = ( 0 .. 9, 'A' .. 'Z' )[ 0 .. $base - 1 ];
+
+    for (
+        my $i =
+        int( sqrt( base_to_dec( $base, join( '', reverse @digits ) ) ) ) ;
+        $i > 0 ;
+        $i--
+      )
+    {
+        my $perfect_square = dec_to_base( $base, $i**2 );
 
         my @digits = split( '', $perfect_square );
 
-        scalar uniq(@digits) == scalar @digits;
-    }
-    reverse( 0 .. int( sqrt( $base**$base - 1 ) ) );
+        return $perfect_square if scalar uniq(@digits) == scalar @digits;
 
-    return dec_to_base( $base, $x**2 );
+    }
 }
 
 sub dec_to_base ( $base, $n ) {
@@ -63,3 +69,30 @@ sub dec_to_base ( $base, $n ) {
 
     dec_to_base( $base, $next ) . $digits[$rem];
 }
+
+sub base_to_dec ( $base, $n ) {
+    my $power = 1;
+    my $num   = 0;
+
+    my @digits = split( '', $n );
+
+    for my $i ( reverse( 0 .. $#digits ) ) {
+
+        $num += value( $digits[$i] ) * $power;
+        $power = $power * $base;
+
+    }
+
+    return $num;
+
+}
+
+sub value($c) {
+
+    if ( $c ge '0' && $c le '9' ) {
+        return ord($c) - ord('0');
+
+    }
+
+    return ord($c) - ord('A') + 10;
+}
-- 
cgit