Packed Origin with Raku (and Perl)
[117] Published 27. February 2021.This is my response to the Perl Weekly Challenge #101.
Challenge #101.1: Pack a Spiral
@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.
Example 1:
Input: @A = (1,2,3,4)
Output:
4 3
1 2
Since 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 2
Input: @A = (1..6)
Output:
6 5 4
1 2 3
or
5 4
6 3
1 2
Either will do as an answer, because they're equally tight.
Input: @A = (1..12)
Output:
9 8 7 6
10 11 12 5
1 2 3 4
or
8 7 6
9 12 5
10 11 4
1 2 3
Weekly Matrices
The Weekly challenges has visited matrices three times before:
- Challenge #011 - FC Matrix with Raku
- Challenge #053 - Vowelled Matrix with Raku
- Challenge #088 - Arrayed Spiral with Raku and Perl
The current challenge resembles #088.2 Spiral Matrix, as it is the inverse operation.
First we need to decide the matrix dimensions (number of rows and columns):
File: pick-spiral (partial)
#! /usr/bin/env raku
unit sub MAIN ($A, :v(:$verbose)); # [1]
my @A = $A.split(/<[\s\,]>+/)
# ###### # 2 ##############
.map({ /^(\d+) \.\. (\d+)$/ ?? ($0 .. $1).list !! $_ })
# 3 ###################### ## # 3a ########## ## 3b ##
.flat;
# 4 #
say ": Values: { @A.join(", ") }" if $verbose;
my $elems = @A.elems; # [5]
my $length = @A>>.chars.max; # [6]
say ": Number of values: $elems (max length: $length)" if $verbose;
[1] Specify the values as a (single) string.
[2] Using words to split the string into (for lack of a better term)
words, will fail if we use commas, as the examples. So we split (with
split and a suitable regex) on a combination of spaces and/or commas.
[3] Then we use map to change those words. We start by matching
against this regex to look for a range (one or more digits, two periods, and one or more
digits) [3]. If it succeeds, we construct a list from the range (with the list
method to expand the range to a list of values) [3a]. If not, use the value itself [3b].
[4] The map caused a list (from the range, if any) inside the list. We do
not want that, so a final flat flattens the structure into a one dimentional
list.
[5] Get the number of elements.
[6] Get the max length, to be used for tabulation (so that the matrix looks nice).
Running the partial program:
$ ./pack-spiral -v "1 2 3 4..10 11 12"
: Values: 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12
: Number of values: 12 (max length: 2)
$ ./pack-spiral -v "99 2 3 000"
: Values: 99, 2, 3, 000
: Number of values: 4 (max length: 3)
The difference between the number of rows and columns should be as small as possible. (And all the rows and columns have to be filled in.)
If the number of values is a prime number, we get one row. (Or as many rows as values, with one value per row, if you like skyscrapers. But I'll stick with one row.)
File: pick-spiral (partial)
if $elems.is-prime # [7]
{
say @A.join(" "); # [7a]
exit; # [7b]
}
[7] If the number of elements is a prime value, print the values on a single row (without bothering with tabulation, as the single row does not need to be tabulated against anything) [7a], and exit (as we are done) [7b].
Running it:
$ ./pack-spiral -v "1..11"
: Values: 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11
: Number of values: 11 (max length: 2)
1 2 3 4 5 6 7 8 9 10 11
The other special case is if the number of rows and columns are identical. That gives a zero difference (indifference?), which is the lowest possible value we can get. This is the case if we can get an integer square root of the number of values:
File: pick-spiral (partial)
my ($rows, $cols);
if $elems.sqrt ~~ Int # [8]
{
$rows = $cols = $elems.sqrt; # [8a]
}
[8] If the square root of the number of elemenst is an integer (by smartmatching), we have the answer (i.e. the square root).
If this one did not get the job done, we have to do it (finding all the combinations of two numbers multiplied togeter that gives the number of elements) the hard way. The divisors of the number would be a good start, and I just happen to have them at hand…
Divisors
The following procedure, returning all the divisors for a given integer, has been copied from my Centenary Sequences with Raku Part 5 - Divisors and Factors article.
sub divisors ($number, :$not-self, :$not-one)
{
my @divisors;
for ($not-one ?? 2 !! 1) .. $number/2 -> $candidate
{
@divisors.push: $candidate if $number %% $candidate;
}
@divisors.push: $number unless $not-self;
return @divisors;
}
We do not want the number itself, nor 1, to be included, so we call it like this:
my @divisors = divisors($elems, :not-self, :not-one);
For e.g. «12» this will give «2, 3, 4 and 6».
else
{
my @divisors = divisors($elems, :not-self, :not-one); # [9]
my %divisors = @divisors.Set; # [10]
say ": Divisors: { @divisors.join(", ") }" if $verbose;
my @sizes; # [11]
for @divisors -> $current # [12]
{
my $div = $elems div $current; # [13]
if %divisors{$div} # [14]
{
@sizes.push: ($current => $div); # [14a]
say ": Candidate: $current x $div" if $verbose;
}
}
my $tightest = @sizes
.sort({ abs($^a.key - $^a.value ) <=> abs($^b.key - $^b.value ) })
.first; # [15]
($rows, $cols) = $tightest.key, $tightest.value; # [16]
}
say ": Tightest: $rows x $cols" if $verbose;
[9] Get the divisors, excluding 1 and the number itself.
[10] We need a way of checking if a candidate is a divisor (in [14]).
Using a hash is ideal for that. Using the Set type is even better. (It is
a hash variety where the value is True. Looking up a non-existing key
gives False.)
[11] The candicates (combinations of rows and columns that gives us the required size) will go here.
[12] Iterate over the divisors,
[13] • Divide the number of items with the current divisor. (Note that we can
use integer division here (with div), as we now that the current value
is divisible by it. We know this, as it is a divisor.)
[14] • Is the result (from [13]) (also) a divisor in the number
of items? If so, we add the pair (the two divisors) to the list of candidates. The
=> (fat arrow operator) gives a Pair, one key and one
value. (This is the building block of hashes and named arguments, but can be used
explicitly as well. As we do here.)
[15]
We have a list of Pair objects, and we want the tighest.
So we sort the list by the tighness, using abs to get rid of
the sign. Then we pick the first one in the sorted list, with first.
[16]
We have a Pair object, so must use the key and
value methods to get the two values.
See
docs.raku.org/type/Set for more
information about the Set type.
See
docs.raku.org/routine/Set for
more information about the Set method.
See
docs.raku.org/type/Pair
for more information about the Pair type.
See
docs.raku.org/routine/=>
for more information about the Pair constructing operator =>
See
docs.raku.org/routine/abs
for more information about abs.
See
docs.raku.org/routine/first
for more information about first.
See
docs.raku.org/routine/key
for more information about key, and
docs.raku.org/routine/value
for more information about value.
Running it:
$ ./pack-spiral -v "1..12"
: Values: 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12
: Number of values: 12 (max length: 2)
: Divisors: 2, 3, 4, 6
: Candidate: 2 x 6
: Candidate: 3 x 4
: Candidate: 4 x 3
: Candidate: 6 x 2
: Tightest: 3 x 4
So far so good. We have the dimensions of the matrix (number of rows and columns).
Now we can populate the matrix. We start at the lower left corner, facing east. We continue straight ahead, until we reach the edge - or an already populated cell. Then we take a left hand turn, and go on in that direction (until we reach an edge - or an already populated cell. And so on):
This is how it looks like for a 4x4 matrix, with the values 1..16:
my @matrix; # [17]
my $row2 = $rows -1; # [18]
my $col2 = $cols -1; # [18a]
my $current_row = $row2; # [19]
my $current_col = 0; # [19a]
my $direction = 'E'; # [20]
for @A -> $item # [21]
{
@matrix[$current_row][$current_col] = $item; # [22]
say ": Placing item \"$item\" at [$current_row, $current_col]" if $verbose;
if $direction eq 'E' # [23]
{
$current_col < $col2 && ! @matrix[$current_row][$current_col +1].defined
?? $current_col++
!! ( $direction = 'N'; $current_row-- );
}
elsif $direction eq 'N' # [24]
{
$current_row > 0 && ! @matrix[$current_row -1][$current_col].defined
?? $current_row--
!! ( $direction = 'W'; $current_col-- );
}
elsif $direction eq 'W' # [25]
{
$current_col > 0 && ! @matrix[$current_row][$current_col -1].defined
?? $current_col--
!! ( $direction = 'S'; $current_row++ );
}
elsif $direction eq 'S' # [26]
{
$current_row < $row2 && ! @matrix[$current_row +1][$current_col].defined
?? $current_row++
!! ( $direction = 'E'; $current_col++ );
}
}
[17] We fill in the values in this matrix variable.
[18] The index of the last row and column [18a] (as the first one has index 0).
[19] We start in the lower left corner,
[20] Heading East ("E").
[21] Iterate over the values to place in the matrix.
[22] • Place the value at the current position.
[23] Are we heading East? If so check that we have a cell in front of us (the
code before the &&) and that the cell has not been populated
already (has a defined value, with .defined). If it is free,
change the current position one cell straight ahead (the ?? part).
If not, take a left hand turn (i.e. change the direction) and change the current
position one cell in thar direction.
[24] Are we heading North?
[25] Are we heading West?
[26] Are we heading South?
And finally, we print the matrix:
File: pick-matrix (the rest)
for @matrix -> @row # [27]
{
say @row.map({ $_.fmt("%{$length}s") }).join(" "); # [27a]
}
[27] For each row, print the values, nicely tabulated [27a].
Running it:
$ ./pack-spiral "1,2,3,4"
4 3
1 2
$ ./pack-spiral "1..6"
6 5 4
1 2 3
$ ./pack-spiral "1..12"
9 8 7 6
10 11 12 5
1 2 3 4
With verbose mode:
$ ./pack-spiral -v "1,2,3,4"
: Values: 1, 2, 3, 4
: Number of values: 4 (max length: 1)
: Divisors: 2
: Candidate: 2 x 2
: Tightest: 2 x 2
: Placing item "1" at [1, 0]
: Placing item "2" at [1, 1]
: Placing item "3" at [0, 1]
: Placing item "4" at [0, 0]
4 3
1 2
$ ./pack-spiral -v "1..6"
: Values: 1, 2, 3, 4, 5, 6
: Number of values: 6 (max length: 1)
: Divisors: 2, 3
: Candidate: 2 x 3
: Candidate: 3 x 2
: Tightest: 2 x 3
: Placing item "1" at [1, 0]
: Placing item "2" at [1, 1]
: Placing item "3" at [1, 2]
: Placing item "4" at [0, 2]
: Placing item "5" at [0, 1]
: Placing item "6" at [0, 0]
6 5 4
1 2 3
$ ./pack-spiral -v "1..12"
: Values: 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12
: Number of values: 12 (max length: 2)
: Divisors: 2, 3, 4, 6
: Candidate: 2 x 6
: Candidate: 3 x 4
: Candidate: 4 x 3
: Candidate: 6 x 2
: Tightest: 3 x 4
: Placing item "1" at [2, 0]
: Placing item "2" at [2, 1]
: Placing item "3" at [2, 2]
: Placing item "4" at [2, 3]
: Placing item "5" at [1, 3]
: Placing item "6" at [0, 3]
: Placing item "7" at [0, 2]
: Placing item "8" at [0, 1]
: Placing item "9" at [0, 0]
: Placing item "10" at [1, 0]
: Placing item "11" at [1, 1]
: Placing item "12" at [1, 2]
9 8 7 6
10 11 12 5
1 2 3 4
And finally a couple of larger matrices, just for fun:
$ ./pack-spiral "1..100"
28 27 26 25 24 23 22 21 20 19
29 58 57 56 55 54 53 52 51 18
30 59 80 79 78 77 76 75 50 17
31 60 81 94 93 92 91 74 49 16
32 61 82 95 100 99 90 73 48 15
33 62 83 96 97 98 89 72 47 14
34 63 84 85 86 87 88 71 46 13
35 64 65 66 67 68 69 70 45 12
36 37 38 39 40 41 42 43 44 11
1 2 3 4 5 6 7 8 9 10
$ ./pack-spiral "1..144"
34 33 32 31 30 29 28 27 26 25 24 23
35 72 71 70 69 68 67 66 65 64 63 22
36 73 102 101 100 99 98 97 96 95 62 21
37 74 103 124 123 122 121 120 119 94 61 20
38 75 104 125 138 137 136 135 118 93 60 19
39 76 105 126 139 144 143 134 117 92 59 18
40 77 106 127 140 141 142 133 116 91 58 17
41 78 107 128 129 130 131 132 115 90 57 16
42 79 108 109 110 111 112 113 114 89 56 15
43 80 81 82 83 84 85 86 87 88 55 14
44 45 46 47 48 49 50 51 52 53 54 13
1 2 3 4 5 6 7 8 9 10 11 12
Looking good.
Perl
No Perl version of this one, alas.Challenge #101.2: Origin-containing Triangle
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.
Example 1:
Input: A=(0,1), B=(1,0) and C=(2,2)
Output: 0 because that triangle does not contain (0,0).
Input: A=(1,1), B=(-1,1) and C=(0,-3)
Output: 1 because that triangle contains (0,0) in its interior.
Input: A=(0,1), B=(2,0) and C=(-6,0)
Output: 1 because (0,0) is on the edge connecting B and C.
There are several ways of solving this. The easy one, insofar as it is understandable, requires the calculation of rectangle areas. It has the added benefit that the fourth point does not have to be origo (but that does not matter here).
Given a triangle formed by the three points A, B and C, the fourth point P can either be inside it (PI) or outside it (PO):
We can calculate the area of the initial triangle (ABC), and compare it with the sum of the three sub-triangles we get by swapping A, B or C with P. If P is inside the original triangle (shown in the middle), the three sub-triangles will fill in the whole triangle 100%. If on the other hand P is outside of the triangle, we get a sum that does not match.
This explanation (and the program) is based on www.geeksforgeeks.org/check-whether-a-given-point-lies-inside-a-triangle-or-not/.
File: origin-containing-triangle
#! /usr/bin/env raku
unit sub MAIN ($x1, $y1, $x2, $y2, $x3, $y3, $x = 0, $y = 0); # [1]
my $ABC = area($x1, $y1, $x2, $y2, $x3, $y3); # [2]
my $PBC = area($x, $y, $x2, $y2, $x3, $y3); # [2a]
my $PAC = area($x1, $y1, $x, $y, $x3, $y3); # [2b]
my $PAB = area($x1, $y1, $x2, $y2, $x, $y); # [2c]
say ($ABC == $PBC + $PAC + $PAB) ?? 1 !! 0; # [3]
sub area($x1, $y1, $x2, $y2, $x3, $y3) # [4]
{
return abs( ($x1 * ($y2 - $y3) + $x2 * ($y3 - $y1) + $x3 * ($y1 - $y2) ) / 2);
}
[1] Note the third point, which defaults to origo if not given.
[2] Get the area of the whole triangle, and the three sub-rectangles we get by swapping one edge with P; A [2a], B [2b] and C [2c].
[3] Is the sum of the three triangles the same as the whole? If so print «1», else «0».
[4] Get the area of the rectangle.
See e.g. www.mathsisfun.com/triangle.html for more information about triangles (including how to calculate the area).
Running it:
$ ./origin-containing-triangle 0 1 1 0 2 2
0
$ ./origin-containing-triangle 1 1 -1 1 0 -3
1
$ ./origin-containing-triangle 0 1 2 0 -6 0
1
Looking good.
Perl
This is a straight forward translation of the Raku version. File: origin-containing-triangle-perl
#! /usr/bin/env perl
use strict;
use warnings;
use feature 'say';
use feature 'signatures';
no warnings "experimental::signatures";
die "Specify 6 or 8 values" unless @ARGV == 6 || @ARGV == 8;
my ($x1, $y1, $x2, $y2, $x3, $y3, $x, $y) = @ARGV;
$x = 0 unless defined $x;
$y = 0 unless defined $y;
my $ABC = area($x1, $y1, $x2, $y2, $x3, $y3);
my $PBC = area($x, $y, $x2, $y2, $x3, $y3);
my $PAC = area($x1, $y1, $x, $y, $x3, $y3);
my $PAB = area($x1, $y1, $x2, $y2, $x, $y);
($ABC == $PBC + $PAC + $PAB) ? say 1 : say 0; # [1]
sub area($x1, $y1, $x2, $y2, $x3, $y3)
{
return abs( ($x1 * ($y2 - $y3) + $x2 * ($y3 - $y1) + $x3 * ($y1 - $y2) ) / 2);
}
[1] We cannot put say up front, as in Raku, so we end up with two of
them.
Running it gives the same result as the Raku version:
$ ./origin-containing-triangle-perl 0 1 1 0 2 2
0
$ ./origin-containing-triangle-perl 1 1 -1 1 0 -3
1
$ ./origin-containing-triangle-perl 0 1 2 0 -6 0
1
Note that the error checking is minimal.
And that's it.