1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
|
#! /opt/local/bin/perl
#
# sprialling-out-of-control.pl
#
# PWC 101
# TASK #1 › Pack a Spiral
#
# Submitted by: Stuart Little
# 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.
#
# 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
# Example 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.
# method:
# Given an array, there will always be one packing available, 1 x n,
# the linear form of the array itself. Beyond that, a tighter
# packing would have to contain the correct number of elements
# before any spiralling can commence.
#
# THus the first course of action is to compute the ideal
# 2-dimensional form from those avaailable.
#
# The absolute ideal two dimensional orthogonal packing would be a
# square, so that (m-n) would be 0. Unfortunately this is only
# available to arrays with lengths in the square numbers,
# 1,4,9,16,25,36 etc.
# In a general sense the dimensions of our rectangle, our
# 2-dimensional matrix, will be composed of two integers such that m
# x n = L, the length of the original array to be spiralized. As our
# ideal is a square form, the ideal dimension is the square root of
# L, and any divergence from that ideal will expand the gap between
# m and n. Thus by finding the smallest factor of L less than the
# square root we will locate m, and from that we can determine n.
#
# Once we have our dimensions determined, we can commence rotation
# and scalar reduction.
#
#
# conclusions and deep structure:
# For testing we will make arrays from 1 to 100 items items long and
# test them all. The actual values of the elements is
# inconsequential so we will use sequentail values starting at 1;
# this will make it easy to observe the spiralling.
# The observed pattern of minimized rectangular ratio, hence
# minimizing abs(m-n) is:
#
# 2,0,4,1,6,2,0,3,10,1,12,5,2,0,16,3,18,1,4,9,22,2,0,11,6,3,28...
# from The On-Line Encyclopedia of Integer Sequences
# 2,0,4,1,6,2,0,3,10,1,12,5,2,0,16,3,18,1,4,9,22,2,0,11,6,3,28
# A056737
# Minimum nonnegative integer m such that n = k*(k+m) for some
# positive integer k.
#
# © 2021 colin crain
## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ##
use warnings;
use strict;
use feature ":5.26";
use feature qw(signatures);
no warnings 'experimental::signatures';
use POSIX;
use List::Util qw(max);
my @arr;
for my $n (3..100) {
@arr = (1..$n);
my ($m, $n) = find_dim( scalar @arr );
my $spiral = spiral_fill( $m, $n, @arr );
print_matrix( $spiral );
say '';
}
sub find_dim ($size) {
## SV Int size -> (SV Int m, SV Int n)
## find the largest factor less than or equal to the square root
my $try = (int sqrt $size) + 1;
while (--$try > 1) {
last unless $size % $try;
}
return ($try, int $size/$try);
}
sub spiral_fill ( $rows, $cols, @arr ) {
## given dimensions and an array spiral fills a matrix with those dimensions
my $rank = 0;
my $mat;
while ( -spiralize ) {
## lower - left to right
return $mat if $rank > ceil( $rows / 2 - 1);
for my $col ( $rank..$cols - $rank - 1) {
$mat->[$rows-$rank-1][$col] = shift @arr;
}
## right - bottom to top
return $mat if $rank > ceil( $cols / 2 - 1);
for my $row ( reverse $rank+1..$rows-$rank-2 ) {
$mat->[$row][$cols-$rank-1] = shift @arr;
}
## upper - right to left
return $mat if $rank > floor( $rows / 2 - 1);
for my $col ( reverse $rank..$cols - $rank - 1) {
$mat->[$rank][$col] = shift @arr;
}
## left - top to bottom
return $mat if $rank > floor( $cols / 2 - 1);
for my $row ( $rank+1..$rows-$rank-2 ) {
$mat->[$row][$rank] = shift @arr;
}
## close ranks
$rank++;
}
}
sub print_matrix ( $matrix ) {
if (scalar $matrix->@* == 1) {
say "$_->@*" for $matrix->@*;
}
else {
my @maxes = map { max $_->@* } $matrix->@*;
my $max = max @maxes;
my $order = 0;
$order++ while int($max/10**$order) > 0;
$order+=2; ## padding
my $fmt = ("%-" . $order . "d") x scalar $matrix->[0]->@*;
for (keys $matrix->@*) {
printf "$fmt\n", $matrix->[$_]->@*;
}
}
}
|
