Take the 2-minute tour ×
Mathematica Stack Exchange is a question and answer site for users of Mathematica. It's 100% free, no registration required.

How to check whether or not the sum of the cube of each digit of a number is equal to the number itself?

In the following code, I tried to return the number in question whenever it matches the condition.

In[191]:= Func[x_]:=If[Total[Map[#^3& ,IntegerDigits[x]]]==x,x,0];
Func[300]

Out[192]= 300

Apparently the checking seems to be wrongly done. What caused this issue? How to fix it?

share|improve this question
2  
Func[300] returns 0 on my machine... –  cormullion Dec 30 '13 at 15:30
    
Have you reset the Kernel before? Maybe there is some old definition for Func. p.s. you don't have to Map in such cases: Total[IntegerDigits[300]^3] will do too. –  Kuba Dec 30 '13 at 15:40
    
@cormullion: Oh my ghost, I forgot to kill the kernel first. –  In PSTricks we trust Dec 30 '13 at 15:40

2 Answers 2

up vote 7 down vote accepted

We would like to find all integers x satisfying the following equation Total[ IntegerDigits[x]^3] == x (we don't have to map #^3& since Power is Listable).

Warning: Flexibility and polymorphism of Mathematica notation is restricted by Operator Precedence (see also When is f@g not the same as f[g]?). It appears to be the case here. One could suspect this was the problem defining Func initially.

f[x_] := Total[ IntegerDigits[x]^3] == x

however we might get incorrect results using this definition Total @ IntegerDigits @ x^3 == x while this one works fine Total[ IntegerDigits @ x^3] == x.

Select[ Range[0, 10^5], f @ # &]
{0, 1, 153, 370, 371, 407}

One can easily observe that we don't have to search for such integers anymore since Total[ IntegerDigits[x]^3] increases in a polynomial rate with the exponent in Range while x increases in an exponential rate and

Total[ IntegerDigits[99999]^3] < 10^5
True

Thus the above are all integers satisfying Total[ IntegerDigits[x]^3] == x.

Edit

Out of curiosity I have found how the solutions depend on the exponent. Defining:

f[x_, k_] := Total[ IntegerDigits[x]^k] == x

immediately we find with Select[ Range[ 0, 10^4], f[#, 2]&] that for k == 2 there are no solutions (besides 0 and 1).

ListPlot[ 
  Append[ 
    Table[ Log @ Total[ IntegerDigits[10^k - 1]^m], {m, 3, 9}, {k, 15}], 
    Table[ Log[ 10^(k - 1)], {k, 15}]], AxesOrigin -> {1, 0}, 
  PlotMarkers -> {Automatic, Medium}, PlotRange -> All, Joined -> True,
  PlotStyle -> Thick, PlotLegends -> Range[3, 9]]

enter image description here

With this plot it appears to be easier to estimate appropriate range of search space. We've got:

Select[ Range[10^6], f[#, 4]&]
{ 1, 1634, 8208, 9474}
Select[ Range[10^7], f[#, 5]&]
{ 1, 4150, 4151, 54748, 92727, 93084, 194979}
Select[ Range[5 10^7], f[#, 6]&]
{ 1, 548834}
share|improve this answer

It works as Artes showed, but here's, not faster but why not, another approach:

func = (1 - Unitize[Norm[IntegerDigits[#], 3]^3 - #]) # &

for clarification, see the documentation for Norm and it's second argument.

share|improve this answer

Your Answer

 
discard

By posting your answer, you agree to the privacy policy and terms of service.

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