Sum-Product Number

Author

Eric W. Weisstein
February 2, 2006

This notebook downloaded from http://mathworld.wolfram.com/notebooks/IntegerSequences/Sum-ProductNumber.nb.

For more information, see Eric's MathWorld entry http://mathworld.wolfram.com/Sum-ProductNumber.html.

©2006 Wolfram Research, Inc. except for portions noted otherwise

Code

SumProductQ[n_Integer?Positive]:=SumProductDifference[n]==0
SumProductDifference[n_Integer?Positive]:=Module[{i=IntegerDigits[n]},
Times@@i Plus@@i-n
]
SetAttributes[{SumProductQ,SumProductDifference},Listable];

Enumeration

Position[Range[10^6],_?SumProductQ]//Flatten//Timing

l={};
Do[If[SumProductQ[n],AppendTo[l,n]; Print[l]];
	If[Mod[n,10^6]==0,Print[n,"..."]],
	{n,10^7}
]

Near Misses

10^8

misses=Position[Range[10^8],_?(Abs[SumProductDifference[#]]<100&)]//Flatten;//Timing

table=Split[Sort[{Abs[SumProductDifference[#]],#}&/@misses],First[#1]==First[#2]&];

{#[[1,1]],Last/@#}&/@Select[table,#[[1,1]]<10&]//ColumnForm

l=First/@table

max=Position[-Subtract@@@Partition[First/@l,2,1],_?(#>1&),1,1][[1,1]]

Last/@Take[l,max]

2 10^8

misses=Position[Range[2 10^8],_?(Abs[SumProductDifference[#]]<100&)]//Flatten;//Timing

...out of memory; 7.5+ GB...

5 10^8

misses=Position[Range[5 10^8],_?(Abs[SumProductDifference[#]]<100&)]//Flatten;//Timing

...out of memory; 7.5+ GB...

misses=Position[Abs[SumProductDifference[Range[5 10^8]]],_?(#<100&)]//Flatten;//Timing

...out of memory; 7.5+ GB...

Efficient Code for Near Misses

n==5

With[{dig=5,n=31},
Do[id=IntegerDigits@k;
If[Abs[(Plus@@id)(Times@@id)-k]==n,Return[k]],
{k,10^dig-1}]
]//Timing

With[{dig=5,n=31},
vars=a/@Range[dig];
Do[If[Abs[Plus@@vars Times@@vars-FromDigits[vars]]==n,Return[FromDigits[vars]]],Evaluate[Sequence@@({#,9}&/@vars)]]
]//Timing

With[{dig=5,n=31},
Do[
id=1+IntegerDigits[k,9,dig];
If[Abs[(Plus@@id)(Times@@id)-FromDigits[id]]==n,Return[FromDigits[id]]],{k,0,9^dig-1}]]//Timing

n==49 Miss

With[{dig=5,n=49},
Do[id=IntegerDigits@k;
If[Abs[(Plus@@id)(Times@@id)-k]==n,Return[k]],
{k,10^dig-1}]
]//Timing

With[{dig=5,n=49},
vars=a/@Range[dig];
Do[If[Abs[Plus@@vars Times@@vars-FromDigits[vars]]==n,Return[FromDigits[vars]]],Evaluate[Sequence@@({#,9}&/@vars)]]
]//Timing

With[{dig=5,n=49},
Do[
id=1+IntegerDigits[k,9,dig];
If[Abs[(Plus@@id)(Times@@id)-FromDigits[id]]==n,Return[FromDigits[id]]],{k,0,9^dig-1}]]//Timing

n==49 Hit

With[{dig=6,n=49},
Do[id=IntegerDigits@k;
If[Abs[(Plus@@id)(Times@@id)-k]==n,Return[k]],
{k,10^dig-1}]
]//Timing

With[{dig=6,n=49},
vars=a/@Range[dig];
Do[If[Abs[Plus@@vars Times@@vars-FromDigits[vars]]==n,Return[FromDigits[vars]]],Evaluate[Sequence@@({#,9}&/@vars)]]
]//Timing

With[{dig=6,n=49},
Do[
id=1+IntegerDigits[k,9,dig];
If[Abs[(Plus@@id)(Times@@id)-FromDigits[id]]==n,Return[FromDigits[id]]],{k,0,9^dig-1}]]//Timing

n==33 Miss for 6 digits

With[{dig=6,n=33},
Do[id=IntegerDigits@k;
If[Abs[(Plus@@id)(Times@@id)-k]==n,Return[k]],
{k,10^dig-1}]
]//Timing

With[{dig=6,n=33},
vars=a/@Range[dig];
Do[If[Abs[Plus@@vars Times@@vars-FromDigits[vars]]==n,Return[FromDigits[vars]]],Evaluate[Sequence@@({#,9}&/@vars)]]
]//Timing

With[{dig=6,n=33},
Do[
id=1+IntegerDigits[k,9,dig];
If[Abs[(Plus@@id)(Times@@id)-FromDigits[id]]==n,Return[FromDigits[id]]],{k,0,9^dig-1}]]//Timing

n==33 Miss for 7 digits

With[{dig=7,n=33},
Do[id=IntegerDigits@k;
If[Abs[(Plus@@id)(Times@@id)-k]==n,Return[k]],
{k,10^dig-1}]
]//Timing

With[{dig=7,n=33},
vars=a/@Range[dig];
Do[If[Abs[Plus@@vars Times@@vars-FromDigits[vars]]==n,Return[FromDigits[vars]]],Evaluate[Sequence@@({#,9}&/@vars)]]
]//Timing

With[{dig=7,n=33},
Do[
id=1+IntegerDigits[k,9,dig];
If[Abs[(Plus@@id)(Times@@id)-FromDigits[id]]==n,Return[FromDigits[id]]],{k,0,9^dig-1}]]//Timing

n==33 Miss for 8 digits

With[{dig=8,n=33},
Do[id=IntegerDigits@k;
If[Abs[(Plus@@id)(Times@@id)-k]==n,Return[k]],
{k,10^dig-1}]
]//Timing

With[{dig=8,n=33},
vars=a/@Range[dig];
Do[If[Abs[Plus@@vars Times@@vars-FromDigits[vars]]==n,Return[FromDigits[vars]]],Evaluate[Sequence@@({#,9}&/@vars)]]
]//Timing

With[{dig=8,n=33},
Do[
id=1+IntegerDigits[k,9,dig];
If[Abs[(Plus@@id)(Times@@id)-FromDigits[id]]==n,Return[FromDigits[id]]],{k,0,9^dig-1}]]//Timing