RabbitFarm

2020-11-08

Perl Weekly Challenge 085

Part 1

You are given an array of real numbers greater than zero. Write a script to find if there exists a triplet (a,b,c) such that 1 < a+b+c < 2. Print 1 if you succeed otherwise 0.

Solution


use strict;
use warnings;
##
# You are given an array of real numbers greater than zero.
# Write a script to find if there exists a triplet (a,b,c) 
# such that 1 < a+b+c < 2. Print 1 if you succeed otherwise 0.
##
use boolean;
use Math::Combinatorics;

sub build_constraints{
    my @constraints;
    my $a_not_equal_b = sub { $_[0] != $_[1] };
    my $a_not_equal_c = sub { $_[0] != $_[2] };
    my $b_not_equal_c = sub { $_[1] != $_[2] };
    my $sum_greater_than_1 = sub { 1 < ($_[0] + $_[1] + $_[2]) };
    my $sum_less_than_2 = sub { 2 > ($_[0] + $_[1] + $_[2]) };
    return (
       $a_not_equal_b,
       $a_not_equal_c,
       $b_not_equal_c,
       $sum_greater_than_1,
       $sum_less_than_2
    );
}

MAIN:{
    my $combinations = Math::Combinatorics->new(
                           count => 3,
                           data => [@ARGV],
                       );
    my $found;                  
    while(my @combination = $combinations->next_combination()){  
        $found = true;  
        for my $constraint (build_constraints()){
            if(!$constraint->(@combination)){
                $found = false;
                last;
            }
        }
        do{ print "1\n"; last; } if($found);
    }
    print "0\n" if(!$found);
}

Sample Run


$ perl perl/ch-1.pl 0.1 1.2 3.4 0.2
1
$ perl perl/ch-1.pl 1.1 1.2 3.4 0.2
0

Notes

I decided to try a constraint programming approach for this. While there are several modules for doing this available on CPAN I didn’t want to quite go so deep down that rabbithole. Instead I took the simpler path of implementing each constraint as a subroutine stored in an array. For each candidate combination the constraints are tests. Since all constraints must be satisfied if any one returns a false value then we can move immediately to the next combination.

Part 2

You are given a positive integer $N. Write a script to find if it can be expressed as a ** b where a > 0 and b > 1. Print 1 if you succeed otherwise 0.

Solution


use strict;
use warnings;
##
# You are given a positive integer $N.
# Write a script to find if it can be expressed
# as a ^ b where a > 0 and b > 1. 
# Print 1 if you succeed otherwise 0.
##
use boolean;

sub log_a{
    my($a, $n) = @_;
    return log($n)/log($a);
}

MAIN:{
    my $N = $ARGV[0];
    my $found = false;                  
    for my $a (2 .. $N){ 
        my $b = log_a($a, $N);
        if($b =~ /^[-]?\d+$/ && $b > 1){ 
            print "1\n";
            $found = true;
            last;
        }
    }
    print "0\n" if(!$found);
}

Sample Run


$ perl perl/ch-2.pl 7
0
$ perl perl/ch-2.pl 9
1

Notes

I was tempted to repeat roughly the same design as Part 1 and use constraints but that really would be over engineering it! Instead here we just loop over all possible values $a and test using logarithms to see if $b holds an integer value. There seems to be a number of ways to do the test to determine if a scalar holds an integer but a regex seems maybe the most idiomatically Perlish way.

posted at: 16:20 by: Adam Russell | path: /perl | permanent link to this entry