2016 Update
This commit is contained in:
Tina Müller
parent
948b86eafa
commit
dcf5d15da3
7965 changed files with 139854 additions and 31002 deletions
|
|
@ -0,0 +1,67 @@
|
|||
(defparameter *nlimit* 16)
|
||||
(defparameter *klimit* (expt 2 47))
|
||||
(defparameter *asht* (make-hash-table))
|
||||
(load "proper-divisors")
|
||||
|
||||
(defun ht-insert (v n)
|
||||
(setf (gethash v *asht*) n))
|
||||
|
||||
(defun ht-find (v n)
|
||||
(let ((nprev (gethash v *asht*)))
|
||||
(if nprev (- n nprev) nil)))
|
||||
|
||||
(defun ht-list ()
|
||||
(defun sort-keys (&optional (res '()))
|
||||
(maphash #'(lambda (k v) (push (cons k v) res)) *asht*)
|
||||
(sort (copy-list res) #'< :key (lambda (p) (cdr p))))
|
||||
(let ((sorted (sort-keys)))
|
||||
(dotimes (i (length sorted)) (format t "~A " (car (nth i sorted))))))
|
||||
|
||||
(defun aliquot-generator (K1)
|
||||
"integer->function::fn to generate aliquot sequence"
|
||||
(let ((Kn K1))
|
||||
#'(lambda () (setf Kn (reduce #'+ (proper-divisors-recursive Kn) :initial-value 0)))))
|
||||
|
||||
(defun aliquot (K1)
|
||||
"integer->symbol|nil::classify aliquot sequence"
|
||||
(defun aliquot-sym (Kn n)
|
||||
(let* ((period (ht-find Kn n))
|
||||
(sym (if period
|
||||
(cond ; period event
|
||||
((= Kn K1)
|
||||
(case period (1 'PERF) (2 'AMIC) (otherwise 'SOCI)))
|
||||
((= period 1) 'ASPI)
|
||||
(t 'CYCL))
|
||||
(cond ; else check for limit event
|
||||
((= Kn 0) 'TERM)
|
||||
((> Kn *klimit*) 'TLIM)
|
||||
((= n *nlimit*) 'NLIM)
|
||||
(t nil)))))
|
||||
;; if period event store the period, if no event insert the value
|
||||
(if sym (when period (setf (symbol-plist sym) (list period)))
|
||||
(ht-insert Kn n))
|
||||
sym))
|
||||
|
||||
(defun aliquot-str (sym &optional (period 0))
|
||||
(case sym (TERM "terminating") (PERF "perfect") (AMIC "amicable") (ASPI "aspiring")
|
||||
(SOCI (format nil "sociable (period ~A)" (car (symbol-plist sym))))
|
||||
(CYCL (format nil "cyclic (period ~A)" (car (symbol-plist sym))))
|
||||
(NLIM (format nil "non-terminating (no classification before added term limit of ~A)" *nlimit*))
|
||||
(TLIM (format nil "non-terminating (term threshold of ~A exceeded)" *klimit*))
|
||||
(otherwise "unknown")))
|
||||
|
||||
(clrhash *asht*)
|
||||
(let ((fgen (aliquot-generator K1)))
|
||||
(setf (symbol-function 'aliseq) #'(lambda () (funcall fgen))))
|
||||
(ht-insert K1 0)
|
||||
(do* ((n 1 (1+ n))
|
||||
(Kn (aliseq) (aliseq))
|
||||
(alisym (aliquot-sym Kn n) (aliquot-sym Kn n)))
|
||||
(alisym (format t "~A:" (aliquot-str alisym)) (ht-list) (format t "~A~%" Kn) alisym)))
|
||||
|
||||
(defun main ()
|
||||
(princ "The last item in each sequence triggers classification.") (terpri)
|
||||
(dotimes (k 10)
|
||||
(aliquot (+ k 1)))
|
||||
(dolist (k '(11 12 28 496 220 1184 12496 1264460 790 909 562 1064 1488 15355717786080))
|
||||
(aliquot k)))
|
||||
|
|
@ -0,0 +1,50 @@
|
|||
defmodule Proper do
|
||||
def divisors(1), do: []
|
||||
def divisors(n), do: [1 | divisors(2,n,:math.sqrt(n))] |> Enum.sort
|
||||
|
||||
defp divisors(k,_n,q) when k>q, do: []
|
||||
defp divisors(k,n,q) when rem(n,k)>0, do: divisors(k+1,n,q)
|
||||
defp divisors(k,n,q) when k * k == n, do: [k | divisors(k+1,n,q)]
|
||||
defp divisors(k,n,q) , do: [k,div(n,k) | divisors(k+1,n,q)]
|
||||
end
|
||||
|
||||
defmodule Aliquot do
|
||||
def sequence(n, maxlen\\16, maxterm\\140737488355328)
|
||||
def sequence(0, _maxlen, _maxterm), do: "terminating"
|
||||
def sequence(n, maxlen, maxterm) do
|
||||
{msg, s} = sequence(n, maxlen, maxterm, [n])
|
||||
{msg, Enum.reverse(s)}
|
||||
end
|
||||
|
||||
defp sequence(n, maxlen, maxterm, s) when length(s) < maxlen and n < maxterm do
|
||||
m = Proper.divisors(n) |> Enum.sum
|
||||
cond do
|
||||
m in s ->
|
||||
case {m, List.last(s), hd(s)} do
|
||||
{x,x,_} ->
|
||||
case length(s) do
|
||||
1 -> {"perfect", s}
|
||||
2 -> {"amicable", s}
|
||||
_ -> {"sociable of length #{length(s)}", s}
|
||||
end
|
||||
{x,_,x} -> {"aspiring", [m | s]}
|
||||
_ -> {"cyclic back to #{m}", [m | s]}
|
||||
end
|
||||
m == 0 -> {"terminating", [0 | s]}
|
||||
true -> sequence(m, maxlen, maxterm, [m | s])
|
||||
end
|
||||
end
|
||||
defp sequence(_, _, _, s), do: {"non-terminating", s}
|
||||
end
|
||||
|
||||
Enum.each(1..10, fn n ->
|
||||
{msg, s} = Aliquot.sequence(n)
|
||||
:io.fwrite("~7w:~21s: ~p~n", [n, msg, s])
|
||||
end)
|
||||
IO.puts ""
|
||||
[11, 12, 28, 496, 220, 1184, 12496, 1264460, 790, 909, 562, 1064, 1488, 15355717786080]
|
||||
|> Enum.each(fn n ->
|
||||
{msg, s} = Aliquot.sequence(n)
|
||||
if n<10000000, do: :io.fwrite("~7w:~21s: ~p~n", [n, msg, s]),
|
||||
else: :io.fwrite("~w: ~s: ~p~n", [n, msg, s])
|
||||
end)
|
||||
|
|
@ -1,5 +1,15 @@
|
|||
proper_divisors =: [: */&> [: }: [: , [: { [: <@:({. ^ i.@:>:@:{:)";: [: |: 2 p: x:
|
||||
aliquot =: ([: +/ proper_divisors) ::0:
|
||||
rc_aliquot_sequence =: aliquot^:(i.16)&>
|
||||
rc_classify =: [: {. ([;.1' invalid terminate non-terminating perfect amicable sociable aspiring cyclic') #~ (16 ~: #) , (6 > {:) , (([: +./ (2^47x)&<) +. (16 = #@:~.)) , (1 = #@:~.) , ((8&= , 1&<)@:{.@:(#/.~)) , ([: =/ _2&{.) , 1:
|
||||
rc_display_aliquot_sequence =: (":,~' ',~rc_classify)@:rc_aliquot_sequence
|
||||
proper_divisors=: [: */@>@}:@,@{ [: (^ i.@>:)&.>/ 2 p: x:
|
||||
aliquot=: +/@proper_divisors ::0:
|
||||
rc_aliquot_sequence=: aliquot^:(i.16)&>
|
||||
rc_classify=: 3 :0
|
||||
if. 16 ~:# y do. ' invalid '
|
||||
elseif. 6 > {: y do. ' terminate '
|
||||
elseif. (+./y>2^47) +. 16 = #~.y do. ' non-terminating'
|
||||
elseif. 1=#~. y do. ' perfect '
|
||||
elseif. 8= st=. {.#/.~ y do. ' amicable '
|
||||
elseif. 1 < st do. ' sociable '
|
||||
elseif. =/_2{. y do. ' aspiring '
|
||||
elseif. 1 do. ' cyclic '
|
||||
end.
|
||||
)
|
||||
rc_display_aliquot_sequence=: (rc_classify,' ',":)@:rc_aliquot_sequence
|
||||
|
|
|
|||
|
|
@ -11,17 +11,17 @@
|
|||
terminate 10 8 7 1 0 0 0 0 0 0 0 0 0 0 0 0
|
||||
|
||||
rc_display_aliquot_sequence&>11, 12, 28, 496, 220, 1184, 12496, 1264460, 790, 909, 562, 1064, 1488, 15355717786080x
|
||||
terminate 11 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 ...
|
||||
terminate 12 16 15 9 4 3 1 0 0 0 0 0 0 0 0 0 ...
|
||||
perfect 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 ...
|
||||
perfect 496 496 496 496 496 496 496 496 496 496 496 496 496 496 496 496 ...
|
||||
amicable 220 284 220 284 220 284 220 284 220 284 220 284 220 284 220 284 ...
|
||||
amicable 1184 1210 1184 1210 1184 1210 1184 1210 1184 1210 1184 1210 1184 1210 1184 1210 ...
|
||||
sociable 12496 14288 15472 14536 14264 12496 14288 15472 14536 14264 12496 14288 15472 14536 14264 12496 ...
|
||||
sociable 1264460 1547860 1727636 1305184 1264460 1547860 1727636 1305184 1264460 1547860 1727636 1305184 1264460 1547860 1727636 1305184 ...
|
||||
aspiring 790 650 652 496 496 496 496 496 496 496 496 496 496 496 496 496 ...
|
||||
aspiring 909 417 143 25 6 6 6 6 6 6 6 6 6 6 6 6 ...
|
||||
cyclic 562 284 220 284 220 284 220 284 220 284 220 284 220 284 220 284 ...
|
||||
cyclic 1064 1336 1184 1210 1184 1210 1184 1210 1184 1210 1184 1210 1184 1210 1184 1210 ...
|
||||
non-terminating 1488 2480 3472 4464 8432 9424 10416 21328 22320 55056 95728 96720 236592 459792 881392 882384 ...
|
||||
non-terminating 15355717786080 44534663601120 144940087464480 471714103310688 1130798979186912 2688948041357088 6050151708497568 13613157922639968 35513546724070632 74727605255142168 162658586225561832 353930992506879768 642678347124409032 112510261154846...
|
||||
terminate 11 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0
|
||||
terminate 12 16 15 9 4 3 1 0 0 0 0 0 0 0 0 0
|
||||
perfect 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28
|
||||
perfect 496 496 496 496 496 496 496 496 496 496 496 496 496 496 496 496
|
||||
amicable 220 284 220 284 220 284 220 284 220 284 220 284 220 284 220 284
|
||||
amicable 1184 1210 1184 1210 1184 1210 1184 1210 1184 1210 1184 1210 1184 1210 1184 1210
|
||||
sociable 12496 14288 15472 14536 14264 12496 14288 15472 14536 14264 12496 14288 15472 14536 14264 12496
|
||||
sociable 1264460 1547860 1727636 1305184 1264460 1547860 1727636 1305184 1264460 1547860 1727636 1305184 1264460 1547860 1727636 1305184
|
||||
aspiring 790 650 652 496 496 496 496 496 496 496 496 496 496 496 496 496
|
||||
aspiring 909 417 143 25 6 6 6 6 6 6 6 6 6 6 6 6
|
||||
cyclic 562 284 220 284 220 284 220 284 220 284 220 284 220 284 220 284
|
||||
cyclic 1064 1336 1184 1210 1184 1210 1184 1210 1184 1210 1184 1210 1184 1210 1184 1210
|
||||
non-terminating 1488 2480 3472 4464 8432 9424 10416 21328 22320 55056 95728 96720 236592 459792 881392 882384
|
||||
non-terminating 15355717786080 44534663601120 144940087464480 471714103310688 1130798979186912 2688948041357088 6050151708497568 13613157922639968 35513546724070632 74727605255142168 162658586225561832 353930992506879768 642678347124409032 1125102611548462968 1977286128289819992 3415126495450394808
|
||||
|
|
|
|||
|
|
@ -0,0 +1,62 @@
|
|||
import java.util.*;
|
||||
import java.util.stream.LongStream;
|
||||
import static java.util.stream.LongStream.rangeClosed;
|
||||
|
||||
public class AliquotSequenceClassifications {
|
||||
|
||||
public static Long properDivsSum(long n) {
|
||||
return rangeClosed(1, (n + 1) / 2).filter(i -> n % i == 0 && n != i).sum();
|
||||
}
|
||||
|
||||
static boolean aliquot(long n, int maxLen, long maxTerm) {
|
||||
List<Long> s = new ArrayList<>(maxLen);
|
||||
s.add(n);
|
||||
long newN = n;
|
||||
|
||||
while (s.size() <= maxLen && newN < maxTerm) {
|
||||
|
||||
newN = properDivsSum(s.get(s.size() - 1));
|
||||
|
||||
if (s.contains(newN)) {
|
||||
|
||||
if (s.get(0) == newN) {
|
||||
|
||||
switch (s.size()) {
|
||||
case 1:
|
||||
return report("Perfect", s);
|
||||
case 2:
|
||||
return report("Amicable", s);
|
||||
default:
|
||||
return report("Sociable of length " + s.size(), s);
|
||||
}
|
||||
|
||||
} else if (s.get(s.size() - 1) == newN) {
|
||||
return report("Aspiring", s);
|
||||
|
||||
} else
|
||||
return report("Cyclic back to " + newN, s);
|
||||
|
||||
} else {
|
||||
s.add(newN);
|
||||
if (newN == 0)
|
||||
return report("Terminating", s);
|
||||
}
|
||||
}
|
||||
|
||||
return report("Non-terminating", s);
|
||||
}
|
||||
|
||||
static boolean report(String msg, List<Long> result) {
|
||||
System.out.println(msg + ": " + result);
|
||||
return false;
|
||||
}
|
||||
|
||||
public static void main(String[] args) {
|
||||
long[] arr = {11L, 12, 28, 496, 220, 1184, 12496, 1264460,
|
||||
790, 909, 562, 1064, 1488};
|
||||
|
||||
LongStream.rangeClosed(1, 10).forEach(n -> aliquot(n, 16, 1L << 47));
|
||||
System.out.println();
|
||||
Arrays.stream(arr).forEach(n -> aliquot(n, 16, 1L << 47));
|
||||
}
|
||||
}
|
||||
|
|
@ -0,0 +1,44 @@
|
|||
print "ROSETTA CODE - Aliquot sequence classifications"
|
||||
[Start]
|
||||
input "Enter an integer: "; K
|
||||
K=abs(int(K)): if K=0 then goto [Quit]
|
||||
call PrintAS K
|
||||
goto [Start]
|
||||
|
||||
[Quit]
|
||||
print "Program complete."
|
||||
end
|
||||
|
||||
sub PrintAS K
|
||||
Length=52
|
||||
dim Aseq(Length)
|
||||
n=K: class=0
|
||||
for element=2 to Length
|
||||
Aseq(element)=PDtotal(n)
|
||||
print Aseq(element); " ";
|
||||
select case
|
||||
case Aseq(element)=0
|
||||
print " terminating": class=1: exit for
|
||||
case Aseq(element)=K and element=2
|
||||
print " perfect": class=2: exit for
|
||||
case Aseq(element)=K and element=3
|
||||
print " amicable": class=3: exit for
|
||||
case Aseq(element)=K and element>3
|
||||
print " sociable": class=4: exit for
|
||||
case Aseq(element)<>K and Aseq(element-1)=Aseq(element)
|
||||
print " aspiring": class=5: exit for
|
||||
case Aseq(element)<>K and Aseq(element-2)= Aseq(element)
|
||||
print " cyclic": class=6: exit for
|
||||
end select
|
||||
n=Aseq(element)
|
||||
if n>priorn then priorn=n: inc=inc+1 else inc=0: priorn=0
|
||||
if inc=11 or n>30000000 then exit for
|
||||
next element
|
||||
if class=0 then print " non-terminating"
|
||||
end sub
|
||||
|
||||
function PDtotal(n)
|
||||
for y=2 to n
|
||||
if (n mod y)=0 then PDtotal=PDtotal+(n/y)
|
||||
next
|
||||
end function
|
||||
|
|
@ -1,8 +1,9 @@
|
|||
sub propdivsum (\x) {
|
||||
[+] x > 1, gather for 2 .. x.sqrt.floor -> \d {
|
||||
my @l = x > 1, gather for 2 .. x.sqrt.floor -> \d {
|
||||
my \y = x div d;
|
||||
if y * d == x { take d; take y unless y == d }
|
||||
}
|
||||
[+] gather @l.deepmap(*.take);
|
||||
}
|
||||
|
||||
multi quality (0,1) { 'perfect ' }
|
||||
|
|
|
|||
|
|
@ -0,0 +1,34 @@
|
|||
function Get-NextAliquot ( [int]$X )
|
||||
{
|
||||
If ( $X -gt 1 )
|
||||
{
|
||||
$NextAliquot = 0
|
||||
(1..($X/2)).Where{ $x % $_ -eq 0 }.ForEach{ $NextAliquot += $_ }.Where{ $_ }
|
||||
return $NextAliquot
|
||||
}
|
||||
}
|
||||
|
||||
function Get-AliquotSequence ( [int]$K, [int]$N )
|
||||
{
|
||||
$X = $K
|
||||
$X
|
||||
(1..($N-1)).ForEach{ $X = Get-NextAliquot $X; $X }
|
||||
}
|
||||
|
||||
function Classify-AlliquotSequence ( [int[]]$Sequence )
|
||||
{
|
||||
$K = $Sequence[0]
|
||||
$LastN = $Sequence.Count
|
||||
If ( $Sequence[-1] -eq 0 ) { return "terminating" }
|
||||
If ( $Sequence[-1] -eq 1 ) { return "terminating" }
|
||||
If ( $Sequence[1] -eq $K ) { return "perfect" }
|
||||
If ( $Sequence[2] -eq $K ) { return "amicable" }
|
||||
If ( $Sequence[3..($Sequence.Count-1)] -contains $K ) { return "sociable" }
|
||||
If ( $Sequence[-1] -eq $Sequence[-2] ) { return "aspiring" }
|
||||
If ( $Sequence.Count -gt ( $Sequence | Select -Unique ).Count ) { return "cyclic" }
|
||||
return "non-terminating and non-repeating through N = $($Sequence.Count)"
|
||||
}
|
||||
|
||||
(1..10).ForEach{ [string]$_ + " is " + ( Classify-AlliquotSequence -Sequence ( Get-AliquotSequence -K $_ -N 16 ) ) }
|
||||
|
||||
( 11, 12, 28, 496, 220, 1184, 790, 909, 562, 1064, 1488 ).ForEach{ [string]$_ + " is " + ( Classify-AlliquotSequence -Sequence ( Get-AliquotSequence -K $_ -N 16 ) ) }
|
||||
|
|
@ -0,0 +1,63 @@
|
|||
function Get-NextAliquot ( [int]$X )
|
||||
{
|
||||
If ( $X -gt 1 )
|
||||
{
|
||||
$NextAliquot = 1
|
||||
If ( $X -gt 2 )
|
||||
{
|
||||
$XSquareRoot = [math]::Sqrt( $X )
|
||||
|
||||
(2..$XSquareRoot).Where{ $X % $_ -eq 0 }.ForEach{ $NextAliquot += $_ + $x / $_ }
|
||||
|
||||
If ( $XSquareRoot % 1 -eq 0 ) { $NextAliquot -= $XSquareRoot }
|
||||
}
|
||||
return $NextAliquot
|
||||
}
|
||||
}
|
||||
|
||||
function Get-AliquotSequence ( [int]$K, [int]$N )
|
||||
{
|
||||
$X = $K
|
||||
$X
|
||||
$i = 1
|
||||
While ( $X -and $i -lt $N )
|
||||
{
|
||||
$i++
|
||||
$Next = Get-NextAliquot $X
|
||||
If ( $Next )
|
||||
{
|
||||
If ( $X -eq $Next )
|
||||
{
|
||||
($i..$N).ForEach{ $X }
|
||||
$i = $N
|
||||
}
|
||||
Else
|
||||
{
|
||||
$X = $Next
|
||||
$X
|
||||
}
|
||||
}
|
||||
Else
|
||||
{
|
||||
$i = $N
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
function Classify-AlliquotSequence ( [int[]]$Sequence )
|
||||
{
|
||||
$K = $Sequence[0]
|
||||
$LastN = $Sequence.Count
|
||||
If ( $Sequence[-1] -eq 0 ) { return "terminating" }
|
||||
If ( $Sequence[-1] -eq 1 ) { return "terminating" }
|
||||
If ( $Sequence[1] -eq $K ) { return "perfect" }
|
||||
If ( $Sequence[2] -eq $K ) { return "amicable" }
|
||||
If ( $Sequence[3..($Sequence.Count-1)] -contains $K ) { return "sociable" }
|
||||
If ( $Sequence[-1] -eq $Sequence[-2] ) { return "aspiring" }
|
||||
If ( $Sequence.Count -gt ( $Sequence | Select -Unique ).Count ) { return "cyclic" }
|
||||
return "non-terminating and non-repeating through N = $($Sequence.Count)"
|
||||
}
|
||||
|
||||
(1..10).ForEach{ [string]$_ + " is " + ( Classify-AlliquotSequence -Sequence ( Get-AliquotSequence -K $_ -N 16 ) ) }
|
||||
|
||||
( 11, 12, 28, 496, 220, 1184, 12496, 1264460, 790, 909, 562, 1064, 1488 ).ForEach{ [string]$_ + " is " + ( Classify-AlliquotSequence -Sequence ( Get-AliquotSequence -K $_ -N 16 ) ) }
|
||||
|
|
@ -1,63 +1,63 @@
|
|||
/*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. */
|
||||
/*REXX program classifies various positive integers for types of aliquot sequences. */
|
||||
parse arg low high L /*obtain optional arguments from the CL*/
|
||||
high=word(high low 10,1); low=word(low 1,1) /*obtain the LOW and HIGH (range). */
|
||||
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, "═")
|
||||
big=2**47; NTlimit=16+1 /*limit for a non─terminating sequence.*/
|
||||
numeric digits max(9, 1+length(big)) /*be able to handle big numbers for // */
|
||||
#.=.; #.0=0; #.1=0 /*#. are the proper divisor sums. */
|
||||
say center('numbers from ' low " to " high, 79, "═")
|
||||
|
||||
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. */
|
||||
do n=low to high /*process (probably) some low numbers. */
|
||||
call classify 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 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*/
|
||||
class.=0 /* [↓] ensure one number of each class*/
|
||||
do q=1 until class.sociable\==0 /*the only one that has to be counted. */
|
||||
call classify -q /*the minus (-) sign indicates ¬ tell. */
|
||||
_=what; upper _; class._=class._+1 /*bump counter for this class sequence.*/
|
||||
if class._==1 then call show_class q,$ /*only display the first occurrence. */
|
||||
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 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: 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.*/
|
||||
do i=1 for words(L) /*L: is a list of "special numbers".*/
|
||||
call classify 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: parse arg a 1 aa; a=abs(a) /*obtain number that's to be classified*/
|
||||
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) /*Not defined? Then sum proper divisors*/
|
||||
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: 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 divison sum for argument X.*/
|
||||
return s /*return " " " " " */
|
||||
|
|
|
|||
|
|
@ -0,0 +1,41 @@
|
|||
10 PRINT "Number classification sequence"
|
||||
20 INPUT "Enter a number (0 to end): ";k: IF k>0 THEN GO SUB 2000: PRINT k;" ";s$: GO TO 20
|
||||
40 STOP
|
||||
1000 REM sumprop
|
||||
1010 IF oldk=1 THEN LET newk=0: RETURN
|
||||
1020 LET sum=1
|
||||
1030 LET root=SQR oldk
|
||||
1040 FOR i=2 TO root-0.1
|
||||
1050 IF oldk/i=INT (oldk/i) THEN LET sum=sum+i+oldk/i
|
||||
1060 NEXT i
|
||||
1070 IF oldk/root=INT (oldk/root) THEN LET sum=sum+root
|
||||
1080 LET newk=sum
|
||||
1090 RETURN
|
||||
2000 REM class
|
||||
2010 LET oldk=k: LET s$=" "
|
||||
2020 GO SUB 1000
|
||||
2030 LET oldk=newk
|
||||
2040 LET s$=s$+" "+STR$ newk
|
||||
2050 IF newk=0 THEN LET s$="terminating"+s$: RETURN
|
||||
2060 IF newk=k THEN LET s$="perfect"+s$: RETURN
|
||||
2070 GO SUB 1000
|
||||
2080 LET oldk=newk
|
||||
2090 LET s$=s$+" "+STR$ newk
|
||||
2100 IF newk=0 THEN LET s$="terminating"+s$: RETURN
|
||||
2110 IF newk=k THEN LET s$="amicable"+s$: RETURN
|
||||
2120 FOR t=4 TO 16
|
||||
2130 GO SUB 1000
|
||||
2140 LET s$=s$+" "+STR$ newk
|
||||
2150 IF newk=0 THEN LET s$="terminating"+s$: RETURN
|
||||
2160 IF newk=k THEN LET s$="sociable (period "+STR$ (t-1)+")"+s$: RETURN
|
||||
2170 IF newk=oldk THEN LET s$="aspiring"+s$: RETURN
|
||||
2180 LET b$=" "+STR$ newk+" ": LET ls=LEN s$: LET lb=LEN b$: LET ls=ls-lb
|
||||
2190 FOR i=1 TO ls
|
||||
2200 IF s$(i TO i+lb-1)=b$ THEN LET s$="cyclic (at "+STR$ newk+") "+s$: LET i=ls
|
||||
2210 NEXT i
|
||||
2220 IF LEN s$<>(ls+lb) THEN RETURN
|
||||
2300 IF newk>140737488355328 THEN LET s$="non-terminating (term > 140737488355328)"+s$: RETURN
|
||||
2310 LET oldk=newk
|
||||
2320 NEXT t
|
||||
2330 LET s$="non-terminating (after 16 terms)"+s$
|
||||
2340 RETURN
|
||||
Loading…
Add table
Add a link
Reference in a new issue