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:

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

Challenge 123

C++ solution for Part 1

C++ solution for Part 2

Rhombus

posted at: 17:00 by: Adam Russell | path: /perl | permanent link to this entry