Perl Weekly Challenge: Week 148
Challenge 1:
Eban Numbers
Write a script to generate all
Eban Numbers<= 100.An Eban number is a number that has no letter ‘e’ in it when the number is spelled in English (American or British).
Example
2, 4, 6, 30, 32 are the first 5 Eban numbers.
This is conceptually really simple. All we have to do is make a list of all the spelled-out numbers from 1 to 100 and remove the ones which have 'e's in them. But it seems to be a bit of a chore to have to write a hundred numbers. Can't the computer do it for us. The answer is... mostly. The problem is the first 19 numbers in English are irregular in construction. And 100 is the only three-digit number under consideration so it will have to be special-cased as well. I created a hash that maps these numbers to their spellings.
my %spelling = (
1 => 'one',
2 => 'two',
3 => 'three',
4 => 'four',
5 => 'five',
6 => 'six',
7 => 'seven',
8 => 'eight',
9 => 'nine',
10 => 'ten',
11 => 'eleven',
12 => 'twelve',
13 => 'thirteen',
14 => 'fourteen',
15 => 'fifteen',
16 => 'sixteen',
17 => 'seventeen',
18 => 'eighteen',
19 => 'nineteen',
100 => 'hundred'
);
The numbers from 20 to 99 are more regular. The 10'a digit is represented by a fixed word followed
by a hyphen and then the one's digit which is represented by the same word as the numbers 1 to 9. We already
have the latter so all we need to add is a list of the former. This could have been a hash like %spelling
but I chose to use an array where the index equals the 10's digit. Hence the first two entries in the array are undefined
because we don't have a word for numbers with a 0 in the 10's digit (i.e. single-digit numbers) or 1.
my @tens =
Nil,
Nil,
'twenty',
'thirty',
'forty',
'fifty',
'sixty',
'seventy',
'eighty',
'ninety',
;
Now we can automate adding entries to %spelling for 20 to 99. All these numbers begin with the appropriate word from
@tens for the value of the 10's digit. (i.e. @tens[2] or 'twenty' for 20, 21, 22 etc.) If the unit digit is 0 (i.e. 20)
we can leave it at that. If not we add a hyphen and the word from %spelling that goes with it. (i.e. %spelling{1} or 'one` for
21 making 'twenty-one' etc.)
for 20 .. 99 -> $n {
my ($ten, $unit) = $n.comb;
%spelling{$n} = @tens[$ten] ~ ($unit == 0 ?? q{} !! "-%spelling{$unit}");
}
Now solving the actual problem is easy. For each key in %spelling (numbers from 1 to 100) we filter out the ones whoes values
don't have an 'e' in them. Then we sort this list numerically, join it up with commas and spaces so it looks nice and print it.
%spelling.keys
.grep({ !%spelling{$_}.match(/e/); })
.sort({ $^a <=> $^b })
.join(q{, })
.say;
This is the Perl version.
my %spelling = (
1 => 'one',
2 => 'two',
3 => 'three',
4 => 'four',
5 => 'five',
6 => 'six',
7 => 'seven',
8 => 'eight',
9 => 'nine',
10 => 'ten',
11 => 'eleven',
12 => 'twelve',
13 => 'thirteen',
14 => 'fourteen',
15 => 'fifteen',
16 => 'sixteen',
17 => 'seventeen',
18 => 'eighteen',
19 => 'nineteen',
100 => 'hundred'
);
my @tens = (
undef,
undef,
'twenty',
'thirty',
'forty',
'fifty',
'sixty',
'seventy',
'eighty',
'ninety',
);
for my $n (20 .. 99) {
my ($ten, $unit) = split //, $n;
$spelling{$n} = $tens[$ten] . ($unit == 0 ? q{} : "-$spelling{$unit}");
}
say join q{, }, sort { $a <=> $b } grep { $spelling{$_} !~ /e/; } keys %spelling;
The complete lisr of Eban numbers under 100 is:
2, 4, 6, 30, 32, 34, 36, 40, 42, 44, 46, 50, 52, 54, 56, 60, 62, 64, 66
Challenge 2:
Cardano Triplets
Write a script to generate first 5
Cardano Triplets.A triplet of positive integers (a,b,c) is called a Cardano Triplet if it satisfies the below condition.
Example
(2,1,5) is the first Cardano Triplet.
I wouldn't be at all surprised if this is the absolute slowest way of slowing this but it was the only one my maths-averse brain could come up with.
We start with a counter for how many Cardono triplets have been found.
my $count = 0;
Now we look through all combinations of $a, $b, and $c where each ranges between 1 to 100. If you
remember from your algorithms class, this is On3. Not good at all but hopefully managable for
this problem.
for 1 .. 100 -> $a {
for 1 .. 100 -> $b {
for 1 .. 100 -> $c {
The value of $b * sqrt($c) is needed in both terms of the formula given in the spec so we might
get a small speedup by storing it instead of calculating it twice.
my $bc = $b * sqrt($c);
This is the term on the left.
my $left = ($a + $bc) ** (1/3);
I thought it would be just as easy to calculate the term on the right but I ran into problems. A little investigation revealed it is because subtraction can result in negative numbers so you need this rigmarole to get the correct answer.
my $x = $a - $bc;
my $right = $x >= 0 ?? $x ** (1/3) !! -$x.abs ** (1/3);
If the left term and the the right term equal 1 we should have a winner but again I kept getting wrong answers. It is because arithmetic with floating-point numbers can be somewhat imprecise. Rounding the answer off so it only needs to be approximately 1 will fix it.
if ($left + $right).round(0.001) == 1.0 {
If we do have a Cardano triplet, one is added to the count and it is printed.
$count++;
($a, $b, $c).join(q{, }).say;
If we have five such triplets we are finished.
if $count > 4 {
exit;
}
}
}
}
}
The Perl version was translated directly from Raku with one notable exception.
my $count = 0;
for my $a (1 .. 100) {
for my $b (1 .. 100) {
for my $c (1 .. 100) {
my $bc = $b * sqrt($c);
my $left = ($a + $bc) ** (1/3);
my $x = $a - $bc;
my $right = ($x >= 0) ? $x ** (1/3) : -abs($x) ** (1/3);
Perl doesn't have a .round() method. Rather than create my own (which probably would have all kinds of
mathematical gotchas) I turned to the Math::Round module which has a round()
function. Which is not what you want. In fact the right function is called nearest() and its' parameters are in the
opposite order from what you (or I atleast) would intuitively expect. Aaargh!
if (nearest(0.001, $left + $right) == 1.0) {
$count++;
say join q{, }, ($a, $b, $c);
if ($count > 4) {
exit;
}
}
}
}
}
The first five Cardano triplets are:
2, 1, 5
5, 1, 52
5, 2, 13
8, 3, 21
11, 4, 29