This is my response to the Perl Weekly Challenge #141.
lowest 10 positive integers having exactly
8 divisors.
24 is the first such number having exactly 8 divisors.
1, 2, 3, 4, 6, 8, 12 and 24.
The «divisors» function, which I introduced way back in Centenary Sequences with Raku - Part 5: Divisors and Factors, comes in handy here:
File: number-divisors
#! /usr/bin/env raku
unit sub MAIN (Int $limit = 8, :v(:$verbose)); # [1]
my $eight-divisors := (1..Inf).grep({ divisors($_).elems == 8 }); # [2]
say $eight-divisors[^$limit].join(", "); # [3]
sub divisors ($number, :$not-self, :$not-one) # [4]
{
my @divisors;
for ($not-one ?? 2 !! 1) .. $number/2 -> $candidate
{
@divisors.push: $candidate if $number %% $candidate;
}
@divisors.push: $number unless $not-self;
say ": $number has { @divisors.elems } divisors: { @divisors.join(", ") }"
if $verbose;
return @divisors;
}
[1] 8 is the default value.
[2] Set it up as a sequence, starting with the positive integers and keeping those that have 8 divisors only.
[3] Print the requried number of values (8 by default).
[4] The procedure doing the real work.
Running it:
./number-divisors
24, 30, 40, 42, 54, 56, 66, 70
$ ./number-divisors 10
24, 30, 40, 42, 54, 56, 66, 70, 78, 88
With verbose mode:
$ ./number-divisors -v
: 1 has 1 divisors: 1
: 2 has 2 divisors: 1, 2
: 3 has 2 divisors: 1, 3
: 4 has 3 divisors: 1, 2, 4
: 5 has 2 divisors: 1, 5
: 6 has 4 divisors: 1, 2, 3, 6
: 7 has 2 divisors: 1, 7
: 8 has 4 divisors: 1, 2, 4, 8
: 9 has 3 divisors: 1, 3, 9
: 10 has 4 divisors: 1, 2, 5, 10
: 11 has 2 divisors: 1, 11
: 12 has 6 divisors: 1, 2, 3, 4, 6, 12
: 13 has 2 divisors: 1, 13
: 14 has 4 divisors: 1, 2, 7, 14
: 15 has 4 divisors: 1, 3, 5, 15
: 16 has 5 divisors: 1, 2, 4, 8, 16
: 17 has 2 divisors: 1, 17
: 18 has 6 divisors: 1, 2, 3, 6, 9, 18
: 19 has 2 divisors: 1, 19
: 20 has 6 divisors: 1, 2, 4, 5, 10, 20
: 21 has 4 divisors: 1, 3, 7, 21
: 22 has 4 divisors: 1, 2, 11, 22
: 23 has 2 divisors: 1, 23
: 24 has 8 divisors: 1, 2, 3, 4, 6, 8, 12, 24
: 25 has 3 divisors: 1, 5, 25
: 26 has 4 divisors: 1, 2, 13, 26
: 27 has 4 divisors: 1, 3, 9, 27
: 28 has 6 divisors: 1, 2, 4, 7, 14, 28
: 29 has 2 divisors: 1, 29
: 30 has 8 divisors: 1, 2, 3, 5, 6, 10, 15, 30
: 31 has 2 divisors: 1, 31
: 32 has 6 divisors: 1, 2, 4, 8, 16, 32
: 33 has 4 divisors: 1, 3, 11, 33
: 34 has 4 divisors: 1, 2, 17, 34
: 35 has 4 divisors: 1, 5, 7, 35
: 36 has 9 divisors: 1, 2, 3, 4, 6, 9, 12, 18, 36
: 37 has 2 divisors: 1, 37
: 38 has 4 divisors: 1, 2, 19, 38
: 39 has 4 divisors: 1, 3, 13, 39
: 40 has 8 divisors: 1, 2, 4, 5, 8, 10, 20, 40
: 41 has 2 divisors: 1, 41
: 42 has 8 divisors: 1, 2, 3, 6, 7, 14, 21, 42
: 43 has 2 divisors: 1, 43
: 44 has 6 divisors: 1, 2, 4, 11, 22, 44
: 45 has 6 divisors: 1, 3, 5, 9, 15, 45
: 46 has 4 divisors: 1, 2, 23, 46
: 47 has 2 divisors: 1, 47
: 48 has 10 divisors: 1, 2, 3, 4, 6, 8, 12, 16, 24, 48
: 49 has 3 divisors: 1, 7, 49
: 50 has 6 divisors: 1, 2, 5, 10, 25, 50
: 51 has 4 divisors: 1, 3, 17, 51
: 52 has 6 divisors: 1, 2, 4, 13, 26, 52
: 53 has 2 divisors: 1, 53
: 54 has 8 divisors: 1, 2, 3, 6, 9, 18, 27, 54
: 55 has 4 divisors: 1, 5, 11, 55
: 56 has 8 divisors: 1, 2, 4, 7, 8, 14, 28, 56
: 57 has 4 divisors: 1, 3, 19, 57
: 58 has 4 divisors: 1, 2, 29, 58
: 59 has 2 divisors: 1, 59
: 60 has 12 divisors: 1, 2, 3, 4, 5, 6, 10, 12, 15, 20, 30, 60
: 61 has 2 divisors: 1, 61
: 62 has 4 divisors: 1, 2, 31, 62
: 63 has 6 divisors: 1, 3, 7, 9, 21, 63
: 64 has 7 divisors: 1, 2, 4, 8, 16, 32, 64
: 65 has 4 divisors: 1, 5, 13, 65
: 66 has 8 divisors: 1, 2, 3, 6, 11, 22, 33, 66
: 67 has 2 divisors: 1, 67
: 68 has 6 divisors: 1, 2, 4, 17, 34, 68
: 69 has 4 divisors: 1, 3, 23, 69
: 70 has 8 divisors: 1, 2, 5, 7, 10, 14, 35, 70
24, 30, 40, 42, 54, 56, 66, 70
$m and $n.
$m which is also divisible by $n.
Input: $m = 1234, $n = 2
Output: 9
Possible integers created using the digits of 1234 are:
1, 2, 3, 4, 12, 13, 14, 23, 24, 34, 123, 124, 134 and 234.
There are 9 integers divisible by 2 such as:
2, 4, 12, 14, 24, 34, 124, 134 and 234.
Input: $m = 768, $n = 4
Output: 3
Possible integers created using the digits of 768 are:
7, 6, 8, 76, 78 and 68.
There are 3 integers divisible by 4 such as:
8, 76 and 68.
Let us do this with recursion.
The idea is to fork off in two directions at each digit; either include it [11] or exclude it [12]. In addition we have a result (partial number) at any time [8a].
File: like-numbers
#! /usr/bin/env raku
subset PosInt of Int where * >= 1; # [1]
unit sub MAIN (PosInt $m, PosInt $n, :v(:$verbose)); # [1]
my $seq := gather { recurse("", $m.comb); } # [2]
my %seen; # [3]
sub recurse($done, @todo is copy) # [4]
{
unless %seen{$done} # [8]
{
take $done if 1 <= $done.chars < $m.chars; # [8a]
%seen{$done} = True; # [8b]
}
return unless @todo; # [9]
my $next = @todo.shift; # [10]
recurse($done ~ $next, @todo); # [11]
recurse($done, @todo); # [12]
}
my @candidates = $seq; # [5]
my @divisible = @candidates.grep( * %% $n ); # [6]
say ": Candidates: { @candidates.join(", ") }" if $verbose;
say ": Divisibles: { @divisible.join(", ") }" if $verbose;
say @divisible.elems; # [7]
[1] Ensure two positive integers as input.
[2] Setting up the sequence with gather/take
is ideal here, with a recurisve procedure. The actual take is hidden away
in the recursive procedure (see [8a]).
See my Raku Gather,
I Take article or
docs.raku.org/syntax/gather take for more information about
gather/take.
[3] We need this to avoid duplicates. The problem is that we later on (in [12]) do
a recursive call with the same $done value as we got - and that would lead
to duplicates from the take (in [8a]).
[4] The first argument is the number so far, as a string. The second is th remaining digits,
as a list. Note the is copy so that we can change the array (with shift
in [10]).
[5] We started with a sequence, a lazy data structure. Get it evaluated as an array.
[6] Get the divisible values only.
[7] Print the number of divisible values.
[8] Return new values with take. Ensure that they are unique.
[9] We are done when we have run out of digits.
[10] Get the next digit.
[11] Use that digit, and recurse.
[12] Ignore the digit, and recurse.
Note that we could have replaced the %seen
code with a single unique in [5] (at the end). But it is nicer to have the
algorithm douing the right thing.
Running it:
$ ./like-numbers 1234 2
9
$ ./like-numbers 768 4
3
Looking good.
With verbose mode:
$ ./like-numbers -v 1234 2
: Candidates: 1, 12, 123, 124, 13, 134, 14, 2, 23, 234, 24, 3, 34, 4
: Divisibles: 12, 124, 134, 14, 2, 234, 24, 34, 4
9
$ ./like-numbers -v 768 4
: Candidates: 7, 76, 78, 6, 68, 8
: Divisibles: 76, 68, 8
3
The other way I can think of involves a binary bitmap. In the case with a four digit number, we get a bitmap of «1111» (or 15 decimal); [1]. Then we iterate over the values 1 to 15 [2], convert it to binary (zero padded, i.e. «0001» to «1111») [3] and use that as a bitmap ANDing it on the original number to decide if the digit should be included (binary 1) or not (binary 0) [4]. No recursion on this one, but the code calculating the candidates is quite complicated.
File: like-numbers-bitmap
#! /usr/bin/env raku
subset PosInt of Int where * >= 1;
unit sub MAIN (PosInt $m, PosInt $n, :v(:$verbose));
my $size = $m.chars;
my $upto = 2 ** $size - 1; # [1]
say ": Bitmap: { $upto.fmt('%b') }" if $verbose;
my @candidates;
for 1 .. $upto -> $mask # [2]
{
my $bitmap = $mask.fmt('%0' ~ $size ~ 'b'); # [3]
my $value = ($bitmap.comb Z $m.comb).grep({ $^a[0] > 0}) \
>>.reduce({ $^a * $^b }).join; # [4]
say ": Candidate: $m AND $bitmap -> $value" if $verbose;
@candidates.push: $value unless $value.chars == $size;
}
my @divisible = @candidates.grep( * %% $n );
say ": Candidates: { @candidates.join(", ") }" if $verbose;
say ": Divisibles: { @divisible.join(", ") }" if $verbose;
say @divisible.elems;
[4]
The zip operator Z merges the two lists, forming
pairs of values. The first value in the pair is the one from the bitmap (0 or 1),
and the second is the value from the original number. The grep gets
rid of pairs where the first value (from the bitmap) is zero, as they should not
be included. The reduce reduces the remaining pars to the single
value from the number, by multiplying the two values of the pair (as the first
one is 1). Probably not the best way, but it works. And finally we slap on a
join to get the individial digits as a single string.
See
docs.raku.org/routine/Z for
more information about the zip operator Z.
See
docs.raku.org/routine/reduce for
more information about reduce.
Running it gives the same result as the recursive version, but verbose mode is more verbose.
$ ./like-numbers-bitmap -v 1234 2
: Bitmap: 1111
: Candidate: 1234 AND 0001 -> 4
: Candidate: 1234 AND 0010 -> 3
: Candidate: 1234 AND 0011 -> 34
: Candidate: 1234 AND 0100 -> 2
: Candidate: 1234 AND 0101 -> 24
: Candidate: 1234 AND 0110 -> 23
: Candidate: 1234 AND 0111 -> 234
: Candidate: 1234 AND 1000 -> 1
: Candidate: 1234 AND 1001 -> 14
: Candidate: 1234 AND 1010 -> 13
: Candidate: 1234 AND 1011 -> 134
: Candidate: 1234 AND 1100 -> 12
: Candidate: 1234 AND 1101 -> 124
: Candidate: 1234 AND 1110 -> 123
: Candidate: 1234 AND 1111 -> 1234
: Candidates: 4, 3, 34, 2, 24, 23, 234, 1, 14, 13, 134, 12, 124, 123
: Divisibles: 4, 34, 2, 24, 234, 14, 134, 12, 124
9
$ ./like-numbers-bitmap -v 768 4
: Bitmap: 111
: Candidate: 768 AND 001 -> 8
: Candidate: 768 AND 010 -> 6
: Candidate: 768 AND 011 -> 68
: Candidate: 768 AND 100 -> 7
: Candidate: 768 AND 101 -> 78
: Candidate: 768 AND 110 -> 76
: Candidate: 768 AND 111 -> 768
: Candidates: 8, 6, 68, 7, 78, 76
: Divisibles: 8, 68, 76
3
The heavy lifting (in line [4]) can be refactored to something much easier on the eye (and mind):
File: like-numbers-bitmap2 (changes only)
my $value =
$m.comb.grep({ state $index = 0; $bitmap.substr($index++,1) > 0 }).join;
This time we iterate over the digits in the numbers, letting them through if the corresponding digit (using the index via a state variable) is set (> 0) in the mask.
See
docs.raku.org/syntax/state for
more information about the variable declarator state.
The result of running this version is the same:
$ ./like-numbers-bitmap2 1234 2
9
$ ./like-numbers-bitmap2 768 4
3
And that's it.