Búsqueda de los números perfectos menores que un tope. Pag 50, Introduction to Programming to Mathematica.Ed.Telos

properDivisors[n_]:=Drop[Divisors[n],-1]
perfectQ[n_Integer]:=Apply[Plus,properDivisors[n]]==n
perfect[n_]:=Select[Range[n],perfectQ]
perfect[10000]