Merge pull request #3611 from drbaggy/master

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..c3b75a4ff6
--- /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 {
+
+  ## 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...
+
+  my( $rows )               = reverse grep { ! (@_ % $_) } 1 .. sqrt @_;
+  my( $cols, $r, $c, @out ) = ( @_/$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...
+  ## Remember shift by default operates on @_;
+
+  while( @_ ) {                                      # do until empty
+    $out[ $r ][ ++$c ] = shift foreach 1 .. $cols--; # >>
+    $out[ --$r ][ $c ] = shift foreach 1 .. --$rows; # ^^
+    last                       unless  @_;           # exit if empty
+    $out[ $r ][ --$c ] = shift foreach 1 .. $cols--; # <<
+    $out[ ++$r ][ $c ] = shift 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..f34c8f5ebb
--- /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 ( $a, $b, $wn ) = @_[ -2, -1 ], 0;
+
+  while( my($x,$y) = splice @_, 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%2;
+}
+