Merge pull request #4372 from polettix/polettix/pwc119

Add polettix's solution to challenge-119

6 files changed, 87 insertions, 0 deletions

diff --git a/challenge-119/polettix/blog.txt b/challenge-119/polettix/blog.txt
new file mode 100644
index 0000000000..794db24dab
--- /dev/null
+++ b/challenge-119/polettix/blog.txt
@@ -0,0 +1 @@
+https://github.polettix.it/ETOOBUSY/2021/06/30/pwc119-swap-nibbles/
diff --git a/challenge-119/polettix/blog1.txt b/challenge-119/polettix/blog1.txt
new file mode 100644
index 0000000000..12a273c69a
--- /dev/null
+++ b/challenge-119/polettix/blog1.txt
@@ -0,0 +1 @@
+https://github.polettix.it/ETOOBUSY/2021/07/01/pwc119-sequence-without-1-on-1/
diff --git a/challenge-119/polettix/perl/ch-1.pl b/challenge-119/polettix/perl/ch-1.pl
new file mode 100644
index 0000000000..c6b56ba561
--- /dev/null
+++ b/challenge-119/polettix/perl/ch-1.pl
@@ -0,0 +1,5 @@
+#!/usr/bin/env perl
+use v5.24;
+sub swap_nibbles { ($_[0] & 0x0F) << 4 | $_[0] >> 4 }
+my @inputs = @ARGV ? @ARGV : qw< 101 18 >;
+say swap_nibbles($_) for @inputs;
diff --git a/challenge-119/polettix/perl/ch-2.pl b/challenge-119/polettix/perl/ch-2.pl
new file mode 100644
index 0000000000..44e3356b10
--- /dev/null
+++ b/challenge-119/polettix/perl/ch-2.pl
@@ -0,0 +1,42 @@
+#!/usr/bin/env perl
+use 5.024;
+use warnings;
+use experimental qw< postderef signatures >;
+no warnings qw< experimental::postderef experimental::signatures >;
+
+sub sequence_without_1_on_1 ($N) {
+   my $candidate = 1;
+   while ($N > 1) {
+      $candidate = succ_of($candidate);
+      --$N if $candidate !~ m{11}mxs;
+   }
+   return $candidate;
+}
+
+sub succ_of ($x) {
+   $x = base_4_to_10($x);
+   while ('necessary') {
+      my $candidate = base_10_to_4(++$x);
+      return $candidate if $candidate !~ m{0}mxs;
+   }
+}
+
+sub base_4_to_10 ($x) {
+   my $X = 0;
+   for my $digit (split m{}mxs, $x) {
+      $X = ($X << 2) + $digit;
+   }
+   return $X;
+}
+
+sub base_10_to_4 ($x) {
+   my @digits;
+   while ($x) {
+      push @digits, $x & 0b11;
+      $x >>= 2;
+   }
+   return join '', @digits ? reverse @digits : 0;
+}
+
+my @inputs = @ARGV ? @ARGV : qw< 5 10 60 >;
+say sequence_without_1_on_1($_) for @inputs;
diff --git a/challenge-119/polettix/raku/ch-1.raku b/challenge-119/polettix/raku/ch-1.raku
new file mode 100644
index 0000000000..7738a9eeda
--- /dev/null
+++ b/challenge-119/polettix/raku/ch-1.raku
@@ -0,0 +1,5 @@
+#!/usr/bin/env raku
+use v6;
+sub swap-nibbles (Int:D $N where 0 < $N <= 255) { $N +& 0x0F +< 4 +| $N +> 4 }
+my @inputs = @*ARGS ?? @*ARGS !! < 101 18 >;
+swap-nibbles(+$_).put for @inputs;
diff --git a/challenge-119/polettix/raku/ch-2.raku b/challenge-119/polettix/raku/ch-2.raku
new file mode 100644
index 0000000000..8f590f2e05
--- /dev/null
+++ b/challenge-119/polettix/raku/ch-2.raku
@@ -0,0 +1,33 @@
+#!/usr/bin/env raku
+use v6;
+
+sub sequence-without-one-on-one (Int:D $N is copy where 0 < *) {
+   my $candidate = '1';
+   while ($N > 1) {
+      $candidate = succ-of-b4($candidate);
+      --$N if $candidate !~~ /11/;
+   }
+   return $candidate;
+}
+
+sub succ-of ($x) {
+   my ($carry, @succ) = (True, $x.comb.reverse>>.Int.Slip);
+   for @succ -> $item is rw {
+      ($item, $carry) = ($item + 1, False) if $carry;
+      ($item, $carry) = (1        , True)  if $item > 3;
+      last unless $carry;
+   }
+   @succ.push: 1 if $carry;
+   @succ.reverse.join: '';
+}
+
+sub succ-of-b4 (Str:D $x) {
+   my $X = $x.parse-base(4);
+   loop {
+      my $candidate = (++$X).base(4);
+      return $candidate if $candidate !~~ /0/;
+   }
+}
+
+my @inputs = @*ARGS ?? @*ARGS !! qw< 5 10 60 >;
+sequence-without-one-on-one(+$_).put for @inputs;