Task: Smith numbers







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


list_smith_numbers(10_000)




Fortran:       MODULE FACTORISE	
       USE PRIMEBAG		
       INTEGER LASTP		
       PARAMETER (LASTP = 9)	
       TYPE FACTORED		
        INTEGER PVAL(0:LASTP)	
        INTEGER PPOW(LASTP)	
       END TYPE FACTORED	

       CONTAINS		
        SUBROUTINE SHOWFACTORS(N)	
         TYPE(FACTORED) N	
         INTEGER I		
          DO I = 1,N.PVAL(0)	
            IF (I.GT.1) WRITE (MSG,"('x',$)")	
            WRITE (MSG,"(I0,$)") N.PVAL(I)	
            IF (N.PPOW(I).GT.1) WRITE (MSG,"('^',I0,$)") N.PPOW(I)	
          END DO		
          WRITE (MSG,1) N.PVAL(0)	
    1     FORMAT (": Factor count ",I0)	
        END SUBROUTINE SHOWFACTORS	

        TYPE(FACTORED) FUNCTION FACTOR(IT)	
Careful
         INTEGER IT,N	
         INTEGER F,FP	
          IF (IT.LE.0) STOP "Factor only positive numbers
          FACTOR.PVAL(0) = 0	
          F = 0			
          N = IT		
Collapse N into its prime factors.
   10     DO WHILE(N.GT.1)	
            IF (ISPRIME(N)) THEN
              F = N			
              FP = 1			
              N = 1			
             ELSE		
              FP = 0			
   11         F = NEXTPRIME(F)		
              DO WHILE(MOD(N,F).EQ.0)	
                FP = FP + 1			
                N = N/F				
              END DO			
              IF (FP.LE.0) GO TO 11	
            END IF		
            IF (FACTOR.PVAL(0).GE.LASTP) THEN	
              WRITE (MSG,1) IT,LASTP		
    1         FORMAT ("Factoring ",I0," but with provision for only ",	
     1         I0," distinct prime factors
              CALL SHOWFACTORS(FACTOR)		
              STOP "Not enough storage
            END IF			
            FACTOR.PVAL(0) = FACTOR.PVAL(0) + 1	
            FACTOR.PVAL(FACTOR.PVAL(0)) = F	
            FACTOR.PPOW(FACTOR.PVAL(0)) = FP	
          END DO		
        END FUNCTION FACTOR	
      END MODULE FACTORISE	

      MODULE SMITHSTUFF	
       CONTAINS		
        INTEGER FUNCTION DIGITSUM(N,BASE)	
         INTEGER N,IT	
         INTEGER BASE	
         IF (N.LT.0) STOP "DigitSum: negative numbers need not apply
          DIGITSUM = 0	
          IT = N	
          DO WHILE(IT.GT.0)	
            DIGITSUM = MOD(IT,BASE) + DIGITSUM	
            IT = IT/BASE			
          END DO		
        END FUNCTION DIGITSUM	

        LOGICAL FUNCTION SMITHNUM(N,BASE)	
         USE FACTORISE		
         INTEGER N		
         INTEGER BASE		
         TYPE(FACTORED) F	
         INTEGER I,FD		
          F = FACTOR(N)		
c          write (6,"(a,I0,1x)",advance="no") "N=",N
c          call ShowFactors(F)
          FD = 0		
          DO I = 1,F.PVAL(0)	
            FD = DIGITSUM(F.PVAL(I),BASE)*F.PPOW(I) + FD	
          END DO		
          SMITHNUM = FD.EQ.DIGITSUM(N,BASE)	
        END FUNCTION SMITHNUM	
      END MODULE SMITHSTUFF	

      USE PRIMEBAG	
      USE SMITHSTUFF	
      INTEGER LAST		
      PARAMETER (LAST = 9999)	
      INTEGER I,N,BASE		
      INTEGER NB,BAG(20)	
      MSG = 6	

      WRITE (MSG,1) LAST	
    1 FORMAT ('To find the "Smith" numbers up to ',I0)
      IF (.NOT.GRASPPRIMEBAG(66)) STOP "Gan't grab my file

   10 DO BASE = 2,12	
        WRITE (MSG,11) BASE	
   11   FORMAT (/,"Working in base ",I0)
        N = 0			
        NB = 0			
        DO I = 1,LAST		
          IF (ISPRIME(I)) CYCLE		
          IF (SMITHNUM(I,BASE)) THEN	
            N = N + 1				
            IF (NB.GE.20) THEN			
              WRITE (MSG,12) BAG			
   12         FORMAT (20I6)				
              NB = 0					
            END IF				
            NB = NB + 1				
            BAG(NB) = I				
          END IF			
        END DO			
        WRITE (MSG,12) BAG(1:NB)
        WRITE (MSG,13) N	
   13   FORMAT (I9," found.")	
      END DO		
      END