RogerBW's Blog

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.