Task: Aliquot sequence classifications







Python: from proper_divisors import proper_divs
from functools import lru_cache


@lru_cache()
def pdsum(n): 
    return sum(proper_divs(n))
    
    
def aliquot(n, maxlen=16, maxterm=2**47):
    if n == 0:
        return 'terminating', [0]
    s, slen, new = [n], 1, n
    while slen <= maxlen and new < maxterm:
        new = pdsum(s[-1])
        if new in s:
            if s[0] == new:
                if slen == 1:
                    return 'perfect', s
                elif slen == 2:
                    return 'amicable', s
                else:
                    return 'sociable of length %i' % slen, s
            elif s[-1] == new:
                return 'aspiring', s
            else:
                return 'cyclic back to %i' % new, s
        elif new == 0:
            return 'terminating', s + [0]
        else:
            s.append(new)
            slen += 1
    else:
        return 'non-terminating', s
                
if __name__ == '__main__':
    for n in range(1, 11): 
        print('%s: %r' % aliquot(n))
    print()
    for n in [11, 12, 28, 496, 220, 1184,  12496, 1264460, 790, 909, 562, 1064, 1488, 15355717786080]: 
        print('%s: %r' % aliquot(n))




Fortran:       MODULE FACTORSTUFF	
Concocted by R.N.McLean, MMXV.
c       INTEGER*4 I4LIMIT
c       PARAMETER (I4LIMIT = 2147483647)
       INTEGER*8 TOOBIG		
       PARAMETER (TOOBIG = 2**47)	
       INTEGER LOTS			
       PARAMETER (LOTS = 10000)	
       INTEGER*8 KNOWNSUM(LOTS)	
       CONTAINS			
        INTEGER*8 FUNCTION SUMF(N)	
         INTEGER*8 N			
         INTEGER*8 F,F2		
         INTEGER*8 S,INC,BOOST		
          IF (N.LE.LOTS) THEN		
            SUMF = KNOWNSUM(N)			
           ELSE			
Could use SUMF in place of S, but some compilers have been confused by such usage.
            S = 1			
            F = 1			
            INC = 1			
            IF (MOD(N,2) .EQ. 1) INC = 2
    1       F = F + INC			
            F2 = F*F				
            IF (F2 .LT. N) THEN			
              IF (MOD(N,F) .EQ. 0) THEN		
                BOOST = F + N/F			
                IF (S .GT. TOOBIG - BOOST) GO TO 666	
                S = S + BOOST			
              END IF				
              GO TO 1				
            END IF			
            IF (F2 .EQ. N) THEN	
              IF (S .GT. TOOBIG - F) GO TO 666	
              S = S + F			
            END IF			
            SUMF = S			
          END IF			
         RETURN			
Cannot calculate the sum, because it exceeds the INTEGER*8 limit.
  666     SUMF = -666		
        END FUNCTION SUMF	
         SUBROUTINE PREPARESUMF	
Convert the Sieve of Eratoshenes to have each slot contain the sum of the proper divisors of its slot number.
Changes to instead count the number of factors, or prime factors, etc. would be simple enough.
         INTEGER*8 F		
          KNOWNSUM(1) = 0		
          KNOWNSUM(2:LOTS) = 1		
          DO F = 2,LOTS/2		
            FORALL(I = F + F:LOTS:F) KNOWNSUM(I) = KNOWNSUM(I) + F	
          END DO			
        END SUBROUTINE PREPARESUMF	
         SUBROUTINE CLASSIFY(N)	
         INTEGER*8 N		
         INTEGER ROPE		
         PARAMETER(ROPE = 16)	
         INTEGER*8 TRAIL(ROPE)	
         INTEGER*8 SF		
         INTEGER I,L		
         CHARACTER*28 THIS	
          L = 1		
          TRAIL(1) = N		
          SF = N		
   10     SF = SUMF(SF)		
          IF (SF .LT. 0) THEN		
            WRITE (THIS,11) L,"overflows
   11       FORMAT ("After ",I0,", ",A)		
            CALL REPORT(ADJUSTR(THIS))		
          ELSE IF (SF .EQ. 0) THEN		
            WRITE (THIS,11) L,"terminates
            CALL REPORT(ADJUSTR(THIS))		
          ELSE IF (ANY(TRAIL(1:L) .EQ. SF)) THEN	
            IF (L .EQ. 1) THEN				
              CALL REPORT("Perfect
            ELSE IF (L .EQ. 2) THEN			
              CALL REPORT("Amicable:")			
            ELSE					
              I = MINLOC(ABS(TRAIL(1:L) - SF),DIM=1)	
              IF (I .EQ. 1) THEN		
                WRITE (THIS,12) L		
   12           FORMAT ("Sociable ",I0,":")	
                CALL REPORT(ADJUSTR(THIS))	
              ELSE IF (I .EQ. L) THEN		
                CALL REPORT("Aspiring:")	
              ELSE				
                WRITE (THIS,13) L - I + 1,SF	
   13           FORMAT ("Cyclic end ",I0,", to ",I0,":")	
                CALL REPORT(ADJUSTR(THIS))	
              END IF				
            END IF			
          ELSE				
            IF (L .GE. ROPE) THEN		
              WRITE (THIS,11) L,"non-terminating?"	
              CALL REPORT(ADJUSTR(THIS))		
             ELSE				
              L = L + 1			
              TRAIL(L) = SF			
              GO TO 10				
            END IF			
          END IF		
         RETURN		
         CONTAINS		
          SUBROUTINE REPORT(WHAT)	
           CHARACTER*(*) WHAT		
            WRITE (6,1) WHAT,TRAIL(1:L)
    1       FORMAT (A28,1X,12(I0:","))	
          END SUBROUTINE REPORT	
        END SUBROUTINE CLASSIFY	
       END MODULE FACTORSTUFF	
       PROGRAM CLASSIFYTHEM	
       USE FACTORSTUFF		
       INTEGER*8 I,N		
       INTEGER*8 THIS(14)	
       DATA THIS/11,12,28,496,220,1184,12496,1264460,790,909,     
     1  562,1064,1488,15355717786080/	
         CALL PREPARESUMF		
         DO I = 1,10			
          CALL CLASSIFY(I)
        END DO
         DO I = 1,SIZE(THIS)		
          CALL CLASSIFY(THIS(I))
        END DO
       END