Perl Weekly Challenge 101.
My solutions (task 1 and task 2) to the The Weekly Challenge - 101.
Task 1: Pack a Spiral
Submitted by: Stuart Little
You are given an array
@Aof 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. Example 1:
Input: @A = (1,2,3,4) Output: 4 3 1 2Since the given array is already a 1x4 matrix on its own, but that’s not as tight as possible. Instead, you’d spiral it counterclockwise into
4 3 1 2Example 2:
Input: @A = (1..6) Output: 6 5 4 1 2 3or
5 4 6 3 1 2Either will do as an answer, because they’re equally tight.
Example 3:
Input: @A = (1..12) Output: 9 8 7 6 10 11 12 5 1 2 3 4or
8 7 6 9 12 5 10 11 4 1 2 3
There is an ambiguity in the task. Should empty slots be allowed? Or
should all available places in the rectangular array be used? In other
terms, should M and N divide the size of the array @A exactly or is it
allowed to use M and N such that MxN> size of @A? I’ll assume
that they have to be exact divisors. Then I can choose M to be largest divisor
below the sqrt and N the smallest divisor above the sqrt. I assume
all the input data is contained in @ARGV.
First I load the usual packages and define a simple usage sub.
# Perl weekly challenge 101
# Task 1: Pack a spiral
#
# See https://wlmb.github.io/2021/02/22/PWC101/#task-1-pack-a-spiral
use strict;
use warnings;
use v5.12;
use POSIX qw(floor);
use List::Util qw(first);
sub usage {
say "./ch-1.pl item1 item2...\nArranges items in spiral";
exit 1;
}
Now I find out how to best factor the number of elements of the array, and I initialize a few variables.
my $M=first {@ARGV%$_==0} reverse(1..sqrt @ARGV); #Highest divisor below sqrt
my $N=@ARGV/$M; #smallest divisor above sqrt
my $result=[[]]; #
my @current_coords=(0,-1); # starting position, left of first array element
Now comes the fun part. To build the spiral one has to store succesive
values along a line until the border of the array is hit. Then the
direction of motion is modified and the process continues. The border
where it is disallowed to store values shrinks after each motion. All
motions are similar. They only differ in the coordinate (x or y) that
is affected, and in the way it is modified (increasing or decreasing)
and the next direction to try after hitting the border. Thus I make a
builder of motion routines parametrized by these parameters. The last
parameter to this routine is the motion to try next in the order
right, up, left, down and right again. Thus, to build $right I
need $up, and to build $up I need $left, for $left I need $down and for
$down I need $right. To break this vicious circle I use double
indirection, where I use a reference to a reference to the
subroutine. This allows initializations with routines that have not
been built yet.
my $right;
my $down= build_moves(0,-1, 0, \$right);
my $left= build_moves(1,-1, -1, \$down);
my $up= build_moves(0, 1, $N, \$left);
$right= build_moves(1, 1, $M, \$up);
my $next_move=$right; # First move to try
The program just iterates over all the array elements putting them in their final place and then prints the results.
usage() unless @ARGV; #At least some argument is required
for(@ARGV){
&$next_move();
$result->[$current_coords[0]][$current_coords[1]]=$_;
}
say join " ", "Input:", @ARGV;
say join "\n", "Output:", reverse map {join "\t", @$_} @$result;
This is the tricky subroutine that builds the motion subs from a few parameters.
sub build_moves {
my $index=shift; # which coordinate to affect
my $delta=shift; # increment
my $border=shift; # current position of border
my $next=shift; # next direction to try.
sub {
if($current_coords[$index]+$delta==$border){
$next_move=$$next;
$border= $border-$delta;
$next_move->();
} else {
$current_coords[$index]+=$delta;
}
}
}
Example 1:
./ch-1.pl 1 2 3 4
Example 2:
./ch-1.pl 1 2 3 4 5 6
Example 3:
./ch-1.pl 1 2 3 4 5 6 7 8 9 10 11 12
Other examples:
./ch-1.pl a b c d e f g h i
./ch-1.pl a b c d e f g h i j
./ch-1.pl a b c d e f g h i j k
./ch-1.pl a b c d e f g h i j k l
Another solution could be obtained by using the power of the Perl Data Language to build the array. The first part of the program would be almost identical.
# Perl weekly challenge 101
# Task 1: Pack a spiral PDL solution
#
# See https://wlmb.github.io/2021/02/22/PWC101/#task-1-pack-a-spiral
use strict;
use warnings;
use v5.12;
use List::Util qw(first);
use PDL;
use PDL::NiceSlice;
sub usage {
say "./ch-1.pl item1 item2...\nArranges items in spiral";
exit 1;
}
my $total=@ARGV;
my $M=first {@ARGV%$_==0} reverse(1..sqrt @ARGV); #Highest divisor below sqrt
my $N=@ARGV/$M; #smallest divisor above sqrt
I use the spiral subroutine (below) to make a pdl with indices. I use these indices to print the final array.
my $m=zeroes($M, $N);
spiral($m,0);
say "Input: ", join " ", @ARGV;
say "Output:";
for my $r(reverse 0..$N-1){
print $ARGV[$m->at($_, $r)], "\t" for (0..$M-1);
say "";
}
Now I build a spiral of indices. To get a spiral with N rows and M
columns I make a row of M elements, organize recursively the remaining elements
in a spiral of M rows and N-1 columns, and I rotate that spiral
counterclockwise to join to the first row.
sub spiral { # receive a pdl to store result and the starting value
my ($m, $start)=@_;
$m(,(0)).=sequence($m->dim(0))+$start;
return $m if $m->dim(1)==1;
spiral($m->transpose->(1:-1,-1:0), $start+$m->dim(0));
}
Example 1:
./ch-1a.pl 1 2 3 4
Example 2:
./ch-1a.pl 1 2 3 4 5 6
Example 3:
./ch-1a.pl 1 2 3 4 5 6 7 8 9 10 11 12
Other examples:
./ch-1a.pl a b c d e f g h i
./ch-1a.pl a b c d e f g h i j
./ch-1a.pl a b c d e f g h i j k
./ch-1a.pl a b c d e f g h i j k l
Task 2: Origin-containing Triangle
Submitted by: Stuart Little
You are given three points in the plane, as a list of six co-ordinates:
A=(x1,y1),B=(x2,y2)andC=(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.
Example 1:
Input: A=(0,1), B=(1,0) and C=(2,2) Output: 0because that triangle does not contain (0,0).
Example 2:
Input: A=(1,1), B=(-1,1) and C=(0,-3) Output: 1 because that triangle contains (0,0) in its interior. Example 3: Input: A=(0,1), B=(2,0) and C=(-6,0) Output: 1because (0,0) is on the edge connecting B and C.
If the origin is within the triangle, the sign of the vector products of consecutive vectors traversed in a cyclically doesn’t change. This allows almost-one-liner solutions
Example 1:
perl -MList::Util=pairs -E 'sub c {($a,$b,$c,$d)=(@{$_[0]},@{$_[1]}); return $a*$d-$b*$c;}
($A,$B,$C)=pairs @ARGV;
$r=(c($A,$B)>=0&& c($B,$C)>=0 && c($C,$A)>=0)||(c($A,$B)<=0 && c($B,$C)<=0 && c($C,$A)<=0)?1:0;
say "Output: $r"' 0 1 1 0 2 2
Output: 0
Example 2:
perl -MList::Util=pairs -E 'sub c {($a,$b,$c,$d)=(@{$_[0]},@{$_[1]}); return $a*$d-$b*$c;}
($A,$B,$C)=pairs @ARGV;
$r=(c($A,$B)>=0&& c($B,$C)>=0 && c($C,$A)>=0)||(c($A,$B)<=0 && c($B,$C)<=0 && c($C,$A)<=0)?1:0;
say "Output: $r"' 1 1 -1 1 0 -3
Output: 1
Example 3:
perl -MList::Util=pairs -E 'sub c {($a,$b,$c,$d)=(@{$_[0]},@{$_[1]}); return $a*$d-$b*$c;}
($A,$B,$C)=pairs @ARGV;
$r=(c($A,$B)>=0&& c($B,$C)>=0 && c($C,$A)>=0)||(c($A,$B)<=0 && c($B,$C)<=0 && c($C,$A)<=0)?1:0;
say "Output: $r"' 0 1 2 0 -6 0
Output: 1
A full program would only add some checks.
# Perl weekly challenge 101
# Task 2: Origin containing triangle
#
# See https://wlmb.github.io/2021/02/22/PWC101/#task-2-origin-containing-triangle
use strict;
use warnings;
use v5.12;
use POSIX qw(floor);
use List::Util qw(all any pairs);
use Scalar::Util qw(looks_like_number);
sub usage {
say "./ch-2.pl x1 y1 x2 y2 x3 y3\nChecks if origin in triangle (x1,y1)(x2,y2)(x3,y3)";
exit 1;
}
sub cross {
my ($A, $B)=@_;
return $A->[0]*$B->[1]-$A->[1]*$B->[0];
}
usage() unless @ARGV==6 and all {looks_like_number $_} @ARGV;
my ($A, $B, $C)=pairs @ARGV;
my ($AB, $BC, $CA)=(cross($A,$B), cross($B,$C), cross($C,$A));
my $clockwise=all {$_>=0} ($AB, $BC, $CA);
my $counterclockwise=all {$_<=0} ($AB, $BC, $CA);
my $result=($clockwise||$counterclockwise)?1:0;
my $edge=any {$_==0} ($AB, $BC, $CA);
say "Input: ", join " ", map {"($_->[0],$_->[1])"} ($A, $B, $C);
say "Output: $result";
say "Since (0,0) is within the triangle" if $result and !$edge;
say "Since (0,0) is within an edge" if $result and $edge;
say "Since (0,0) is not within the triangle" unless $result;
Example 1:
./ch-2.pl 0 1 1 0 2 2
Input: 0
Output:
Input: 1
Output: 1
Input: 1
Output: 1
Input: 0
Output:
Input: 2
Output: 2
Input: 2
Output: 2
Example 2:
./ch-2.pl 1 1 -1 1 0 -3
Input: 1
Output: 1
Input: 1
Output: 1
Input: -1
Output: -, 1
Input: 1
Output: 1
Input: 0
Output:
Input: -3
Output: -, 3
Example 3:
./ch-2.pl 0 1 2 0 -6 0
Input: 0
Output:
Input: 1
Output: 1
Input: 2
Output: 2
Input: 0
Output:
Input: -6
Output: -, 6
Input: 0
Output: