# RogerBW's Blog

Perl Weekly Challenge 123: Ugly Square 28 July 2021

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

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
{
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=(,,);
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,@s,@s);
for 0..2 -> \$i {
``````

Take that number off each queue on which it appears.

``````      if (@s[\$i] == \$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 [,,]. 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 [,,].

Next pass. Smallest first value is 2. That comes off the 2-queue, leaving [[],,]. Then we push on 2 × the coefficient: [,[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.)

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]-\$w[\$pp])**2+(\$w[\$pp+1]-\$w[\$pp])**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 != \$t) {
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) {
if (\$delta==0) {     # coincident points
return 0;
}
\$angle=\$delta>0?90:-90;
} else {
}
push @angles,\$angle;
}
push @angles,\$angles;
``````

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!=90 && \$deltas != 270) {
next;
} else {
``````

The others must each be the same as the first one.

``````      foreach my \$di (1..3) {
if (\$deltas[\$di] != \$deltas) {
\$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.

1. Posted by Paul Blackwell at 11:59am on 28 July 2021

Just a gut feeling - haven't sat down and thought about it - but it feels like you should be able to speed up the 'angle' part of the calculation quite a bit by just checking explicitly for orthogonality, rather than calculating the angle and seeing if it's appropriate.

2. Posted by RogerBW at 12:06pm on 28 July 2021

Probably, yes – side 1's x/y should match side 2's y/x and so on, without going through the atan2 step.

3. Posted by RogerBW at 03:14pm on 02 August 2021

Part 1: probably a more Dijkstra-like approach is to use multiple pointers (for 2, 3, 5) into a single list. Many people factored; some built every combination to an upper bound. (There's also a solution in Mark-Jason Dominus' Higher Order Perl.)

Part 2: even cleaner than Paul's suggestion, simply check for the opposed diagonals being of equal length!

One might optimise further by removing the multiple orderings, taking the six squared distances between all possible pairs (0→[1,2,3], 1→[2,3], 2→), and confirming that in a sorted list of those values d==d and d==d.

``````sub sp {
my \$m=shift;
my @ds;
foreach my \$a (0..2) {
foreach my \$b (\$a+1..3) {
push @ds,(\$m->[\$b]-\$m->[\$a])**2+(\$m->[\$b]-\$m->[\$a])**2;
}
}
@ds=sort {\$a <=> \$b} @ds;
if (\$ds==\$ds && \$ds==\$ds) {
return 1;
}
return 0;
}``````