laurent_r

These are some answers to the Week 141 of the Perl Weekly Challenge organized by Mohammad S. Anwar.

Spoiler Alert: This weekly challenge deadline is due in a few days from now (on December 5, 2021 at 24:00). This blog post offers some solutions to this challenge, please don’t read on if you intend to complete the challenge on your own.

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

This is quite straight forward. We can look at consecutive integers, count their factors, and stop when we reach ten integers having 8 divisors.

Number Divisors in Raku

We create an infinite list of integers (from 8 to infinity), and, for each such integer, call the has_8_divisors subroutine, which computes all factors of the input integer and returns True if it has eight divisors. This subroutine checks every integer between 1 and the input integer and filters out those that do not divide evenly the input number (using the Raku built-in infix %% divisibility operator).

use v6;

sub has_8_divisors (UInt $n) {
    my @divisors = grep {$n %% $_}, 1..$n;
    return @divisors.elems == 8;
}

my $count = 0;
for 8..Inf -> $m {
    say $m and $count++ if has_8_divisors $m;
    last if $count >= 10;
}

This script displays the following output:

$ raku ./eight-div.raku
24
30
40
42
54
56
66
70
78
88

It is interesting to notice that the first 10 integers having exactly eight divisors are all even. With a small change to the above program (changing the maximal value of $count), you could find out that the first odd such integer is the 13th one, 105.

Number Divisors in Perl

This is essentially a port to Perl of the above program:

use strict;
use warnings;
use feature "say";

sub has_8_divisors {
    my $n = shift;
    my @divisors = grep {$n % $_ == 0} 1..$n;
    return @divisors == 8;
}

my $count = 0;
for my $m (8..1_000_000) {
    say $m and $count++ if has_8_divisors $m;
    last if $count >= 10;
}

This script displays the following output:

$ perl ./eight-div.pl
24
30
40
42
54
56
66
70
78
88

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

Like Numbers in Raku

In Raku, we use the built-in combinations method to generate all numbers with at most one digit less than the input integer that can be derived from the input number. We then filter out those which are not evenly divided by the other input integer. And finally print out the number of such integers.

use v6;

sub like_numbers (UInt $m, UInt $n) {
    my @digits = $m.comb;
    return grep { $_ %% $n }, 
        (@digits.combinations: 1..$m.chars-1)>>.join(''); 
}
for (1234, 2), (768, 4) -> $test {
    my @vals = like_numbers $test[0], $test[1];
    # say @vals; # -> [2 4 12 14 24 34 124 134 234]
    say "$test => ", @vals.elems;
}

This script displays the following output:

raku ./like-nums.raku
1234 2 => 9
768 4 => 3

Like Numbers in Perl

This is essentially a port to Perl of the above Raku program. The main difference is that we need to roll out our own combine recursive subroutine.

use strict;
use warnings;
use feature "say";

my @result;

sub combine {
    my $part_comb = shift;
    my @digits = @{$_[0]};
    my $max_size = $_[1];
    push @result, $part_comb unless $part_comb eq "";
    return if length $part_comb >= $max_size;
    for my $i (0..$#digits) {
        my $new_comb = $part_comb . $digits[$i];
        combine($new_comb, [ @digits[$i+1..$#digits]], $max_size);
    }
}
sub like_numbers {
    my $n = shift;
    my @digits = split //, shift;
    combine ("", [@digits], @digits - 1);
    return grep { $_ % $n == 0 } @result;
}
for my $test ( [2, 1234], [4, 768] ) {
    @result = ();
    my @vals = like_numbers $test->[0], $test->[1];
    # say "@vals"; # -> 12 124 134 14 2 234 24 34 4
    say "@$test => ", scalar @vals;
}

This script displays the following output:

$ perl  ./like-nums.pl
2 1234 => 9
4 768 4 => 3

Wrapping up

The next week Perl Weekly Challenge will start soon. If you want to participate in this challenge, please check https://perlweeklychallenge.org/ and make sure you answer the challenge before 23:59 BST (British summer time) on December 12, 2021. And, please, also spread the word about the Perl Weekly Challenge if you can.