Ugly Points with Raku and Perl
[139] Published 31. July 2021.This is my response to the Perl Weekly Challenge #123.
Challenge #123.1: Ugly Numbers
$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.
Example:
Input: $n = 7
Output: 8
Input: $n = 10
Output: 12
Ugly Numbers was mentioned way back in Challenge #3.1. See From Babylon to Pascal with Raku for one way of computing them. (I am going to do it another way this time.)
The definition as given in the challenge is unprecise. www.geeksforgeeks.org has a better one: «Ugly numbers are numbers whose only prime factors are 2, 3 or 5. (...) By convention, 1 is included.»
We need the prime factors. We can ge those with the «factors» procedure from the program with the same name in my Centenary Sequences with Raku Part 5 - Divisors and Factors article. (Scroll down to sequence #065). Then we apply cut and paste:
File: ugly-numbers (partial)
sub factors ($number is copy)
{
return (1) if $number == 1;
return ($number) if $number.is-prime;
my @factors;
for (2 .. $number div 2).grep( *.is-prime) -> $candidate
{
while $number %% $candidate
{
@factors.push: $candidate;
$number /= $candidate;
}
}
return @factors;
}
The rest of the program is actually quite easy:
File: ugly-numbers (the rest)
unit sub MAIN (Int $n where $n > 0, :v(:$verbose)); # [1]
my $ugly-seq := gather # [2]
{
take 1; # [3]
for 2 .. Inf -> $candidate # [4]
{
my @prime-factors = factors($candidate); # [5]
take $candidate if all(@prime-factors) == any(2,3,5); # [6]
}
}
say ": Sequence: { $ugly-seq[^$n].join(", ") }" if $verbose;
say $ugly-seq[$n -1]; # [7]
[1] Ensure that $n is a positive integer.
[2] Using gather/take to
collect the values (as a sequence) looks like a good idea.
[3] The first value is «1», by convention.
[4] For all the possible numbers,
[5] • Get the prime factors for the candidate number.
[6]
• Use (i.e. take) the candidate number
if all the prime factores have one of the values 2, 3 or 5. We do this comparison
with two junctions; all and any.
[7] Print the $nth element.
See my Raku Gather,
I Take article or
docs.raku.org/syntax/gather take for more information about
gather/take.
See
docs.raku.org/routine/all
for more information about all.
See
docs.raku.org/routine/any
for more information about any.
See docs.raku.org/type/Junction for more information about Junctions.
Running it:
$ ./ugly-numbers 7
8
$ ./ugly-numbers 10
12
With verbose mode:
$ ./ugly-numbers -v 7
: Sequence: 1, 2, 3, 4, 5, 6, 8
8
$ ./ugly-numbers -v 10
: Sequence: 1, 2, 3, 4, 5, 6, 8, 9, 10, 12
12
The Geeks (i.e. www.geeksforgeeks.org) says that the 150th number is 5832. We got that one right, thankfully:
$ ./ugly-numbers -v 150
: Sequence: 1, 2, 3, 4, 5, 6, 8, 9, 10, 12, 15, 16, 18, 20, 24, 25, 27, 30, \
32, 36, 40, 45, 48, 50, 54, 60, 64, 72, 75, 80, 81, 90, 96, 100, 108, 120, \
125, 128, 135, 144, 150, 160, 162, 180, 192, 200, 216, 225, 240, 243, 250, \
256, 270, 288, 300, 320, 324, 360, 375, 384, 400, 405, 432, 450, 480, 486, \
500, 512, 540, 576, 600, 625, 640, 648, 675, 720, 729, 750, 768, 800, 810, \
864, 900, 960, 972, 1000, 1024, 1080, 1125, 1152, 1200, 1215, 1250, 1280, \
1296, 1350, 1440, 1458, 1500, 1536, 1600, 1620, 1728, 1800, 1875, 1920, \
1944, 2000, 2025, 2048, 2160, 2187, 2250, 2304, 2400, 2430, 2500, 2560, \
2592, 2700, 2880, 2916, 3000, 3072, 3125, 3200, 3240, 3375, 3456, 3600, \
3645, 3750, 3840, 3888, 4000, 4050, 4096, 4320, 4374, 4500, 4608, 4800, \
4860, 5000, 5120, 5184, 5400, 5625, 5760, 5832
5832
Factor Bonus
Do you want the factors? Run the «factors» program (from Centenary Sequences with Raku Part 5 - Divisors and Factors, and included in the zip file):
$ ./factors 100
[2 2 5 5]
$ ./factors 26
[2 13]
$ ./factors 5832
[2 2 2 3 3 3 3 3 3]
A Perl Version
This is straight forward translation of the Raku version, depending on your definition of straight and forward… File: ugly-numbers-perl
#! /usr/bin/env perl
use strict;
use warnings;
use feature 'say';
use feature 'signatures';
no warnings qw(experimental::signatures);
use Getopt::Long;
use Math::Prime::Util qw/is_prime/; # [1]
use Perl6::Junction qw/all any/; # [2]
my $verbose = 0;
GetOptions("verbose" => \$verbose);
my $n = $ARGV[0] || die "Please specify a positive integer";
die "Please specify a positive integer" unless $n =~ /^[1-9]\d*$/;
my @ugly_seq = (1); # [3]
my $candidate = 2; # [4]
while (1) # [4a]
{
last if @ugly_seq == $n; # [4b]
my @prime_factors = factors($candidate);
push(@ugly_seq, $candidate) if all(@prime_factors) == any(2,3,5); # [3a]
$candidate++; # [4c]
}
say ": Sequence: ", join(", ", @ugly_seq) if $verbose;
say $ugly_seq[$n -1];
sub factors ($number)
{
return (1) if $number == 1;
return ($number) if is_prime($number);
my @factors;
for my $candidate (grep { is_prime($_) } 2 .. $number / 2) # [1]
{
while ($number % $candidate == 0) # [5]
{
push(@factors, $candidate);
$number /= $candidate;
}
}
return @factors;
}
[1] Perl does not have a built in prime deciding function, but CPAN comes to the rescue.
[2] Ditto for Junctions.
[3] The first value in the sequence.
[4] Instead of the loop in Raku. Perl does not have infinity (as a built in value), but an eternal loop ([4a] and [4c]) in combination with an exit strategy (in [4b]) does the job.
[5] Perl does not have the divisibility operator, but modulo and checking for zero does the same.
Running it gives the same result as the Raku version:
$ ./ugly-numbers-perl 7
8
$ ./ugly-numbers-perl -v 10
: Sequence: 1, 2, 3, 4, 5, 6, 8, 9, 10, 12
12
$ ./ugly-numbers-perl 150
5832
Challenge #123.2: Square Points
Write a script to find out if the given four points form a square.
Example:
Input: x1 = 10, y1 = 20
x2 = 20, y2 = 20
x3 = 20, y3 = 10
x4 = 10, y4 = 10
Output: 1 as the given coordinates form a square.
Input: x1 = 12, y1 = 24
x2 = 16, y2 = 10
x3 = 20, y3 = 12
x4 = 18, y4 = 16
Output: 0 as the given coordinates doesn't form a square.
A square is a geometrical figure where the four sides have the same length, and the four angles are the same (90 degree). (See en.wikipedia.org/wiki/Square for a more formal definition.)
We should assume that the points are specified in the correct order, i.e. that the edges are between neighbouring points:
Specifying the points in the wrong order will not work out, as the program will not try to sort it out for you.
Let us start with the edges, checking that they have the same length. The «Wrong Order» example above clearly fails that test.
File: square-spoints (partial)
#! /usr/bin/env raku
unit sub MAIN (Numeric $x1, Numeric $y1, # [1]
Numeric $x2, Numeric $y2, # [2]
Numeric $x3, Numeric $y3, # [3]
Numeric $x4, Numeric $y4, # [4]
:v(:$verbose));
my $l12 = (($x2 - $x1).abs ** 2 + ($y2 - $y1).abs ** 2).sqrt; # [1-2]
my $l23 = (($x3 - $x2).abs ** 2 + ($y3 - $y2).abs ** 2).sqrt; # [2-3]
my $l34 = (($x4 - $x3).abs ** 2 + ($y4 - $y3).abs ** 2).sqrt; # [3-4]
my $l41 = (($x1 - $x4).abs ** 2 + ($y1 - $y4).abs ** 2).sqrt; # [4-1]
unless $l12 == $l23 == $l34 == $l41 # [5]
{
say ": The four edges does not have the same length \
($l12, $l23, $l34, $l41)" if $verbose;
say 0;
exit;
}
if $l12 == 0 # [6]
{
say ": All the points have the same position" if $verbose;
say 0;
exit;
}
[1] The X and Y valuues for the first point, of the type Numeric.
[2] Ditto, for the second point.
[3] Ditto, for the third point.
[4] Ditto, for the fourth point.
[1-2] The length of the edge from point 1 to 2 (or: the distance beween point 1 and 2).
The Distance Between Two Points
The formula is the difference (increase) in the x value, squared, and added to the difference (increase) in the y value, also squared. And finally the square root of that sum.
In quasi code:
sqrt( (x2 - x1) ** 2 + (y2 - y1) ** 2 )
Feel free to look it up.
Note that half the expression (either to the left or right of the plus sign) is zero when the points have the same x or y value, so the distance between a point (10,10) and (20,10) is 10. You know it is, and the formula agrees.
[2-3] Ditto, from 2 to 3.
[3-4] Ditto, from 3 to 4.
[4-1] Ditto, from 4 to 1.
[5] The edges must have the same length. If not print zero and exit.
[6] Ensure that the length is non-zero (i.e. that the points are distinct).
The examples below (horizontal, rotated, skewed) have edges with the same length. The second one has been rotated (away from the baseline), but it is still a square. The third one is skewed, and is not a square - as the angles are not 90 degrees anymore.
We do not actually have to check that all the angles are 90 degrees. (Red Herring Fun Fact: The sum of the four angles is 360, so the sum of any three should be 270 (i.e. 360 - 90).)
One is sufficient, as shown below. If we move one point outwards, the length (of one or both sides) increases and the first test (all sides have the same length) catches the problem. The same applies if we move it inwards, until the point is at the same position as the one in that corner. (We'll get back to that.)
Right Angles, Right?
We could have used atan2 on a suitable combination of
the numbers:
$angle = atan2($y2 - $y1, $x2 - $x1) -
atan2($y4 - $y1, $x4 - $x1);
See
docs.raku.org/routine/atan2
for more information about atan2.
But that would have given us the angle in radians. 90 degrees is 1.5707963267948966 (pi/2) in radians, or rather it is approximately that. Rounding errors abound. Let us not go there…
The Dot Prodcuct (scroll
down to the «Algebraic definition» section) is much better than atan2,
as it gives us the number zero if the angle is 90 degrees (and something else if
it isn't).
my $dot-product = ($x2 - $x1) * ($y2 - $y1) + ($x4 - $x1) * ($y4 - $y1);
if $dot-product
{
say ": Not 90 Degrees between lines 1-2 and 1-4" if $verbose;
say 0;
exit;
}
The last part is done by ensuring that the first and third corners does not have the same position:
File: square-spoints (partial)
if $x1 == $x3 && $y1 == $y3
{
say ": Point 1 and 3 are equal" if $verbose;
say 0;
exit;
}
Note that this check, which is essential, makes the zero check (in [6]) redundant. I have chosen to leave it in, as the verbose message is useful.
And finally, if it has not failed by now, we are in the clear:
File: square-spoints (last part)
say 1;
Running it:
$ ./square-points 10 20 20 20 20 10 10 10
1
$ ./square-points 12 24 16 10 20 12 18 16
0
$ ./square-points -v 12 24 16 10 20 12 18 16
: The four edges does not have the same length \
(14.560219778561036, 4.47213595499958, 4.47213595499958, 10)
0
Looking good.
I have used extra spaces between the points to make it easier to see the pairs (x's and y's). We can add suppport for a comma, so that we can group the values as points like this:
$ ./square-points-multi -v 10,10 0,20 10,30 20,20
1
#! /usr/bin/env raku
multi MAIN (Str $xy1, Str $xy2, Str $xy3, Str $xy4, :v(:$verbose)) # [1]
{
my ($x1, $y1) = $xy1.split(",")>>.Numeric; # [2]
my ($x2, $y2) = $xy2.split(",")>>.Numeric;
my ($x3, $y3) = $xy3.split(",")>>.Numeric;
my ($x4, $y4) = $xy4.split(",")>>.Numeric;
MAIN($x1, $y1, $x2, $y2, $x3, $y3, $x4, $y4, :$verbose); # [3]
}
multi MAIN (Numeric $x1, Numeric $y1, Numeric $x2, Numeric $y2, # [4]
Numeric $x3, Numeric $y3, Numeric $x4, Numeric $y4,
:v(:$verbose))
{
my $l12 = (($x2 - $x1).abs ** 2 + ($y2 - $y1).abs ** 2).sqrt;
my $l23 = (($x3 - $x2).abs ** 2 + ($y3 - $y2).abs ** 2).sqrt;
my $l34 = (($x4 - $x3).abs ** 2 + ($y4 - $y3).abs ** 2).sqrt;
my $l41 = (($x1 - $x4).abs ** 2 + ($y1 - $y4).abs ** 2).sqrt;
unless $l12 == $l23 == $l34 == $l41
{
say ": The four edges does not have the same length \
($l12, $l23, $l34, $l41)" if $verbose;
say 0;
exit;
}
if $l12 == 0
{
say ": All the points have the same position" if $verbose;
say 0;
exit;
}
my $dot-product = ($x2 - $x1) * ($y2 - $y1) + ($x4 - $x1) * ($y4 - $y1);
if $dot-product
{
say ": Not 90 Degrees between lines 1-2 and 1-4" if $verbose;
say 0;
exit;
}
if $x1 == $x3 && $y1 == $y3
{
say ": Point 1 and 3 are equal" if $verbose;
say 0;
exit;
}
say 1;
}
[1] A new multi MAIN that kicks in if we have four parameters.
[2] Split each argument on a comma, and coerce the resulting values to Numeric values (as they are strings otherwise).
[3] Call the second multi MAIN.
[4] The second (and original) multi MAIN.
Running it:
$ ./square-point-multi -v 10 10 0 20 10 30 20 20
1
$ ./square-point-multi -v 10,10 0,20 10,30 20,20
1
$ ./square-points-multi -v 0,0 0,10 0,0 10,0
: Point 1 and 3 are equal
0
$ ./square-points-multi -v 0,0 0,0 10,10 10,0
: The four edges does not have the same length (0, 14.142135623730951, 10, 10)
0
$ ./square-points-multi -v 0,0 0,0 0,0 0,0
: All the points have the same position
0
Perl
This is a straight forward(ish) translation of the last Raku version. File: square-points-perl
#! /usr/bin/env perl
use strict;
use warnings;
use feature 'say';
use Getopt::Long;
use Scalar::Util qw(looks_like_number);
my $verbose = 0;
GetOptions("verbose" => \$verbose);
my @args;
for my $val (@ARGV) # [1]
{
if ($val =~ /\,/) # [1a]
{
my ($a, $b) = split(/\,/, $val); # [1b]
push(@args, $a, $b); # [1b]
}
else
{
push(@args, $val); # [1c]
}
}
die "Wrong number of arguments" unless @args == 8; # [2]
map { die "$_: Not a numeric value" unless looks_like_number($_) } @args;
# [3]
my ($x1, $y1, $x2, $y2, $x3, $y3, $x4, $y4) = @args;
my $l12 = sqrt(abs($x2 - $x1) ** 2 + abs($y2 - $y1) ** 2);
my $l23 = sqrt(abs($x3 - $x2) ** 2 + abs($y3 - $y2) ** 2);
my $l34 = sqrt(abs($x4 - $x3) ** 2 + abs($y4 - $y3) ** 2);
my $l41 = sqrt(abs($x1 - $x4) ** 2 + abs($y1 - $y4) ** 2);
unless ($l12 == $l23 && $l34 == $l41 && $l12 == $l41) # [4]
{
say ": The four edges does not have the same length \
($l12, $l23, $l34, $l41)" if $verbose;
say 0;
exit;
}
if ($l12 == 0)
{
say ": All the points have the same position" if $verbose;
say 0;
exit;
}
my $dot_product = ($x2 - $x1) * ($y2 - $y1) + ($x4 - $x1) * ($y4 - $y1);
if ($dot_product)
{
say ": Not 90 Degrees between lines 1-2 and 1-4" if $verbose;
say 0;
exit;
}
if ($x1 == $x3 && $y1 == $y3)
{
say ": Point 1 and 3 are equal" if $verbose;
say 0;
exit;
}
say 1;
[1] For each value on the command line check if it contains a comma [1a]. If yes, get the parts before and after the comma [1b] and add them to the list of arguments. If not, add the value itself [1c].
[2] Check if we have the correct number of arguments (8).
[3] Use «Scalar::Util::looks_like_number» on each value to see if they are (or
rather, look) numeric. Die if not. Note the use of map instead of a
loop.
[4] Perl does not allow chaining of the equality operator, so we must split them up.
Running it gives the same result as the Raku version:
$ ./square-points-perl 0,0 0,10 10,10 10,0
1
Note that it supports mixing of single and double arguments:
$ ./square-points-perl 0,0 0 10 10 10 10,0
1
This is not very useful, though…
And that's it.