Smith numbers: Difference between revisions

From Rosetta Code
Content added Content deleted
m (Fixed translation note.)
m (added highlighting to the task's preamble.)
Line 4: Line 4:
By definition, all primes are ''excluded'' as they (naturally) satisfy this condition!
By definition, all primes are ''excluded'' as they (naturally) satisfy this condition!


Smith numbers are also known as joke numbers.
Smith numbers are also known as   ''joke''   numbers.





Revision as of 19:49, 8 September 2017

Task
Smith numbers
You are encouraged to solve this task according to the task description, using any language you may know.

Smith numbers are numbers such that the sum of the decimal digits of the integers that make up that number is the same as the sum of the decimal digits of its prime factors excluding 1.

By definition, all primes are excluded as they (naturally) satisfy this condition!

Smith numbers are also known as   joke   numbers.


Example

Using the number 166
Find the prime factors of 166 which are: 2 x 83
Then, take those two prime factors and sum all their decimal digits: 2 + 8 + 3 which is 13
Then, take the decimal digits of 166 and add their decimal digits: 1 + 6 + 6 which is 13
Therefore, the number 166 is a Smith number.


Task

Write a program to find all Smith numbers below 10000.


See also



Ada

Works with: Ada version 2012

<lang ada> with Ada.Text_IO;

procedure smith is

 type Vector is array (natural range <>) of Positive;
 empty_vector : constant Vector(1..0):= (others=>1);
 
 function digits_sum (n : Positive) return Positive is 
 (if n < 10 then n else n mod 10 + digits_sum (n / 10));
 function prime_factors (n : Positive; d : Positive := 2) return Vector is 
 (if n = 1 then empty_vector elsif n mod d = 0 then prime_factors (n / d, d) & d
  else prime_factors (n, d + (if d=2 then 1 else 2)));
 
 function vector_digits_sum (v : Vector) return Natural is 
 (if v'Length = 0 then 0 else digits_sum (v(v'First)) + vector_digits_sum (v(v'First+1..v'Last)));
 

