Add solutions to PWC123

3 files changed, 56 insertions, 0 deletions

diff --git a/challenge-123/wlmb/blog.txt b/challenge-123/wlmb/blog.txt
new file mode 100644
index 0000000000..848b1ee146
--- /dev/null
+++ b/challenge-123/wlmb/blog.txt
@@ -0,0 +1 @@
+https://wlmb.github.io/2021/07/27/PWC123/
diff --git a/challenge-123/wlmb/perl/ch-1.pl b/challenge-123/wlmb/perl/ch-1.pl
new file mode 100755
index 0000000000..da3f90362c
--- /dev/null
+++ b/challenge-123/wlmb/perl/ch-1.pl
@@ -0,0 +1,29 @@
+#!/usr/bin/env perl
+# Perl weekly challenge 123
+# Task 1: Ugly numbers
+#
+# See https://wlmb.github.io/2021/07/27/PWC123/#task-1-ugly-numbers
+
+use warnings;
+use strict;
+use v5.12;
+my @uglies=(1); #known uglies
+my @u_id=(0,0,0); # indices into uglies array corresponding to
+my @factors=(2,3,5); # prime factors of uglies
+
+foreach(@ARGV){
+    say "Input: $_ Output: ", ugly($_);
+}
+
+sub ugly {
+    my $n=shift @_; # desired ugly number
+    while($n>@uglies){
+	my ($next_id)=sort {$uglies[$u_id[$a]]*$factors[$a]<=>$uglies[$u_id[$b]]*$factors[$b]}
+	               (0..2);
+	my $next_val=$uglies[$u_id[$next_id]]*$factors[$next_id];
+	$u_id[$next_id]++;
+	next unless $next_val>$uglies[-1];
+	push @uglies, $next_val;
+    }
+    return $uglies[$n-1];
+}
diff --git a/challenge-123/wlmb/perl/ch-2.pl b/challenge-123/wlmb/perl/ch-2.pl
new file mode 100755
index 0000000000..01fca9c85a
--- /dev/null
+++ b/challenge-123/wlmb/perl/ch-2.pl
@@ -0,0 +1,26 @@
+#!/usr/bin/env perl
+# Perl weekly challenge 123
+# Task 2: Square points
+#
+# See https://wlmb.github.io/2021/07/27/PWC123/#task-2-square-points
+use strict;
+use warnings;
+use v5.12;
+use PDL;
+foreach(@ARGV){
+    # assume data as strings "[[x0,y0],[x1,y1],[x2,y2],[x3,y3]]"
+    my $m=pdl($_);
+    # Separate into four vectors, translate the origin to the first
+    # and sort by size
+    my $v0=$m->slice(":,(0)");
+    my (undef, $s1, $s2, $d)=sort {size2($a) <=> size2($b)} map {$_-$v0} $m->dog;
+    # $s1 and $s2 ought to be the sides and $d the diagonal
+    # check they add up and their sizes.
+    my $ok=approx(size2($s1+$s2-$d),0) && approx(size2($s1),size2($s2))
+           && approx(size2($d),2*size2($s1));
+    say "Input: $m Output: $ok"
+}
+sub size2 { #size of vector squared
+    my $v=shift @_;
+    return ($v*$v)->sumover;
+}