Data commit

Task/Aliquot-sequence-classifications/Tcl/aliquot-sequence-classifications.tcl

@@ -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]]
+}]