begin

 for n in 1..10000 loop
   declare 
     primes : Vector := prime_factors (n);
   begin
     if  primes'Length > 1 and then vector_digits_sum (primes) = digits_sum (n) then 
       Ada.Text_IO.put (n'img);
     end if;
   end;
 end loop; 

end smith; </lang>

ALGOL 68

<lang algol68># sieve of Eratosthene: sets s[i] to TRUE if i is prime, FALSE otherwise # PROC sieve = ( REF[]BOOL s )VOID:

    BEGIN
       # start with everything flagged as prime                             # 
       FOR i TO UPB s DO s[ i ] := TRUE OD;
       # sieve out the non-primes                                           #
       s[ 1 ] := FALSE;
       FOR i FROM 2 TO ENTIER sqrt( UPB s ) DO
           IF s[ i ] THEN FOR p FROM i * i BY i TO UPB s DO s[ p ] := FALSE OD FI
       OD
    END # sieve # ;
  1. construct a sieve of primes up to the maximum number required for the task #

INT max number = 10 000; [ 1 : max number ]BOOL is prime; sieve( is prime );

  1. returns the sum of the digits of n #

OP DIGITSUM = ( INT n )INT:

  BEGIN
      INT sum  := 0;
      INT rest := ABS n;
      WHILE rest > 0 DO
          sum +:= rest MOD 10;
          rest OVERAB 10
      OD;
      sum 
  END # DIGITSUM # ;
  1. returns TRUE if n is a Smith number, FALSE otherwise #
  2. n must be between 1 and max number #

PROC is smith = ( INT n )BOOL:

    IF is prime[ ABS n ] THEN
        # primes are not Smith numbers                                      #
        FALSE
    ELSE
        # find the factors of n and sum the digits of the factors           #
        INT rest             := ABS n;
        INT factor digit sum := 0;
        INT factor           := 2;
        WHILE factor < max number AND rest > 1 DO
            IF NOT is prime[ factor ] THEN
                # factor isn't a prime                                      #
                factor +:= 1
            ELSE
                # factor is a prime                                         #
                IF rest MOD factor /= 0 THEN
                    # factor isn't a factor of n                            #
                    factor +:= 1
                ELSE
                    # factor is a factor of n                               #
                    rest OVERAB factor;
                    factor digit sum +:= DIGITSUM factor
                FI
            FI
        OD;
        ( factor digit sum = DIGITSUM n )
    FI # is smith # ;
  1. print all the Smith numbers below the maximum required #

INT smith count := 0; FOR n TO max number - 1 DO

   IF is smith( n ) THEN
       # have a smith number #
       print( ( whole( n, -7 ) ) );
       smith count +:= 1;
       IF smith count MOD 10 = 0 THEN
           print( ( newline ) )
       FI
   FI

OD; print( ( newline, "THere are ", whole( smith count, -7 ), " Smith numbers below ", whole( max number, -7 ), newline ) ) </lang>

Output:
      4     22     27     58     85     94    121    166    202    265
    274    319    346    355    378    382    391    438    454    483
    ...
   9717   9735   9742   9760   9778   9840   9843   9849   9861   9880
   9895   9924   9942   9968   9975   9985
THere are     376 Smith numbers below   10000

C

Translation of: C++

<lang c>

  1. include <stdlib.h>
  2. include <stdio.h>
  3. include <stdbool.h>

int numPrimeFactors(unsigned x) {

   unsigned p = 2;
   int pf = 0;
   if (x == 1)
       return 1;
   else {
       while (true) {
           if (!(x % p)) {
               pf++;
               x /= p;
               if (x == 1)
                   return pf;
           }
           else
               ++p;
       }
   }

}

void primeFactors(unsigned x, unsigned* arr) {

   unsigned p = 2;
   int pf = 0;
   if (x == 1)
       arr[pf] = 1;
   else {
       while (true) {
           if (!(x % p)) {
               arr[pf++] = p;
               x /= p;
               if (x == 1)
                   return;
           }
           else
               p++;
       }
   }

}

unsigned sumDigits(unsigned x) {

   unsigned sum = 0, y;
   while (x) {
       y = x % 10;
       sum += y;
       x /= 10;
   }
   return sum;

}

unsigned sumFactors(unsigned* arr, int size) {

   unsigned sum = 0;
   for (int a = 0; a < size; a++)
       sum += sumDigits(arr[a]);
   return sum;

}

void listAllSmithNumbers(unsigned x) {

   unsigned *arr;
   for (unsigned a = 4; a < x; a++) {
       int numfactors = numPrimeFactors(a);
       arr = (unsigned*)malloc(numfactors * sizeof(unsigned));
       if (numfactors < 2)
           continue;	
       primeFactors(a, arr);	
       if (sumDigits(a) == sumFactors(arr,numfactors))
           printf("%4u ",a);
       free(arr);
   }

}

int main(int argc, char* argv[]) {

   printf("All the Smith Numbers < 10000 are:\n");
   listAllSmithNumbers(10000);
   return 0;

} </lang>

Output:
All the Smith Numbers < 10000 are:
   4   22   27   58   85   94  121  166  202  265  274  319  346  355  378  382
 391  438  454  483  517  526  535  562  576  588  627  634  636  645  648  654
 663  666  690  706  728  729  762  778  825  852  861  895  913  915  922  958 
 985 1086 1111 1165 1219 1255 1282 1284 1376 1449 1507 1581 1626 1633 1642 1678 
1736 1755 1776 1795 1822 1842 1858 1872 1881 1894 1903 1908 1921 1935 1952 1962 
1966 2038 2067 2079 2155 2173 2182 2218 2227 2265 2286 2326 2362 2366 2373 2409 
2434 2461 2475 2484 2515 2556 2576 2578 2583 2605 2614 2679 2688 2722 2745 2751 
2785 2839 2888 2902 2911 2934 2944 2958 2964 2965 2970 2974 3046 3091 3138 3168 
3174 3226 3246 3258 3294 3345 3366 3390 3442 3505 3564 3595 3615 3622 3649 3663 
3690 3694 3802 3852 3864 3865 3930 3946 3973 4054 4126 4162 4173 4185 4189 4191 
4198 4209 4279 4306 4369 4414 4428 4464 4472 4557 4592 4594 4702 4743 4765 4788 
4794 4832 4855 4880 4918 4954 4959 4960 4974 4981 5062 5071 5088 5098 5172 5242 
5248 5253 5269 5298 5305 5386 5388 5397 5422 5458 5485 5526 5539 5602 5638 5642 
5674 5772 5818 5854 5874 5915 5926 5935 5936 5946 5998 6036 6054 6084 6096 6115 
6171 6178 6187 6188 6252 6259 6295 6315 6344 6385 6439 6457 6502 6531 6567 6583 
6585 6603 6684 6693 6702 6718 6760 6816 6835 6855 6880 6934 6981 7026 7051 7062 
7068 7078 7089 7119 7136 7186 7195 7227 7249 7287 7339 7402 7438 7447 7465 7503 
7627 7674 7683 7695 7712 7726 7762 7764 7782 7784 7809 7824 7834 7915 7952 7978 
8005 8014 8023 8073 8077 8095 8149 8154 8158 8185 8196 8253 8257 8277 8307 8347 
8372 8412 8421 8466 8518 8545 8568 8628 8653 8680 8736 8754 8766 8790 8792 8851 
8864 8874 8883 8901 8914 9015 9031 9036 9094 9166 9184 9193 9229 9274 9276 9285 
9294 9296 9301 9330 9346 9355 9382 9386 9387 9396 9414 9427 9483 9522 9535 9571 
9598 9633 9634 9639 9648 9657 9684 9708 9717 9735 9742 9760 9778 9840 9843 9849 
9861 9880 9895 9924 9942 9968 9975 9985

C++

<lang cpp>

  1. include <iostream>
  2. include <vector>
  3. include <iomanip>

void primeFactors( unsigned n, std::vector<unsigned>& r ) {

   int f = 2; if( n == 1 ) r.push_back( 1 );
   else {
       while( true ) {
           if( !( n % f ) ) {
               r.push_back( f );
               n /= f; if( n == 1 ) return;
           }
           else f++;
       }
   }

} unsigned sumDigits( unsigned n ) {

   unsigned sum = 0, m;
   while( n ) {
       m = n % 10; sum += m;
       n -= m; n /= 10;
   }
   return sum;

} unsigned sumDigits( std::vector<unsigned>& v ) {

   unsigned sum = 0;
   for( std::vector<unsigned>::iterator i = v.begin(); i != v.end(); i++ ) {
       sum += sumDigits( *i );
   }
   return sum;

} void listAllSmithNumbers( unsigned n ) {

   std::vector<unsigned> pf;
   for( unsigned i = 4; i < n; i++ ) {
       primeFactors( i, pf ); if( pf.size() < 2 ) continue;
       if( sumDigits( i ) == sumDigits( pf ) )
           std::cout << std::setw( 4 ) << i << " ";
       pf.clear();
   }
   std::cout << "\n\n";

} int main( int argc, char* argv[] ) {

   listAllSmithNumbers( 10000 );
   return 0;

} </lang>

Output:
   4   22   27   58   85   94  121  166  202  265  274  319  346  355  378  382
 391  438  454  483  517  526  535  562  576  627  634  636  645  663  666  690
...
9301 9330 9346 9355 9382 9386 9387 9396 9427 9483 9535 9571 9598 9633 9634 9639 
9648 9657 9684 9708 9717 9735 9742 9760 9778 9843 9849 9861 9880 9895 9975 9985

Elixir

<lang elixir>defmodule Smith do

 def number?(n) do
   d = decomposition(n)
   length(d)>1 and sum_digits(n) == Enum.map(d, &sum_digits/1) |> Enum.sum
 end
 
 defp sum_digits(n) do
   Integer.digits(n) |> Enum.sum
 end
 
 defp decomposition(n, k\\2, acc\\[])  
 defp decomposition(n, k, acc) when n < k*k, do: [n | acc]
 defp decomposition(n, k, acc) when rem(n, k) == 0, do: decomposition(div(n, k), k, [k | acc])
 defp decomposition(n, k, acc), do: decomposition(n, k+1, acc)

end

m = 10000 smith = Enum.filter(1..m, &Smith.number?/1) IO.puts "#{length(smith)} smith numbers below #{m}:" IO.puts "First 10: #{Enum.take(smith,10) |> Enum.join(", ")}" IO.puts "Last 10: #{Enum.take(smith,-10) |> Enum.join(", ")}"</lang>

Output:
376 smith numbers below 10000:
First 10: 4, 22, 27, 58, 85, 94, 121, 166, 202, 265
Last  10: 9843, 9849, 9861, 9880, 9895, 9924, 9942, 9968, 9975, 9985

FreeBASIC

<lang freebasic>' FB 1.05.0 Win64

Sub getPrimeFactors(factors() As UInteger, n As UInteger)

 If n < 2 Then Return
 Dim factor As UInteger = 2
 Do
   If n Mod factor = 0 Then
     Redim Preserve factors(0 To UBound(factors) + 1)
     factors(UBound(factors)) = factor
     n \= factor
     If n = 1 Then Return
   Else
     ' non-prime factors will always give a remainder > 0 as their own factors have already been removed
     ' so it's not worth checking that the next potential factor is prime  
     factor += 1  
   End If    
 Loop

End Sub

Function sumDigits(n As UInteger) As UInteger

 If n < 10 Then Return n
 Dim sum As UInteger = 0
 While n > 0
   sum += n Mod 10
   n \= 10
 Wend
 Return sum

End Function

Function isSmith(n As UInteger) As Boolean

 If n < 2 Then Return False
 Dim factors() As UInteger
 getPrimeFactors factors(), n
 If UBound(factors) = 0 Then Return False   n must be prime if there's only one factor
 Dim primeSum As UInteger = 0
 For i As UInteger = 0 To UBound(factors)
   primeSum += sumDigits(factors(i))
 Next
 Return sumDigits(n) = primeSum

End Function

Print "The Smith numbers below 10000 are : " Print Dim count As UInteger = 0 For i As UInteger = 2 To 9999

 If isSmith(i) Then  
   Print Using "#####"; i;
   count += 1
 End If

Next Print : Print Print count; " numbers found" Print Print "Press any key to quit" Sleep</lang>

Output:
The Smith numbers below 10000 are :

    4   22   27   58   85   94  121  166  202  265  274  319  346  355  378  382
  391  438  454  483  517  526  535  562  576  588  627  634  636  645  648  654
  663  666  690  706  728  729  762  778  825  852  861  895  913  915  922  958
  985 1086 1111 1165 1219 1255 1282 1284 1376 1449 1507 1581 1626 1633 1642 1678
 1736 1755 1776 1795 1822 1842 1858 1872 1881 1894 1903 1908 1921 1935 1952 1962
 1966 2038 2067 2079 2155 2173 2182 2218 2227 2265 2286 2326 2362 2366 2373 2409
 2434 2461 2475 2484 2515 2556 2576 2578 2583 2605 2614 2679 2688 2722 2745 2751
 2785 2839 2888 2902 2911 2934 2944 2958 2964 2965 2970 2974 3046 3091 3138 3168
 3174 3226 3246 3258 3294 3345 3366 3390 3442 3505 3564 3595 3615 3622 3649 3663
 3690 3694 3802 3852 3864 3865 3930 3946 3973 4054 4126 4162 4173 4185 4189 4191
 4198 4209 4279 4306 4369 4414 4428 4464 4472 4557 4592 4594 4702 4743 4765 4788
 4794 4832 4855 4880 4918 4954 4959 4960 4974 4981 5062 5071 5088 5098 5172 5242
 5248 5253 5269 5298 5305 5386 5388 5397 5422 5458 5485 5526 5539 5602 5638 5642
 5674 5772 5818 5854 5874 5915 5926 5935 5936 5946 5998 6036 6054 6084 6096 6115
 6171 6178 6187 6188 6252 6259 6295 6315 6344 6385 6439 6457 6502 6531 6567 6583
 6585 6603 6684 6693 6702 6718 6760 6816 6835 6855 6880 6934 6981 7026 7051 7062
 7068 7078 7089 7119 7136 7186 7195 7227 7249 7287 7339 7402 7438 7447 7465 7503
 7627 7674 7683 7695 7712 7726 7762 7764 7782 7784 7809 7824 7834 7915 7952 7978
 8005 8014 8023 8073 8077 8095 8149 8154 8158 8185 8196 8253 8257 8277 8307 8347
 8372 8412 8421 8466 8518 8545 8568 8628 8653 8680 8736 8754 8766 8790 8792 8851
 8864 8874 8883 8901 8914 9015 9031 9036 9094 9166 9184 9193 9229 9274 9276 9285
 9294 9296 9301 9330 9346 9355 9382 9386 9387 9396 9414 9427 9483 9522 9535 9571
 9598 9633 9634 9639 9648 9657 9684 9708 9717 9735 9742 9760 9778 9840 9843 9849
 9861 9880 9895 9924 9942 9968 9975 9985

376 numbers found


Haskell

<lang haskell>import Data.Tuple (swap) import Data.List (unfoldr)

isSmith :: Int -> Bool isSmith n = pfs /= [n] && sumDigits n == foldr ((+) . sumDigits) 0 pfs

 where
   sumDigits = sum . baseDigits 10
   root = floor . sqrt . fromIntegral
   pfs = primeFactors n
   primeFactors n =
     let fs = take 1 $ filter ((0 ==) . rem n) [2 .. root n]
     in case fs of
          [] -> [n]
          _ -> fs ++ primeFactors (div n (head fs))

baseDigits :: Int -> Int -> [Int] baseDigits base = unfoldr remQuot

 where
   remQuot 0 = Nothing
   remQuot x = Just (swap (quotRem x base))

lowSmiths :: [Int] lowSmiths = filter isSmith [2 .. 9999]

lowSmithCount :: Int lowSmithCount = length lowSmiths

main :: IO () main =

 mapM_
   putStrLn
   [ "Count of Smith Numbers below 10k:"
   , show lowSmithCount
   , "\nFirst 15 Smith Numbers:"
   , unwords (show <$> take 15 lowSmiths)
   , "\nLast 12 Smith Numbers below 10k:"
   , unwords (show <$> drop (lowSmithCount - 12) lowSmiths)
   ]</lang>
Output:
Count of Smith Numbers below 10k:
376

First 15 Smith Numbers:
4 22 27 58 85 94 121 166 202 265 274 319 346 355 378

Last 12 Smith Numbers below 10k:
9778 9840 9843 9849 9861 9880 9895 9924 9942 9968 9975 9985

J

Implementation: <lang J>digits=: 10&#.inv sumdig=: +/@,@digits notprime=: -.@(1&p:) smith=: #~ notprime * (=&sumdig q:)every</lang>

Task example: <lang J> #smith }.i.10000 376

  q:376

2 2 2 47

  47 8$smith }.i.10000
  4   22   27   58   85   94  121  166
