Merge pull request #5377 from polettix/polettix/pwc143

Add polettix's solution to challenge-143

6 files changed, 226 insertions, 0 deletions

diff --git a/challenge-143/polettix/blog.txt b/challenge-143/polettix/blog.txt
new file mode 100644
index 0000000000..3da28beca3
--- /dev/null
+++ b/challenge-143/polettix/blog.txt
@@ -0,0 +1 @@
+https://github.polettix.it/ETOOBUSY/2021/12/15/pwc143-calculator/
diff --git a/challenge-143/polettix/blog1.txt b/challenge-143/polettix/blog1.txt
new file mode 100644
index 0000000000..7a97631ede
--- /dev/null
+++ b/challenge-143/polettix/blog1.txt
@@ -0,0 +1 @@
+https://github.polettix.it/ETOOBUSY/2021/12/16/stealthy-number/
diff --git a/challenge-143/polettix/perl/ch-1.pl b/challenge-143/polettix/perl/ch-1.pl
new file mode 100644
index 0000000000..ca6254bb70
--- /dev/null
+++ b/challenge-143/polettix/perl/ch-1.pl
@@ -0,0 +1,143 @@
+#!/usr/bin/env perl
+use v5.24;
+use warnings;
+use experimental 'signatures';
+no warnings 'experimental::signatures';
+
+say parse(shift);
+
+# main entry point, useful for extracting the return value
+sub parse ($exp) { return pf_PARSE(expression())->($exp)->[0] }
+
+# <term> [+/- <term> [+/- <term> [...]]] | <group>
+sub expression { pf_alternatives(canned_ops(term(), '-', '+'), group()) }
+
+# <factor> [* <factor> [* <factor> [...]]]
+sub term { canned_ops(factor(), '*') }
+
+# <value> | <group>
+sub factor { pf_alternatives(value(), group()) }
+
+# '(' <expression> ')'
+sub group {
+   return sub {
+      state $matcher = pf_sequence('(', expression(), ')');
+      my $match = $matcher->(@_) or return;
+      return $match->[1];
+   }
+}
+
+# some integer without sign
+sub value { pf_regexp(qr{\s*(0|[1-9]\d*)\s*}) }
+
+# implementation of operand [op operand [op operand [...]]]
+sub canned_ops ($operand, @operators) {
+   my $ops = join '|', map { quotemeta } @operators ;
+   my $op_opd = pf_sequence(pf_regexp(qr{\s*($ops)\s*}), $operand);
+   my $matcher = pf_sequence($operand, pf_repeated($op_opd));
+   return sub {
+      my $match = $matcher->(@_) or return;
+      my $retval = $match->[0][0];
+      for my $opv ($match->[1]->@*) {
+         my ($op, $val) = map { $_->[0] }$opv->@*;
+         if    ($op eq '*') { $retval *= $val }
+         elsif ($op eq '+') { $retval += $val }
+         elsif ($op eq '-') { $retval -= $val }
+      }
+      return [ $retval ];
+   }
+}
+
+
+# parsing facilities
+sub pf_alternatives {
+   my (@A, $r) = @_;
+   return sub { (defined($r = $_->($_[0])) && return $r) for @A; return };
+}
+
+sub pf_exact {
+   my ($wlen, $what, @retval) = (length($_[0]), @_);
+   unshift @retval, $what unless scalar @retval;
+   return sub {
+      my ($rtext, $pos) = ($_[0], pos(${$_[0]}) || 0);
+      return if length($$rtext) - $pos < $wlen;
+      return if substr($$rtext, $pos, $wlen) ne $what;
+      pos($$rtext) = $pos + $wlen;
+      return [@retval];
+   };
+}
+
+sub pf_list {
+   my ($w, $s, $sep_as_last) = @_; # (what, separator, sep_as_last)
+   $s = pf_exact($s) if defined($s) && !ref($s);
+   return sub {
+      defined(my $base = $w->($_[0])) or return;
+      my $rp = sub { return ($s && !($s->($_[0])) ? () : $w->($_[0])) };
+      my $rest = pf_repeated($rp)->($_[0]);
+      $s->($_[0]) if $s && $sep_as_last; # attempt last separator?
+      unshift $rest->@*, $base;
+      return $rest;
+   };
+}
+
+sub pf_match_and_filter {
+   my ($matcher, $filter) = @_;
+   return sub {
+      my $match = $matcher->($_[0]) or return;
+      return $filter->($match);
+   };
+}
+
+sub pf_PARSE {
+   my ($expression) = @_;
+   return sub {
+      my $rtext = ref $_[0] ? $_[0] : \$_[0]; # avoid copying
+      my $ast = $expression->($rtext) or die "nothing parsed\n";
+      my $pos = pos($$rtext) || 0;
+      my $delta = length($$rtext) - $pos;
+      return $ast if $delta == 0;
+      my $offending = substr $$rtext, $pos, 72;
+      substr $offending, -3, 3, '...' if $delta > 72;
+      die "unknown sequence starting at $pos <$offending>\n";
+   };
+}
+
+sub pf_regexp {
+   my ($rx, @forced_retval) = @_;
+   return sub {
+      scalar(${$_[0]} =~ m{\G()$rx}cgmxs) or return;
+      return scalar(@forced_retval) ? [@forced_retval] : [$2];
+   };
+}
+
+sub pf_repeated { # *(0,-1) ?(0,1) +(1,-1) {n,m}(n,m)
+   my ($w, $m, $M) = ($_[0], $_[1] || 0, (defined($_[2]) ? $_[2] : -1));
+   return sub {
+      my ($rtext, $pos, $lm, $lM, @retval) = ($_[0], pos ${$_[0]}, $m, $M);
+      while ($lM != 0) { # lm = local minimum, lM = local maximum
+         defined(my $piece = $w->($rtext)) or last;
+         $lM--;
+         push @retval, $piece;
+         if ($lm > 0) { --$lm } # no success yet
+         else         { $pos = pos $$rtext } # ok, advance
+      }
+      pos($$rtext) = $pos if $lM != 0;  # maybe "undo" last attempt
+      return if $lm > 0;    # failed to match at least $min
+      return \@retval;
+   };
+}
+
+sub pf_sequence {
+   my @items = map { ref $_ ? $_ : pf_exact($_) } @_;
+   return sub {
+      my ($rtext, $pos, @rval) = ($_[0], pos ${$_[0]});
+      for my $item (@items) {
+         if (defined(my $piece = $item->($rtext))) { push @rval, $piece }
+         else { pos($$rtext) = $pos; return } # failure, revert back
+      }
+      return \@rval;
+   };
+}
+
+{ my $r; sub pf_ws  { $r ||= pf_regexp(qr{(\s+)}) } }
+{ my $r; sub pf_wso { $r ||= pf_regexp(qr{(\s*)}) } }
diff --git a/challenge-143/polettix/perl/ch-2.pl b/challenge-143/polettix/perl/ch-2.pl
new file mode 100644
index 0000000000..b6829b205c
--- /dev/null
+++ b/challenge-143/polettix/perl/ch-2.pl
@@ -0,0 +1,19 @@
+#!/usr/bin/env perl
+use v5.24;
+use warnings;
+use experimental 'signatures';
+no warnings 'experimental::signatures';
+
+sub is_stealthy ($n) {
+   my %match;
+   for my $k (1 .. sqrt($n)) {
+      next if $n % $k;
+      my $sum = $k + $n / $k;
+      return 1 if $match{$sum - 1} || $match{$sum + 1};
+      $match{$sum} = 1;
+   }
+   return 0;
+}
+
+my @inputs = @ARGV ? @ARGV : qw< 36 12 6 >;
+say "$_ -> " . is_stealthy($_) for @inputs;
diff --git a/challenge-143/polettix/raku/ch-1.raku b/challenge-143/polettix/raku/ch-1.raku
new file mode 100644
index 0000000000..8536409cdf
--- /dev/null
+++ b/challenge-143/polettix/raku/ch-1.raku
@@ -0,0 +1,43 @@
+#!/usr/bin/env raku
+use v6;
+
+grammar Calc {
+    rule TOP        { ^ <expression> $ }
+    rule expression { <term>+ %% $<op>=(['+'|'-']) | <group> }
+    rule term       { <factor>+  %% $<op>=(['*']) }
+    rule factor     { <value> | <group> }
+    rule group      { '(' <expression> ')' }
+    token value     { 0 | <[ 1..9 ]> \d* }
+}
+
+class Actions {
+   method TOP ($/) { $/.make: $<expression>.made }
+   method expression ($/) {
+      if $<group> { $/.make: $<group>.made }
+      else        { $/.make: self!calc($<term>, $<op>) }
+   }
+   method term ($/) { $/.make: self!calc($<factor>, $<op>) }
+   method factor ($/) {
+      if $<group> { $/.make: $<group>.made }
+      else        { $/.make: $<value>.made }
+   }
+   method group ($/) { $/.make: $<expression>.made }
+   method value ($/) { $/.make: +$/ }
+
+   method !calc ($operands, $operators) {
+      my ($retval, @vals) = $operands».made;
+      my @ops = $operators.map: ~*;
+      for @ops Z @vals -> ($_, $val) {
+         when '*' { $retval *= $val }
+         when '+' { $retval += $val }
+         when '-' { $retval -= $val }
+      }
+      return $retval;
+   }
+}
+
+sub MAIN ($expression) {
+   my $calc = Calc.parse($expression, actions => Actions)
+      or die 'cannot parse input expression';
+   say $calc.made;
+}
diff --git a/challenge-143/polettix/raku/ch-2.raku b/challenge-143/polettix/raku/ch-2.raku
new file mode 100644
index 0000000000..717ad9dcc2
--- /dev/null
+++ b/challenge-143/polettix/raku/ch-2.raku
@@ -0,0 +1,19 @@
+#!/usr/bin/env raku
+use v6;
+subset PosInt of Int where * > 0;
+
+sub is-stealthy (PosInt:D $n) {
+   my $match = SetHash.new;
+   for 1 .. $n.sqrt.Int -> $k {
+      next unless $n %% $k;
+      my Int() $sum = $k + $n / $k;
+      return 1 if $match (&) ($sum - 1, $sum + 1);
+      $match.set: $sum;
+   }
+   return 0;
+}
+
+sub MAIN (*@args) {
+   @args = 36, 12, 6 unless @args.elems;
+   "$_ -> {is-stealthy($_)}".put for @args;
+}