# Checking whether a number can be composed from the cube of its digit

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?

-
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. – kiss my armpit Dec 30 '13 at 15:40

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]]


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}

-

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.

-