202  265  274  319  346  355  378  382
391  438  454  483  517  526  535  562
576  588  627  634  636  645  648  654
663  666  690  706  728  729  762  778
825  852  861  895  913  915  922  958
985 1086 1111 1165 1219 1255 1282 1284

1376 1449 1507 1581 1626 1633 1642 1678 1736 1755 1776 1795 1822 1842 1858 1872 1881 1894 1903 1908 1921 1935 1952 1962 1966 2038 2067 2079 2155 2173 2182 2218 2227 2265 2286 2326 2362 2366 2373 2409 2434 2461 2475 2484 2515 2556 2576 2578 2583 2605 2614 2679 2688 2722 2745 2751 2785 2839 2888 2902 2911 2934 2944 2958 2964 2965 2970 2974 3046 3091 3138 3168 3174 3226 3246 3258 3294 3345 3366 3390 3442 3505 3564 3595 3615 3622 3649 3663 3690 3694 3802 3852 3864 3865 3930 3946 3973 4054 4126 4162 4173 4185 4189 4191 4198 4209 4279 4306 4369 4414 4428 4464 4472 4557 4592 4594 4702 4743 4765 4788 4794 4832 4855 4880 4918 4954 4959 4960 4974 4981 5062 5071 5088 5098 5172 5242 5248 5253 5269 5298 5305 5386 5388 5397 5422 5458 5485 5526 5539 5602 5638 5642 5674 5772 5818 5854 5874 5915 5926 5935 5936 5946 5998 6036 6054 6084 6096 6115 6171 6178 6187 6188 6252 6259 6295 6315 6344 6385 6439 6457 6502 6531 6567 6583 6585 6603 6684 6693 6702 6718 6760 6816 6835 6855 6880 6934 6981 7026 7051 7062 7068 7078 7089 7119 7136 7186 7195 7227 7249 7287 7339 7402 7438 7447 7465 7503 7627 7674 7683 7695 7712 7726 7762 7764 7782 7784 7809 7824 7834 7915 7952 7978 8005 8014 8023 8073 8077 8095 8149 8154 8158 8185 8196 8253 8257 8277 8307 8347 8372 8412 8421 8466 8518 8545 8568 8628 8653 8680 8736 8754 8766 8790 8792 8851 8864 8874 8883 8901 8914 9015 9031 9036 9094 9166 9184 9193 9229 9274 9276 9285 9294 9296 9301 9330 9346 9355 9382 9386 9387 9396 9414 9427 9483 9522 9535 9571 9598 9633 9634 9639 9648 9657 9684 9708 9717 9735 9742 9760 9778 9840 9843 9849 9861 9880 9895 9924 9942 9968 9975 9985</lang>

(first we count how many smith numbers are in our result, then we look at the prime factors of that count - turns out that 8 columns of 47 numbers each is perfect for this task.)

Java

Works with: Java version 7

<lang java>import java.util.*;

public class SmithNumbers {

   public static void main(String[] args) {
       for (int n = 1; n < 10_000; n++) {
           List<Integer> factors = primeFactors(n);
           if (factors.size() > 1) {
               int sum = sumDigits(n);
               for (int f : factors)
                   sum -= sumDigits(f);
               if (sum == 0)
                   System.out.println(n);
           }
       }
   }
   static List<Integer> primeFactors(int n) {
       List<Integer> result = new ArrayList<>();
       for (int i = 2; n % i == 0; n /= i)
           result.add(i);
       for (int i = 3; i * i <= n; i += 2) {
           while (n % i == 0) {
               result.add(i);
               n /= i;
           }
       }
       if (n != 1)
           result.add(n);
       return result;
   }
   static int sumDigits(int n) {
       int sum = 0;
       while (n > 0) {
           sum += (n % 10);
           n /= 10;
       }
       return sum;
   }

}</lang>

4
22
27
58
85
94
121
...
9924
9942
9968
9975
9985

JavaScript

ES6

Translation of: Haskell

<lang JavaScript>(() => {

   'use strict';
   // GENERIC FUNCTIONS -----------------------------------------------------
   // concat :: a -> [a] | [String] -> String
   const concat = xs => {
       if (xs.length > 0) {
           const unit = typeof xs[0] === 'string' ?  : [];
           return unit.concat.apply(unit, xs);
       } else return [];
   }
   // range :: Int -> Int -> [Int]
   const range = (m, n) =>
       Array.from({
           length: Math.floor(n - m) + 1
       }, (_, i) => m + i);
   // dropWhile :: (a -> Bool) -> [a] -> [a]
   const dropWhile = (p, xs) => {
       let i = 0;
       for (let lng = xs.length;
           (i < lng) && p(xs[i]); i++) {}
       return xs.slice(i);
   }
   // head :: [a] -> a
   const head = xs => xs.length ? xs[0] : undefined;
   // Int -> [a] -> [a]
   const take = (n, xs) => xs.slice(0, n);
   // drop :: Int -> [a] -> [a]
   const drop = (n, xs) => xs.slice(n);
   // floor :: Num a => a -> Int
   const floor = Math.floor;
   // floor :: Num -> Num
   const sqrt = Math.sqrt;
   // show :: a -> String
   const show = x => JSON.stringify(x, null, 2);
   // unwords :: [String] -> String
   const unwords = xs => xs.join(' ');


   // MAIN -----------------------------------------------------------------
   // primeFactors :: Int -> [Int]
   const primeFactors = n => {
       const fs = take(1, (dropWhile(x => n % x !== 0, range(2, floor(sqrt(n))))));
       return fs.length === 0 ? (
           [n]
       ) : fs.concat(primeFactors(floor(n / head(fs))));
   };
   // digitSum :: [Char] -> Int
   const digitSum = ds =>
       ds
       .reduce((a, b) => parseInt(a, 10) + parseInt(b, 10), 0);
   // isSmith :: Int -> Bool
   const isSmith = n => {
       const pfs = primeFactors(n);
       return (head(pfs) !== n) &&
           digitSum(n.toString()
               .split()) == digitSum(
               concat(pfs.map(x => x.toString()))
               .split()
           );
   }
   // TEST ------------------------------------------------------------------
   // lowSmiths :: [Int]
   const lowSmiths = range(2, 9999)
       .filter(isSmith);
   // lowSmithCount :: Int
   const lowSmithCount = lowSmiths.length;
   return [
       "Count of Smith Numbers below 10k:",
           show(lowSmithCount),
           "\nFirst 15 Smith Numbers:",
           unwords(take(15, lowSmiths)),
           "\nLast 12 Smith Numbers below 10000:",
           unwords(drop(lowSmithCount - 12, lowSmiths))
   ].join('\n');

})();</lang>

