Another update from ingydotnet^djgoku
This commit is contained in:
Ingy döt Net
parent
91df62d461
commit
948b86eafa
7604 changed files with 108452 additions and 22726 deletions
|
|
@ -0,0 +1,66 @@
|
|||
#!/bin/gawk -f
|
||||
function sumprop(num, i,sum,root) {
|
||||
if (num == 1) return 0
|
||||
sum=1
|
||||
root=sqrt(num)
|
||||
for ( i=2; i < root; i++) {
|
||||
if (num % i == 0 )
|
||||
{
|
||||
sum = sum + i + num/i
|
||||
}
|
||||
}
|
||||
if (num % root == 0)
|
||||
{
|
||||
sum = sum + root
|
||||
}
|
||||
return sum
|
||||
}
|
||||
function class(k, oldk,newk,seq){
|
||||
# first term
|
||||
oldk = k
|
||||
seq = " "
|
||||
# second term
|
||||
newk = sumprop(oldk)
|
||||
oldk = newk
|
||||
seq = seq " " newk
|
||||
if (newk == 0) return "terminating " seq
|
||||
if (newk == k) return "perfect " seq
|
||||
# third term
|
||||
newk = sumprop(oldk)
|
||||
oldk = newk
|
||||
seq = seq " " newk
|
||||
if (newk == 0) return "terminating " seq
|
||||
if (newk == k) return "amicable " seq
|
||||
for (t=4; t<17; t++) {
|
||||
newk = sumprop(oldk)
|
||||
seq = seq " " newk
|
||||
if (newk == 0) return "terminating " seq
|
||||
if (newk == k) return "sociable (period " t-1 ") "seq
|
||||
if (newk == oldk) return "aspiring " seq
|
||||
if (index(seq," " newk " ") > 0) return "cyclic (at " newk ") " seq
|
||||
if (newk > 140737488355328) return "non-terminating (term > 140737488355328) " seq
|
||||
oldk = newk
|
||||
}
|
||||
return "non-terminating (after 16 terms) " seq
|
||||
}
|
||||
BEGIN{
|
||||
print "Number classification sequence"
|
||||
for (j=1; j < 11; j++)
|
||||
{
|
||||
print j,class(j)}
|
||||
print 11,class(11)
|
||||
print 12,class(12)
|
||||
print 28,class(28)
|
||||
print 496,class(496)
|
||||
print 220,class(220)
|
||||
print 1184,class(1184)
|
||||
print 12496,class(12496)
|
||||
print 1264460,class(1264460)
|
||||
print 790,class(790)
|
||||
print 909,class(909)
|
||||
print 562,class(562)
|
||||
print 1064,class(1064)
|
||||
print 1488,class(1488)
|
||||
print 15355717786080,class(15355717786080)
|
||||
|
||||
}
|
||||
|
|
@ -0,0 +1,123 @@
|
|||
MODULE FACTORSTUFF !This protocol evades the need for multiple parameters, or COMMON, or one shapeless main line...
|
||||
Concocted by R.N.McLean, MMXV.
|
||||
c INTEGER*4 I4LIMIT
|
||||
c PARAMETER (I4LIMIT = 2147483647)
|
||||
INTEGER*8 TOOBIG !Some bounds.
|
||||
PARAMETER (TOOBIG = 2**47) !Computer arithmetic is not with real numbers.
|
||||
INTEGER LOTS !Nor is computer storage infinite.
|
||||
PARAMETER (LOTS = 10000) !So there can't be all that many of these.
|
||||
INTEGER*8 KNOWNSUM(LOTS) !If multiple references are expected, it is worthwhile calculating these.
|
||||
CONTAINS !Assistants.
|
||||
INTEGER*8 FUNCTION SUMF(N) !Sum of the proper divisors of N.
|
||||
INTEGER*8 N !The number in question.
|
||||
INTEGER*8 F,F2 !Candidate factor, and its square.
|
||||
INTEGER*8 S,INC,BOOST !Assistants.
|
||||
IF (N.LE.LOTS) THEN !If we're within reach,
|
||||
SUMF = KNOWNSUM(N) !The result is to hand.
|
||||
ELSE !Otherwise, some on-the-spot effort ensues.
|
||||
Could use SUMF in place of S, but some compilers have been confused by such usage.
|
||||
S = 1 !1 is always a factor of N, but N is deemed not proper.
|
||||
F = 1 !Prepare a crude search for factors.
|
||||
INC = 1 !One by plodding one.
|
||||
IF (MOD(N,2) .EQ. 1) INC = 2!Ah, but an odd number cannot have an even number as a divisor.
|
||||
1 F = F + INC !So half the time we can doubleplod.
|
||||
F2 = F*F !Up to F2 < N rather than F < SQRT(N) and worries over inexact arithmetic.
|
||||
IF (F2 .LT. N) THEN !F2 = N handled below.
|
||||
IF (MOD(N,F) .EQ. 0) THEN !Does F divide N?
|
||||
BOOST = F + N/F !Yes. The divisor and its counterpart.
|
||||
IF (S .GT. TOOBIG - BOOST) GO TO 666 !Would their augmentation cause an overflow?
|
||||
S = S + BOOST !No, so count in the two divisors just discovered.
|
||||
END IF !So much for a divisor discovered.
|
||||
GO TO 1 !Try for another.
|
||||
END IF !So much for N = p*q style factors.
|
||||
IF (F2 .EQ. N) THEN !Special case: N may be a perfect square, not necessarily of a prime number.
|
||||
IF (S .GT. TOOBIG - F) GO TO 666 !It is. And it too might cause overflow.
|
||||
S = S + F !But if not, count F once only.
|
||||
END IF !All done.
|
||||
SUMF = S !This is the result.
|
||||
END IF !Whichever way obtained,
|
||||
RETURN !Done.
|
||||
Cannot calculate the sum, because it exceeds the INTEGER*8 limit.
|
||||
666 SUMF = -666 !An expression of dismay that the caller will notice.
|
||||
END FUNCTION SUMF !Alternatively, find the prime factors, and combine them...
|
||||
SUBROUTINE PREPARESUMF !Initialise the KNOWNSUM array.
|
||||
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 !A factor for numbers such as 2F, 3F, 4F, 5F, ...
|
||||
KNOWNSUM(1) = 0 !Proper divisors of N do not include N.
|
||||
KNOWNSUM(2:LOTS) = 1 !So, although 1 divides all N without remainder, 1 is excluded for itself.
|
||||
DO F = 2,LOTS/2 !Step through all the possible divisors of numbers not exceeding LOTS.
|
||||
FORALL(I = F + F:LOTS:F) KNOWNSUM(I) = KNOWNSUM(I) + F !And augment each corresponding slot.
|
||||
END DO !Different divisors can hit the same slot. For instance, 6 by 2 and also by 3.
|
||||
END SUBROUTINE PREPARESUMF !Could alternatively generate all products of prime numbers.
|
||||
SUBROUTINE CLASSIFY(N) !Traipse along the SumF trail.
|
||||
INTEGER*8 N !The starter.
|
||||
INTEGER ROPE !The size of my memory is not so great..
|
||||
PARAMETER(ROPE = 16) !Indeed, this is strictly limited.
|
||||
INTEGER*8 TRAIL(ROPE) !But the numbers can be large.
|
||||
INTEGER*8 SF !The working sum of proper divisors.
|
||||
INTEGER I,L !Indices, merely.
|
||||
CHARACTER*28 THIS !A perfect scratchpad for remarks.
|
||||
L = 1 !Every journey starts with its first step.
|
||||
TRAIL(1) = N !Which is this.
|
||||
SF = N !Syncopation.
|
||||
10 SF = SUMF(SF) !Step onwards.
|
||||
IF (SF .LT. 0) THEN !Trouble?
|
||||
WRITE (THIS,11) L,"overflows!" !Yes. Too big a number.
|
||||
11 FORMAT ("After ",I0,", ",A) !Describe the situation.
|
||||
CALL REPORT(ADJUSTR(THIS)) !And give the report.
|
||||
ELSE IF (SF .EQ. 0) THEN !Otherwise, a finish?
|
||||
WRITE (THIS,11) L,"terminates!" !Yay!
|
||||
CALL REPORT(ADJUSTR(THIS)) !This sequence is finished.
|
||||
ELSE IF (ANY(TRAIL(1:L) .EQ. SF)) THEN !Otherwise, is there an echo somewhere?
|
||||
IF (L .EQ. 1) THEN !Yes!
|
||||
CALL REPORT("Perfect!") !Are we at the start?
|
||||
ELSE IF (L .EQ. 2) THEN !Or perhaps not far along.
|
||||
CALL REPORT("Amicable:") !These are held special.
|
||||
ELSE !Otherwise, we've wandered further along.
|
||||
I = MINLOC(ABS(TRAIL(1:L) - SF),DIM=1) !Damnit, re-scan the array to finger the first matching element.
|
||||
IF (I .EQ. 1) THEN !If all the way back to the start,
|
||||
WRITE (THIS,12) L !Then there are this many elements in the sociable ring.
|
||||
12 FORMAT ("Sociable ",I0,":") !Computers are good at counting.
|
||||
CALL REPORT(ADJUSTR(THIS)) !So, perform an added service.
|
||||
ELSE IF (I .EQ. L) THEN !Perhaps we've hit a perfect number!
|
||||
CALL REPORT("Aspiring:") !A cycle of length one.
|
||||
ELSE !But otherwise,
|
||||
WRITE (THIS,13) L - I + 1,SF !A longer cycle. Amicable, or sociable.
|
||||
13 FORMAT ("Cyclic end ",I0,", to ",I0,":") !Name the flashback value too.
|
||||
CALL REPORT(ADJUSTR(THIS)) !Thus.
|
||||
END IF !So much for cycles.
|
||||
END IF !So much for finding an echo.
|
||||
ELSE !Otherwise, nothing special has happened.
|
||||
IF (L .GE. ROPE) THEN !So, how long is a piece of string?
|
||||
WRITE (THIS,11) L,"non-terminating?" !Not long enough!
|
||||
CALL REPORT(ADJUSTR(THIS)) !So we give up.
|
||||
ELSE !But if there is more scope,
|
||||
L = L + 1 !Advance one more step.
|
||||
TRAIL(L) = SF !Save the latest result.
|
||||
GO TO 10 !And try for the next.
|
||||
END IF !So much for continuing.
|
||||
END IF !So much for the classification.
|
||||
RETURN !Finished.
|
||||
CONTAINS !Not quite.
|
||||
SUBROUTINE REPORT(WHAT) !There is this service routine.
|
||||
CHARACTER*(*) WHAT !Whatever the length of the text, the FORMAT's A28 shows 28 characters, right-aligned.
|
||||
WRITE (6,1) WHAT,TRAIL(1:L)!Mysteriously, a fresh line after every twelve elements.
|
||||
1 FORMAT (A28,1X,12(I0:",")) !And obviously, the : signifies "do not print what follows unless there is another number to go.
|
||||
END SUBROUTINE REPORT !That was easy.
|
||||
END SUBROUTINE CLASSIFY !Enough.
|
||||
END MODULE FACTORSTUFF !Enough assistants.
|
||||
PROGRAM CLASSIFYTHEM !Report on the nature of the sequence N, Sumf(N), Sumf(Sumf(N)), etc.
|
||||
USE FACTORSTUFF !This should help.
|
||||
INTEGER*8 I,N !Steppers.
|
||||
INTEGER*8 THIS(14) !A testing collection.
|
||||
DATA THIS/11,12,28,496,220,1184,12496,1264460,790,909, !Old-style continuation character in column six.
|
||||
1 562,1064,1488,15355717786080/ !Monster value far exceeds the INTEGER*4 limit
|
||||
CALL PREPARESUMF !Prepare for 1:LOTS, even though this test run will use only a few.
|
||||
DO I = 1,10 !As specified, the first ten integers.
|
||||
CALL CLASSIFY(I)
|
||||
END DO
|
||||
DO I = 1,SIZE(THIS) !Now for the specified list.
|
||||
CALL CLASSIFY(THIS(I))
|
||||
END DO
|
||||
END !Done.
|
||||
|
|
@ -0,0 +1,24 @@
|
|||
function aliquotclassifier{T<:Integer}(n::T)
|
||||
a = T[n]
|
||||
b = divisorsum(a[end])
|
||||
len = 1
|
||||
while len < 17 && !(b in a) && 0 < b && b < 2^47+1
|
||||
push!(a, b)
|
||||
b = divisorsum(a[end])
|
||||
len += 1
|
||||
end
|
||||
if b in a
|
||||
1 < len || return ("Perfect", a)
|
||||
if b == a[1]
|
||||
2 < len || return ("Amicable", a)
|
||||
return ("Sociable", a)
|
||||
elseif b == a[end]
|
||||
return ("Aspiring", a)
|
||||
else
|
||||
return ("Cyclic", push!(a, b))
|
||||
end
|
||||
end
|
||||
push!(a, b)
|
||||
b != 0 || return ("Terminating", a)
|
||||
return ("Non-terminating", a)
|
||||
end
|
||||
|
|
@ -0,0 +1,17 @@
|
|||
function pcontrib{T<:Integer}(p::T, a::T)
|
||||
n = one(T)
|
||||
pcon = one(T)
|
||||
for i in 1:a
|
||||
n *= p
|
||||
pcon += n
|
||||
end
|
||||
return pcon
|
||||
end
|
||||
|
||||
function divisorsum{T<:Integer}(n::T)
|
||||
dsum = one(T)
|
||||
for (p, a) in factor(n)
|
||||
dsum *= pcontrib(p, a)
|
||||
end
|
||||
dsum -= n
|
||||
end
|
||||
|
|
@ -0,0 +1,6 @@
|
|||
println("Classification Tests:")
|
||||
tests = [1:12, 28, 496, 220, 1184, 12496, 1264460, 790, 909, 562, 1064, 1488]
|
||||
for i in tests
|
||||
(class, a) = aliquotclassifier(i)
|
||||
println(@sprintf("%8d => ", i), @sprintf("%16s, ", class), a)
|
||||
end
|
||||
|
|
@ -0,0 +1,19 @@
|
|||
seq[n_] :=
|
||||
NestList[If[# == 0, 0,
|
||||
DivisorSum[#, # &, Function[div, div != #]]] &, n, 16];
|
||||
class[seq_] :=
|
||||
Which[Length[seq] < 2, "Non-terminating", MemberQ[seq, 0],
|
||||
"Terminating", seq[[1]] == seq[[2]], "Perfect",
|
||||
Length[seq] > 2 && seq[[1]] == seq[[3]], "Amicable",
|
||||
Length[seq] > 3 && MemberQ[seq[[4 ;;]], seq[[1]]], "Sociable",
|
||||
MatchQ[class[Rest[seq]], "Perfect" | "Aspiring"], "Aspiring",
|
||||
MatchQ[class[Rest[seq]], "Amicable" | "Sociable" | "Cyclic"],
|
||||
"Cyclic", True, "Non-terminating"];
|
||||
notate[seq_] :=
|
||||
Which[seq == {}, {},
|
||||
MemberQ[Rest[seq],
|
||||
seq[[1]]], {Prepend[TakeWhile[Rest[seq], # != seq[[1]] &],
|
||||
seq[[1]]]}, True, Prepend[notate[Rest[seq]], seq[[1]]]];
|
||||
Print[{#, class[seq[#]], notate[seq[#]] /. {0} -> 0}] & /@ {1, 2, 3, 4, 5, 6, 7,
|
||||
8, 9, 10, 11, 12, 28, 496, 220, 1184, 12496, 1264460, 790, 909,
|
||||
562, 1064, 1488, 15355717786080};
|
||||
|
|
@ -13,13 +13,13 @@ multi quality ($,$n) { "cyclic-$n" }
|
|||
|
||||
sub aliquotidian ($x) {
|
||||
my %seen;
|
||||
my @seq := $x, &propdivsum ... *;
|
||||
my @seq = $x, &propdivsum ... *;
|
||||
for 0..16 -> $to {
|
||||
my $this = @seq[$to] or return "$x terminating [@seq[^$to]]";
|
||||
my $this = @seq[$to] or return "$x\tterminating\t[@seq[^$to]]";
|
||||
last if $this > 140737488355328;
|
||||
if %seen{$this}:exists {
|
||||
my $from = %seen{$this};
|
||||
return "$x &quality($from, $to-$from) [@seq[^$to]]";
|
||||
return "$x\t&quality($from, $to-$from)\t[@seq[^$to]]";
|
||||
}
|
||||
%seen{$this} = $to;
|
||||
}
|
||||
|
|
@ -27,7 +27,7 @@ sub aliquotidian ($x) {
|
|||
|
||||
}
|
||||
|
||||
aliquotidian($_).say for
|
||||
aliquotidian($_).say for flat
|
||||
1..10,
|
||||
11, 12, 28, 496, 220, 1184, 12496, 1264460,
|
||||
790, 909, 562, 1064, 1488,
|
||||
|
|
|
|||
|
|
@ -1,62 +1,63 @@
|
|||
/*REXX pgm classifies various positive integers for aliquot sequences. */
|
||||
parse arg low high L /*get optional arguments*/
|
||||
/*REXX program classifies various positive integers for aliquot sequences. */
|
||||
parse arg low high L /*get some optional arguments.*/
|
||||
high=word(high low 10,1); low=word(low 1,1) /*get the LOW and HIGH. */
|
||||
if L='' then L=11 12 28 496 220 1184 12496 1264460 790 909 562 1064 1488
|
||||
big=2**47; NTlimit=16+1 /*limit: non-terminating*/
|
||||
numeric digits max(9, 1+length(big)) /*be able to handle // */
|
||||
@.=.; @.0=0; @.1=0 /*proper divisor sums. */
|
||||
if L='' then L=11 12 28 496 220 1184 12496 1264460 790 909 562 1064 1488 15355717786080
|
||||
big=2**47; NTlimit=16+1 /*seq. non─terminating limit. */
|
||||
numeric digits max(9, 1+length(big)) /*be able to handle // oper.*/
|
||||
#.=.; #.0=0; #.1=0 /*#. are proper divisor sums.*/
|
||||
say center('numbers from ' low " to " high, 79, "═")
|
||||
|
||||
do n=low to high /*process probably some low nums.*/
|
||||
call classify_aliquot n /*call subroutine to classify it.*/
|
||||
end /*n*/ /* [↑] process a range of ints.*/
|
||||
do n=low to high /*process (probably) some low numbers. */
|
||||
call classify_aliquot n /*call a subroutine to classify number.*/
|
||||
end /*n*/ /* [↑] process a range of integers. */
|
||||
say
|
||||
say center('first numbers for each classification', 79, "═")
|
||||
b.=0 /* [↓] ensure one of each class.*/
|
||||
do q=1 until b.sociable \== 0 /*only one that has to be counted*/
|
||||
call classify_aliquot -q /*the minus sign indicates ¬tell.*/
|
||||
b._=b._+1; if b._==1 then call show_class q,$ /*show 1st found.*/
|
||||
end /*q*/ /* [↑] until all classes found. */
|
||||
b.=0 /* [↓] ensure one number of each class*/
|
||||
do q=1 until b.sociable \== 0 /*the only one that has to be counted. */
|
||||
call classify_aliquot -q /*the minus (-) sign indicates ¬ tell. */
|
||||
_=what; upper _; b._=b._+1 /*bump the counter for this seq. class.*/
|
||||
if b._==1 then call show_class q,$ /*show the first occurrence only.*/
|
||||
end /*q*/ /* [↑] process until all classes found*/
|
||||
say
|
||||
say center('classifications for specific numbers', 79, "═")
|
||||
|
||||
do i=1 for words(L) /*L is a list of "special numbers*/
|
||||
call classify_aliquot word(L,i) /*call subroutine to classify it.*/
|
||||
end /*i*/ /* [↑] process a list of numbers*/
|
||||
exit /*stick a fork in it, we're done.*/
|
||||
/*──────────────────────────────────CLASSIFY_ALIQUOT subroutine─────────*/
|
||||
classify_aliquot: parse arg a 1 aa; a=abs(a) /*get what # to be used.*/
|
||||
if @.a\==. then s=@.a /*Was number been summed before? */
|
||||
else s=SPdivs(a) /*No, then do it the hard way. */
|
||||
@.a=s; $=s /*define sum of the proper DIVs. */
|
||||
what='terminating' /*assume this classification kind*/
|
||||
c.=0; c.s=1 /*clear all cyclic seqs, set 1st.*/
|
||||
if $==a then what='perfect' /*check for "perfect" number. */
|
||||
else do t=1 while s\==0 /*loop until sum isn't 0 or >big.*/
|
||||
m=word($, words($)) /*obtain the last number in seq. */
|
||||
if @.m==. then s=SPdivs(m) /*if ¬defined, then sum Pdivs.*/
|
||||
else s=@.m /*use the previously found number*/
|
||||
if m==s & m\==0 then do; what='aspiring' ; leave; end
|
||||
if word($,2)==a then do; what='amicable' ; leave; end
|
||||
$=$ s /*append a sum to number sequence*/
|
||||
if s==a & t>3 then do; what='sociable' ; leave; end
|
||||
if c.s & m\==0 then do; what='cyclic' ; leave; end
|
||||
c.s=1 /*assign another possible cyclic.*/
|
||||
/* [↓] Rosetta Code's limit: >16*/
|
||||
if t>NTlimit then do; what='non-terminating'; leave; end
|
||||
if s>big then do; what='NON-TERMINATING'; leave; end
|
||||
end /*t*/ /* [↑] only permit within reason*/
|
||||
if aa>0 then call show_class a,$ /*only display if A is positive.*/
|
||||
do i=1 for words(L) /*L is a list of "special numbers". */
|
||||
call classify_aliquot word(L,i) /*call a subroutine to classify number.*/
|
||||
end /*i*/ /* [↑] process a list of integers. */
|
||||
exit /*stick a fork in it, we're all done. */
|
||||
/*────────────────────────────────────────────────────────────────────────────*/
|
||||
classify_aliquot: parse arg a 1 aa; a=abs(a) /*get what number is to be used.*/
|
||||
if #.a\==. then s=#.a /*Was this number been summed before? */
|
||||
else s=sigma(a) /*No, then classify number the hard way*/
|
||||
#.a=s; $=s /*define sum of the proper divisors. */
|
||||
what='terminating' /*assume this kind of classification. */
|
||||
c.=0; c.s=1 /*clear all cyclic sequences; set 1st.*/
|
||||
if $==a then what='perfect' /*check for a "perfect" number. */
|
||||
else do t=1 while s\==0 /*loop until sum isn't 0 or > big.*/
|
||||
m=word($, words($)) /*obtain the last number in sequence. */
|
||||
if #.m==. then s=sigma(m) /*if not defined, then sum proper divs.*/
|
||||
else s=#.m /*use the previously found integer. */
|
||||
if m==s & m\==0 then do; what='aspiring' ; leave; end
|
||||
if word($,2)==a then do; what='amicable' ; leave; end
|
||||
$=$ s /*append a sum to the integer sequence.*/
|
||||
if s==a & t>3 then do; what='sociable' ; leave; end
|
||||
if c.s & m\==0 then do; what='cyclic' ; leave; end
|
||||
c.s=1 /*assign another possible cyclic number*/
|
||||
/* [↓] Rosetta Code task's limit: >16 */
|
||||
if t>NTlimit then do; what='non-terminating'; leave; end
|
||||
if s>big then do; what='NON-TERMINATING'; leave; end
|
||||
end /*t*/ /* [↑] only permit within reason. */
|
||||
if aa>0 then call show_class a,$ /*only display if A is positive. */
|
||||
return
|
||||
/*──────────────────────────────────SHOW_CLASS subroutine───────────────*/
|
||||
show_class: say right(arg(1),digits()) 'is' center(what,15) arg(2); return
|
||||
/*──────────────────────────────────SPDIVS subroutine───────────────────*/
|
||||
SPdivs: procedure expose @.; parse arg x; if x<2 then return 0; odd=x//2
|
||||
s=1 /* [↓] use only EVEN|ODD integers*/
|
||||
do j=2+odd by 1+odd while j*j<x /*divide by all integers up to √x*/
|
||||
if x//j==0 then s=s+j+ x%j /*add the two divisors to the sum*/
|
||||
end /*j*/ /* [↑] % is REXX integer divide*/
|
||||
/* [↓] adjust for square. _ */
|
||||
if j*j==x then s=s+j /*Was X a square? If so, add √x.*/
|
||||
@.x=s /*define the sum for the arg X. */
|
||||
return s /*return divisors (both lists). */
|
||||
/*────────────────────────────────────────────────────────────────────────────*/
|
||||
show_class: say right(arg(1),digits()) 'is' center(what,15) arg(2); return
|
||||
/*────────────────────────────────────────────────────────────────────────────*/
|
||||
sigma: procedure expose #.; parse arg x; if x<2 then return 0; odd=x//2
|
||||
s=1 /* [↓] use only EVEN|ODD ints. ___*/
|
||||
do j=2+odd by 1+odd while j*j<x /*divide by all the integers up to √ X */
|
||||
if x//j==0 then s=s+j+ x%j /*add the two divisors to the sum. */
|
||||
end /*j*/ /* [↑] % is the REXX integer division*/
|
||||
/* [↓] adjust for square. ___ */
|
||||
if j*j==x then s=s+j /*Was X a square? If so, add √ X */
|
||||
#.x=s /*define the sum for the argument X. */
|
||||
return s /*return the sum of the divisors of X.*/
|
||||
|
|
|
|||
|
|
@ -0,0 +1,45 @@
|
|||
#[derive(Debug)]
|
||||
enum AliquotType { Terminating, Perfect, Amicable, Sociable, Aspiring, Cyclic, NonTerminating }
|
||||
|
||||
fn classify_aliquot(num: i64) -> (AliquotType, Vec<i64>) {
|
||||
let limit = 1i64 << 47; //140737488355328
|
||||
let mut terms = Some(num).into_iter().collect::<Vec<_>>();
|
||||
for i in 0..16 {
|
||||
let n = terms[i];
|
||||
let divsum = (1..(n + 1) / 2 + 1).filter(|&x| n % x == 0 && n != x).fold(0, |sum, x| sum + x);
|
||||
let classification = if divsum == 0 {
|
||||
Some(AliquotType::Terminating)
|
||||
}
|
||||
else if divsum > limit {
|
||||
Some(AliquotType::NonTerminating)
|
||||
}
|
||||
else if let Some(prev_idx) = terms.iter().position(|&x| x == divsum) {
|
||||
let cycle_len = terms.len() - prev_idx;
|
||||
Some(if prev_idx == 0 {
|
||||
match cycle_len {
|
||||
1 => AliquotType::Perfect,
|
||||
2 => AliquotType::Amicable,
|
||||
_ => AliquotType::Sociable
|
||||
}
|
||||
}
|
||||
else {
|
||||
if cycle_len == 1 {AliquotType::Aspiring} else {AliquotType::Cyclic}
|
||||
})
|
||||
}
|
||||
else {
|
||||
None
|
||||
};
|
||||
terms.push(divsum);
|
||||
if let Some(result) = classification {
|
||||
return (result, terms);
|
||||
}
|
||||
}
|
||||
(AliquotType::NonTerminating, terms)
|
||||
}
|
||||
|
||||
fn main() {
|
||||
let nums = [1i64, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 28, 496, 220, 1184, 12496, 1264460, 790, 909, 562, 1064, 1488/*, 15355717786080*/];
|
||||
for num in &nums {
|
||||
println!("{} {:?}", num, classify_aliquot(*num));
|
||||
}
|
||||
}
|
||||
|
|
@ -0,0 +1,73 @@
|
|||
proc ProperDivisors {n} {
|
||||
if {$n == 1} {return 0}
|
||||
set divs 1
|
||||
set sum 1
|
||||
for {set i 2} {$i*$i <= $n} {incr i} {
|
||||
if {! ($n % $i)} {
|
||||
lappend divs $i
|
||||
incr sum $i
|
||||
if {$i*$i<$n} {
|
||||
lappend divs [set d [expr {$n / $i}]]
|
||||
incr sum $d
|
||||
}
|
||||
}
|
||||
}
|
||||
list $sum $divs
|
||||
}
|
||||
|
||||
proc al_iter {n} {
|
||||
yield [info coroutine]
|
||||
while {$n} {
|
||||
yield $n
|
||||
lassign [ProperDivisors $n] n
|
||||
}
|
||||
yield 0
|
||||
return -code break
|
||||
}
|
||||
|
||||
proc al_classify {n} {
|
||||
coroutine iter al_iter $n
|
||||
set items {}
|
||||
try {
|
||||
set type "non-terminating"
|
||||
while {[llength $items] < 16} {
|
||||
set i [iter]
|
||||
if {$i == 0} {
|
||||
set type "terminating"
|
||||
}
|
||||
set ix [lsearch -exact $items $i]
|
||||
set items [linsert $items 0 $i]
|
||||
switch $ix {
|
||||
-1 { continue }
|
||||
0 { throw RESULT "perfect" }
|
||||
1 { throw RESULT "amicable" }
|
||||
default { throw RESULT "sociable" }
|
||||
}
|
||||
}
|
||||
} trap {RESULT} {type} {
|
||||
rename iter {}
|
||||
set map {
|
||||
perfect aspiring
|
||||
amicable cyclic
|
||||
sociable cyclic
|
||||
}
|
||||
if {$ix != [llength $items]-2} {
|
||||
set type [dict get $map $type]
|
||||
}
|
||||
}
|
||||
list $type [lreverse $items]
|
||||
}
|
||||
|
||||
for {set i 1} {$i <= 10} {incr i} {
|
||||
puts [format "%8d -> %-16s : %s" $i {*}[al_classify $i]]
|
||||
}
|
||||
|
||||
foreach i {11 12 28 496 220 1184 12496 1264460 790 909 562 1064 1488 } {
|
||||
puts [format "%8d -> %-16s : %s" $i {*}[al_classify $i]]
|
||||
}
|
||||
|
||||
;# stretch goal .. let's time it:
|
||||
set i 15355717786080
|
||||
puts [time {
|
||||
puts [format "%8d -> %-16s : %s" $i {*}[al_classify $i]]
|
||||
}]
|
||||
Loading…
Add table
Add a link
Reference in a new issue