Merge pull request #5274 from wlmb/challenges

Add solution to PWC140

3 files changed, 54 insertions, 0 deletions

diff --git a/challenge-140/wlmb/blog.txt b/challenge-140/wlmb/blog.txt
new file mode 100644
index 0000000000..ce0eac51e7
--- /dev/null
+++ b/challenge-140/wlmb/blog.txt
@@ -0,0 +1 @@
+https://wlmb.github.io/2021/11/23/PWC140/
diff --git a/challenge-140/wlmb/perl/ch-1.pl b/challenge-140/wlmb/perl/ch-1.pl
new file mode 100755
index 0000000000..c5ee90be8e
--- /dev/null
+++ b/challenge-140/wlmb/perl/ch-1.pl
@@ -0,0 +1,28 @@
+#!/usr/bin/env perl
+# Perl weekly challenge 140
+# Task 1: Add Binary
+#
+# See https://wlmb.github.io/2021/11/23/PWC140/#task-1-add-binary
+use v5.12;
+use warnings;
+use integer;
+use List::Util qw(all max);
+
+my $word_size=8; # finite number of bits, to allow for negative 2s-complement numbers.
+say("Usage: ch-1.pl a b [wordsize], to add two binary numbers"), exit unless @ARGV>=2;
+say("Only '0' and '1' allowed for binary numbers"), exit unless all {$_=~m/^[01]+$/} @ARGV[0,1];
+say("Word size should be positive"), exit unless !defined $ARGV[2] || $ARGV[2]>=1;
+my ($x, $y)=map {[reverse (0,split "",$_)]} @ARGV; # bit arrays, least significant first
+$word_size=$ARGV[2] if $ARGV[2];
+my $length=max scalar @$x, scalar @$y;
+my $carry=0;
+my $r;
+my @result=map {($r,$carry)=full_adder($x->[$_],$y->[$_],$carry);$r} 0..$length-1;
+splice @result, $word_size; # truncate to maximum number of bits
+my $result=join "", reverse @result;
+say sprintf "Input: \$a=%d, \$b=%d, Output: %d", @ARGV[0,1], $result;
+
+sub full_adder{ # add two bits and a carry, produce result and carry
+    my ($a, $b, $c)=@_;
+    return(($a+$b+$c)%2,($a+$b+$c)/2);
+}
diff --git a/challenge-140/wlmb/perl/ch-2.pl b/challenge-140/wlmb/perl/ch-2.pl
new file mode 100755
index 0000000000..81ee630168
--- /dev/null
+++ b/challenge-140/wlmb/perl/ch-2.pl
@@ -0,0 +1,25 @@
+#!/usr/bin/env perl
+# Perl weekly challenge 140
+# Task 2: Multiplication Table
+#
+# See https://wlmb.github.io/2021/11/23/PWC140/#task-2-multiplication-table
+use v5.12;
+use warnings;
+use integer;
+use PDL;
+use PDL::NiceSlice;
+
+say("Usage: ./ch-2.pl i j k to get the k-th element of an iXj multiplication table"),
+    exit unless @ARGV==3;
+my($i, $j, $k)=@ARGV;
+say("i and j should be positive"), exit unless $i>=1 && $j>=1;
+say("k should be positive and not greater than iXj"), exit unless 1<=$k<=$i*$j;
+
+my $result=(
+    my $sorted=(
+	my $table=(zeroes($j,$i)->ndcoords+1)->prodover
+        )->flat->qsort
+    )->(($k-1));
+say "Input: i=$i, j=$j, k=$k,\nOutput=$result",
+	    "\nsince the ${i}X$j multiplication table is",
+    $table, "which sorted becomes\n$sorted,\nwhose $k-th element is $result\n";