Output:
Count of Smith Numbers below 10k:
376

First 15 Smith Numbers:
4 22 27 58 85 94 121 166 202 265 274 319 346 355 378

Last 12 Smith Numbers below 10000:
9778 9840 9843 9849 9861 9880 9895 9924 9942 9968 9975 9985

Julia

<lang julia># v0.6

function sumdigits(n::Integer)

   sum = 0
   while n > 0
       sum += n % 10
       n = div(n, 10)
   end
   return sum

end

using Primes issmith(n::Integer) = !isprime(n) && sumdigits(n) == sum(sumdigits(f) for f in factor(Vector, n))

smithnumbers = collect(n for n in 2:10000 if issmith(n)) println("Smith numbers up to 10000:\n$smithnumbers")</lang>

Output:
Smith numbers up to 10000:
[4, 22, 27, 58, 85, 94, 121, 166, 202, 265, 274, 319, 346, 355, 378, 382, 391, 438, 454, 483, 517, 526, 535,
562, 576, 588, 627, 634, 636, 645, 648, 654, 663, 666, 690, 706, 728, 729, 762, 778, 825, 852, 861, 895, 913,
915, 922, 958, 985, 1086, 1111, 1165, 1219, 1255, 1282, 1284, 1376, 1449, 1507, 1581, 1626, 1633, 1642, 1678,
1736, 1755, 1776, 1795, 1822, 1842, 1858, 1872, 1881, 1894, 1903, 1908, 1921, 1935, 1952, 1962, 1966, 2038,
2067, 2079, 2155, 2173, 2182, 2218, 2227, 2265, 2286, 2326, 2362, 2366, 2373, 2409, 2434, 2461, 2475, 2484,
2515, 2556, 2576, 2578, 2583, 2605, 2614, 2679, 2688, 2722, 2745, 2751, 2785, 2839, 2888, 2902, 2911, 2934,
2944, 2958, 2964, 2965, 2970, 2974, 3046, 3091, 3138, 3168, 3174, 3226, 3246, 3258, 3294, 3345, 3366, 3390,
3442, 3505, 3564, 3595, 3615, 3622, 3649, 3663, 3690, 3694, 3802, 3852, 3864, 3865, 3930, 3946, 3973, 4054,
4126, 4162, 4173, 4185, 4189, 4191, 4198, 4209, 4279, 4306, 4369, 4414, 4428, 4464, 4472, 4557, 4592, 4594,
4702, 4743, 4765, 4788, 4794, 4832, 4855, 4880, 4918, 4954, 4959, 4960, 4974, 4981, 5062, 5071, 5088, 5098,
5172, 5242, 5248, 5253, 5269, 5298, 5305, 5386, 5388, 5397, 5422, 5458, 5485, 5526, 5539, 5602, 5638, 5642,
5674, 5772, 5818, 5854, 5874, 5915, 5926, 5935, 5936, 5946, 5998, 6036, 6054, 6084, 6096, 6115, 6171, 6178,
6187, 6188, 6252, 6259, 6295, 6315, 6344, 6385, 6439, 6457, 6502, 6531, 6567, 6583, 6585, 6603, 6684, 6693,
6702, 6718, 6760, 6816, 6835, 6855, 6880, 6934, 6981, 7026, 7051, 7062, 7068, 7078, 7089, 7119, 7136, 7186,
7195, 7227, 7249, 7287, 7339, 7402, 7438, 7447, 7465, 7503, 7627, 7674, 7683, 7695, 7712, 7726, 7762, 7764,
7782, 7784, 7809, 7824, 7834, 7915, 7952, 7978, 8005, 8014, 8023, 8073, 8077, 8095, 8149, 8154, 8158, 8185,
8196, 8253, 8257, 8277, 8307, 8347, 8372, 8412, 8421, 8466, 8518, 8545, 8568, 8628, 8653, 8680, 8736, 8754,
8766, 8790, 8792, 8851, 8864, 8874, 8883, 8901, 8914, 9015, 9031, 9036, 9094, 9166, 9184, 9193, 9229, 9274,
9276, 9285, 9294, 9296, 9301, 9330, 9346, 9355, 9382, 9386, 9387, 9396, 9414, 9427, 9483, 9522, 9535, 9571,
9598, 9633, 9634, 9639, 9648, 9657, 9684, 9708, 9717, 9735, 9742, 9760, 9778, 9840, 9843, 9849, 9861, 9880,
9895, 9924, 9942, 9968, 9975, 9985]

Kotlin

Translation of: FreeBASIC

<lang scala>// version 1.0.6

fun getPrimeFactors(n: Int): MutableList<Int> {

   val factors = mutableListOf<Int>()
   if (n < 2) return factors
   var factor = 2
   var nn = n
   while (true) {
       if (nn % factor == 0) {
           factors.add(factor)
           nn /= factor
           if (nn == 1) return factors
       }
       else if (factor >= 3) factor += 2
       else factor = 3
   }

}

fun sumDigits(n: Int): Int = when {

       n < 10 -> n
       else   -> {
           var sum = 0
           var nn = n
           while (nn > 0) {
               sum += (nn % 10)
               nn /= 10
           }
           sum
       }
   }

fun isSmith(n: Int): Boolean {

   if (n < 2) return false
   val factors = getPrimeFactors(n)
   if (factors.size == 1) return false
   val primeSum = factors.sumBy { sumDigits(it) }
   return sumDigits(n) == primeSum

}

fun main(args: Array<String>) {

   println("The Smith numbers below 10000 are:\n")
   var count = 0
   for (i in 2 until 10000) {
       if (isSmith(i)) {
           print("%5d".format(i))
           count++
       }
   }
   println("\n\n$count numbers found")

}</lang>

Output:
    4   22   27   58   85   94  121  166  202  265  274  319  346  355  378  382
  391  438  454  483  517  526  535  562  576  588  627  634  636  645  648  654
  663  666  690  706  728  729  762  778  825  852  861  895  913  915  922  958
  985 1086 1111 1165 1219 1255 1282 1284 1376 1449 1507 1581 1626 1633 1642 1678
 1736 1755 1776 1795 1822 1842 1858 1872 1881 1894 1903 1908 1921 1935 1952 1962
 1966 2038 2067 2079 2155 2173 2182 2218 2227 2265 2286 2326 2362 2366 2373 2409
 2434 2461 2475 2484 2515 2556 2576 2578 2583 2605 2614 2679 2688 2722 2745 2751
 2785 2839 2888 2902 2911 2934 2944 2958 2964 2965 2970 2974 3046 3091 3138 3168
 3174 3226 3246 3258 3294 3345 3366 3390 3442 3505 3564 3595 3615 3622 3649 3663
 3690 3694 3802 3852 3864 3865 3930 3946 3973 4054 4126 4162 4173 4185 4189 4191
 4198 4209 4279 4306 4369 4414 4428 4464 4472 4557 4592 4594 4702 4743 4765 4788
 4794 4832 4855 4880 4918 4954 4959 4960 4974 4981 5062 5071 5088 5098 5172 5242
 5248 5253 5269 5298 5305 5386 5388 5397 5422 5458 5485 5526 5539 5602 5638 5642
 5674 5772 5818 5854 5874 5915 5926 5935 5936 5946 5998 6036 6054 6084 6096 6115
 6171 6178 6187 6188 6252 6259 6295 6315 6344 6385 6439 6457 6502 6531 6567 6583
 6585 6603 6684 6693 6702 6718 6760 6816 6835 6855 6880 6934 6981 7026 7051 7062
 7068 7078 7089 7119 7136 7186 7195 7227 7249 7287 7339 7402 7438 7447 7465 7503
 7627 7674 7683 7695 7712 7726 7762 7764 7782 7784 7809 7824 7834 7915 7952 7978
 8005 8014 8023 8073 8077 8095 8149 8154 8158 8185 8196 8253 8257 8277 8307 8347
 8372 8412 8421 8466 8518 8545 8568 8628 8653 8680 8736 8754 8766 8790 8792 8851
 8864 8874 8883 8901 8914 9015 9031 9036 9094 9166 9184 9193 9229 9274 9276 9285
 9294 9296 9301 9330 9346 9355 9382 9386 9387 9396 9414 9427 9483 9522 9535 9571
 9598 9633 9634 9639 9648 9657 9684 9708 9717 9735 9742 9760 9778 9840 9843 9849
 9861 9880 9895 9924 9942 9968 9975 9985

