I’ve been doing the Weekly
Challenges. The
latest
involved regular numbers and geometrical squareness testing. (Note that
this is open until 1 August 2021.)
TASK #1 › Ugly Numbers
You are given an integer $n
>= 1.
Write a script to find the $nth element of Ugly Numbers.
Ugly numbers are those number whose prime factors are 2, 3 or 5. For
example, the first 10 Ugly Numbers are 1, 2, 3, 4, 5, 6, 8, 9, 10,
12.
These are also known as Regular
numbers. They appear as
OEIS #A051037.
So there's obviously a naïve way of doing this: start at 1, test for
divisibility by only 2, 3 and 5, and increment the counter if it
passes. That's what I did in PostScript. (The inner loop divides
repeatedly by, in turn, 2, 3 and 5; if what's left after that is 1,
there are no other prime factors.)
/un {
/c exch def
0
{
1 add
dup
[ 2 3 5 ] {
/k exch def
{
dup k mod 0 eq {
k idiv
} {
exit
} ifelse
} loop
} forall
1 eq {
/c c 1 sub def
} if
c 0 le {
exit
} if
} loop
} def
But division is slow even for this limited form of factorisation so
let's see if we can do better. Actually we can stand directly on the
shoulders of giants: Dijkstra used this as an example in A Discipline
of Programming (1976). (Chapter 17, "An Exercise Attributed to R. W.
Hamming"; it's, hmm, less clear than it might be to a modern reader,
but one can still dig out what he's getting at… though this code is
based on it rather than a direct implementation, if the latter is even
possible.)
I'll use the Raku here, because Perl's syntax for lists of lists is
less clear than it might be.
sub un($m) {
my $n;
We have three FIFO queues: the multiples of 2, of 3, and of 5, each
seeded with 1.
my @s=([1],[1],[1]);
my @c=(2,3,5);
for (1..$m) {
The next number in the sequence is the lowest value on any of the
queues (which will be in the first position).
$n=min(@s[0][0],@s[1][0],@s[2][0]);
for 0..2 -> $i {
Take that number off each queue on which it appears.
if (@s[$i][0] == $n) {
shift @s[$i];
}
And append to each queue the number multiplied by that queue's
coefficient.
push @s[$i],$n*@c[$i];
}
}
return $n;
}
So we start with [[1],[1],[1]]. Smallest first value is 1. So we shift
that off the front of each queue (leaving them all empty), and push on
the back 1 × the coefficient, leaving [[2],[3],[5]].
Next pass. Smallest first value is 2. That comes off the 2-queue,
leaving [[],[3],[5]]. Then we push on 2 × the coefficient:
[[4],[3,6],[5,10]].
Again. Smallest first value is 3 on the 3-queue. End result is
[[4,6],[6,9],[5,10,15]].
Again. Smallest first value is 4 on the 2-queue. End result is
[[6,8],[6,9,12],[5,10,15,20]].
Again. Smallest first value is 5 on the 5-queue. End result is
[[6,8,10],[6,9,12,15],[10,15,20,25]].
Again. Smallest first value is 6 on the 2- and 3-queues. End result is
[[8,10,12],[9,12,15,18],[10,15,20,25,30]].
Again. Smallest first value is 8 on the 2-queue (we don't need to
bother doing anything with 7, or any of its multiples). End result is
[[10,12,16],[9,12,15,18,24],[10,15,20,25,30,40]].
And so on, gradually increasing the queue size and required storage.
There's a slight inefficiency in that some numbers are queued twice,
e.g. 3×2 and 2×3. Python and Rust use a special "deque" type for FIFO
buffers like this (implementing it as a ring with start and end
pointers); in Ruby, Perl and Raku any list will do. (One could
doubtless implement a FIFO queue in PostScript, but it would be
complex and fiddly.)
TASK #2 › Square Points
You are given coordinates of four points i.e. (x1, y1), (x2, y2),
(x3, y3) and (x4, y4).
Write a script to find out if the given four points form a square.
One has to make some assumptions here. Although the examples both
trace out the points in an order that produces an outline with no
crossovers, I choose to regard the order of the points as
insignificant, so that if any ordering forms a square I'll regard it
as valid.
The number of orderings of 4 things, i.e. number of ways to trace a
path between 4 points visiting each exactly once, is 4×3×2=24. But we
don't care about which point we start at (divide by 4), and a reversal
will work the same way as a forward trip (divide by 2), leaving only 3
significant orderings that need be considered: ABCD, ABDC, ACBD.
sub sp {
my $m=shift;
So I'm going to start by just mapping my points into the current
order – with an extra copy of the first one on the end, for
convenience. (Probably ought to check for receiving a number of points
other than 4, really, but the problem definition tells me that 4 is
what I'll get. I'm also assuming two-dimensional coordinate space.)
foreach my $ordering ([0,1,2,3,0],[0,1,3,2,0],[0,2,1,3,0]) {
my @w=map {$m->[$ordering->[$_%4]]} (0..4);
What is a square? It is a four-sided form with each side of equal
length, and each angle of 90 degrees. I'll check for the sides first,
because that's computationally cheaper. Basic Pythagoras… but since I
only care whether the sides are equal, not how long they are, I skip
the square-root stage.
my @ds;
foreach my $pp (0..3) {
push @ds,($w[$pp+1][0]-$w[$pp][0])**2+($w[$pp+1][1]-$w[$pp][1])**2;
}
List::MoreUtils
gives me an all-in-one function to calculate maximum
and minimum in the same operation; the alternative would be if
(min(@t) != max(@t))
, which I used in some of the other languages.
(In Rust, float types are by design not directly sortable because of
the possibility of NaN
, which leads to some extra fiddle.)
my @t=minmax(@ds);
if ($t[0] != $t[1]) {
next;
}
OK, all the sides are equal. Now how about the corners? First of all
I'll get a set of angles for each side relative to the X axis. A good
atan2
function will probably not fail in the case where x==0, but
since I'm checking for x==y==0 anyway…
my @angles;
foreach my $pp (0..3) {
my @delta=map {$w[$pp+1][$_]-$w[$pp][$_]} (0,1);
my $angle;
if ($delta[0]==0) {
if ($delta[1]==0) { # coincident points
return 0;
}
$angle=$delta[1]>0?90:-90;
} else {
$angle=rad2deg(atan2($delta[1],$delta[0]));
}
push @angles,$angle;
}
push @angles,$angles[0];
Now I want a set of deltas, i.e. the angle between each successive
pair of sides. (Wrapping the angle to be positive, since I'm checking
equality.)
my $good=1;
my @deltas=map {($angles[$_+1]-$angles[$_]+360)%360} (0..3);
The first one must be 90 or 270. (We might be traversing the square
clockwise or anticlockwise.)
if ($deltas[0]!=90 && $deltas[0] != 270) {
next;
} else {
The others must each be the same as the first one.
foreach my $di (1..3) {
if ($deltas[$di] != $deltas[0]) {
$good=0;
last;
}
}
}
If all the deltas were valid, $good
is still 1 and we can return a
successful result.
return $good;
}
return 0;
}
This is doing floating-point equality testing, which is of course a
sin against von Neumann. At least for the test cases, it seems to
work, though; if it didn't, I'd define an "equal-ish" function
allowing for an arbitrary level of error.
I added two more coordinate sets for testing: a square with sides set
at 45 degrees to the axes, so that you can't just check for corners
with matching coordinate values, and a rhombus with all four sides of
equal length but non-right angles.
Full code on
github.
Comments on this post are now closed. If you have particular grounds for adding a late comment, comment on a more recent post quoting the URL of this one.