solution to 101!

2 files changed, 76 insertions, 0 deletions

diff --git a/challenge-101/james-smith/perl/ch-1.pl b/challenge-101/james-smith/perl/ch-1.pl
new file mode 100644
index 0000000000..ac89a45459
--- /dev/null
+++ b/challenge-101/james-smith/perl/ch-1.pl
@@ -0,0 +1,41 @@
+#!/usr/local/bin/perl
+
+use strict;
+
+use warnings;
+use feature qw(say);
+use Test::More;
+
+print_spiral( 1 .. $_ ) foreach 1..30;
+
+sub print_spiral {
+  say join q( ), map { sprintf '%2d', $_ } @{$_} foreach @{pack_spiral(@_)};
+  say '';
+}
+
+sub pack_spiral {
+  my( $rows, @in ) = ( 1, @_ );
+
+  ## Get the value for columns & rows which have the smallest gap
+  ## but still multiply to size of array (we choose rows to be
+  ## no greater than columns as printing is neater - but for no
+  ## other reason...
+
+  $rows = @in%$_ ? $rows : $_ foreach 2 .. sqrt @in;
+
+  my ($cols,$r,$c,@out) = (@in/$rows,$rows-1,-1);
+
+  ## We start bottom left...
+  ## because we use pre-inc we actually start 1 to the left of it!
+  ## as we "jump" before depositing the entry of the array...
+
+  while( $rows && $cols ) {         ## Do we have anything else to do?
+    $out[$r][++$c] = shift @in foreach 1..$cols--; # >>
+    $out[--$r][$c] = shift @in foreach 1..--$rows; # ^^
+    last unless $rows && $cols;     ## Skip if we have finished here
+    $out[$r][--$c] = shift @in foreach 1..$cols--; # <<
+    $out[++$r][$c] = shift @in foreach 1..--$rows; # vv
+  }
+
+  return \@out;
+}
diff --git a/challenge-101/james-smith/perl/ch-2.pl b/challenge-101/james-smith/perl/ch-2.pl
new file mode 100644
index 0000000000..e68bdbbca8
--- /dev/null
+++ b/challenge-101/james-smith/perl/ch-2.pl
@@ -0,0 +1,35 @@
+#!/usr/local/bin/perl
+
+use strict;
+
+use warnings;
+use feature qw(say);
+use Test::More;
+
+is( winding_number(qw(0 1 1 0 2 2)), 0 );
+is( winding_number(qw(0 1 -1 1 0 -3)), 1 );
+is( winding_number(qw(0 1 2 0 -6 0)), 1 );
+
+done_testing();
+
+sub winding_number {
+  ## Winding number is a generic way of working out whether a point lies
+  ## within a polygon - as this is not difficult we can implement the
+  ## trick for our triangle...
+  ## We have to work with edges - each edge in the code is represented
+  ## by ($a,$b) -> ($x,$y)... We start from the edge which joins the
+  ## "last" node to the first and then we work our way around the circle
+  ## The winding number goes up or down depening on whether the edge
+  ## crosses the +ve axis (adding or subtracking 1 depending on the
+  ## direction) - this boils down to the algorithm below..
+
+  my @pts = @_;
+  my ($a,$b,$wn) = @pts[-2,-1],0;
+  while( my($x,$y) = splice @pts,0,2 ) {
+    $wn += $a<=0 ? $y>0  && $a*$y-$x*$b >  0 ?  1 : 0
+                 : $y<=0 && $a*$y-$x*$b <= 0 ? -1 : 0;
+    ($a,$b)=($x,$y);
+  }
+  return $wn?1:0;
+}
+