by Arne Sommer

Numbly Numbers with Raku

 Published 5. December 2021.

This is my response to the Perl Weekly Challenge #141.

Challenge #141.1: Number Divisors

Write a script to find lowest 10 positive integers having exactly 8 divisors.

Example:
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));                     # 

my \$eight-divisors := (1..Inf).grep({ divisors(\$_).elems == 8 });  # 

say \$eight-divisors[^\$limit].join(", ");                           # 

sub divisors (\$number, :\$not-self, :\$not-one)                      # 
{
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;
}

 8 is the default value.

 Set it up as a sequence, starting with the positive integers and keeping those that have 8 divisors only.

 Print the requried number of values (8 by default).

 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

Challenge #141.2: Like Numbers

You are given positive integers, \$m and \$n.

Write a script to find total count of integers created using the digits of \$m which is also divisible by \$n.

Repeating of digits are not allowed. Order/Sequence of digits can't be altered. You are only allowed to use (n-1) digits at the most. For example, 432 is not acceptable integer created using the digits of 1234. Also for 1234, you can only have integers having no more than three digits.

Example 1:
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.
Example 2:
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  or exclude it . 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;                    # 

unit sub MAIN (PosInt \$m, PosInt \$n, :v(:\$verbose));  # 

my \$seq := gather { recurse("", \$m.comb); }           # 

my %seen;                                             # 

sub recurse(\$done, @todo is copy)                     # 
{
unless %seen{\$done}                                 # 
{
take \$done if 1 <= \$done.chars < \$m.chars;        # [8a]
%seen{\$done} = True;                              # [8b]
}

return unless @todo;                                # 
my \$next = @todo.shift;                             # 
recurse(\$done ~ \$next, @todo);                      # 
recurse(\$done, @todo);                              # 
}

my @candidates = \$seq;                                # 
my @divisible  = @candidates.grep( * %% \$n );         # 

say ": Candidates: { @candidates.join(", ") }" if \$verbose;
say ": Divisibles: { @divisible.join(", ") }"  if \$verbose;

say @divisible.elems;                                 # 

 Ensure two positive integers as input.

 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]).

 We need this to avoid duplicates. The problem is that we later on (in ) do a recursive call with the same \$done value as we got - and that would lead to duplicates from the take (in [8a]).

 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 ).

 We started with a sequence, a lazy data structure. Get it evaluated as an array.

 Get the divisible values only.

 Print the number of divisible values.

 Return new values with take. Ensure that they are unique.

 We are done when we have run out of digits.

 Get the next digit.

 Use that digit, and recurse.

 Ignore the digit, and recurse.

Note that we could have replaced the %seen code with a single unique in  (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); . Then we iterate over the values 1 to 15 , convert it to binary (zero padded, i.e. «0001» to «1111»)  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) . 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;                     # 

say ": Bitmap: { \$upto.fmt('%b') }" if \$verbose;

my @candidates;

for 1 .. \$upto -> \$mask                        # 
{
my \$bitmap = \$mask.fmt('%0' ~ \$size ~ 'b');  # 

my \$value  = (\$bitmap.comb Z \$m.comb).grep({ \$^a > 0}) \
>>.reduce({ \$^a * \$^b }).join;       # 

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;

 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.

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 ) 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.