RabbitFarm
2021-08-01
Ugly Numbers / Square Points
The examples used here are from The Weekly Challenge problem statement and demonstrate the working solution.
Part 1
You are given an integer $n >= 1. Write a script to find the $nth Ugly Number.
Solution
use strict;
use warnings;
use boolean;
sub prime_factor{
my $x = shift(@_);
my @factors;
for (my $y = 2; $y <= $x; $y++){
next if $x % $y;
$x /= $y;
push @factors, $y;
redo;
}
return @factors;
}
sub is_ugly{
my($x) = @_;
for my $factor (prime_factor($x)){
return false if $factor != 2 && $factor != 3 && $factor !=5;
}
return true;
}
sub nth_ugly{
my($n) = @_;
return 1 if $n == 1;
my $ugly_count = 1;
my $i = 1;
do{
$i++;
$ugly_count++ if is_ugly($i);
}while($ugly_count != $n);
return $i;
}
MAIN:{
my($N);
$N = 7;
print nth_ugly($N) . "\n";
$N = 10;
print nth_ugly($N) . "\n";
}
Sample Run
$ perl perl/ch-1.pl
8
12
Notes
I also worked this problem in Prolog and C++ and, unsurprisingly, the Perl code is the shortest. All three solutions followed the same approach but Perl's syntax is naturally less verbose without making comprehension of the code more difficult.
Part 2
You are given co-ordinates for four points. Write a script to find out if the given four points form a square.
Solution
use strict;
use warnings;
use boolean;
use Math::GSL::Vector;
sub unique{
my %seen;
return grep {!$seen{$_}++} @_;
}
sub is_square{
my @points = @_;
##
# Definitely a square if there are only 2 x and 2 y values.
##
my @x = unique(map {$_->[0]} @points);
my @y = unique(map {$_->[1]} @points);
return true if @x == 2 && @y == 2;
##
# sort the points and compute side lengths
##
my @sorted_x = sort {$a->[0] <=> $b->[0]} @points;
my @sorted_y = sort {$a->[1] <=> $b->[1]} @points;
my($s, $t, $u, $v) = ($sorted_y[@sorted_y - 1], $sorted_x[@sorted_x - 1], $sorted_y[0], $sorted_x[0]);
return false if $s->[0] + $u->[0] != $t->[0] + $v->[0];
return false if $s->[1] + $u->[1] != $t->[1] + $v->[1];
return false if $s->[1] - $u->[1] != $t->[0] - $v->[0];
##
# compute angles
##
my $dv_st = new Math::GSL::Vector([$s->[0] - $t->[0], $s->[1] - $t->[1]]);
my $dv_tu = new Math::GSL::Vector([$t->[0] - $u->[0], $t->[1] - $u->[1]]);
my $dv_uv = new Math::GSL::Vector([$u->[0] - $v->[0], $u->[1] - $v->[1]]);
my $dv_vs = new Math::GSL::Vector([$v->[0] - $s->[0], $v->[1] - $s->[1]]);
return false if $dv_st * $dv_tu != 0;
return false if $dv_tu * $dv_uv != 0;
return false if $dv_uv * $dv_vs != 0;
return true;
}
MAIN:{
my @points;
@points = ([10, 20], [20, 20], [20, 10], [10, 10]);
print is_square(@points) . "\n";
@points = ([12, 24], [16, 10], [20, 12], [18, 16]);
print is_square(@points) . "\n";
@points = ([-3, 1], [4, 2], [9, -3], [2, -4]);
print is_square(@points) . "\n";
@points = ([0, 0], [2, 1], [3, -1], [1, -2]);
print is_square(@points) . "\n";
}
Sample Run
$ perl perl/ch-2.pl
1
0
0
1
Notes
The logic of determining if the points determine a square is clear to most people familiar with geometry:
- Are there only two each of X and Y co-ordinates? Then that is enough to establish that we have a square.
- Otherwise, make sure the side lengths are all equivalent and that the angles between the sides are all 90 degrees.
The code in is_square()
works through that logic with multiple exit points set up along
the way. Perhaps this is a bit odd looking but I have been doing a lot of logic
programming in Prolog recently and thought to give a somewhat more logical style to this
perl solution to this problem. Developing a more logical style for Perl is a bit of a work
in progress for me, I will admit!
The unique
function (and it's clever use of grep
!) was taken from a
PerlMaven article.
References
posted at: 17:00 by: Adam Russell | path: /perl | permanent link to this entry