Solve PWC199

4 files changed, 47 insertions, 0 deletions

diff --git a/challenge-199/wlmb/blog.txt b/challenge-199/wlmb/blog.txt
new file mode 100644
index 0000000000..198feeb165
--- /dev/null
+++ b/challenge-199/wlmb/blog.txt
@@ -0,0 +1,2 @@
+https://wlmb.github.io/2023/01/09/PWC199/
+
diff --git a/challenge-199/wlmb/perl/ch-1.pl b/challenge-199/wlmb/perl/ch-1.pl
new file mode 100755
index 0000000000..6e6ed7ae55
--- /dev/null
+++ b/challenge-199/wlmb/perl/ch-1.pl
@@ -0,0 +1,12 @@
+#!/usr/bin/env perl
+# Perl weekly challenge 199
+# Task 1:  Good Pairs. Searching all combinations
+#
+# See https://wlmb.github.io/2023/01/09/PWC199/#task-1-good-pairs
+use v5.36;
+use Algorithm::Combinatorics qw(combinations);
+say(<<~"FIN"), exit unless @ARGV >= 2;
+    Usage: $0 N1 N2 [N3...]
+    to find all good pairs from the set N1 N2...
+    FIN
+say join " ", @ARGV, "->", 0+grep{$ARGV[$_->[0]]==$ARGV[$_->[1]]} combinations(\@ARGV, 2)
diff --git a/challenge-199/wlmb/perl/ch-1a.pl b/challenge-199/wlmb/perl/ch-1a.pl
new file mode 100755
index 0000000000..15ac9102a2
--- /dev/null
+++ b/challenge-199/wlmb/perl/ch-1a.pl
@@ -0,0 +1,16 @@
+#!/usr/bin/env perl
+# Perl weekly challenge 199
+# Task 1:  Good Pairs. Calculating number of pairs for each distinct value .
+#
+# See https://wlmb.github.io/2023/01/09/PWC199/#task-1-good-pairs
+use v5.36;
+use List::Util qw(sum);
+use List::MoreUtils qw(frequency);
+say(<<~"FIN"), exit unless @ARGV >= 2;
+    Usage: $0 N1 N2 [N3...]
+    to find all good pairs from the set N1 N2...
+    FIN
+my %histogram=frequency @ARGV; # pairs of value=>repetitions
+my @counts=values %histogram;
+my @number_of_pairs=map {$_*($_-1)/2} @counts;
+say join " ", @ARGV, "->", sum @number_of_pairs;
diff --git a/challenge-199/wlmb/perl/ch-2.pl b/challenge-199/wlmb/perl/ch-2.pl
new file mode 100755
index 0000000000..391d86971e
--- /dev/null
+++ b/challenge-199/wlmb/perl/ch-2.pl
@@ -0,0 +1,17 @@
+#!/usr/bin/env perl
+# Perl weekly challenge 199
+# Task 2:  Good Triplets
+#
+# See https://wlmb.github.io/2023/01/09/PWC199/#task-2-good-triplets
+use v5.36;
+use Algorithm::Combinatorics qw(combinations);
+say(<<~"FIN"), exit unless @ARGV >= 6;
+    Usage: $0 x y z N1 N2 N3 [N4...]
+    to find all good pairs with given x y z from the set N1 N2 N3...
+    FIN
+my ($x, $y, $z, @l)=@ARGV;
+my $good=grep {
+    my ($p,$q,$r)=@$_;
+    -$x<=$p-$q<=$x&&-$y<=$q-$r<=$y&&-$z<=$r-$p<=$z
+} combinations(\@l,3);
+say "$x $y $z: @l-> $good";