Merge pull request #7091 from wlmb/challenges

Challenges

4 files changed, 79 insertions, 2 deletions

diff --git a/challenge-191/wlmb/perl/ch-1.pl b/challenge-191/wlmb/perl/ch-1.pl
index e2167c6146..e16f95d9c8 100755
--- a/challenge-191/wlmb/perl/ch-1.pl
+++ b/challenge-191/wlmb/perl/ch-1.pl
@@ -2,7 +2,7 @@
 # Perl weekly challenge 191
 # Task 1:  Twice Largest
 #
-# See https://wlmb.github.io/2022/11/15/PWC191/#task-1-twice-largest
+# See https://wlmb.github.io/2022/11/14/PWC191/#task-1-twice-largest
 use v5.36;
 use List::Util qw(all);
 use Scalar::Util qw(looks_like_number);
diff --git a/challenge-191/wlmb/perl/ch-2.pl b/challenge-191/wlmb/perl/ch-2.pl
index 613914ccf4..f9b4bdaa5e 100755
--- a/challenge-191/wlmb/perl/ch-2.pl
+++ b/challenge-191/wlmb/perl/ch-2.pl
@@ -2,7 +2,7 @@
 # Perl weekly challenge 191
 # Task 2:  Cute List
 #
-# See https://wlmb.github.io/2022/11/15/PWC191/#task-2-cute-list
+# See https://wlmb.github.io/2022/11/14/PWC191/#task-2-cute-list
 use v5.36;
 use Algorithm::Combinatorics qw(permutations);
 use List::Util qw(all);
diff --git a/challenge-191/wlmb/perl/ch-2a.pl b/challenge-191/wlmb/perl/ch-2a.pl
new file mode 100755
index 0000000000..340ea1ecd0
--- /dev/null
+++ b/challenge-191/wlmb/perl/ch-2a.pl
@@ -0,0 +1,39 @@
+#!/usr/bin/env perl
+# Perl weekly challenge 191
+# Task 2:  Cute List. Economize memory
+#
+# See https://wlmb.github.io/2022/11/14/PWC191/#task-2-cute-list
+use v5.36;
+use List::Util qw(all any);
+use Set::CrossProduct;
+sub cute($n){ # iterator over cute sequences
+    my @sets;
+    for my $position(0..$n-1){
+        for(1..$n){
+            push @{$sets[$position]}, $_ if ($position+1)%$_==0 || $_%($position+1)==0;
+	}
+    }
+    my $iter=Set::CrossProduct->new([@sets]);
+    return sub {
+	ITER: while(my $tuple=$iter->get()){
+            my @seen;
+            for(@$tuple){
+	        next ITER if $seen[$_];
+                ++$seen[$_];
+            }
+	    return $tuple;
+	}
+	return;
+    }
+}
+die << "EOF" unless @ARGV;
+Usage: $0 N1 [N2...]
+to count the cute orderings of 1..Ni
+EOF
+die "Only numbers in the range 1..15 are allowed" unless all {1<=$_<=15} @ARGV;
+for(@ARGV){
+    my $iter=cute($_);
+    my $count=0;
+    ++$count while $iter->();
+    say "$_ -> $count";
+}
diff --git a/challenge-191/wlmb/perl/ch-2b.pl b/challenge-191/wlmb/perl/ch-2b.pl
new file mode 100755
index 0000000000..b0ae82e271
--- /dev/null
+++ b/challenge-191/wlmb/perl/ch-2b.pl
@@ -0,0 +1,38 @@
+#!/usr/bin/env perl
+# Perl weekly challenge 191
+# Task 2:  Cute List. Throw duplicates early.
+#
+# See https://wlmb.github.io/2022/11/14/PWC191/#task-2-cute-list
+use v5.36;
+use Set::CrossProduct;
+use List::Util qw(all reduce);
+sub cute($n){ # generate all cute sequences of length $n
+    my @sets;
+    for my $position(0..$n-1){
+        for(1..$n){ # Build sets of divisors and multiples of $position+1
+            push @{$sets[$position]}, $_ if ($position+1)%$_==0 || $_%($position+1)==0;
+	}
+    }
+    my $x=reduce {cute_aux($a, $b)} [[]], @sets; # combine sets into cute sequences
+    return $x;
+}
+sub cute_aux($seqs, $nums){ # combine an ongoing set of cute sequences with a set of numbers
+    my $iter=Set::CrossProduct->new([$seqs, $nums]);
+    my @combined;
+    while(my $tuple=$iter->get){ # Cartesian product of a sequence and a number
+        my @array=@{$tuple->[0]};
+        my $num=$tuple->[1];
+        my @seen;
+        map {$seen[$_]=1} @array; # Seen numbers
+	next if $seen[$num]; # Throw away repetitions
+	push @array, $num; # add number to current sequence
+	push @combined, [@array]; # add sequence to set of ongoing sequences
+    }
+    return [@combined];
+}
+die << "EOF" unless @ARGV;
+Usage: $0 N1 [N2...]
+to count the cute orderings of 1..Ni
+EOF
+die "Only numbers in the range 1..18 are allowed" unless all {1<=$_<=18} @ARGV;
+say "$_ -> ", scalar @{cute($_)} for(@ARGV);