2
$\begingroup$

For the purposes of the assignment, I need these values in a table. We have so far only used for/while loops to check the deficiency or abundance of certain types of numbers. I initially tried using a for loop and AppendTo at my instructor's suggestion, but I couldn't get it to work.

I briefly dabbled with sow and reap, but I had no idea where to start with it. Then I found the TakeWhile function and thought that would work. But it didn't seem to know what to do with DivisorSum in the criteria. Is there a way to make TakeWhile[list,#

Here's what I've tried, sorry it's a such a mess.

    n = 100;
(*While[x\[LessEqual]n,Print[StringForm["Divisors of `` = ``; sum of \
divisors = `` `` `` (``)" \
,x,Most[Divisors[x]],ds=DivisorSum[(x),#&,#<x&],Piecewise[{{">",ds>x},\
{"<",ds<x},{"=",ds=x}}],x,Piecewise[{{"abundant",ds>x},{"deficient",\
ds<x},{"perfect",ds=x}}]]];x=x+1;i=x]*)
def = {}
(*Array[def,n]*)
\
(*AppendTo[def,For[i=1,i\[LessEqual]n,i++,Print[{i,DivisorSum[i,#&,#<\
i&]}]]]*)
\
(*For[i=1,i\[LessEqual]n,i++,Print[{i,DivisorSum[i,#&,#<i&]}]]*)
\
(*For[i=1,i\[LessEqual]n,i++,Print[StringForm["Sum of proper divisors \
for `` = `` this is `` `` \
(``)",i,ds=DivisorSum[i,#&,#<i&],Piecewise[{{">",ds>i},{"<",ds<i},{"=\
",ds=i}}],i,Piecewise[{{"abundant",ds>i},{"deficient",ds<i},{\
"perfect",ds=i}}]]]]*)
div = 
 For[i = 1, i <= n, i++, Print[{i, a = DivisorSum[i, # &, # < i &]}]]
TakeWhile[{div}, # < a]
num = Table[i + 1, {i, 0, 99}]
divtb = Table[DivisorSum[i, # &, # < i &], {i, n}]
TakeWhile[num, # < DivisorSum[#, # &, # < i &]]

Any and all suggestions appreciated. Thanks.

$\endgroup$
  • 1
    $\begingroup$ It would be helpful if you included only relevant code. (A whole bunch of commented code makes it harder to parse what you have.) In addition, it would be useful to describe the mathematical problem you are trying to solve rather than having us try to infer it from your code. $\endgroup$ – march Oct 21 at 22:34
6
$\begingroup$

You can use ILD`DeficientNumberQ:

i=0; k=1;
Reap[While[k <= 100, If[ILD`DeficientNumberQ[++i], k++; Sow[i]]]][[2,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, 101, 103, 105, 106, 107, 109, 110, 111, 113, 115, 116, 117, 118, 119, 121, 122, 123, 124, 125, 127, 128, 129, 130, 131}

or use the definition of ILD`DeficientNumberQ directly:

i = 0; k = 1; 
Reap[While[k <= 100, If[DivisorSigma[1, ++i] < 2 i, k++; Sow[i]]]][[2, 1]]

same result

Alternatively, use DivisorSum:

i = 0; k = 1; 
Reap[While[k <= 100,  If[DivisorSum[++i, # &] < 2 i, k++; Sow[i]]]][[2, 1]]

same result

$\endgroup$
  • $\begingroup$ I had searched the documentation for anything to do with deficient numbers, but I couldn't find anything. The only thing I knew for sure was PerfectNumber and PerfectNumberQ, but I didn't see how that would help. This elegantly simple code does exactly what I need, but where can I find more to read about ILD`DeficientNumberQ? $\endgroup$ – hemicyon Oct 22 at 17:20
  • 1
    $\begingroup$ @hemicyon, it is not documented. I found it using Names["*`*Deficient*"]. You (btw, there is also ILD`AbundantNumberQ.) You can see its definition using Needs["GeneralUtilities`"]; PrintDefinitions[ILD`DeficientNumberQ]. $\endgroup$ – kglr Oct 22 at 17:36
2
$\begingroup$

According to Sloane's A005100, the n^th deficient number is asymptotic to between 1.3287*n and 1.3298*n. Use a slightly larger limit to capture exceptions.

nFirstDeficientNumbers[n_] :=
    With[{r = Range[1.35 n]},
         Take[Pick[r, UnitStep[DivisorSigma[1, r] - 2 r], 0], n]
    ]
$\endgroup$

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.