with Raku and Perl

This is my response to the Perl Weekly Challenge #123.

You are given an integer

Write a script to find the $n^{th} 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:

`$n`

>= 1.
Write a script to find the $n

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 $n^{th} 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 150^{th} 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

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]

#! /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

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.

Example:

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

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

File: square-points-multi
#! /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

#! /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.