diff options
| -rw-r--r-- | challenge-101/james-smith/perl/ch-1.pl | 41 | ||||
| -rw-r--r-- | challenge-101/james-smith/perl/ch-2.pl | 35 |
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; +} + |
