Task — Smith numbers

Write a script to generate first 10 Smith Numbers in base 10. According to Wikipedia, a Smith number is a non-prime number for which the sum of its digits is equal to the sum of the digits of its prime factors (in a given number base).

Examples

a[1] = 4 
   4 = 2 * 2 and 2 + 2 = 4
a[2] = 22 
   22 = 2 * 11 and 2 + 11 = 13 and 1 + 3 = 4
   2 + 2 = 4
a[3] = 27
   27 = 3 * 3 * 3 and 3 + 3 + 3 = 9
   2 + 7 = 9

Analysis

A quick sampling shows that Smith numbers are not rare - there are 6 less than 100 and 49 less than 1000. Given a positive integer $n, the determination of whether it is a Smith number has only two simple steps: is it prime, is the sum of its digits equal to the sum of the digits in its prime factorization.

So a simple search will be quick and there's no need for complex maths.

Clearly for any solution we are going to need functions is_prime() and sum_of_digits(). In previous challenges we have noted that is_prime() can be obtained from Math::Prime::Util or simply by making a sieve of Eratosthenes such that is_prime[$j] yields the desired result. I'm not aware of a module that provides sum_of_digits(), but it's easily done in Perl, as is the determination of prime factors.

So I went with a pure no-modules approach. It finds 100 Smith numbers in under a second and 1000 in under the time it takes to display them.

#!/usr/bin/perl

# Peter Campbell Smith - 2021-10-05
# PWC 133 task 2

use v5.20;
use strict;
use warnings;

my ($j, $sd_of_number, @prime_factors, $k, $sd_of_prime_factors, $count, @sieve);

# make sieve of Eratosthenes
@sieve = make_sieve(1000000);     # $sieve[$j] == 1 if $j is prime or == 0 if not

# main loop
$count = 1;
for $j (2 .. 999999999) {
    next if $sieve[$j];   # not a candidate as $j is prime
    
    $sd_of_number = sum_of_digits($j);
    
    $sd_of_prime_factors = 0;
    @prime_factors = prime_factors($j);
    for $k (@prime_factors) {
        $sd_of_prime_factors += sum_of_digits($k);
    }       
    next unless $sd_of_number == $sd_of_prime_factors;
    
    say qq[a[$count] = $j];
    last if $count ++ == 10;
}

sub make_sieve {
    
    # make sieve of Eratosthenes
    my ($arg, $j, $k, @sieve);
    
    # set all values provisionally to 1 (ie prime)
    $arg = $_[0];
    for $j (0 .. $arg) {
        $sieve[$j] = 1;
    }
    
    # for each prime in turn, set its multiples to 0 (ie not prime)
    for $j (2 .. $arg) {
        next unless $sieve[$j];   # $j is not prime     
        last if $j ** 2 > $arg;
        for $k ($j .. $arg) {
            last if $k * $j > $arg;
            $sieve[$k * $j] = 0;
        }
    }
    return @sieve;
}

sub sum_of_digits {
    
    # returns sum of the digits of the argument
    my ($number, $digit, $sum);
    
    $number = $_[0];
    while ($number) {
        $digit = $number % 10;
        $sum += $digit;
        $number = ($number - $digit) / 10;
    }
    return $sum;
}

sub prime_factors {

    # return array of prime factors of argument
    my ($j, $arg, $rem, @factors);

    $arg = $_[0];
    $rem = $arg;
    for $j (2 .. $arg) {
        next unless $sieve[$j];
        while ($rem % $j == 0) {
            push @factors, $j;
            $rem /= $j;
        }
    }
    return @factors;    
}
    

Output

a[1] = 4
a[2] = 22
a[3] = 27
a[4] = 58
a[5] = 85
a[6] = 94
a[7] = 121
a[8] = 166
a[9] = 202
a[10] = 265