73 lines
1.7 KiB
Tcl
73 lines
1.7 KiB
Tcl
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]]
|
|
}]
|