Add polettix's solution to challenge-134

6 files changed, 148 insertions, 0 deletions

diff --git a/challenge-134/polettix/blog.txt b/challenge-134/polettix/blog.txt
new file mode 100644
index 0000000000..1c2d2af5d8
--- /dev/null
+++ b/challenge-134/polettix/blog.txt
@@ -0,0 +1 @@
+https://github.polettix.it/ETOOBUSY/2021/10/13/pwc134-pandigital-numbers/
diff --git a/challenge-134/polettix/blog1.txt b/challenge-134/polettix/blog1.txt
new file mode 100644
index 0000000000..7c99adb3d0
--- /dev/null
+++ b/challenge-134/polettix/blog1.txt
@@ -0,0 +1 @@
+https://github.polettix.it/ETOOBUSY/2021/10/14/pwc134-distinct-terms-count/
diff --git a/challenge-134/polettix/perl/ch-1.pl b/challenge-134/polettix/perl/ch-1.pl
new file mode 100644
index 0000000000..91d05ce016
--- /dev/null
+++ b/challenge-134/polettix/perl/ch-1.pl
@@ -0,0 +1,33 @@
+#!/usr/bin/env perl
+use v5.24;
+use warnings;
+use experimental 'signatures';
+no warnings 'experimental::signatures';
+
+sub next_permutation (@arrangement) {
+   my $i = $#arrangement - 1;
+   --$i while $i >= 0 && $arrangement[$i] >= $arrangement[$i + 1];
+   return unless $i >= 0;
+   my $end = my $j = $#arrangement;
+   --$j while $arrangement[$i] >= $arrangement[$j];
+   @arrangement[$i, $j] = @arrangement[$j, $i];
+   @arrangement[$i + 1 .. $end]  = reverse @arrangement[$i + 1 .. $end];
+   return @arrangement;
+}
+
+sub pandigital_numbers ($n = 5, $b = 10) {
+   my ($n_digits, $factorial) = (1, 1);
+   $factorial *= ++$n_digits while $factorial < $n;
+   die "I'm too lazy for more general algorithms"
+      if $n_digits >= $b - 1;
+
+   state $p36_min = '1023456789ABCDEFGHIJKLMNOPQRSTUVWXYZ';
+   my $fix = substr $p36_min, 0, $b - $n_digits;
+   my @moving = split m{}mxs, substr $p36_min, $b - $n_digits, $n_digits;
+   map {
+      @moving = next_permutation(@moving) if $_;
+      join '', $fix, @moving;
+   } 0 .. $n - 1;
+}
+
+say for pandigital_numbers(@ARGV);
diff --git a/challenge-134/polettix/perl/ch-2.pl b/challenge-134/polettix/perl/ch-2.pl
new file mode 100644
index 0000000000..e53d166b69
--- /dev/null
+++ b/challenge-134/polettix/perl/ch-2.pl
@@ -0,0 +1,40 @@
+#!/usr/bin/env perl
+use v5.24;
+use warnings;
+use experimental 'signatures';
+no warnings 'experimental::signatures';
+
+sub distinct_terms_count ($m = 3, $n = 5) {
+   my $width          = length($n * $m);
+   my $idx_width      = length($m);
+   my $data_formatter = sub ($first, @rest) {
+      join ' ', sprintf("%${idx_width}d", $first),
+        map { sprintf "%${width}d", $_ } @rest;
+   };
+   my @lines;
+   push @lines,
+     sprintf("%${idx_width}s | ", 'x') . $data_formatter->(1 .. $n);
+   push @lines,
+     ('-' x $idx_width) . '-+-'
+     . ('-' x (length($lines[0]) - 3 - $idx_width));
+   my %distinct;
+   for my $r (1 .. $m) {
+      push @lines, sprintf("%${idx_width}d | ", $r) . $data_formatter->(
+         map {
+            $distinct{my $p = $r * $_} = 1;
+            $p;
+         } 1 .. $n
+      );
+   } ## end for my $r (1 .. $m)
+   return {
+      table    => join("\n", @lines),
+      distinct => [sort { $a <=> $b } keys %distinct],
+   };
+} ## end sub distinct_terms_count
+
+say '';
+my $outcome = distinct_terms_count(@ARGV);
+say $outcome->{table} =~ s{^}{      }rgmxs;
+say '';
+say 'Distinct Terms: ', join ', ', $outcome->{distinct}->@*;
+say 'Count: ', scalar($outcome->{distinct}->@*);
diff --git a/challenge-134/polettix/raku/ch-1.raku b/challenge-134/polettix/raku/ch-1.raku
new file mode 100644
index 0000000000..b3539e7410
--- /dev/null
+++ b/challenge-134/polettix/raku/ch-1.raku
@@ -0,0 +1,34 @@
+#!/usr/bin/env raku
+use v6;
+
+sub next-permutation (@arrangement) {
+   my $i = @arrangement.end - 1;
+   --$i while $i >= 0 && @arrangement[$i] >= @arrangement[$i + 1];
+   return unless $i >= 0;
+   my $j = @arrangement.end;
+   --$j while @arrangement[$i] >= @arrangement[$j];
+   @arrangement[$i, $j] = @arrangement[$j, $i];
+   @arrangement[$i + 1 .. *]  = @arrangement[$i + 1 .. *].reverse;
+   return @arrangement;
+}
+
+subset PosInt of Int:D where * > 0;
+subset Base of PosInt where * <= 36;
+sub pandigital-numbers (PosInt $n is copy, Base $b) {
+   my ($n-digits, $factorial) = 1, 1;
+   $factorial *= ++$n-digits while $factorial < $n;
+   die "I'm too lazy for more general algorithms"
+      if $n-digits >= $b - 1;
+
+   state $p36-min = '1023456789ABCDEFGHIJKLMNOPQRSTUVWXYZ';
+   my $fix = $p36-min.substr(0, $b - $n-digits);
+   my @moving = $p36-min.substr($b - $n-digits, $n-digits).comb(/./);
+   gather while $n > 0 {
+      take $fix ~ @moving.join('');
+      @moving = next-permutation(@moving) if --$n;
+   };
+}
+
+sub MAIN (PosInt $n = 5, Base $b = 10) {
+   .put for pandigital-numbers($n, $b);
+}
diff --git a/challenge-134/polettix/raku/ch-2.raku b/challenge-134/polettix/raku/ch-2.raku
new file mode 100644
index 0000000000..f13f3223eb
--- /dev/null
+++ b/challenge-134/polettix/raku/ch-2.raku
@@ -0,0 +1,39 @@
+#!/usr/bin/env raku
+use v6;
+
+subset PosInt of Int where * > 0;
+sub distinct-terms-count (PosInt:D $m, PosInt:D $n) {
+   my $width          = ($n * $m).chars;
+   my $idx_width      = $m.chars;
+   my &data_formatter = sub (*@items) {
+      my $first = @items.shift;
+      join ' ', sprintf("%{$idx_width}d", $first),
+        @items.map: { sprintf "%{$width}d", $_ };
+   };
+   my @lines;
+   @lines.push:
+     sprintf("%{$idx_width}s | ", 'x') ~ &data_formatter(1 .. $n);
+   @lines.push:
+     ('-' x $idx_width) ~ '-+-'
+     ~ ('-' x (@lines[0].chars- 3 - $idx_width));
+   my %distinct;
+   for 1 .. $m -> $r {
+      @lines.push: sprintf("%{$idx_width}d | ", $r) ~ &data_formatter(
+         (1 .. $n).map: {
+            %distinct{my $p = $r * $_} = 1;
+            $p;
+         }
+      );
+   } ## end for my $r (1 .. $m)
+   return join("\n", @lines), %distinct.keys.sort({ $^a <=> $^b });
+}
+
+sub MAIN ($m = 3, $n = 5) {
+   my ($table, $distinct) = distinct-terms-count($m, $n);
+   my @distinct = @$distinct;
+   put '';
+   put S:g/^^/      / with $table;
+   put '';
+   put 'Distinct Terms: ', @distinct.join(', ');
+   put 'Count: ', @distinct.elems;
+}