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.
$\begingroup$
$\endgroup$
Add a comment
|
3 Answers
$\begingroup$
$\endgroup$
1
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
-
1$\begingroup$ Very nice. "Count[Array[ILD`DeficientNumberQ,100],True]" also seems to work. (Another Mathematica function I knew nothing about) $\endgroup$– user1066Apr 3, 2020 at 19:36
$\begingroup$
$\endgroup$
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}
$\begingroup$
$\endgroup$
1
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
-
$\begingroup$ But
Array[ILD`DeficientNumberQ, 100] // Counts(as a slight variant of that given by kglr) is probably superior to anything given above. $\endgroup$– user1066Apr 4, 2020 at 19:23