Abundant, deficient and perfect number classifications: Difference between revisions

Tcl implementation added
(Tcl implementation added)
Line 1,212:
println("There are \(deficients) deficient, \(perfects) perfect and \(abundants) abundant integers from 1 to 20000.")</lang>
{{out}}<pre>There are 15043 deficient, 4 perfect and 4953 abundant integers from 1 to 20000.</pre>
 
=={{header|Tcl}}==
 
<lang 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 cmp {i j} { ;# analogous to [string compare], but for numbers
if {$i == $j} {return 0}
if {$i > $j} {return 1}
return -1
}
 
proc classify {k} {
lassign [ProperDivisors $k] p ;# we only care about the first part of the result
dict get {
1 abundant
0 perfect
-1 deficient
} [cmp $k $p]
}
 
puts "Classifying the integers in \[1, 20_000\]:"
set classes {} ;# this will be a dict
 
for {set i 1} {$i <= 20000} {incr i} {
set class [classify $i]
dict incr classes $class
}
 
# using [lsort] to order the dictionary by value:
foreach {kind count} [lsort -stride 2 -index 1 -integer $classes] {
puts "$kind: $count"
}</lang>
 
{{out}}
<pre>Classifying the integers in [1, 20_000]:
perfect: 4
deficient: 4953
abundant: 15043</pre>
 
=={{header|VBScript}}==
Anonymous user