5
$\begingroup$

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

What is the number of deficient numbers less than 100?

Please help me.

$\endgroup$
8
$\begingroup$
Count[ILD`DeficientNumberQ /@ 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[ILD`DeficientNumberQ] @ 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

| improve this answer | |
$\endgroup$
  • 1
    $\begingroup$ Very nice. "Count[Array[ILD`DeficientNumberQ,100],True]" also seems to work. (Another Mathematica function I knew nothing about) $\endgroup$ – user1066 Apr 3 at 19:36
7
$\begingroup$

From Wikipedia

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}
| improve this answer | |
$\endgroup$
4
$\begingroup$

With some serious 'borrowing' from other answers:

Array[2# > DivisorSum[#, Identity]&, 100] //Counts
<|True -> 76, False -> 24|>

Original Answer

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

| improve this answer | |
$\endgroup$
  • $\begingroup$ But Array[ILD`DeficientNumberQ, 100] // Counts (as a slight variant of that given by kglr) is probably superior to anything given above. $\endgroup$ – user1066 Apr 4 at 19:23

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.