James Curtis-Smith

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...

You can see the progress below:

       [__]  [__]  [__]  [__] 


       [__]  [__]  [__]  [__]

 (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;

}