Solve 102: Rare Numbers & Hash Counting String by E. Choroba

2 files changed, 171 insertions, 0 deletions

diff --git a/challenge-102/e-choroba/perl5/ch-1.pl b/challenge-102/e-choroba/perl5/ch-1.pl
new file mode 100755
index 0000000000..0374fbc037
--- /dev/null
+++ b/challenge-102/e-choroba/perl5/ch-1.pl
@@ -0,0 +1,135 @@
+#!/usr/bin/perl
+use warnings;
+use strict;
+
+# As Palindromic Rare Numbers were mentioned separately, I only
+# considered non-palindromic ones.
+
+# Originally, I checked all the numbers, but the tests took more than
+# 4 minutes. So I decided to generate the numbers instead (even if the
+# middle part is still checking all the possibilities). The tests now
+# take 37 seconds on my machine. You can find the original code after
+# the END marker.
+
+sub is_rare {
+    my ($n, $r) = @_;
+    return if $n <= $r;
+
+    my $diff = $n - $r;
+    my $sqrt_diff = sqrt $diff;
+    return unless int($sqrt_diff) * int($sqrt_diff) == $diff;
+
+    my $sum = $n + $r;
+    my $sqrt_sum = sqrt $sum;
+    return unless int($sqrt_sum) * int($sqrt_sum) == $sum;
+
+    return 1
+}
+
+sub inner_iterator {
+    my ($size) = @_;
+    if (4 == $size) {
+        my $first = 1;
+        return sub {
+            undef $first, return ""
+                if $first;
+
+            return
+        }
+    } else {
+        my $max = 9 x ($size - 4);
+        my $n = 0;
+        return sub {
+            return sprintf '%0*d', $size - 4, $n - 1
+                if $n++ <= $max;
+
+            return
+        }
+    }
+}
+
+my %start_end = (
+    2 => {2 => [map [$_, $_], 0 .. 9]},
+    4 => {0 => [map {
+                    my $x = $_;
+                    map [$x, $_], grep 0 == abs($x - $_) % 2, 0 .. 9
+                } 0 .. 9 ]},
+    6 => {map {$_ => [map {
+                          my $x = $_;
+                          map [$x, $_], grep 1 == abs($x - $_) % 2, 0 .. 9
+                      } 0 .. 9]} 0, 5},
+    8 => {2 => [map [$_, 9 - $_], 0 .. 9],
+          3 => [map [$_, $_ + ($_ < 7 ? 3 : -7)], 0 .. 9],
+          7 => [map [$_, ($_ > 1 ? 11 : 1) - $_], 0 .. 9],
+          8 => [map [$_, $_], 0 .. 9]}
+);
+
+sub rare_numbers {
+    my ($size) = @_;
+    return [] if $size < 2;  # Single digit numbers are palindromes.
+
+    my @rare;
+    if ($size < 4) {
+        for (my $n = 10 ** ($size - 1); $n < 10 ** $size; ++$n) {
+            if ($n =~ /^([^2468])/) {
+                $n = $1 . '9' x ($size - 1);
+                next
+            }
+            push @rare, $n if is_rare($n, scalar reverse $n);
+        }
+
+    } else {
+        for my $start (keys %start_end) {
+            for my $end (keys %{ $start_end{$start} }) {
+                for my $pair (@{ $start_end{$start}{$end} }) {
+                    my $inner_iterator = inner_iterator($size);
+                    while (defined(my $inner = $inner_iterator->())) {
+                        my $n = join "", $start, $pair->[0],
+                                         $inner, $pair->[1], $end;
+                        push @rare, $n if is_rare($n, scalar reverse $n);
+                    }
+                }
+            }
+        }
+    }
+    return \@rare
+}
+
+use Test::More;
+
+is_deeply rare_numbers(2), [65], '(a)';
+is_deeply rare_numbers(6), [621770], '(b)';
+is_deeply rare_numbers(9), [281089082], '(c)';
+is_deeply rare_numbers($_), [], "empty $_" for 1, 3, 4, 5, 7, 8;
+
+done_testing();
+
+__END__
+
+sub rare_numbers {
+    my ($size) = @_;
+    my $from = 10 ** ($size - 1);
+    my $to = '9' x $size;
+    my @rare;
+    for (my $n = $from; $n <= $to; ++$n) {
+        if ($n =~ /^([^2468])/) {
+            $n = $1 . '9' x ($size - 1);
+            next
+        }
+
+        my $r = reverse $n;
+        next if $n <= $r;
+
+        my $diff = $n - $r;
+
+        my $sqrt_diff = sqrt $diff;
+        next unless $sqrt_diff == int $sqrt_diff;
+
+        my $sum = $n + $r;
+        my $sqrt_sum = sqrt $sum;
+        next unless $sqrt_sum == int $sqrt_sum;
+
+        push @rare, $n;
+    }
+    return \@rare
+}
diff --git a/challenge-102/e-choroba/perl5/ch-2.pl b/challenge-102/e-choroba/perl5/ch-2.pl
new file mode 100755
index 0000000000..de6ca37104
--- /dev/null
+++ b/challenge-102/e-choroba/perl5/ch-2.pl
@@ -0,0 +1,36 @@
+#!/usr/bin/perl
+use warnings;
+use strict;
+use feature qw{ say };
+
+sub hash_counting_string {
+    my ($length) = @_;
+    my $s = '#' x $length;
+    while (-1 != (my $pos = rindex $s, '##')) {
+        my $n = $pos + 2;
+        substr $s, $pos + 1 - length $n, length $n, $n;
+    }
+    return $s
+}
+
+use Test::More;
+
+is hash_counting_string(1), '#', '(a)';
+is hash_counting_string(2), '2#', '(b)';
+is hash_counting_string(3), '#3#', '(c)';
+is hash_counting_string(10), '#3#5#7#10#', '(d)';
+is hash_counting_string(14), '2#4#6#8#11#14#', '(e)';
+
+is hash_counting_string(200), '#3#5#7#9#12#15#18#21#24#27#30#33#36#39#42#45#'
+                            . '48#51#54#57#60#63#66#69#72#75#78#81#84#87#90#'
+                            . '93#96#100#104#108#112#116#120#124#128#132#136#'
+                            . '140#144#148#152#156#160#164#168#172#176#180#'
+                            . '184#188#192#196#200#', 'long string';
+
+is hash_counting_string(201), '#3#5#7#10#13#16#19#22#25#28#31#34#37#40#43#'
+                            . '46#49#52#55#58#61#64#67#70#73#76#79#82#85#88#'
+                            . '91#94#97#101#105#109#113#117#121#125#129#133'
+                            . '#137#141#145#149#153#157#161#165#169#173#177'
+                            . '#181#185#189#193#197#201#', 'even longer';
+
+done_testing();