## Perl weekly challenge 101

Here are solutions to this weeks challenges from the Perl Weekly Challenge.

You can find my full code on Github

### Task 1: Pack a Spiral

You are given an array @A of items (integers say, but they can be anything).Your task is to pack that array into an MxN matrix spirally counterclockwise, as tightly as possible.

‘Tightly’ means the absolute value |M-N| of the difference has to be as small as possible.

(1..4) -> 4 3 1 2 (1..6) -> 6 5 4 5 4 1 2 3 6 3 1 2 (1..12) -> 9 8 7 6 8 7 6 10 11 12 5 9 12 5 1 2 3 4 10 11 4 1 2 3

#### The solution

No attempting at real*golfing*this week - but still want to keep it "minimalist"...

Our `pack_spiral`

routine starts by finding the largest factor of the size of the list below sqrt of the size of the list. The two dimensions we will need are this (`$rows`

) and `$cols`

. Just for compactness when printing we chose it so that `$rows < $cols`

.

To compute the number of rows ($rows) this is the largest number < sqrt of the number of elements (N) which is a factor of N. We can use grep to get all factors - if we reverse this the highest factor is the first element of the list...

```
sub pack_spiral {
my( $rows ) = reverse grep { ! (@_ % $_) } 1 .. sqrt @_;
my( $cols, $r, $c, @out ) = ( @_/$rows, $rows-1, -1 );
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;
}
```

We work around the spiral starting bottom left - and then work our way right `++$c`

, up `--$r`

, left `--$c`

& down `++$r`

. Each time when we draw one less column (when going left or right) and one less row (when going up or down) - hence the `$cols--`

& `--$rows`

.

Notes: `shift`

by itself shifts off the magic "@_" array - so in our cases takes the next item of the list...

[__] [__] [__] [__] [__] [__] [__] [__] (st) [__] [__] [__] [__] $rows = 3; $cols = 4; $r = 2; $c = -1; @_=12; $out[ $r ][ ++$c ] = shift foreach 1 .. $cols--; < 4 > [__] [__] [__] [__] [__] [__] [__] [__] st ->[_1]->[_2]->[_3]->(_4) $rows = 3; $cols = 3; $r = 2; $c = 3; @_=8; $out[ --$r ][ $c ] = shift foreach 1 .. --$rows; < 2 > [__] [__] [__] (_6) ^^ [__] [ ] [ ] [_5] ^^ st [_1]->[_2]->[_3]->[_4] $rows = 2; $cols = 3; $r = 0; $c = 3; @_=6; $out[ $r ][ ++$c ] = shift foreach 1 .. $cols--; < 3 > (_9)<-[_8]<-[_7]<-[_6] ^^ [__] [ ] [ ] [_5] ^^ st [_1]->[_2]->[_3]->[_4] $rows = 2; $cols = 2; $r = 0; $c = 0; @_=3; $out[ ++$r ][ $c ] = shift foreach 1 .. --$rows; < 1 > [_9]<-[_8]<-[_7]<-[_6] vv ^^ (10) [ ] [ ] [_5] ^^ st [_1]->[_2]->[_3]->[_4] $rows = 1; $cols = 2; $r = 1; $c = 0; @_=1; $out[ $r ][ ++$c ] = shift foreach 1 .. $cols--; < 2 > [_9]<-[_8]<-[_7]<-[_6] vv ^^ [10]->[11]->(12) [_5] ^^ st [_1]->[_2]->[_3]->[_4] $rows = 1; $cols = 1; $r = 1; $c = 2; @_=0; $out[ --$r ][ $c ] = shift foreach 1 .. --$rows; # does nothing.. < 0 > [_9]<-[_8]<-[_7]<-[_6] vv ^^ [10]->[11]->(12) [_5] ^^ st [_1]->[_2]->[_3]->[_4]

### Task 2: Origin-containing Triangle

You are given three points in the plane, as a list of six co-ordinates: A=(x1,y1), B=(x2,y2) and C=(x3,y3).

Write a script to find out if the triangle formed by the given three co-ordinates contain origin (0,0).

Print 1 if found otherwise 0.

Input: A=(0,1) B=(1,0) C=(2,2) Output: 0 Input: A=(1,1) B=(-1,1) C=(0,-3) Output: 1 Input: A=(0,1) B=(2,0) C=(-6,0) Output: 1

#### The solution

One of the uses I put my degree to at work was to use "Winding numbers" to replicate image maps in web pages {we needed to implement drag features and click feature on an image}... So winding numbers are what I will use here...*Winding number* - imagine you are a dalek standing at the origin - and you trace around the triangle with your gunstick... If your head turns a full 360 either way then you are in the triangle - if it does not you are outside the triangle! This extends to any shape - you are inside the shape if you take an odd number of turns - outside if you take an even number. The following code is a quick way to compute the winding number.

To include each line - we start with the last point and join it to the first... and then first to second until we finally get back to the line between the last two points.

```
sub winding_number {
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;
}
```

## Leave a comment