Merge pull request #3608 from wlmb/challenges

Add solutions to challenge 101

4 files changed, 120 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-1a.pl b/challenge-101/wlmb/perl/ch-1a.pl
new file mode 100755
index 0000000000..152cfc9c01
--- /dev/null
+++ b/challenge-101/wlmb/perl/ch-1a.pl
@@ -0,0 +1,35 @@
+#!/usr/bin/env perl
+# Perl weekly challenge 101
+# Task 1: Pack a spiral PDL solution
+#
+# See https://wlmb.github.io/2021/02/22/PWC101/#task-1-pack-a-spiral
+use strict;
+use warnings;
+use v5.12;
+use List::Util qw(first);
+use PDL;
+use PDL::NiceSlice;
+
+sub usage {
+    say "./ch-1.pl item1 item2...\nArranges items in spiral";
+    exit 1;
+}
+my $total=@ARGV;
+my $M=first {@ARGV%$_==0} reverse(1..sqrt @ARGV); #Highest divisor below sqrt
+my $N=@ARGV/$M; #smallest divisor above sqrt
+
+my $m=zeroes($M, $N);
+spiral($m,0);
+say "Input: ", join " ", @ARGV;
+say "Output:";
+for my $r(reverse 0..$N-1){
+    print $ARGV[$m->at($_, $r)], "\t" for (0..$M-1);
+    say "";
+}
+
+sub spiral { # receive a pdl to storee result and the starting value
+    my ($m, $start)=@_;
+    $m(,(0)).=sequence($m->dim(0))+$start;
+    return $m if $m->dim(1)==1;
+    spiral($m->transpose->(1:-1,-1:0), $start+$m->dim(0));
+}
diff --git a/challenge-101/wlmb/perl/ch-2.pl b/challenge-101/wlmb/perl/ch-2.pl
new file mode 100755
index 0000000000..21c9503ff6
--- /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-2.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;