Merge pull request #1939 from Firedrake/rogerbw-challenge-069

Solutions to challenge #69.

6 files changed, 222 insertions, 0 deletions

diff --git a/challenge-069/roger-bell-west/perl/ch-1.pl b/challenge-069/roger-bell-west/perl/ch-1.pl
new file mode 100755
index 0000000000..bd86423d56
--- /dev/null
+++ b/challenge-069/roger-bell-west/perl/ch-1.pl
@@ -0,0 +1,44 @@
+#! /usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 1;
+
+is_deeply(sg(50,100),
+          [69,88,96],
+          'example 1',
+            );
+
+sub sg {
+  my @range=@_;
+  my @out;
+  my %charges=(
+    6 => 9,
+    9 => 6,
+    8 => 8,
+    0 => 0,
+      );
+  my $cm=join('',keys %charges);
+ OUTER:
+  foreach my $n ($range[0]..$range[1]) {
+    if ($n !~ /^[$cm]*$/) {
+      next;
+    }
+    if ($n =~ /0$/) {
+      next;
+    }
+    my $nl=length($n)-1;
+    my %locs;
+    foreach my $pos (0..$nl) {
+      $locs{$nl-$pos}=$charges{substr($n,$pos,1)};
+    }
+    foreach my $pos (keys %locs) {
+      if (substr($n,$pos,1) ne $locs{$pos}) {
+        next OUTER;
+      }
+    }
+    push @out,$n;
+  }
+  return \@out;
+}
diff --git a/challenge-069/roger-bell-west/perl/ch-2a.pl b/challenge-069/roger-bell-west/perl/ch-2a.pl
new file mode 100755
index 0000000000..22042a0bfc
--- /dev/null
+++ b/challenge-069/roger-bell-west/perl/ch-2a.pl
@@ -0,0 +1,40 @@
+#! /usr/bin/perl
+
+use strict;
+use warnings;
+
+my $s='';
+my $n=0;
+while (1) {
+  print "S$n = \"$s\"\n";
+  my @i;
+  my $l=-1;
+  do {
+    $l=index($s,'1',$l+1);
+    if ($l>-1) {
+      push @i,$l+1;
+    }
+  } while ($l!=-1);
+  print join(',',@i),"\n";
+  $s=plusone($s);
+  $n++;
+  sleep 1;
+}
+
+sub plusone {
+  my $in=shift;
+  return join('',$in,'0',switch(rev($in)));
+}
+
+sub switch {
+  my $str=shift;
+  $str =~ s/1/x/g;
+  $str =~ s/0/1/g;
+  $str =~ s/x/0/g;
+  return $str;
+}
+
+sub rev {
+  my @in=split '',shift;
+  return join('',reverse @in);
+}
diff --git a/challenge-069/roger-bell-west/perl/ch-2b.pl b/challenge-069/roger-bell-west/perl/ch-2b.pl
new file mode 100755
index 0000000000..b93f44fcf5
--- /dev/null
+++ b/challenge-069/roger-bell-west/perl/ch-2b.pl
@@ -0,0 +1,47 @@
+#! /usr/bin/perl
+
+use strict;
+use warnings;
+
+use List::Util qw(min);
+
+my $s=1000;
+my $l=2**$s-1;
+
+my $pos=1;
+my $seq=4;
+while (1) {
+  my $p1=$seq-1;
+  my $n0=min($p1-$pos,$l-$pos);
+  print '0' x $n0;
+  $pos+=$n0;
+  if ($p1<=$l) {
+    print '1';
+    $pos++;
+  }
+  if ($pos>$l) {
+    last;
+  }
+  $seq=nextseq($seq);
+}
+print "\n";
+
+sub nextseq {
+  my $prev=shift;
+  my $c=$prev;
+  while (1) {
+    $c++;
+    my $t=$c-1;
+    while (1) {
+      my $r=int($t/2);
+      if ($t % 2 != 0) {
+        last;
+      }
+      $t=$r;
+    }
+    if ($t % 4 == 3) {
+      last;
+    }
+  }
+  return $c;
+}
diff --git a/challenge-069/roger-bell-west/raku/ch-1.p6 b/challenge-069/roger-bell-west/raku/ch-1.p6
new file mode 100755
index 0000000000..06011127ab
--- /dev/null
+++ b/challenge-069/roger-bell-west/raku/ch-1.p6
@@ -0,0 +1,45 @@
+#! /usr/bin/perl6
+
+use Test;
+
+plan 1;
+
+is-deeply(sg(50,100),
+          [69,88,96],
+          'example 1',
+            );
+
+sub sg ($a,$b) {
+  my @out;
+  my %charges=(
+    6 => 9,
+    9 => 6,
+    8 => 8,
+    0 => 0,
+      );
+  my $cm='^<[' ~ %charges.keys.join('') ~ ']>*$';
+  for $a..$b -> $n {
+    if ($n !~~ /<$cm>/) {
+      next;
+    }
+    if ($n ~~ /0$/) {
+      next;
+    }
+    my $nl=chars($n)-1;
+    my %locs;
+    for 0..$nl -> $pos {
+      %locs{$nl-$pos}=%charges{substr($n,$pos,1)};
+    }
+    my $nn=$n;
+    for keys %locs -> $pos {
+      if (substr($n,$pos,1) ne %locs{$pos}) {
+        $nn=-1;
+        last;
+      }
+    }
+    if ($nn>=0) {
+      push @out,$nn;
+    }
+  }
+  return @out;
+}
diff --git a/challenge-069/roger-bell-west/raku/ch-2b.p6 b/challenge-069/roger-bell-west/raku/ch-2b.p6
new file mode 100755
index 0000000000..8f3a6159ef
--- /dev/null
+++ b/challenge-069/roger-bell-west/raku/ch-2b.p6
@@ -0,0 +1,41 @@
+#! /usr/bin/perl6
+
+my $s=1000;
+my $l=2**$s-1;
+
+my $pos=1;
+my $seq=4;
+while (1) {
+  my $p1=$seq-1;
+  my $n0=min($p1-$pos,$l-$pos);
+  print '0' x $n0;
+  $pos+=$n0;
+  if ($p1 <= $l) {
+    print '1';
+    $pos++;
+  }
+  if ($pos > $l) {
+    last;
+  }
+  $seq=nextseq($seq);
+}
+print "\n";
+
+sub nextseq ($prev) {
+  my $c=$prev;
+  while (1) {
+    $c++;
+    my $t=$c-1;
+    while (1) {
+      my $r=truncate($t/2);
+      if ($t % 2 != 0) {
+        last;
+      }
+      $t=$r;
+    }
+    if ($t % 4 == 3) {
+      last;
+    }
+  }
+  return $c;
+}
diff --git a/challenge-069/roger-bell-west/readme.txt b/challenge-069/roger-bell-west/readme.txt
new file mode 100644
index 0000000000..fe68098357
--- /dev/null
+++ b/challenge-069/roger-bell-west/readme.txt
@@ -0,0 +1,5 @@
+For problem #2:
+
+ch-2a is the utility code that enabled me to find the solution.
+
+ch-2b is the code that outputs the desired answer (yes, even for S=1000).