Merge pull request #4742 from polettix/polettix/pwc126

Add polettix's solution to challenge-126

6 files changed, 225 insertions, 0 deletions

diff --git a/challenge-126/polettix/blog.txt b/challenge-126/polettix/blog.txt
new file mode 100644
index 0000000000..f6af4f6a0f
--- /dev/null
+++ b/challenge-126/polettix/blog.txt
@@ -0,0 +1 @@
+https://github.polettix.it/ETOOBUSY/2021/08/18/pwc126-count-numbers/
diff --git a/challenge-126/polettix/blog1.txt b/challenge-126/polettix/blog1.txt
new file mode 100644
index 0000000000..22924d0381
--- /dev/null
+++ b/challenge-126/polettix/blog1.txt
@@ -0,0 +1 @@
+https://github.polettix.it/ETOOBUSY/2021/08/19/pwc126-minesweeper-game/
diff --git a/challenge-126/polettix/perl/ch-1.pl b/challenge-126/polettix/perl/ch-1.pl
new file mode 100644
index 0000000000..14cd60d02b
--- /dev/null
+++ b/challenge-126/polettix/perl/ch-1.pl
@@ -0,0 +1,54 @@
+#!/usr/bin/env perl
+use v5.24;
+use warnings;
+use experimental 'signatures';
+no warnings 'experimental::signatures';
+use Benchmark 'cmpthese';
+
+my $N = shift || 15;
+say 'brute force: ', count_like_no_ones_bf($N) if $N < 1000;
+say 'iterative:   ', count_like_no_ones($N);
+say 'recursive:   ', count_like_no_ones_r($N);
+
+exit 0 unless $ENV{BENCHMARK};
+
+#my @inputs = 0 .. 9999;
+my @inputs = 99999999990000 .. 99999999999999;
+cmpthese(-5,
+   {
+      #brute     => sub { count_like_no_ones_bf($_) for @inputs },
+      recursive => sub { count_like_no_ones_r($_) for @inputs },
+      iterative => sub { count_like_no_ones($_) for @inputs },
+   }
+);
+
+say 'done';
+
+sub count_like_no_ones_bf ($N) { scalar grep {! m{1}mxs} 2 .. $N }
+
+sub count_like_no_ones ($N) {
+   my $count = 0;
+   my @digits = split m{}mxs, $N;
+   while (@digits) {
+      my $first = shift @digits;
+      if (@digits) { # more to go after, use chunking
+         my $factor = $first > 1 ? $first - 1 : $first;
+         $count += $factor * 9 ** @digits;
+      }
+      else { # last digit, count all including 0
+         $count += $first > 1 ? $first : 1;
+      }
+      last if ($first == 1);
+   }
+   # we took into account sequence of all 0, so we remove it
+   return $count - 1;
+}
+
+sub count_like_no_ones_r ($N) {
+   return($N > 1 ? $N - 1 : 0) if $N < 10;
+   my $first = substr $N, 0, 1, '';
+   my $factor = $first > 1 ? $first - 1 : $first;
+   my $count = $factor * 9 ** length($N);
+   $count += 1 + count_like_no_ones_r($N) if $first != 1;
+   return $count - 1;
+}
diff --git a/challenge-126/polettix/perl/ch-2.pl b/challenge-126/polettix/perl/ch-2.pl
new file mode 100644
index 0000000000..344461da42
--- /dev/null
+++ b/challenge-126/polettix/perl/ch-2.pl
@@ -0,0 +1,70 @@
+#!/usr/bin/env perl
+use v5.24;
+use warnings;
+use experimental 'signatures';
+no warnings 'experimental::signatures';
+
+my $field_text = <<'END';
+x * * * x * x x x x
+* * * * * * * * * x
+* * * * x * x * x *
+* * * x x * * * * *
+x * * * x * * * * x
+END
+
+my $field = [map { [split m{\s+}mxs] } split m{\n}mxs, $field_text];
+
+print_field($field);
+say '';
+print_field(reveal_solution($field));
+
+sub print_field ($field) { say join ' ', $_->@* for $field->@* }
+
+sub reveal_solution ($field) {
+   # this will keep the "revealed" field
+	my @retval;
+
+   # we need address cells in the @retval grid, so we have to iterate
+   # over indices of the input array instead of on the rows directly
+	for my $ri (0 .. $field->$#*) {
+      my $row = $field->[$ri];
+
+      # same for columns, we need the index and we get it in $ci
+      for my $ci (0 .. $row->$#*) {
+
+         # make sure that the element is initialized.
+         $retval[$ri][$ci] //= 0;
+
+         # after this, the only cell that is meaningful for us is the mine,
+         # as we will "propagate" its effects on the surrounding cells.
+         # This is efficient as long as there are *few* mines.
+         next if $row->[$ci] ne 'x';
+
+         # if the input field has a mine, the output has one too
+         $retval[$ri][$ci] = 'x';
+
+         # now we iterate over the 3x3 grid centered as ($ri, $ci),
+         # making sure to ignore the central position (which cannot
+         # influence itself) and that we don't go beyond the limits
+         # of the input field. $rd is a "delta" for rows.
+         for my $rd (-1, 0, 1) {
+            # This is a position in the output field that is influenced
+            # by the mine we just found. Well, actually it's a row for
+            # multiple positions.
+            my $Ri = $ri + $rd;
+            next if $Ri < 0 || $Ri > $field->$#*;
+
+            # similarly we do for column indexes
+            for my $cd (-1, 0, 1) {
+               next unless $rd || $cd; # get rid of (0, 0)
+               my $Ci = $ci + $cd;
+               next if $Ci < 0 || $Ci > $row->$#*;
+               $retval[$Ri][$Ci] //= 0; # initialize if necessary
+               next if $retval[$Ri][$Ci] eq 'x'; # don't overwrite mines
+               $retval[$Ri][$Ci]++; # increment close-by position
+            }
+         }
+      }
+	}
+   return \@retval;
+}
diff --git a/challenge-126/polettix/raku/ch-1.raku b/challenge-126/polettix/raku/ch-1.raku
new file mode 100644
index 0000000000..a84e32bcff
--- /dev/null
+++ b/challenge-126/polettix/raku/ch-1.raku
@@ -0,0 +1,27 @@
+#!/usr/bin/env raku
+use v6;
+
+sub count-like-no-one-bf (Int:D $N where * > 0) {
+   (2 .. $N).grep({! /1/}).elems
+}
+
+sub count-like-no-one (Int:D $N where * > 0) {
+   my $count = 0;
+   my @digits = $N.comb;
+   while (@digits) {
+      my $first = @digits.shift;
+      if (@digits) {
+         my $factor = $first > 1 ?? $first - 1 !! $first;
+         $count += $factor * 9 ** @digits;
+      }
+      else {
+         $count += $first > 1 ?? $first !! 1;
+      }
+      last if $first == 1;
+   }
+   return $count - 1;
+}
+
+sub MAIN (Int:D $N where * > 0) {
+   say count-like-no-one($N) - count-like-no-one-bf($N);
+}
diff --git a/challenge-126/polettix/raku/ch-2.raku b/challenge-126/polettix/raku/ch-2.raku
new file mode 100644
index 0000000000..78eeca71dc
--- /dev/null
+++ b/challenge-126/polettix/raku/ch-2.raku
@@ -0,0 +1,72 @@
+#!/usr/bin/env raku
+use v6;
+
+
+
+sub MAIN {
+   my $field-text = q:to/END/;
+x * * * x * x x x x
+* * * * * * * * * x
+* * * * x * x * x *
+* * * x x * * * * *
+x * * * x * * * * x
+END
+
+   $field-text.put;
+
+   my @field = $field-text.lines.map: {[.comb(/\S+/).List]};
+   print-field(@field);
+   ''.put;
+   print-field(reveal-solution(@field));
+}
+
+sub print-field (@field) { @field.map: *.join(' ').put }
+
+sub reveal-solution (@field) {
+   # this will keep the "revealed" field
+	my @retval;
+
+   # we need address cells in the @retval grid, so we have to iterate
+   # over indices of the input array instead of on the rows directly
+	for 0 .. @field.end -> $ri {
+      my @row := @field[$ri];
+
+      # same for columns, we need the index and we get it in $ci
+      for 0 .. @row.end -> $ci {
+
+         # make sure that the element is initialized.
+         @retval[$ri][$ci] //= 0;
+
+         # after this, the only cell that is meaningful for us is the mine,
+         # as we will "propagate" its effects on the surrounding cells.
+         # This is efficient as long as there are *few* mines.
+         next if @row[$ci] ne 'x';
+
+         # if the input field has a mine, the output has one too
+         @retval[$ri][$ci] = 'x';
+
+         # now we iterate over the 3x3 grid centered as ($ri, $ci),
+         # making sure to ignore the central position (which cannot
+         # influence itself) and that we don't go beyond the limits
+         # of the input field. $rd is a "delta" for rows.
+         for -1, 0, 1 -> $rd {
+            # This is a position in the output field that is influenced
+            # by the mine we just found. Well, actually it's a row for
+            # multiple positions.
+            my $Ri = $ri + $rd;
+            next if $Ri < 0 || $Ri > @field.end;
+
+            # similarly we do for column indexes
+            for -1, 0, 1 -> $cd {
+               next unless $rd || $cd; # get rid of (0, 0)
+               my $Ci = $ci + $cd;
+               next if $Ci < 0 || $Ci > @row.end;
+               @retval[$Ri][$Ci] //= 0; # initialize if necessary
+               next if @retval[$Ri][$Ci] eq 'x'; # don't overwrite mines
+               @retval[$Ri][$Ci]++; # increment close-by position
+            }
+         }
+      }
+	}
+   return @retval;
+}