Merge pull request #5713 from Util/branch-for-challenge-153

Add TWC 153 solutions by Bruce Gray : Raku, Perl, and WebAssembly.

7 files changed, 145 insertions, 0 deletions

diff --git a/challenge-153/bruce-gray/perl/ch-1.pl b/challenge-153/bruce-gray/perl/ch-1.pl
new file mode 100644
index 0000000000..0ebce643ee
--- /dev/null
+++ b/challenge-153/bruce-gray/perl/ch-1.pl
@@ -0,0 +1,7 @@
+use Modern::Perl;
+use List::Util qw<reductions>;
+
+say join ', ', reductions { $a + $b }
+            1, reductions { $a * $b } 1..9;
+
+# Output: 1, 2, 4, 10, 34, 154, 874, 5914, 46234, 409114
diff --git a/challenge-153/bruce-gray/perl/ch-2.pl b/challenge-153/bruce-gray/perl/ch-2.pl
new file mode 100644
index 0000000000..22285b5c4e
--- /dev/null
+++ b/challenge-153/bruce-gray/perl/ch-2.pl
@@ -0,0 +1,15 @@
+use Modern::Perl;
+use experimental qw<signatures postderef>;
+use List::Util   qw<sum0 reductions>;
+
+use constant Factorials => [ 1, reductions { $a * $b } 1..9 ];
+sub is_factorion ( $n ) {
+    return $n == sum0 Factorials->@[ split '', $n ];
+}
+
+say join ', ', map  { 0 + is_factorion($_) } 145, 123;
+say join ', ', grep {     is_factorion($_) } 0 .. 2_000_000;
+
+# Output:
+#   1, 0
+#   1, 2, 145, 40585
diff --git a/challenge-153/bruce-gray/raku/ch-1.raku b/challenge-153/bruce-gray/raku/ch-1.raku
new file mode 100644
index 0000000000..09a4b26c28
--- /dev/null
+++ b/challenge-153/bruce-gray/raku/ch-1.raku
@@ -0,0 +1,6 @@
+my @fact = 1, |[\*] 1 .. *;
+my @left =     [\+] @fact;
+
+say join ', ', @left.head(10);
+
+# Output: 1, 2, 4, 10, 34, 154, 874, 5914, 46234, 409114
diff --git a/challenge-153/bruce-gray/raku/ch-2.raku b/challenge-153/bruce-gray/raku/ch-2.raku
new file mode 100644
index 0000000000..5cc277ec49
--- /dev/null
+++ b/challenge-153/bruce-gray/raku/ch-2.raku
@@ -0,0 +1,11 @@
+sub is_factorion ( UInt $n --> Bool ) {
+    constant @factorials = 1, |[\*] 1..*;
+    return $n == @factorials[$n.comb].sum;
+}
+
+put (145,123).map:  &is_factorion;
+put (^41_000).grep: &is_factorion;
+
+# Output:
+#   True False
+#   1 2 145 40585
diff --git a/challenge-153/bruce-gray/webassembly/ch-1.wat b/challenge-153/bruce-gray/webassembly/ch-1.wat
new file mode 100644
index 0000000000..c3d78ef29d
--- /dev/null
+++ b/challenge-153/bruce-gray/webassembly/ch-1.wat
@@ -0,0 +1,35 @@
+(module
+  (func $left_factorial (export "left_factorial") (param $n i32) (result i32)
+    (local $acc_left i32)
+    (local $acc_fact i32)
+    (local $count    i32)
+
+    ;; If $n < 1, return 1, else return the result of the loop.
+    (i32.lt_s (get_local $n) (i32.const 1))
+    if (result i32)
+      i32.const 1
+    else
+      (set_local $count    (i32.const  0)) ;; $count     = 0
+      (set_local $acc_left (i32.const  1)) ;; $acc_left  = 1
+      (set_local $acc_fact (i32.const  1)) ;; $acc_fact  = 1
+
+      (loop $accumulate
+        (set_local $count     (i32.add (get_local $count     ) (i32.const 1         ))) ;; $count    += 1
+        (set_local $acc_fact  (i32.mul (get_local $acc_fact  ) (get_local $count    ))) ;; $acc_fact *= $count
+        (set_local $acc_left  (i32.add (get_local $acc_left  ) (get_local $acc_fact ))) ;; $acc_left += $acc_fact
+
+        (br_if $accumulate (i32.lt_s (get_local $count) (get_local $n)))                ;; loop if $count < $n
+      )
+
+      get_local $acc_left    ;; return $acc_left
+    end
+  )
+)
+;; To test, go to https://webassembly.github.io/wabt/demo/wat2wasm/ ,
+;; copy the code above to the WAT window (top-left),
+;; and  the code below to the JS  window (bottom-left).
+;; Output will be in the JS LOG   window (bottom-right).
+const wasmInstance = new WebAssembly.Instance(wasmModule, {});
+const { left_factorial } = wasmInstance.exports;
+console.log([...Array(10+1).keys()].map(left_factorial).join(', '));
+// Output is: 1, 2, 4, 10, 34, 154, 874, 5914, 46234, 409114, 4037914
diff --git a/challenge-153/bruce-gray/webassembly/ch-2.wat b/challenge-153/bruce-gray/webassembly/ch-2.wat
new file mode 100644
index 0000000000..ad57e61829
--- /dev/null
+++ b/challenge-153/bruce-gray/webassembly/ch-2.wat
@@ -0,0 +1,49 @@
+(module
+  (memory (export "factorial_table") 1)
+
+  ;; Generated by: raku -e 'sub HexStr ($_) { <"> ~ .polymod(256 xx 3).fmt(<\\%02X>, Q<>) ~ <">} ;say "(data (i32.const 0x{(.key * 4).fmt: <%02X>}) { HexStr(.value) })  ;; {.key}! == {.value.fmt: <%6d>}" for (1, |[\*] 1..9).flat.pairs;' | m
+  (data (i32.const 0x00) "\01\00\00\00")  ;; 0! ==      1
+  (data (i32.const 0x04) "\01\00\00\00")  ;; 1! ==      1
+  (data (i32.const 0x08) "\02\00\00\00")  ;; 2! ==      2
+  (data (i32.const 0x0C) "\06\00\00\00")  ;; 3! ==      6
+  (data (i32.const 0x10) "\18\00\00\00")  ;; 4! ==     24
+  (data (i32.const 0x14) "\78\00\00\00")  ;; 5! ==    120
+  (data (i32.const 0x18) "\D0\02\00\00")  ;; 6! ==    720
+  (data (i32.const 0x1C) "\B0\13\00\00")  ;; 7! ==   5040
+  (data (i32.const 0x20) "\80\9D\00\00")  ;; 8! ==  40320
+  (data (i32.const 0x24) "\80\89\05\00")  ;; 9! == 362880
+
+  (func $is_factorion (export "is_factorion") (param $n i32) (result i32)
+    (local $digit   i32)  ;; Right-most digit of (the bleeding copy of) $n
+    (local $bleeder i32)  ;; Copy of $n that is "bled" of its right-most digit
+    (local $offset  i32)  ;; Offset into the factorial_table
+    (local $fact    i32)  ;; Factorial of the digit, pulled from the table
+    (local $acc     i32)  ;; Accumulator
+
+    (set_local $bleeder (get_local $n))   ;; $bleeder = $n
+
+    (loop $accumulate
+      (set_local $digit   (i32.rem_u (get_local $bleeder) (i32.const 10    ) ))  ;; $digit     = $bleeder % 10;
+      (set_local $bleeder (i32.sub   (get_local $bleeder) (get_local $digit) ))  ;; $bleeder  -= $digit;
+      (set_local $bleeder (i32.div_u (get_local $bleeder) (i32.const 10    ) ))  ;; $bleeder  /= 10;
+      (set_local $offset  (i32.mul   (get_local $digit  ) (i32.const  4    ) ))  ;; $offset    = $digit * 4
+      (set_local $fact    (i32.load  (get_local $offset )                    ))  ;; $factorial = @memory[$offset]
+      (set_local $acc     (i32.add   (get_local $acc    ) (get_local $fact ) ))  ;; $acc      += $factorial
+
+      (br_if $accumulate (get_local $bleeder))  ;; while $bleeder != 0
+    )
+
+    (i32.eq (get_local $n) (get_local $acc))    ;; return $n == $acc
+  )
+)
+;; To test, go to https://webassembly.github.io/wabt/demo/wat2wasm/ ,
+;; copy the code above to the WAT window (top-left),
+;; and  the code below to the JS  window (bottom-left).
+;; Output will be in the JS LOG   window (bottom-right).
+const wasmInstance = new WebAssembly.Instance(wasmModule, {});
+const { is_factorion } = wasmInstance.exports;
+console.log(                    [145,123].map(is_factorion).join(', '));
+console.log([...Array(2000000).keys()].filter(is_factorion).join(', '));
+// Output is:
+//    1, 0
+//    1, 2, 145, 40585
diff --git a/challenge-153/bruce-gray/webassembly/ch-2_quick.wat b/challenge-153/bruce-gray/webassembly/ch-2_quick.wat
new file mode 100644
index 0000000000..0b021ba4c5
--- /dev/null
+++ b/challenge-153/bruce-gray/webassembly/ch-2_quick.wat
@@ -0,0 +1,22 @@
+(module
+  (func $is_factorion (export "is_factorion") (param $n i32) (result i32)
+    ;; Well-known sequence; The 4 known terms are the only terms possible. See https://oeis.org/A014080
+    (i32.or
+      (i32.or (i32.eq (get_local $n) (i32.const     1))
+              (i32.eq (get_local $n) (i32.const     2)) )
+      (i32.or (i32.eq (get_local $n) (i32.const   145))
+              (i32.eq (get_local $n) (i32.const 40585)) )
+    )
+  )
+)
+;; To test, go to https://webassembly.github.io/wabt/demo/wat2wasm/ ,
+;; copy the code above to the WAT window (top-left),
+;; and  the code below to the JS  window (bottom-left).
+;; Output will be in the JS LOG   window (bottom-right).
+const wasmInstance = new WebAssembly.Instance(wasmModule, {});
+const { is_factorion } = wasmInstance.exports;
+console.log(                    [145,123].map(is_factorion).join(', '));
+console.log([...Array(2000000).keys()].filter(is_factorion).join(', '));
+// Output is:
+//    1, 0
+//    1, 2, 145, 40585