Merge pull request #4422 from Util/challenge-119

Add Raku and Perl solutions for #119.

9 files changed, 227 insertions, 0 deletions

diff --git a/challenge-119/bruce-gray/README b/challenge-119/bruce-gray/README
new file mode 100644
index 0000000000..5d0deab51b
--- /dev/null
+++ b/challenge-119/bruce-gray/README
@@ -0,0 +1 @@
+Solutions by Bruce Gray.
diff --git a/challenge-119/bruce-gray/blog.txt b/challenge-119/bruce-gray/blog.txt
new file mode 100644
index 0000000000..64cc2e9517
--- /dev/null
+++ b/challenge-119/bruce-gray/blog.txt
@@ -0,0 +1,2 @@
+I intend to make my first blog post tomorrow, about this week's challenge:
+http://blogs.perl.org/users/bruce_gray/
diff --git a/challenge-119/bruce-gray/perl/ch-1.pl b/challenge-119/bruce-gray/perl/ch-1.pl
new file mode 100755
index 0000000000..c36c70619e
--- /dev/null
+++ b/challenge-119/bruce-gray/perl/ch-1.pl
@@ -0,0 +1,15 @@
+#!/usr/bin/env perl
+use strict;
+use warnings;
+use 5.010;
+use experimental qw<signatures>;
+
+# Reverse the last two nybbles, without limiting $n to < 256.
+sub nib ( $n ) {
+    return   ($n & 0xFFFFFF00)
+         + ( ($n & 0xF0) >> 4 )
+         + ( ($n & 0x0F) << 4 );
+}
+
+my @in = @ARGV ? @ARGV : (101, 18, 253, 254, 255, 256, 257);
+say $_, " ==> ", nib($_) for @in;
diff --git a/challenge-119/bruce-gray/perl/ch-1_bigint.pl b/challenge-119/bruce-gray/perl/ch-1_bigint.pl
new file mode 100755
index 0000000000..a82759434d
--- /dev/null
+++ b/challenge-119/bruce-gray/perl/ch-1_bigint.pl
@@ -0,0 +1,46 @@
+#!/usr/bin/env perl
+use strict;
+use warnings;
+use 5.010;
+use experimental qw<signatures>;
+use bigint;
+
+# Reverse the last two nybbles, without limiting $n at all.
+sub nib ( $n ) {
+    return   ($n & ~0xFF)
+         + ( ($n &  0xF0) >> 4 )
+         + ( ($n &  0x0F) << 4 );
+}
+
+my @tests = (
+    # All numbers written in hex, to make clearer the correctness of the expected transformation.
+    # The Raku and Perl tests differ for >=256, since they different interpretations what it means to expand the problem past 256.
+    [ 0x65 => 0x56 ], # 101 ==>  86
+    [ 0x12 => 0x21 ], #  18 ==>  33
+    [  0x1 => 0x10 ],
+    [    0 =>    0 ],
+    [ 0xDeadBeef => 0xDeadBefe ],
+    [  0xBadBeef =>  0xBadBefe ],
+    # # Larger than  64-bits; # Even and odd number of nybbles.
+    [ 0x19_Efface_Decade_Facade => 0x19_Efface_Decade_Facaed ],
+    [  0x9_Efface_Decade_Facade =>  0x9_Efface_Decade_Facaed ],
+
+    # Larger than 128-bits; # Even and odd number of nybbles.
+    [ 0x19_BeefCafe_FeedFace_BeefCafe_FeedFace => 0x19_BeefCafe_FeedFace_BeefCafe_FeedFaec ],
+    [  0x9_BeefCafe_FeedFace_BeefCafe_FeedFace =>  0x9_BeefCafe_FeedFace_BeefCafe_FeedFaec ],
+);
+
+if (@ARGV) {
+    say $_, " ==> ", nib($_) for @ARGV;
+}
+else {
+    for (@tests) {
+        my ( $x,  $y  ) = @{$_};
+        my ( $nx, $ny ) = map { nib($_) } @{$_};
+        say $x, " ==> ", $nx;
+        say $y, " ==> ", $ny;
+        die "$x != $ny" if $x != $ny;
+        die "$y != $nx" if $y != $nx;
+    }
+    say 'OK';
+}
diff --git a/challenge-119/bruce-gray/perl/ch-2.pl b/challenge-119/bruce-gray/perl/ch-2.pl
new file mode 100755
index 0000000000..8e86de8e63
--- /dev/null
+++ b/challenge-119/bruce-gray/perl/ch-2.pl
@@ -0,0 +1,26 @@
+#!/usr/bin/env perl
+use strict;
+use warnings;
+use 5.010;
+use experimental qw<signatures>;
+
+# Generator, with state in-between calls.
+# Translation of my `X~` Raku solution, with additional separation by leading digit,
+# to remove the need for grep'ing out the /11/.
+sub s123 ( $n ) {
+    state @s;
+    state $last = [ [], [], [""] ];
+    while ( not defined $s[$n] ) {
+        push @s,            @{$last->[0]},@{$last->[1]},@{$last->[2]};
+
+        $last = [
+            [ map { "1$_" }               @{$last->[1]},@{$last->[2]} ],
+            [ map { "2$_" } @{$last->[0]},@{$last->[1]},@{$last->[2]} ],
+            [ map { "3$_" } @{$last->[0]},@{$last->[1]},@{$last->[2]} ],
+        ];
+    }
+    return $s[$n];
+}
+
+my @in = @ARGV ? @ARGV : (5,10,60,14410);
+say $_, " ==> ", s123($_) for @in;
diff --git a/challenge-119/bruce-gray/perl/ch-2_logN.pl b/challenge-119/bruce-gray/perl/ch-2_logN.pl
new file mode 100755
index 0000000000..65beb02c2d
--- /dev/null
+++ b/challenge-119/bruce-gray/perl/ch-2_logN.pl
@@ -0,0 +1,40 @@
+#!/usr/bin/env perl
+use strict;
+use warnings;
+use 5.010;
+use experimental qw<signatures>;
+use List::Util qw<sum0 first>;
+
+# use bigint; # Uncomment for command-line arguments bigger than 309 digits.
+
+# Translation of my O(log N) Raku solution.
+sub s2 ( $n ) {
+    state $s2 = [ 0, 0, 1 ];
+    while ( not defined $s2->[$n] ) {
+        my $s = sum0 @{$s2}[-3,-2,-1];
+        push @{$s2}, $s - $s2->[-3], $s, $s;
+    }
+    return $s2->[$n];
+}
+sub s3 ( $n ) {
+    state $s3 = [ s2(0) + s2(1) ];
+    while ( not defined $s3->[$n] ) {
+        push @{$s3}, $s3->[-1] + s2($#{$s3} + 1);
+    }
+    return $s3->[$n];
+}
+sub s123 ( $n ) {
+    my $r;
+    while ( $n > 0 ) {
+        my $k = first { s3($_) > $n } 0..4200; # 4200 is enough for 10**600
+        my $pos = $k % 3;
+
+        $r .= $pos + 1; # Digit
+        $n -= sum0 map { s2($_) } ($k-$pos) .. $k;
+    }
+    die "NEGATIVE N: ", $n if $n < 0; # Should be impossible, but I cannot prove it.
+    return $r;
+}
+
+my @in = @ARGV ? @ARGV : (5,10,60,14410);
+say $_, " ==> ", s123($_) for @in;
diff --git a/challenge-119/bruce-gray/raku/ch-1.raku b/challenge-119/bruce-gray/raku/ch-1.raku
new file mode 100755
index 0000000000..7807482670
--- /dev/null
+++ b/challenge-119/bruce-gray/raku/ch-1.raku
@@ -0,0 +1,37 @@
+#!/usr/bin/env raku
+# Simplest solution, from the C language mindset.
+multi sub nib ( Int $n where ^256 ) {
+    return ( ($n +& 0xF0) +> 4 )
+         + ( ($n +& 0x0F) +< 4 );
+}
+# Swap pairs of nybbles within each byte, for any size.
+multi sub nib ( Int $n where * >= 0 ) {
+    my Str $hex = $n.base(16);
+    $hex [R~]= '0' if $hex.chars !%% 2; # append/prepend
+    return $hex.comb(2)».flip.join.parse-base(16);
+}
+
+multi sub MAIN ( *@n ) {
+    say $_, " ==> ", .&nib for +«@n;
+}
+multi sub MAIN ( ) {
+    # All numbers written in hex, to make clearer the correctness of the expected transformation.
+    # The Raku and Perl tests differ for >=256, since they different interpretations what it means to expand the problem past 256.
+    constant @tests =
+        0x65 => 0x56, # 101 ==>  86
+        0x12 => 0x21, #  18 ==>  33
+         0x1 => 0x10,
+           0 =>    0,
+        0xDeadBeef => 0xEddaEbfe,
+        # Larger than  64-bits; # Even and odd number of nybbles.
+        0x19_Efface_Decade_Facade => 0x91_Feafec_Edaced_Afaced,
+         0x9_Efface_Decade_Facade => 0x90_Feafec_Edaced_Afaced,
+
+        # Larger than 128-bits; # Even and odd number of nybbles.
+        0x19_BeefCafe_FeedFace_BeefCafe_FeedFace => 0x91_EbfeAcef_EfdeAfec_EbfeAcef_EfdeAfec,
+         0x9_BeefCafe_FeedFace_BeefCafe_FeedFace => 0x90_EbfeAcef_EfdeAfec_EbfeAcef_EfdeAfec,
+    ;
+    use Test;
+    plan 2*@tests;
+    is nib(.key), .value, "nib {.key.fmt('%3d')} ==> {.value.fmt('%3d')}" for |@tests, |@tests>>.antipair;
+}
diff --git a/challenge-119/bruce-gray/raku/ch-2.raku b/challenge-119/bruce-gray/raku/ch-2.raku
new file mode 100755
index 0000000000..945c6d97fc
--- /dev/null
+++ b/challenge-119/bruce-gray/raku/ch-2.raku
@@ -0,0 +1,24 @@
+#!/usr/bin/env raku
+# Each "generation" contains the same number of digits.
+sub s123 ( Int $n where * > 0 ) {
+    sub next_generation ( @a ) {
+        return [ ( <1 2 3> X~ @a ).grep: {!/11/} ];
+    }
+    constant @s = ( [""], &next_generation ... * ).map(*.<>).flat;
+    return @s[$n];
+}
+
+
+multi sub MAIN ( *@n ) {
+    say $_, " ==> ", .&s123 for +«@n;
+}
+multi sub MAIN ( ) {
+    use Test;
+    my @tests =
+          5 =>   13,
+         10 =>   32,
+         60 => 2223,
+    ;
+    plan +@tests;
+    is s123(.key), .value, "nib {.key.fmt('%3d')} ==> {.value.fmt('%4d')}" for @tests;
+}
diff --git a/challenge-119/bruce-gray/raku/ch-2_logN.raku b/challenge-119/bruce-gray/raku/ch-2_logN.raku
new file mode 100755
index 0000000000..d38dcaa42f
--- /dev/null
+++ b/challenge-119/bruce-gray/raku/ch-2_logN.raku
@@ -0,0 +1,36 @@
+# My best solution. More complex, but O(log N) instead of O(N).
+sub s123 ( Int $n is copy where * > 0 ) {
+    constant @s1 = [0,0,1], { my \s = @^a.sum; [ s - @^a[0], s, s ] } ... *;
+    constant @s2 = @s1.map(*.<>).flat;
+    constant @s3 = [\+] @s2;
+
+    return join '', gather {
+        while $n > 0 {
+            my $k   = @s3.first: :k, * > $n;
+            my $pos = $k % 3;
+
+            take $pos + 1; # Digit
+
+            $n -= @s2[ $k + (-$pos .. 0) ].sum
+        }
+        die "NEGATIVE N: ", $n if $n < 0; # Should be impossible, but I cannot prove it.
+    }
+}
+
+
+multi sub MAIN ( *@n ) {
+    say $_, " ==> ", .&s123 for +«@n;
+}
+multi sub MAIN ( ) {
+    use Test;
+    my @tests =
+          5 =>   13,
+         10 =>   32,
+         60 => 2223,
+
+         10**303 => 2313313132233133213223122123331222122213332132312122131312132322212133122231313232321332332122222212133133312321332321333333222232313222231223212231332131322322122133121222231233312312312121213212133233131312223232322232333133221223132332132331322333231233121222231323221232212222231323213131332312312233232131231222122133223132322132231321321333313221313231333122312313131213232322131323323333232123133212221233222123232232312122132231333313312222332212123323233212322323312123332313213132223212133322223213123313212313232123233232322313333322322123123133122123221232231212222212312131323222322222132131233222232333132233133321313312232133221222223132132213323313232122223132312333131312233121,
+         10**600 => 1221331332313131231213121331323133223312213233221312121332212231213122133232121332322123233332121322333312222321232332312123121332221312231212331333233313232222313212323321312322333131232321313221212313322121333333312123231313132321212313122213321221233233312212232333222132123121333232233321221322222313332233133131212123312132312212213221231332212131212213223213223223322313222322132331322132123333223332233133221322123321212321231223121312131312232132123132233133122122122132323223232121323313322313213322321323323133331213321321233312331333222131312131312331231331212122123223323323333332132331232222122121213312313232323212123131321222231223223133312132323322313332223212223222312232333212132331323122133133223132121223322221212121333213323321333121213233212312222333231223132221212221212223231231313232313223133331322333121331223122323231333232132131212313132122222222223223233222133132223232332332322212133233231212213321222331312123213232312122321232223332232122212233123132121231212221223221331323232333131331223133213322212222132122212332133123312232133232313121222232132322322121321312131213212321232212313231223213332321212232131333121221222221222133232222122213212233223232231332333332332231213322322131322312133322332121222122121312213122122221223331233123221223213122222123222231221312321222313333232332131312223223121232132331212333332223333132123323131232212,
+    ;
+    plan +@tests;
+    is s123(.key), .value, "nib {.key.fmt('%3d')} ==> {.value.fmt('%4d')}" for @tests;
+}