# Program that can count deficient numbers

Using Mathematica, I want to make program which can solve the following question.

What is the number of deficient numbers less than 100?

Count[ILDDeficientNumberQ /@ Range[100], True]


76

Alternatively, you can use DivisorSigma[1, n] or DivisorSum[n, Identity] to get the sum of divisors of n:

DivisorSigma[1, Range @ 1000] == DivisorSum[Range @ 1000, Identity]

True


We can use either with Count:

Count[Thread[DivisorSigma[1, Range@100] < 2 Range[100]], True]

 76

Count[Thread[DivisorSum[ Range@100, Identity] < 2 Range[100]], True]

 76


To get the list of deficient numbers in Range[n] you can use

n = 50;
Select[ILDDeficientNumberQ] @ Range[n]

{1, 2, 3, 4, 5, 7, 8, 9, 10, 11, 13, 14, 15, 16, 17, 19, 21, 22, 23,
25, 26, 27, 29, 31, 32, 33, 34, 35, 37, 38, 39, 41, 43, 44, 45, 46, 47, 49, 50}

Select[DivisorSigma[1, #] < 2 # &]@Range[n]

{1, 2, 3, 4, 5, 7, 8, 9, 10, 11, 13, 14, 15, 16, 17, 19, 21, 22, 23,
25, 26, 27, 29, 31, 32, 33, 34, 35, 37, 38, 39, 41, 43, 44, 45, 46, 47, 49, 50}

Select[DivisorSum[#, Identity] < 2 # &]@Range[n]

{1, 2, 3, 4, 5, 7, 8, 9, 10, 11, 13, 14, 15, 16, 17, 19, 21, 22, 23,
25, 26, 27, 29, 31, 32, 33, 34, 35, 37, 38, 39, 41, 43, 44, 45, 46, 47, 49, 50}

% == %%


True

• Very nice. "Count[Array[ILDDeficientNumberQ,100],True]" also seems to work. (Another Mathematica function I knew nothing about) Apr 3, 2020 at 19:36

In number theory, a deficient number or defective number is a number n for which the sum of divisors σ(n)<2n

Therefore

If[Total[Divisors[#]] < 2 #, #, Nothing[]] & /@ Range[100]


gives

{1, 2, 3, 4, 5, 7, 8, 9, 10, 11, 13, 14, 15, 16, 17, 19, 21, 22, 23, \
25, 26, 27, 29, 31, 32, 33, 34, 35, 37, 38, 39, 41, 43, 44, 45, 46, \
47, 49, 50, 51, 52, 53, 55, 57, 58, 59, 61, 62, 63, 64, 65, 67, 68, \
69, 71, 73, 74, 75, 76, 77, 79, 81, 82, 83, 85, 86, 87, 89, 91, 92, \
93, 94, 95, 97, 98, 99}


With some serious 'borrowing' from other answers:

Array[2# > DivisorSum[#, Identity]&, 100] //Counts

<|True -> 76, False -> 24|>


Count[Array[2#-Total[Divisors[#]]&, 100]//Clip,1]


76

Array[{#,2#-Total[Divisors[#]]}&, 100]//Pick[#[[All,1]],#[[All,2]]//Clip,1]&


{1, 2, 3, 4, 5, 7, 8, 9, 10, 11, 13, 14, 15, 16, 17, 19, 21, 22, 23, 25, 26, 27, 29, 31, 32, 33, 34, 35, 37, 38, 39, 41, 43, 44, 45, 46, 47, 49, 50, 51, 52, 53, 55, 57, 58, 59, 61, 62, 63, 64, 65, 67, 68, 69, 71, 73, 74, 75, 76, 77, 79, 81, 82, 83, 85, 86, 87, 89, 91, 92, 93, 94, 95, 97, 98, 99}

%//Length


76

• But Array[ILDDeficientNumberQ, 100] // Counts (as a slight variant of that given by kglr) is probably superior to anything given above. Apr 4, 2020 at 19:23