376 numbers found

Lua

Slightly long-winded prime factor function but it's a bit faster than the 'easy' way. <lang Lua>-- Returns a boolean indicating whether n is prime function isPrime (n)

   if n < 2 then return false end
   if n < 4 then return true end
   if n % 2 == 0 then return false end
   for d = 3, math.sqrt(n), 2 do
       if n % d == 0 then return false end
   end
   return true

end

-- Returns a table of the prime factors of n function primeFactors (n)

   local pfacs, divisor = {}, 1
   if n < 1 then return pfacs end
   while not isPrime(n) do
       while not isPrime(divisor) do divisor = divisor + 1 end
       while n % divisor == 0 do
           n = n / divisor
           table.insert(pfacs, divisor)
       end
       divisor = divisor + 1
       if n == 1 then return pfacs end
   end
   table.insert(pfacs, n)
   return pfacs

end

-- Returns the sum of the digits of n function sumDigits (n)

   local sum, nStr = 0, tostring(n)
   for digit = 1, nStr:len() do
       sum = sum + tonumber(nStr:sub(digit, digit))
   end
   return sum

end

-- Returns a boolean indicating whether n is a Smith number function isSmith (n)

   if isPrime(n) then return false end
   local sumFacs = 0
   for _, v in ipairs(primeFactors(n)) do
       sumFacs = sumFacs + sumDigits(v)
   end
   return sumFacs == sumDigits(n)

end

-- Main procedure for n = 1, 10000 do

   if isSmith(n) then io.write(n .. "\t") end

end</lang> Seems silly to paste in all 376 numbers but rest assured the output agrees with https://oeis.org/A006753

Objeck

<lang objeck>use Collection;

class Test {

 function : Main(args : String[]) ~ Nil {
   for(n := 1; n < 10000; n+=1;) {
     factors := PrimeFactors(n);
     if(factors->Size() > 1) {
       sum := SumDigits(n);
       each(i : factors) {
         sum -= SumDigits(factors->Get(i));
       };
       
       if(sum = 0) {
         n->PrintLine();
       };
     };
   };
 }
 
 function : PrimeFactors(n : Int) ~ IntVector {
   result := IntVector->New();

   for(i := 2; n % i = 0; n /= i;) {
     result->AddBack(i);
   };

   for(i := 3; i * i <= n; i += 2;) {
     while(n % i = 0) {
       result->AddBack(i);
       n /= i;
     };
   };

   if(n <> 1) {
     result->AddBack(n);
   };
   
   return result;
 }
 
 function : SumDigits(n : Int) ~ Int {
   sum := 0;
   while(n > 0) {
     sum += (n % 10);
     n /= 10;
   };
   
   return sum;
 }

}</lang>

4
22
27
58
85
94
121
166
202
...
9975
9985

Pascal

Works with: Free Pascal

Using a segmented sieve of erathostenes and mark every number with the index of its prime factor <= sqrt(number). I use a presieved segment to reduce the time for small primes. I thought, it would be a small speed improvement ;-)

the function IncDgtSum delivers the next sum of digits very fast (2.6 s for 1 to 1e9 ) <lang pascal>program SmithNum; {$IFDEF FPC}

 {$MODE objFPC} //result and  useful for x64
 {$CODEALIGN PROC=64}

{$ENDIF} uses

 sysutils;

type

 tdigit  = byte;
 tSum    = LongInt;

const

 base = 10;
 //maxDigitCnt *(base-1) <= High(tSum)
 //maxDigitCnt <= High(tSum) DIV (base-1);
 maxDigitCnt = 16;
 StartPrimNo = 6;
 csegsieveSIze = 2*3*5*7*11*13;//prime 0..5

type

 tDgtSum = record
             dgtNum : LongInt;
             dgtSum : tSum;
             dgts   : array[0..maxDigitCnt-1] of tdigit;
           end;
 tNumFactype = word;
 tnumFactor = record
                numfacCnt: tNumFactype;
                numfacts : array[1..15] of tNumFactype;
              end;
 tpnumFactor= ^tnumFactor;
 tsieveprim = record
                spPrim   : Word;
                spDgtsum : Word;
                spOffset : LongWord;
              end;
 tpsieveprim = ^tsieveprim;
 tsievePrimarr  = array[0..6542-1] of tsieveprim;
 tsegmSieve     = array[1..csegsieveSIze] of tnumFactor;

var

 Primarr:tsievePrimarr;
 copySieve,
 actSieve : tsegmSieve;
 PrimDgtSum :tDgtSum;
 PrimCnt : NativeInt;

function IncDgtSum(var ds:tDgtSum):boolean; //add 1 to dgts and corrects sum of Digits //return if overflow happens var

 i : NativeInt;

Begin

 i := High(ds.dgts);
 inc(ds.dgtNum);
 repeat
   IF ds.dgts[i] < Base-1 then
   //add one and done
   Begin
     inc(ds.dgts[i]);
     inc(ds.dgtSum);
     BREAK;
   end
   else
   Begin
     ds.dgts[i] := 0;
     dec(ds.dgtSum,Base-1);
   end;
   dec(i);
until i < Low(ds.dgts);
result := i < Low(ds.dgts)

end;

procedure OutDgtSum(const ds:tDgtSum); var

 i : NativeInt;

Begin

 i := Low(ds.dgts);
 repeat
   write(ds.dgts[i]:3);
   inc(i);
 until i > High(ds.dgts);
 writeln(' sum of digits :  ',ds.dgtSum:3);

end;

procedure OutSieve(var s:tsegmSieve); var

 i,j : NativeInt;

Begin

 For i := Low(s) to High(s) do
   with s[i] do
   Begin
     write(i:6,numfacCnt:4);
     For j := 1 to numfacCnt do
       write(numFacts[j]:5);
     writeln;
   end;

end;

procedure SieveForPrimes; // sieve for all primes < High(Word) var

 sieve : array of byte;
 pS : pByte;
 p,i   : NativeInt;

