Perl Weekly Challenge 141.

My solutions (task 1 and task 2 ) to the The Weekly Challenge - 141.

Task 1: Number Divisors

Submitted by: Mohammad S Anwar
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.

This problem has a very nice solution using a kind of Eratosthenes sieve in reverse. I make an array for the first N integers and initialize it to zero. Then, for each integer N>=n>0 I add 1 to the cells corresponding to all its multiples. Then, the result consists of the first cells that end up with an 8. This can be programed with PDL in a simple one-liner.

perl -MPDL -MPDL::NiceSlice -E '$N=100;$a=zeroes $N;
   $a($_:-1:$_)+=1 for(1..$N-1);
   say $a->xvals->where($a==8)->(0:9);'

I arbitrarily chose $N=100. If it didn’t work, I could choose a larger number. The statement $a=zeroes($N) prepares and array of zeroes. $a($_:-1:$_) is a slice of $a starting at position $_ and going to the end (-1) in steps of $_. I increment those cells with $_ taking all possible values 1..$N-1. $a->xvals is an array with the first $N numbers, and ->where($a==8) selects those elements corresponding to numbers with exactly 8 divisors. Finally, ->(0:7) selects the first 8 of them.

The result is:

[24 30 40 42 54 56 66 70 78 88]

A longer version is

 1  # Perl weekly challenge 141
 2  # Task 1: Number divisors
 3  #
 4  # See https://wlmb.github.io/2021/11/29/PWC141/#task-1-number-divisors
 5  use v5.12;
 6  use warnings;
 7  use PDL;
 8  use PDL::NiceSlice;
 9  #Set defaults and params. from com. line
10  my %params=(try=>100, divisors=>8, results=>10, @ARGV);
11  my ($try, $divisors, $results)
12      =@params{qw(try divisors results)};
13  my $cells=zeroes $try;
14  # count divisors for each number
15  $cells($_:-1:$_)+=1 for(1..$try-1);
16  # find all d-multiples
17  my $multiples=$cells->xvals->where($cells==$divisors);
18  die "Need to increase try" unless $multiples->nelem>=$results;
19  my $out=$multiples(0:$results-1);
20  say "try=$try, divisors=$divisors, results=$results, out=$out";

Examples:

./ch-1.pl
./ch-1.pl try 100 divisors 8 results 10 # explicit parameters
./ch-1.pl try 20000 divisors 7 results 3  # other parameters
./ch-1.pl try 100 divisors 2 results 10

Results:

try=100, divisors=8, results=10, out=[24 30 40 42 54 56 66 70 78 88]
try=100, divisors=8, results=10, out=[24 30 40 42 54 56 66 70 78 88]
try=20000, divisors=7, results=3, out=[64 729 15625]
try=100, divisors=2, results=20, out=[2 3 5 7 11 13 17 19 23 29 31 37 41 43 47 53 59 61 67 71]

The last example prints the first 20 primes, that is, numbers with exactly two divisors, 1 and themselves.

Task 2: Like Numbers

Submitted by: Mohammad S Anwar
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.

For a l-digit number d=dl…d1d0, the possible ordered choices of digits may be obtained by counting from 1 up to 2d-2 (2d-1 if you allow for the complete number) and choosing those digits dn that correspond to a 1 in the n-th position in the binary representation of the number n. It might be overkill, but I like the fact that PDL has a method where to chose from one array those elements for which some other array has a non-null value. Thus I propose this cryptic one-liner solution

perl -MPDL -MPDL::NiceSlice -E '($m,$n)=@ARGV; $l=length $m; $d=pdl[split "", $m];
     say "m=$m, n=$n, Out=", scalar grep {$_!~/^0/&&$_%$n==0} map {join "",
     ($d->where(pdl([split "", sprintf "%b", $_])->(-1:0)))->list} 1..2**$l-2' 1234 2

I read $m and $n from the command line. Compute the length $l of $m and initialize and array $d of digits. Then I use the bits of all numbers from 1 upto 2**$l-2 as a mask to choose digits from which I build the numbers to try, which I filter for divisibility with grep and count them. I also filter out numbers that start with 0.

The result is

m=1234, n=2, Out=9

A second example is

perl -MPDL -MPDL::NiceSlice -E '($m,$n)=@ARGV; $l=length $m; $d=pdl[split "", $m];
     say "m=$m, n=$n, Out=", scalar grep {$_%$n==0} map {join "",
     ($d->where(pdl([split "", sprintf "%b", $_])->(-1:0)))->list} 1..2**$l-2' 768 4

with results

m=768, n=4, Out=3

The full version is

 1  # Perl weekly challenge 141
 2  # Task 2: Like numbers
 3  #
 4  # See https://wlmb.github.io/2021/11/29/PWC141/#task-2-like-numbers
 5  use v5.12;
 6  use warnings;
 7  use PDL;
 8  use PDL::NiceSlice;
 9
10  die "Usage: ./ch-2.pl m n" unless @ARGV==2;
11  my ($m,$n)=@ARGV;
12  my $l=length $m;
13  my $digits=pdl[split "", $m];
14  my $multiples= pdl [
15      sort {$a<=>$b}
16           grep {$_!~/^0/&&$_%$n==0}
17           map {
18  	     my $bits=pdl([split "", sprintf "%b", $_]);
19  	     join "", $digits->where($bits->(-1:0))->list;
20      } 1..2**$l-2
21      ];
22  say "m=$m, n=$n, Out=", $multiples->nelem,
23      "\nas multiples=$multiples";

Examples:

./ch-2.pl 1234 2
./ch-2.pl 768 4

Results:

m=1234, n=2, Out=9
as multiples=[2 4 12 14 24 34 124 134 234]
m=768, n=4, Out=3
as multiples=[8 68 76]

Anther example:

./ch-2.pl 1034 2

Results:

m=1034, n=2, Out=6
as multiples=[4 10 14 34 104 134]

Notice that I would have obtained 9 had I not filtered out leading zeroes, as 0, 04 and 034 are also multiples. Actually, I’m not sure if 0 is expected to qualify as a multiple.

Written on November 29, 2021