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

The Weekly Challenge 123 (Prolog Solutions)

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


:-initialization(main).  

prime_factors(N, L):- 
    N > 0,  
    prime_factors(N, L, 2).
prime_factors(1, [], _):- 
    !.
prime_factors(N, [F|L], F):-                     
    R is N // F, 
    N =:= R * F, 
    !, 
    prime_factors(R, L, F).
prime_factors(N, L, F):-
    next_factor(N, F, NF), 
    prime_factors(N, L, NF).
next_factor(_, 2, 3):- 
    !.
next_factor(N, F, NF):- 
    F * F < N, 
    !, 
    NF is F + 2.
next_factor(N, _, N).

ugly(N, UglyNumber):-
    ugly(N, 1, 1, _, UglyNumber).  
ugly(1, _, _, _, 1).
ugly(N, _, N, UglyNumber, UglyNumber).
ugly(N, X, I, _, UglyNumber):-  
    prime_factors(X, Factors), 
    member(Factor, Factors),   
    (Factor == 2; Factor == 3; Factor == 5), 
    X0 is X + 1,  
    I0 is I + 1,
    ugly(N, X0, I0, X, UglyNumber).  
ugly(N, X, I, UglyNext, UglyNumber):-  
    X0 is X + 1,  
    ugly(N, X0, I, UglyNext, UglyNumber).  

main:-
    ugly(10, UglyNumber),
    write(UglyNumber), nl,
    halt.   

Sample Run


$ gplc prolog/ch-1.p 
$ prolog/ch-1   
12

Notes

Here the first N ugly numbers are generated in a pretty routine way. Much of the code is related to computing the prime factors. Once that is out of way the rest of the code seems to be straightforward to follow: recursively counting up each Ugly Number until we reach the Nth one.

Part 2

You are given coordinates of four points. Write a script to find out if the given four points form a square.

Solution


:-initialization(main).  

dot_product(X0-Y0, X1-Y1, N):-
    N0 is X0 * X1,
    N is N0 + Y0 * Y1.  

swap_key_value([], []).
swap_key_value([A-B|R], [B-A|S]):-
    swap_key_value(R, S). 

square(Points):-
    setof(X, member(X-_, Points),  Xs),    
    setof(Y, member(_-Y, Points),  Ys),    
    length(Xs, LXs),
    length(Ys, LYs), 

    keysort(Points, PointsByX),    
    swap_key_value(Points, Swapped),
    keysort(Swapped, PointsByY0),    
    swap_key_value(PointsByY0, PointsByY),
    last(PointsByY, Sx-Sy),  
    last(PointsByX, Tx-Ty),  
    nth(1, PointsByY, Ux-Uy),  
    nth(1, PointsByX, Vx-Vy), 
    SUx is Sx + Ux,
    TVx is Tx + Vx,
    SUy is Sy + Uy,
    TVy is Ty + Vy,
    SUym is Sy - Uy,
    TVxm is Tx - Vx,

    DVSTx is Sx - Tx,
    DVSTy is Sy - Ty,
    DVTUx is Tx - Ux,
    DVTUy is Ty - Uy,
    DVUVx is Ux - Vx,
    DVUVy is Uy - Vy,
    DVVSx is Vx - Sx,
    DVVSy is Vy - Sy,

    dot_product(DVSTx-DVSTy, DVTUx-DVTUy, DPSTU),   
    dot_product(DVTUx-DVTUy, DVUVx-DVUVy, DPTUV),   
    dot_product(DVUVx-DVUVy, DVVSx-DVVSy, DPUVS),   

    ((LXs == 2, LYs == 2); (SUx == TVx, SUy == TVy, SUym == TVxm, DPSTU == 0, DPTUV == 0, DPUVS == 0)). 


main:-
    ((square([10-20, 20-20, 20-10, 10-10]), write(1)); (write(0))), 
    nl,
    ((square([12-24, 16-10, 20-12, 18-16]), write(1)); (write(0))), 
    nl,
    ((square([-3-1, 4-2, -(9,-3), -(2,-4)]), write(1)); (write(0))), 
    nl,
    ((square([0-0, 2-1, -(3,-1), -(1,-2)]), write(1)); (write(0))), 
    nl,
    halt.

Sample Run


$ gplc prolog/ch-2.p
$ prolog/ch-2
1
0
0
1

Notes

This is most likely the most tedious Prolog code I have written in a long time! The actual logic of determining if the points determine a square is not so bad:

The tedious part is just all the computation of the distance vectors, the sorting and arranging of the points, and so forth.

The points are represented as pairs. To orient the points they are sorted by X (key) or Y (value). This is both done by the builtin keysort/2 predicate, with keys and values swapped to facilitate the sorting by value.

In the case of negative co-ordinates we use the alternative (-)/2 syntax. For example, -(3,-1) is used since 3--1 is not valid syntactically.

In the example output we see that the first and last sets of points are both squares. The first is an example of a square with two unique X and Y co-ordinates. The third example is a rhombus and so is a good test to make sure the angles are being checked correctly.

References

Challenge 123

Rhombus

posted at: 16:58 by: Adam Russell | path: /prolog | permanent link to this entry