Begin

 setlength(sieve,High(Word));
 Fillchar(sieve[Low(sieve)],length(sieve),#0);
 pS:= @sieve[0]; //zero based
 dec(pS);// make it one based
 //sieve
 p := 2;
 repeat
   i := p*p;
   IF i> High(Word) then
     BREAK;
   repeat pS[i] := 1; inc(i,p); until i > High(Word);
   repeat inc(p) until pS[p] = 0;
 until false;
 //now fill array of primes
 fillchar(PrimDgtSum,SizeOf(PrimDgtSum),#0);
 IncDgtSum(PrimDgtSum);//1
 i := 0;
 For p := 2 to High(Word) do
 Begin
   IncDgtSum(PrimDgtSum);
   if pS[p] = 0 then
   Begin
     with PrimArr[i] do
     Begin
       spOffset := 2*p;//start at 2*prime
       spPrim   := p;
       spDgtsum := PrimDgtSum.dgtSum;
     end;
     inc(i);
   end;
 end;
 PrimCnt := i-1;

end;

procedure MarkWithPrime(SpIdx:NativeInt;var sf:tsegmSieve); var

 i : NativeInt;
 pSf :^tnumFactor;
 MarkPrime : NativeInt;

Begin

 with Primarr[SpIdx] do
 Begin
   MarkPrime := spPrim;
   i :=  spOffSet;
   IF i <= csegsieveSize then
   Begin
     pSf := @sf[i];
     repeat
       pSf^.numFacts[pSf^.numfacCnt+1] := SpIdx;
       inc(pSf^.numfacCnt);
       inc(pSf,MarkPrime);
       inc(i,MarkPrime);
     until i > csegsieveSize;
   end;
   spOffset := i-csegsieveSize;
 end;

end;

procedure InitcopySieve(var cs:tsegmSieve); var

 pr: NativeInt;

Begin

 fillchar(cs[Low(cs)],sizeOf(cs),#0);
 For Pr := 0 to 5 do
 Begin
   with Primarr[pr] do
    spOffset := spPrim;//mark the prime too
   MarkWithPrime(pr,cs);
 end;

end;

procedure MarkNextSieve(var s:tsegmSieve); var

 idx: NativeInt;

Begin

 s:= copySieve;
 For idx := StartPrimNo to PrimCnt do
   MarkWithPrime(idx,s);

end;

function DgtSumInt(n: NativeUInt):NativeUInt; var

 r : NativeUInt;

Begin

 result := 0;
 repeat
   r := n div base;
   inc(result,n-base*r);
   n := r
 until r = 0;

end;

{function DgtSumOfFac(pN: tpnumFactor;dgtNo:tDgtSum):boolean;} function TestSmithNum(pN: tpnumFactor;dgtNo:tDgtSum):boolean; var

 i,k,r,dgtSumI,dgtSumTarget : NativeUInt;
 pSp:tpsieveprim;
 pNumFact : ^tNumFactype;

Begin

 i := dgtNo.dgtNum;
 dgtSumTarget :=dgtNo.dgtSum;
 dgtSumI := 0;
 with pN^ do
 Begin
   k := numfacCnt;
   pNumFact := @numfacts[k];
 end;
 For k := k-1 downto 0 do
 Begin
   pSp := @PrimArr[pNumFact^];
   r := i DIV pSp^.spPrim;
   repeat
     i := r;
     r := r DIV pSp^.spPrim;
     inc(dgtSumI,pSp^.spDgtsum);
   until (i - r* pSp^.spPrim) <> 0;
   IF dgtSumI > dgtSumTarget then
   Begin
     result := false;
     EXIT;
   end;
   dec(pNumFact);
 end;
 If i <> 1 then
   inc(dgtSumI,DgtSumInt(i));
 result := dgtSumI = dgtSumTarget

end;

function CheckSmithNo(var s:tsegmSieve;var dgtNo:tDgtSum;Lmt:NativeInt=csegsieveSIze):NativeUInt; var

 pNumFac : tpNumFactor;
 i : NativeInt;

Begin

 result := 0;
 i := low(s);
 pNumFac := @s[i];
 For i := i to lmt do
 Begin
   incDgtSum(dgtNo);
   IF pNumFac^.numfacCnt<> 0 then
     IF TestSmithNum(pNumFac,dgtNo) then
     Begin
       inc(result);
       //Mark as smith number
       inc(pNumFac^.numfacCnt,1 shl 15);
     end;
   inc(pNumFac);
 end;

end;

const

 limit = 100*1000*1000;

var

 actualNo :tDgtSum;
 i,s : NativeInt;

Begin

 SieveForPrimes;
 InitcopySieve(copySieve);
 i := 1;
 s:= -6;//- 2,3,5,7,11,13
 fillchar(actualNo,SizeOf(actualNo),#0);
 while i < Limit-csegsieveSize do
 Begin
   MarkNextSieve(actSieve);
   inc(s,CheckSmithNo(actSieve,actualNo));
   inc(i, csegsieveSize);
 end;
 //check the rest
 MarkNextSieve(actSieve);
 inc(s,CheckSmithNo(actSieve,actualNo,Limit-i+1));
 write(s:8,' smith-numbers up to ',actualNo.dgtnum:10);

end.

</lang>

Output:
64-Bit FPC 3.1.1 -O3 -Xs  i4330 3.5 Ghz
       6 smith-numbers up to        100
      49 smith-numbers up to       1000
     376 smith-numbers up to      10000
    3294 smith-numbers up to     100000
   29928 smith-numbers up to    1000000 real   0m00.064s
  278411 smith-numbers up to   10000000 real   0m00.661s
 2632758 smith-numbers up to  100000000 real   0m06.981s
25154060 smith-numbers up to 1000000000 real   1m14.077s

  Number of Smith numbers below 10^n.     1
  1:1, 2:6, 3:49, 4:376, 5:3294, 6:29928, 7:278411, 8:2632758,
  9:25154060, 10:241882509, 11:2335807857, 12:22635291815,13:219935518608

Perl

Library: ntheory

<lang perl>use ntheory qw/:all/; my @smith; forcomposites {

 push @smith, $_  if sumdigits($_) == sumdigits(join("",factors($_)));

} 10000-1; say scalar(@smith), " Smith numbers below 10000."; say "@smith";</lang>

Output:
376 Smith numbers below 10000.
4 22 27 58 85 94 121 166 202 ... 9924 9942 9968 9975 9985

Perl 6

<lang perl6>constant @primes = 2, |(3, 5, 7 ... *).grep: *.is-prime;

multi factors ( 1 ) { 1 } multi factors ( Int $remainder is copy ) {

 gather for @primes -> $factor {

   # if remainder < factor², we're done
   if $factor * $factor > $remainder {
     take $remainder if $remainder > 1;
     last;
   }

   # How many times can we divide by this prime?
   while $remainder %% $factor {
       take $factor;
       last if ($remainder div= $factor) === 1;
   }
 }

}

  1. Code above here is verbatim from RC:Count_in_factors#Perl6

sub is_smith_number ( Int $n ) {

 (!$n.is-prime) and ( [+] $n.comb ) == ( [+] factors($n).join.comb );

}

my @s = grep &is_smith_number, 2 ..^ 10_000; say "{@s.elems} Smith numbers below 10_000"; say 'First 10: ', @s[ ^10 ]; say 'Last 10: ', @s[ *-10 .. * ];</lang>

Output:
376 Smith numbers below 10_000
First 10: (4 22 27 58 85 94 121 166 202 265)
Last  10: (9843 9849 9861 9880 9895 9924 9942 9968 9975 9985)

Phix

Note that the builtin prime_factors(4) yields {2}, rather than {2,2}, hence the inner loop (admittedly repeat..until style would be better, if only Phix had that). <lang Phix>function sum_digits(integer n, integer base=10) integer res = 0

   while n do
       res += remainder(n,base)
       n = floor(n/base)
   end while
   return res

end function

function smith(integer n)

   sequence p = prime_factors(n)
   integer sp = 0, w = n
   for i=1 to length(p) do
       integer pi = p[i],
               spi = sum_digits(pi)
       while mod(w,pi)=0 do
           sp += spi
           w = floor(w/pi)
       end while
   end for
   return sum_digits(n)=sp

end function

sequence s = {} for i=1 to 10000 do

   if smith(i) then s &= i end if

end for ?length(s) s[8..-8] = {"..."} ?s</lang>

376
{4,22,27,58,85,94,121,"...",9880,9895,9924,9942,9968,9975,9985}

PicoLisp

<lang PicoLisp>(de factor (N)

  (make
     (let (D 2  L (1 2 2 . (4 2 4 2 4 6 2 6 .))  M (sqrt N))
        (while (>= M D)
           (if (=0 (% N D))
              (setq M (sqrt (setq N (/ N (link D)))))
              (inc 'D (pop 'L)) ) )
        (link N) ) ) )

(de sumdigits (N)

  (sum format (chop N)) )

(de smith (X)

  (make
     (for N X
        (let R (factor N)
           (and
              (cdr R)
              (= (sum sumdigits R) (sumdigits N))
              (link N) ) ) ) ) )

(let L (smith 10000)

  (println 'first-10 (head 10 L))
  (println 'last-10 (tail 10 L))
  (println 'all (length L)) )</lang>
Output:
first-10 (4 22 27 58 85 94 121 166 202 265)
last-10 (9843 9849 9861 9880 9895 9924 9942 9968 9975 9985)
all 376

PureBasic

<lang PureBasic>DisableDebugger

  1. ECHO=#True ; #True: Print all results

Global NewList f.i()

Procedure.i ePotenz(Wert.i)

 Define.i var=Wert, i  
 While var
   i+1
   var/10    
 Wend  
 ProcedureReturn i  

EndProcedure

Procedure.i n_Element(Wert.i,Stelle.i=1)

 If Stelle>0
   ProcedureReturn (Wert%Int(Pow(10,Stelle))-Wert%Int(Pow(10,Stelle-1)))/Int(Pow(10,Stelle-1))    
 Else
   ProcedureReturn 0    
 EndIf  

EndProcedure

Procedure.i qSumma(Wert.i)

 Define.i sum, pos  
 For pos=1 To ePotenz(Wert)
   sum+ n_Element(Wert,pos)    
 Next pos  
 ProcedureReturn sum  

EndProcedure

Procedure.b IsPrime(n.i)

 Define.i i=5
 If n<2 : ProcedureReturn #False : EndIf
 If n%2=0 : ProcedureReturn Bool(n=2) : EndIf
 If n%3=0 : ProcedureReturn Bool(n=3) : EndIf
 While i*i<=n
   If n%i=0 : ProcedureReturn #False : EndIf
   i+2
   If n%i=0 : ProcedureReturn #False : EndIf
   i+4
 Wend  
 ProcedureReturn #True

EndProcedure

Procedure PFZ(n.i,pf.i=2)

 If n>1 And n<>pf
   If n%pf=0      
     AddElement(f()) : f()=pf
     PFZ(n/pf,pf)
   Else
     While Not IsPrime(pf+1) : pf+1 : Wend
     PFZ(n,pf+1)
   EndIf
 ElseIf n=pf
   AddElement(f()) : f()=pf
 EndIf   

EndProcedure

OpenConsole("Smith numbers")

upto=100
sn=0 : Gosub Smith_loop
upto=1000
sn=0 : Gosub Smith_loop

upto=10000 : sn=0 : Gosub Smith_loop Input() End

Smith_loop:

 For i=2 To upto
   ClearList(f()) : qs=0
   PFZ(i)
   CompilerIf #ECHO : Print(Str(i)+~": \t") : CompilerEndIf
   ForEach f()
     CompilerIf #ECHO : Print(Str(F())+~"\t") : CompilerEndIf
     qs+qSumma(f())
   Next
   If ListSize(f())>1 And qSumma(i)=qs 
     CompilerIf #ECHO : Print("SMITH-NUMBER") : CompilerEndIf
     sn+1
   EndIf
   CompilerIf #ECHO : PrintN("") : CompilerEndIf
 Next
 Print(~"\n"+Str(sn)+" Smith number up to "+Str(upto))

Return</lang>

Output:
.
.
.
9975:   3       5       5       7       19      SMITH-NUMBER
9976:   2       2       2       29      43
9977:   11      907
9978:   2       3       1663
9979:   17      587
9980:   2       2       5       499
9981:   3       3       1109
9982:   2       7       23      31
9983:   67      149
9984:   2       2       2       2       2       2       2       2       3       13
9985:   5       1997    SMITH-NUMBER
9986:   2       4993
9987:   3       3329
9988:   2       2       11      227
9989:   7       1427
9990:   2       3       3       3       5       37
9991:   97      103
9992:   2       2       2       1249
9993:   3       3331
9994:   2       19      263
9995:   5       1999
9996:   2       2       3       7       7       17
9997:   13      769
9998:   2       4999
9999:   3       3       11      101
10000:  2       2       2       2       5       5       5       5

376 Smith number up To 10000

Python

<lang python> from sys import stdout


def factors(n):

   rt = []
   f = 2
   if n == 1:
       rt.append(1);
   else:
       while 1:
           if 0 == ( n % f ):
               rt.append(f);
               n //= f
               if n == 1:
                   return rt
           else:
               f += 1
   return rt


def sum_digits(n):

   sum = 0
   while n > 0:
       m = n % 10
       sum += m
       n -= m
       n //= 10
   return sum


def add_all_digits(lst):

   sum = 0
   for i in range (len(lst)):
       sum += sum_digits(lst[i])
   return sum


def list_smith_numbers(cnt):

   for i in range(4, cnt):
       fac = factors(i)
       if len(fac) > 1:
           if sum_digits(i) == add_all_digits(fac):
               stdout.write("{0} ".format(i) )
  1. entry point

list_smith_numbers(10_000) </lang>

Output:

4 22 27 58 85 94 121 166 202 265 274 319 346 355 378 382 391 438 454 483 517 526 535 562 576 588 627 634 636 645 648 654 663 666 ... 9535 9571 9598 9633 9634 9639 9648 9657 9684 9708 9717 9735 9742 9760 9778 9840 9843 9849 9861 9880 9895 9924 9942 9968 9975 9985

Racket

<lang racket>#lang racket (require math/number-theory)

(define (sum-of-digits n)

 (let inr ((n n) (s 0))
   (if (zero? n) s (let-values (([q r] (quotient/remainder n 10))) (inr q (+ s r))))))

(define (smith-number? n)

 (and (not (prime? n))
      (= (sum-of-digits n)
         (for/sum ((pe (in-list (factorize n))))
           (* (cadr pe) (sum-of-digits (car pe)))))))

(module+ test

 (require rackunit)
 (check-equal? (sum-of-digits 0) 0)
 (check-equal? (sum-of-digits 33) 6)
 (check-equal? (sum-of-digits 30) 3)
 (check-true (smith-number? 166)))

(module+ main

 (let loop ((ns (filter smith-number? (range 1 (add1 10000)))))
   (unless (null? ns)
     (let-values (([l r] (split-at ns (min (length ns) 15))))
       (displayln l)
       (loop r)))))</lang>
Output:
(4 22 27 58 85 94 121 166 202 265 274 319 346 355 378)
(382 391 438 454 483 517 526 535 562 576 588 627 634 636 645)
(648 654 663 666 690 706 728 729 762 778 825 852 861 895 913)

(9396 9414 9427 9483 9522 9535 9571 9598 9633 9634 9639 9648 9657 9684 9708)
(9717 9735 9742 9760 9778 9840 9843 9849 9861 9880 9895 9924 9942 9968 9975)
(9985)

REXX

unoptimized

<lang rexx>/*REXX program finds (and maybe displays) Smith (or joke) numbers up to a given N.*/ parse arg N . /*obtain optional argument from the CL.*/ if N== | N=="," then N=10000 /*Not specified? Then use the default.*/ tell= (N>0); N=abs(N) - 1 /*use the │N│ for computing (below).*/ w=length(N) /*W: used for aligning Smith numbers. */

  1. =0 /*#: Smith numbers found (so far). */

@=; do j=4 to N; /*process almost all numbers up to N. */

    if sumD(j) \== sumfactr(j)  then iterate    /*Not a Smith number?   Then ignore it.*/
    #=#+1                                       /*bump the Smith number counter.       */
    if \tell  then iterate                      /*Not showing the numbers? Keep looking*/
    @=@ right(j, w);         if length(@)>130  then do;    say substr(@, 2);    @=;   end
    end   /*j*/                                 /* [↑]  if N>0,  then display Smith #s.*/

if @\== then say substr(@, 2) /*if any residual Smith #s, display 'em*/ say /* [↓] display the number of Smith #s.*/ say # ' Smith numbers found ≤ ' N"." /*display number of Smith numbers found*/ exit /*stick a fork in it, we're all done. */ /*──────────────────────────────────────────────────────────────────────────────────────*/ sumD: parse arg x 1 s 2; do d=2 for length(x)-1; s=s+substr(x,d,1); end; return s /*──────────────────────────────────────────────────────────────────────────────────────*/ sumFactr: procedure; parse arg z; $=0; f=0 /*obtain the Z number. */

            do  while z//2==0;  $=$+2;  f=f+1;  z=z% 2;  end    /*maybe add factor of 2*/
            do  while z//3==0;  $=$+3;  f=f+1;  z=z% 3;  end    /*  "    "     "    " 3*/
                                                                /*                  ___*/
            do j=5  by 2  while j<=z  &  j*j<=n                 /*minimum of Z or  √ N */
            if j//3==0  then iterate                            /*skip factors that ÷ 3*/
               do while z//j==0; f=f+1; $=$+sumD(j); z=z%j; end /*maybe reduce  Z by J */
            end   /*j*/                                         /* [↓]  Z:  what's left*/
         if z\==1  then do;      f=f+1; $=$+sumD(z);        end /*Residual?  Then add Z*/
         if f<2    then return 0                                /*Prime?   Not a Smith#*/
                        return $                                /*else return sum digs.*/</lang>

output   when using the default input:

   4   22   27   58   85   94  121  166  202  265  274  319  346  355  378  382  391  438  454  483  517  526  535  562  576  588  627
 634  636  645  648  654  663  666  690  706  728  729  762  778  825  852  861  895  913  915  922  958  985 1086 1111 1165 1219 1255
1282 1284 1376 1449 1507 1581 1626 1633 1642 1678 1736 1755 1776 1795 1822 1842 1858 1872 1881 1894 1903 1908 1921 1935 1952 1962 1966
2038 2067 2079 2155 2173 2182 2218 2227 2265 2286 2326 2362 2366 2373 2409 2434 2461 2475 2484 2515 2556 2576 2578 2583 2605 2614 2679
2688 2722 2745 2751 2785 2839 2888 2902 2911 2934 2944 2958 2964 2965 2970 2974 3046 3091 3138 3168 3174 3226 3246 3258 3294 3345 3366
3390 3442 3505 3564 3595 3615 3622 3649 3663 3690 3694 3802 3852 3864 3865 3930 3946 3973 4054 4126 4162 4173 4185 4189 4191 4198 4209
4279 4306 4369 4414 4428 4464 4472 4557 4592 4594 4702 4743 4765 4788 4794 4832 4855 4880 4918 4954 4959 4960 4974 4981 5062 5071 5088
5098 5172 5242 5248 5253 5269 5298 5305 5386 5388 5397 5422 5458 5485 5526 5539 5602 5638 5642 5674 5772 5818 5854 5874 5915 5926 5935
5936 5946 5998 6036 6054 6084 6096 6115 6171 6178 6187 6188 6252 6259 6295 6315 6344 6385 6439 6457 6502 6531 6567 6583 6585 6603 6684
6693 6702 6718 6760 6816 6835 6855 6880 6934 6981 7026 7051 7062 7068 7078 7089 7119 7136 7186 7195 7227 7249 7287 7339 7402 7438 7447
7465 7503 7627 7674 7683 7695 7712 7726 7762 7764 7782 7784 7809 7824 7834 7915 7952 7978 8005 8014 8023 8073 8077 8095 8149 8154 8158
8185 8196 8253 8257 8277 8307 8347 8372 8412 8421 8466 8518 8545 8568 8628 8653 8680 8736 8754 8766 8790 8792 8851 8864 8874 8883 8901
8914 9015 9031 9036 9094 9166 9184 9193 9229 9274 9276 9285 9294 9296 9301 9330 9346 9355 9382 9386 9387 9396 9414 9427 9483 9522 9535
9571 9598 9633 9634 9639 9648 9657 9684 9708 9717 9735 9742 9760 9778 9840 9843 9849 9861 9880 9895 9924 9942 9968 9975 9985

376  Smith numbers found  ≤  9999.

optimized

This REXX version uses a faster version of the   sumFactr   function;   it's over   20   times faster than the
unoptimized version using a (negative) one million for   N. <lang rexx>/*REXX program finds (and maybe displays) Smith (or joke) numbers up to a given N.*/ parse arg N . /*obtain optional argument from the CL.*/ if N== | N=="," then N=10000 /*Not specified? Then use the default.*/ tell= (N>0); N=abs(N) - 1 /*use the │N│ for computing (below).*/

  1. =0 /*the number of Smith numbers (so far).*/

w=length(N) /*W: used for aligning Smith numbers. */ @=; do j=4 for max(0, N-3) /*process almost all numbers up to N. */

      if sumD(j) \== sumFactr(j)  then iterate  /*Not a Smith number?   Then ignore it.*/
      #=#+1                                     /*bump the Smith number counter.       */
      if \tell  then iterate                    /*Not showing the numbers? Keep looking*/
      @=@ right(j, w);        if length(@)>130 then do;   say substr(@, 2);    @=;    end
      end   /*j*/                               /* [↑]  if N>0,  then display Smith #s.*/

if @\== then say substr(@, 2) /*if any residual Smith #s, display 'em*/ say /* [↓] display the number of Smith #s.*/ say # ' Smith numbers found ≤ ' max(0,N)"." /*display number of Smith numbers found*/ exit /*stick a fork in it, we're all done. */ /*──────────────────────────────────────────────────────────────────────────────────────*/ sumD: parse arg x 1 s 2; do d=2 for length(x)-1; s=s+substr(x,d,1); end; return s /*──────────────────────────────────────────────────────────────────────────────────────*/ sumFactr: procedure; parse arg z; $=0; f=0 /*obtain Z number (arg1).*/

            do  while z// 2==0; $=$+ 2; f=f+1; z=z% 2;  end /*maybe add factor of   2. */
            do  while z// 3==0; $=$+ 3; f=f+1; z=z% 3;  end /*  "    "     "    "   3. */
            do  while z// 5==0; $=$+ 5; f=f+1; z=z% 5;  end /*  "    "     "    "   5. */
            do  while z// 7==0; $=$+ 7; f=f+1; z=z% 7;  end /*  "    "     "    "   7. */
         t=z;  r=0;  q=1;       do while q<=t; q=q*4;   end /*R:  will be the iSqrt(Z).*/
            do while q>1;  q=q%4;  _=t-r-q;  r=r%2;  if _>=0  then do;  t=_;  r=r+q;  end
            end   /*while q>1*/                             /* [↑] compute int. SQRT(Z)*/
            do j=11  by 6  to r  while j<=z                 /*skip factors that are ÷ 3*/
            parse var  j    -1  _;     if _\==5 then,     /*is last dec. digit ¬a 5 ?*/
              do  while z//j==0; f=f+1; $=$+sumD(j); z=z%j; end   /*maybe reduce Z by J*/
            if _==3  then iterate;      y=j+2
              do  while z//y==0; f=f+1; $=$+sumD(y); z=z%y; end   /*maybe reduce Z by Y*/
            end   /*j*/                                     /* [↓]  Z  is what's left. */
         if z\==1  then do;      f=f+1; $=$+sumD(z);  end   /*if a residual, then add Z*/
         if f<2    then return 0                            /*Is prime? It's not Smith#*/
                        return $                            /*else, return sum of digs.*/</lang>

output   when using the input of (negative) one million:   -1000000

29928  Smith numbers found  ≤  999999.

Ruby

<lang ruby>require "prime"

class Integer

 def smith?
   return false if prime?
   digits.sum == prime_division.map{|pr,n| pr.digits.sum * n}.sum
 end

end

n = 10_000 res = 1.upto(n).select(&:smith?)

puts "#{res.size} smith numbers below #{n}:

  1. {res.first(5).join(", ")},... #{res.last(5).join(", ")}"</lang>
Output:
376 smith numbers below 10000:
4, 22, 27, 58, 85,... 9924, 9942, 9968, 9975, 9985

Sidef

Translation of: Perl 6

<lang ruby>var primes = Enumerator({ |callback|

   static primes = Hash()
   var p = 2
   loop {
       callback(p)
       p = (primes{p} := p.next_prime)
   }

})

func factors(remainder) {

   remainder == 1 && return([remainder])
   gather {
       primes.each { |factor|
           if (factor*factor > remainder) {
               take(remainder) if (remainder > 1)
               break
           }
           while (factor.divides(remainder)) {
               take(factor)
               break if ((remainder /= factor) == 1)
           }
       }
   }

}

func is_smith_number(n) {

   !n.is_prime && (n.digits.sum == factors(n).join.to_i.digits.sum)

}

var s = range(2, 10_000).grep { is_smith_number(_) } say "#{s.len} Smith numbers below 10_000" say "First 10: #{s.first(10)}" say "Last 10: #{s.last(10)}"</lang>

Output:
376 Smith numbers below 10_000
First 10: [4, 22, 27, 58, 85, 94, 121, 166, 202, 265]
Last  10: [9843, 9849, 9861, 9880, 9895, 9924, 9942, 9968, 9975, 9985]

Tcl

<lang Tcl>proc factors {x} {

   # list the prime factors of x in ascending order
   set result [list]
   while {$x % 2 == 0} {
       lappend result 2
       set x [expr {$x / 2}]
   }
   for {set i 3} {$i*$i <= $x} {incr i 2} {
       while {$x % $i == 0} {
           lappend result $i
           set x [expr {$x / $i}]
       }
   }
   if {$x != 1} {lappend result $x}
   return $result

}

proc digitsum {n} {

   ::tcl::mathop::+ {*}[split $n ""]

}

proc smith? {n} {

   set fs [factors $n]
   if {[llength $fs] == 1} {
       return false    ;# $n is prime
   }
   expr {[digitsum $n] == [digitsum [join $fs ""]]}

} proc range {n} {

   for {set i 1} {$i < $n} {incr i} {lappend result $i}
   return $result

}

set smiths [lmap i [range 10000] {

   if {![smith? $i]} continue
   set i

}]

puts [lrange $smiths 0 12]... puts ...[lrange $smiths end-12 end] puts "([llength $smiths] total)" </lang>

Output:
4 22 27 58 85 94 121 166 202 265 274 319 346...
...9760 9778 9840 9843 9849 9861 9880 9895 9924 9942 9968 9975 9985
(376 total)

zkl

Uses the code (primeFactors) from Prime decomposition#zkl. <lang zkl>fcn smithNumbers(N=0d10_000){ // -->(Smith numbers to N)

  [2..N].filter(fcn(n){ 
     (pfs:=primeFactors(n)).len()>1 and
     n.split().sum(0)==primeFactors(n).apply("split").flatten().sum(0) 
  })

}</lang> <lang zkl>sns:=smithNumbers(); sns.toString(*).println(" ",sns.len()," numbers");</lang>

Output:
L(4,22,27,58,85,94,121,166,202,265,274,319,346,355,378,382,391, ...
3091,3138,3168,3174,3226,3246,3258,3294,3345,3366,3390,3442,3505, ...
9942,9968,9975,9985) 376 numbers