This is my response to the Perl Weekly Challenge #133.
$N.
Input: $N = 10
Output: 3
Input: $N = 27
Output: 5
Input: $N = 85
Output: 9
Input: $N = 101
Output: 10
On first sight the expression «Please avoid using built-in function» felt unduly problematic. We would have to make a distinction between functions and operators, which Raku simply does not make. But reading it again solved that problem. The last word is «function», in singular. A single function, which in this case clearly has to be the square root function. So any other functions (and operators) are fair game.
The simplest approach is squaring the integers, from 1 and up, and stop when we get there:
File: integer-square-root
#! /usr/bin/env raku
unit sub MAIN (Int $N where $N > 0);
for 2 .. Inf -> $guess
{
my $squared = $guess * $guess;
(say $guess; last) if $squared == $N;
(say $guess -1; last) if $squared > $N;
}
Running it:
$ ./integer-square-root 10
3
$ ./integer-square-root 27
5
$ ./integer-square-root 85
9
$ ./integer-square-root 101
10
This works for smaller numbers, but doesn't scale well:
$ ./integer-square-root 1234567890123 ## 1 second
1111111
$ ./integer-square-root 12345678901234 ## 3.5 seconds
3513641
$ ./integer-square-root 123456789012345 ## 11 seconds
11111111
$ time ./integer-square-root 1234567890123456 ## 31 seconds
35136418
The time usage is from my computer, so you will almost certainly get different results.
The wikipedia article has a working example in C of a better approach, using the right
shift operator (C: >>). Raku has this operator, but it has not been
implemented yet according to the documentation. The implementation concurs:
> "12"~>2
infix:«~>» not yet implemented. Sorry.
But it is easy to implement one:
sub lrs ($value) # [1]
{
my $binary = $value.Int.base(2); # [2]
my $new = '0' ~ $binary.substr(0, $binary.chars -1); # [3]
return $new.parse-base(2); # [4]
}
[1] LRS stands for «Logical Right Shift».
[2] Convert the input to binary, after truncating it to an integer (thus removing any non-integer part).
See
docs.raku.org/routine/base
for more information about base.
[3] Insert a zero to the left side, and chop off the rightmost digit.
[4] Convert it back to decimal, and return it.
See
docs.raku.org/routine/parse-base
for more information about parse-base.
See en.wikipedia.org/wiki/Logical_shift for more information about the algorithm.
Some examples may help:
> say 255.base(2); # -> 11111111
> say 255.base(16); # -> FF
> say "10".parse-base(16); # -> 16
> say "10".parse-base(2); # -> 2
Then the program, without explanation:
File: integer-square-root-bitwise
#! /usr/bin/env raku
unit sub MAIN (Int $N where $N > 0);
say int-sqare-root($N);
sub int-sqare-root ($number)
{
my $x0 = lrs($number);
if $x0
{
my $x1 = lrs( $x0 + $number / $x0 );
while $x1 < $x0
{
$x0 = $x1;
$x1 = lrs( $x0 + $number / $x0 );
}
return $x0;
}
else
{
return $number;
}
}
sub lrs ($value)
{
my $binary = $value.Int.base(2);
my $new = '0' ~ $binary.substr(0, $binary.chars -1);
return $new.parse-base(2);
}
Running it:
$ ./integer-square-root-bitwise 10
3
$ ./integer-square-root-bitwise 27
5
$ ./integer-square-root-bitwise 85
9
$ ./integer-square-root-bitwise 101
10
The program is much faster than the previous version (which used 31 seconds for this value):
$ ./integer-square-root-bitwise 1234567890123456 # 0.2 seconds
35136418
#! /usr/bin/env perl
use strict;
use warnings;
use feature 'say';
use feature 'signatures';
no warnings qw(experimental::signatures);
my $N = $ARGV[0] // die 'Please specify a positive integer';
die "Postive number only" unless $N =~ /^[1-9]\d+$/;
say int_sqare_root($N);
sub int_sqare_root ($number)
{
my $x0 = $number >> 1; # [1]
if ($x0)
{
my $x1 = ( $x0 + $number / $x0 ) >> 1;
while ($x1 < $x0)
{
$x0 = $x1;
$x1 = ( $x0 + $number / $x0 ) >> 1;
}
return $x0;
}
else
{
return $number;
}
}
[1] Perl has the right shift operator >>, so we use it.
Running it gives the same result as the Raku versions:
$ ./integer-square-root 10
3
$ ./integer-square-root 27
5
$ ./integer-square-root 85
9
$ ./integer-square-root 101
10
Comparing it with the Raku (bitwise) version shows that they are equally fast:
./integer-square-root-perl 1234567890123456 # 0.2 seconds
35136418
The time usage does not increase if we go for higher numbers:
$ ./integer-square-root-perl 123456789012345678901234567890 # 0.2 seconds
351364182882014
$ ./integer-square-root-bitwise 123456789012345678901234567890 # 0.2 seconds
351364182882014
Smith Numbers in base 10.
The following terms are of interest:
File: smith-numbers
#! /usr/bin/env raku
unit sub MAIN (Int $n where $n > 0 = 10); # [1]
my $smith-seq := gather # [2]
{
for 4 .. Inf -> $candidate # [3]
{
next if $candidate.is-prime; # [3a]
my @prime-factors = factors($candidate); # [4]
take $candidate if $candidate.comb.sum == @prime-factors>>.comb>>.sum.sum;
} # [5]
}
say $smith-seq[^$n].join(", "); # [6]
sub factors ($number is copy) # [7]
{
return (1) if $number == 1;
return ($number) if $number.is-prime;
my @factors;
for (2 .. $number div 2).grep( *.is-prime) -> $candidate
{
while $number %% $candidate
{
@factors.push: $candidate;
$number /= $candidate;
}
}
return @factors;
}
[1] Show 10 numbers, unless another value is specidied.
[2] Setting up the sequence with gather/take
is ideal here.
See my Raku Gather,
I Take article or
docs.raku.org/syntax/gather take for more information about
gather/take.
[3] The first Composite Number (see above) is 4, so we can start there. (Especially as 1 is not a prime, and would pass the prime test.) Then get rid of prime values [3a].
See
docs.raku.org/routine/is-prime
for more information about is-prime.
[4] Get the Prime Factors.
[5] Return the number (put it in the sequence) if the sum of the digits of the value
itself ($candidate.comb.sum) is the same as the sum of digits in all the
prime factors (@prime-factors>>.comb>>.sum.sum).
@prime-factors>>.comb replaces each number in the list with a list
of the individual digits. Then >>.sum replaces (collapses) each
sublist with the sum of the digits, and finally .sum sums up those numbers
to a single value.
[6] Print the specified number of values from the sequence. They are computed when needed, so nothing more than the requested number of values will be computed.
[7] See Ugly Points with Raku and Perl for a discussion of this procesure
See
docs.raku.org/routine/%%
for more information about the Divisibility Operator %%.
Running it:
$ ./smith-numbers
4, 22, 27, 58, 85, 94, 121, 166, 202, 265
We got the same result as the wikipedia page.
More than 10 numbers? No problem:
$ ./smith-numbers 20
4, 22, 27, 58, 85, 94, 121, 166, 202, 265, 274, 319, 346, 355, 378, 382, \
391, 438, 454, 483
We can do this much simpler:
File: smith-numbers-simple
#! /usr/bin/env raku
say "4, 22, 27, 58, 85, 94, 121, 166, 202, 265";
We were tasked to «generate first 10 Smith Numbers», and one can argue that printing them is a way of generating them. One can also argue that too much cleverness is a bad thing.
Running it gives a very unsurprising result:
$ ./smith-numbers-simple
4, 22, 27, 58, 85, 94, 121, 166, 202, 265
Let us have a go at other bases.
It is not clear from the description how we should so this, and I am unable to find any examples of resulting sequences. So this is just an educated guess:
File: smith-numbers-base
#! /usr/bin/env raku
unit sub MAIN (Int $n where $n > 0 = 10,
Int :$base where 2 <= $base <= 10 = 10);
my $smith-seq := gather
{
for 4 .. Inf -> $candidate
{
next if $candidate.is-prime;
my @prime-factors = factors($candidate);
if $base == 10
{
take $candidate
if $candidate.comb.sum == @prime-factors>>.comb>>.sum.sum;
}
else
{
take $candidate
if $candidate.base($base).comb.sum
== @prime-factors>>.base($base)>>.comb>>.sum.sum;
}
}
}
say $smith-seq[^$n].join(", ");
sub factors ($number is copy)
{
return (1) if $number == 1;
return ($number) if $number.is-prime;
my @factors;
for (2 .. $number div 2).grep( *.is-prime) -> $candidate
{
while $number %% $candidate
{
@factors.push: $candidate;
$number /= $candidate;
}
}
return @factors;
}
Running it for the possible base values:
$ ./smith-numbers-base -base=2
15, 51, 55, 85, 125, 159, 185, 190, 205, 215
$ ./smith-numbers-base -base=3
78, 186, 222, 231, 399, 402, 429, 455, 465, 475
$ ./smith-numbers-base -base=4
10, 25, 34, 46, 55, 58, 85, 106, 115, 142
$ ./smith-numbers-base -base=5
4, 70, 110, 174, 220, 222, 238, 246, 310, 318
$ ./smith-numbers-base -base=6
4, 14, 34, 49, 52, 57, 63, 74, 94, 104
$ ./smith-numbers-base -base=7
4, 27, 42, 132, 186, 195, 222, 231, 243, 258
$ ./smith-numbers-base -base=8
4, 15, 46, 52, 57, 85, 117, 143, 158, 164
$ ./smith-numbers-base -base=9
4, 16, 60, 70, 156, 220, 230, 240, 310, 348
$ ./smith-numbers-base -base=10
4, 22, 27, 58, 85, 94, 121, 166, 202, 265
Bases higher than 10 does not work, as they generate letters (as the digit '9' is followed by the letter 'A'), and letters literally doesn't add up. It is certainly possible to translate the letters to numeric values, but this problem may show that I got it wrong. So I'll leave it as it is.
#! /usr/bin/env perl
use strict;
use warnings;
use feature 'say';
use feature 'signatures';
use Math::Prime::Util qw/is_prime/;
no warnings qw(experimental::signatures);
my $n = $ARGV[0] // 10;
die "Please specify a positive integer" unless $n =~ /^[1-9]\d*$/;
my @smith_seq;
my $candidate = 3;
while (1)
{
$candidate++;
last if @smith_seq == $n;
next if is_prime($candidate);
my @digits = split(//, $candidate);
my $left = 0;
map { $left += $_ } @digits;
my $right = 0;
my @prime_factors = factors($candidate);
for my $prime (@prime_factors)
{
my @digits = split(//, $prime);
map { $right += $_ } @digits;
}
push(@smith_seq, $candidate) if $left == $right;
}
say join(", ", @smith_seq);
sub factors ($number)
{
return (1) if $number == 1;
return ($number) if is_prime($number);
my @factors;
for my $candidate (grep { is_prime($_) } 2 .. $number / 2)
{
while ($number % $candidate == 0)
{
push(@factors, $candidate);
$number /= $candidate;
}
}
return @factors;
}
Running it gives the same result as the Raku version:
$ ./smith-numbers-perl
4, 22, 27, 58, 85, 94, 121, 166, 202, 265
$ ./smith-numbers-perl 20
4, 22, 27, 58, 85, 94, 121, 166, 202, 265, 274, 319, 346, 355, 378, 382, \
391, 438, 454, 483
And that's it.