Merge pull request #6493 from Util/branch-for-challenge-174

Add TWC 174 solutions by Bruce Gray : only Raku, with two bonus Raku solutions to task 1.

4 files changed, 231 insertions, 0 deletions

diff --git a/challenge-174/bruce-gray/raku/ch-1.raku b/challenge-174/bruce-gray/raku/ch-1.raku
new file mode 100644
index 0000000000..5bffac0352
--- /dev/null
+++ b/challenge-174/bruce-gray/raku/ch-1.raku
@@ -0,0 +1,26 @@
+# As usual, a Boolean `is` function, with a constant grep through ℕ,
+# is the simplest solution, but is slow (210 seconds) once you get into the millions.
+# For much faster algorithms, see:
+#       ch-1_big_table.raku (  7x speedup)
+#       ch-1_from_c.raku    (100x speedup)
+
+sub is-Disarium ( UInt $n --> Bool ) {
+    return $n == $n.comb.pairs.map({ .value ** ( 1 + .key ) }).sum;
+    # Could have used `( $n.comb Z** (1..Inf) ).sum`, but that doubles the runtime.
+}
+constant @Disarium = grep &is-Disarium, ^Inf;
+
+
+say @Disarium.head(19);
+
+use Test;
+plan 4;
+constant @A032799 = 0,1,2,3,4,5,6,7,8,9,89,135,175,518,598,1306,1676,2427,2646798,12157692622039623539;
+is @Disarium.head(@A032799.elems - 1), @A032799.head(*-1),
+    'https://oeis.org/A032799 (without final element)';
+{
+    constant $big = @A032799.tail;
+    is is-Disarium($big - 1), False, "{$big - 1} is not a Disarium number";
+    is is-Disarium($big    ), True , "{$big    } is     a Disarium number";
+    is is-Disarium($big + 1), False, "{$big + 1} is not a Disarium number";
+}
diff --git a/challenge-174/bruce-gray/raku/ch-1_big_table.raku b/challenge-174/bruce-gray/raku/ch-1_big_table.raku
new file mode 100644
index 0000000000..9f67262d4c
--- /dev/null
+++ b/challenge-174/bruce-gray/raku/ch-1_big_table.raku
@@ -0,0 +1,31 @@
+# Observe that, if we cache the "sum of powers of digits" calculation for every prior number,
+# then (for example) 8880..8889 is just the cached value of 888,
+# plus (0⁴, 1⁴, 2⁴, 3⁴, 4⁴, 5⁴, 6⁴, 7⁴, 8⁴, 9⁴).
+# Since those @powers_of_last_digits are constant for all 4-digit numbers,
+# they can be calculated just once per "generation".
+
+# This finds .head(19) 7x faster than the is-Disarium() in ch-1.raku !
+# However, it will run out of memory trying to find .head(20) .
+constant @Disarium = gather {
+    my @all = 0..9;
+    .take for @all;
+
+    for 2..22 -> $number_length {
+        my @powers_of_last_digits = (0..9) X** $number_length;
+
+        my $to_skip2 = 10 ** ($number_length - 2);
+        my $to_skip1 = 10 ** ($number_length - 1);
+
+        @all.append: @all.skip($to_skip2) X+ @powers_of_last_digits;
+
+        .take for @all.keys.skip($to_skip1).grep: { @all[$_] == $_ };
+    }
+};
+
+say @Disarium.head(19);
+
+use Test;
+plan 1;
+constant @A032799 = 0,1,2,3,4,5,6,7,8,9,89,135,175,518,598,1306,1676,2427,2646798,12157692622039623539;
+is @Disarium.head(@A032799.elems - 1), @A032799.head(*-1),
+    'https://oeis.org/A032799 (without final element)';
diff --git a/challenge-174/bruce-gray/raku/ch-1_from_c.raku b/challenge-174/bruce-gray/raku/ch-1_from_c.raku
new file mode 100644
index 0000000000..456b982b37
--- /dev/null
+++ b/challenge-174/bruce-gray/raku/ch-1_from_c.raku
@@ -0,0 +1,146 @@
+# Finds .head(19) in under 1 second; 100x speedup compared to other methods.
+
+# IMPORTANT: I do not understand this algorithm!
+# Perhaps you can understand it if you spend more time than I did reading:
+#   https://github.com/rgxgr/Disarium-Numbers/blob/master/README.md
+
+# This code was copied by Bruce Gray
+# from https://github.com/rgxgr/Disarium-Numbers/blob/master/Disarium.c ,
+# translated into Raku, and refactored into constant+gather form.
+# I also partially refactored into idiomatic Raku, but could not nearly
+# eliminate the "C language accent".
+
+# I think the code is doing (among other optimizations) an elaborate form of this Number Theory analysis:
+# raku -e 'for 1..25 -> $n { say "$n : ", ( ( (10 ** ($n-1)) - ( 9 X** (1..^$n)).sum ) ** (1/$n)).ceiling }'
+# Examining that table, we can conclude:
+# A final digit of 0|1|2 can only happen in 1-digit and 2-digit numbers.
+# For numbers between  7 and  8 digits, the final digit must be 7|8|9.
+# For numbers between  9 and 12 digits, the final digit must be 8|9.
+# For numbers between 13 and 22 digits, the final digit must be 9.
+#       (This removes 90% of the search space by itself!)
+# No number larger that 22 digits can be a Disarium number;
+#       9ⁿ is outpaced against 10ⁿ too much for all the 9-power-sums of prior digits to make up for.
+
+constant @Disarium = gather {
+    constant DMAX = 22; # Max # of digits
+
+    # Pre-calculated exponential & power serials
+    constant @EXP = 0 xx 10, |map { 0..9 X*  (10 ** $_) }, ^DMAX;
+    constant @POW = 0 xx 10, |map { 0..9 X** ( 1 +  $_) }, ^DMAX;
+
+    # Element [10] of @EXP and @POW were special-purposed in the original C code.
+    # I separated those elements into their own arrays here.
+    constant @EXP10 = map { 10 ** $_ }, ^DMAX;
+    constant @POW10 = [\+] @POW».[9];
+
+    # Digits of candidate and values of known low bits
+    my Int @DIGITS = 0 xx (DMAX + 1);  # Digits form
+    my Int @Exp    = 0 xx (DMAX + 1);  # Number form
+    my Int @Pow    = 0 xx (DMAX + 1);  # Powers form
+
+    for 1 .. DMAX -> $digit {
+        # say "# of digits: $digit";
+
+        my Int $level = 1;
+        @DIGITS[0] = 0;
+        loop {
+            # Check limits derived from already known low bit values
+            # to find the most possible candidates
+            while $level ~~ 0 ^..^ $digit {
+                # Reset path to try next if checking in level is done
+                if  @DIGITS[$level] > 9 {
+                    @DIGITS[$level] = 0;
+                    $level--;
+                    @DIGITS[$level]++;
+                    next;
+                }
+
+                # Update known low bit values
+                @Exp[$level] = @Exp[$level - 1] + @EXP[             $level][ @DIGITS[$level] ];
+                @Pow[$level] = @Pow[$level - 1] + @POW[$digit + 1 - $level][ @DIGITS[$level] ];
+
+                # Max possible value
+                my Int $pow = @Pow[$level] + @POW10[$digit - $level];
+
+                if $pow < @EXP[$digit][1] {  # Try next since upper limit is invalidly low
+                    @DIGITS[$level]++;
+                    next;
+                }
+
+                my Int $max;
+                {
+                    my Int $short_pow = $pow % @EXP10[$level];
+                    $pow -= $short_pow;
+                    $pow -= @EXP10[$level] if $short_pow < @Exp[$level];
+                    $max  = $pow + @Exp[$level];
+                }
+                if $max < @EXP[$digit][1] {  # Try next since upper limit is invalidly low
+                    @DIGITS[$level]++;
+                    next;
+                }
+
+                # Min possible value
+                my Int $exp = @Exp[$level] + @EXP[$digit][1];
+                $pow = @Pow[$level] + 1;
+
+                if $max < $exp or $max < $pow { # Try next since upper limit is invalidly low
+                    @DIGITS[$level]++;
+                    next;
+                }
+
+                my Int $min;
+                if $pow > $exp {
+                    my Int $short_pow = $pow % @EXP10[$level];
+                    $pow -= $short_pow;
+                    $pow += @EXP10[$level] if $short_pow > @Exp[$level];
+                    $min  = $pow + @Exp[$level];
+                }
+                else {
+                    $min  = $exp;
+                }
+
+                # Check limits existence
+                if $max < $min {
+                    @DIGITS[$level]++;  # Try next number since current limits invalid
+                }
+                else {
+                    $level++;  # Go for further level checking since limits available
+                }
+            }
+
+            # All checking is done, escape from the main check loop
+            last if $level < 1;
+
+            # Final check last bit of the most possible candidates
+            # Update known low bit values
+            @Exp[$level] = @Exp[$level - 1] + @EXP[             $level][ @DIGITS[$level] ];
+            @Pow[$level] = @Pow[$level - 1] + @POW[$digit + 1 - $level][ @DIGITS[$level] ];
+
+            # Loop to check all last bit of candidates
+            while @DIGITS[$level] < 10 {
+                # Found a new Disarium number
+                take +@DIGITS.skip.reverse.join if @Exp[$level] == @Pow[$level];
+
+                # Go to followed last bit candidate
+                @DIGITS[$level]++;
+                @Exp[$level] += @EXP[$level][1];
+                @Pow[$level]++;
+            }
+
+            # Reset to try next path
+            @DIGITS[$level] = 0;
+            $level--;
+            @DIGITS[$level]++;
+        }
+    }
+}
+say @Disarium.head(19);
+
+use Test;
+plan 1;
+constant @A032799 = 0,1,2,3,4,5,6,7,8,9,89,135,175,518,598,1306,1676,2427,2646798,12157692622039623539;
+is @Disarium.head(@A032799.elems - 1), @A032799.head(*-1),
+    'https://oeis.org/A032799 (without final element)';
+
+# Bonus; This would take many hours, but should work.
+# is @Disarium[19], @A032799.tail, 'A032799 (final element; 20-digits!)';
diff --git a/challenge-174/bruce-gray/raku/ch-2.raku b/challenge-174/bruce-gray/raku/ch-2.raku
new file mode 100644
index 0000000000..789b7d5594
--- /dev/null
+++ b/challenge-174/bruce-gray/raku/ch-2.raku
@@ -0,0 +1,28 @@
+# Works with non-Ints, too.
+sub permutation2rank ( @a          ) { @a.sort.permutations.first: :k, * eqv @a.List }
+sub rank2permutation ( @a, UInt $n ) { @a.sort.permutations[$n] }
+
+# I did not read "The rank of a permutation" and "Segment tree" until I had completed this task.
+#   https://tryalgo.org/en/permutations/2016/09/05/permutation-rank/
+#   https://tryalgo.org/en/data%20structures/2016/06/25/segment-tree/
+# Otherwise, I would have been interested in implementing the O(n log n) algorithm,
+# to compare against the performance of Raku's built-in permutations().
+
+multi sub MAIN ( UInt $n, *@a ) { say rank2permutation( @a, $n ) }
+multi sub MAIN (          *@a ) { say permutation2rank( @a     ) }
+multi sub MAIN ( 'test'       ) {
+    use Test;
+    plan 9;
+
+    is permutation2rank( <1 0 2>    ), 2;
+    is rank2permutation( <0 1 2>, 0 ), <0 1 2>;
+    is rank2permutation( <0 1 2>, 1 ), <0 2 1>;
+    is rank2permutation( <0 1 2>, 2 ), <1 0 2>;
+    is rank2permutation( <0 1 2>, 3 ), <1 2 0>;
+    is rank2permutation( <0 1 2>, 4 ), <2 0 1>;
+    is rank2permutation( <0 1 2>, 5 ), <2 1 0>;
+
+    is permutation2rank( <Cinderella Dumbo Ariel      Bambi>     ), 16;
+    is rank2permutation( <Ariel      Bambi Cinderella Dumbo>, 16 ),
+                         <Cinderella Dumbo Ariel      Bambi>;
+}