Add solutions to challenge 101

3 files changed, 85 insertions, 0 deletions

diff --git a/challenge-101/wlmb/blog.txt b/challenge-101/wlmb/blog.txt
new file mode 100644
index 0000000000..9ef38d73e7
--- /dev/null
+++ b/challenge-101/wlmb/blog.txt
@@ -0,0 +1 @@
+https://wlmb.github.io/2021/02/22/PWC101/
diff --git a/challenge-101/wlmb/perl/ch-1.pl b/challenge-101/wlmb/perl/ch-1.pl
new file mode 100755
index 0000000000..32c03cfbc3
--- /dev/null
+++ b/challenge-101/wlmb/perl/ch-1.pl
@@ -0,0 +1,51 @@
+#!/usr/bin/env perl
+# Perl weekly challenge 101
+# Task 1: Pack a spiral
+#
+# See https://wlmb.github.io/2021/02/22/PWC101/#task-1-pack-a-spiral
+use strict;
+use warnings;
+use v5.12;
+use POSIX qw(floor);
+use List::Util qw(first);
+
+sub usage {
+    say "./ch-1.pl item1 item2...\nArranges items in spiral";
+    exit 1;
+}
+
+my $M=first {@ARGV%$_==0} reverse(1..sqrt @ARGV); #Highest divisor below sqrt
+my $N=@ARGV/$M; #smallest divisor above sqrt
+my $result=[[]]; #
+my @current_coords=(0,-1); # starting position, left of first array element
+
+my $right;
+my $down= build_moves(0,-1,  0, \$right);
+my $left= build_moves(1,-1, -1, \$down);
+my $up=   build_moves(0, 1, $N, \$left);
+$right=   build_moves(1, 1, $M, \$up);
+my $next_move=$right; # First move to try
+
+usage() unless @ARGV; #At least some argument is required
+for(@ARGV){
+    &$next_move();
+    $result->[$current_coords[0]][$current_coords[1]]=$_;
+}
+say join " ", "Input:", @ARGV;
+say join "\n", "Output:", reverse map {join "\t", @$_} @$result;
+
+sub build_moves {
+    my $index=shift; # which coordinate to affect
+    my $delta=shift; # increment
+    my $border=shift; # current position of border
+    my $next=shift;  # next direction to try.
+    sub {
+	if($current_coords[$index]+$delta==$border){
+	    $next_move=$$next;
+	    $border= $border-$delta;
+	    $next_move->();
+	} else {
+	    $current_coords[$index]+=$delta;
+	}
+    }
+}
diff --git a/challenge-101/wlmb/perl/ch-2.pl b/challenge-101/wlmb/perl/ch-2.pl
new file mode 100755
index 0000000000..0e4bca0e97
--- /dev/null
+++ b/challenge-101/wlmb/perl/ch-2.pl
@@ -0,0 +1,33 @@
+#!/usr/bin/env perl
+# Perl weekly challenge 101
+# Task 2: Origin containing triangle
+#
+# See https://wlmb.github.io/2021/02/22/PWC101/#task-2-origin-containing-triangle
+use strict;
+use warnings;
+use v5.12;
+use POSIX qw(floor);
+use List::Util qw(all any pairs);
+use Scalar::Util qw(looks_like_number);
+
+sub usage {
+    say "./ch-1.pl x1 y1 x2 y2 x3 y3\nChecks if origin in triangle (x1,y1)(x2,y2)(x3,y3)";
+    exit 1;
+}
+
+sub cross {
+    my ($A, $B)=@_;
+    return $A->[0]*$B->[1]-$A->[1]*$B->[0];
+}
+usage() unless @ARGV==6 and all {looks_like_number $_} @ARGV;
+my ($A, $B, $C)=pairs @ARGV;
+my ($AB, $BC, $CA)=(cross($A,$B), cross($B,$C), cross($C,$A));
+my $clockwise=all {$_>=0} ($AB, $BC, $CA);
+my $counterclockwise=all {$_<=0} ($AB, $BC, $CA);
+my $result=($clockwise||$counterclockwise)?1:0;
+my $edge=any {$_==0} ($AB, $BC, $CA);
+say "Input: ", join " ", map {"($_->[0],$_->[1])"} ($A, $B, $C);
+say "Output: $result";
+say "Since (0,0) is within the triangle" if $result and !$edge;
+say "Since (0,0) is within an edge" if $result and $edge;
+say "Since (0,0) is not within the triangle" unless $result;