EKG Sequence

Author

Eric W. Weisstein
May 19, 2003

This notebook downloaded from http://mathworld.wolfram.com/notebooks/IntegerSequences/EKGSequence.nb.

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

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

Code

Very inefficient code.  This should be rewritten.

powers[l_List]:=Union[Flatten[Outer[Times,Range[600],Union[Flatten[Outer[Power,Union[l],Range[55]]]]]]]
EKG[n_]:=Flatten[{1,Nest[Flatten[{#,Complement[powers[First/@FactorInteger[#[[-1]]]],#][[1]]}]&,{2},n]}]

Sequence

e=EKG[100]

Complement[Range[Max[e]],e][[1]]

Ordering[Take[e,%-1]]

Plot

<<Plot`

Show[GraphicsArray[{
ListPlot[EKG[70],PlotJoined->True,PlotStyle->Red,
DisplayFunction->Identity,
AxesLabel->TraditionalForm/@{n,HoldForm[EKG[n]]}],
IntegerListPlot[EKG[70],DisplayFunction->Identity,
AxesLabel->TraditionalForm/@{n,HoldForm[EKG[n]]}]
}]]

First 1000 Terms

ListPlot[EKG[1000],PlotStyle->Red,AxesLabel->TraditionalForm/@{n,HoldForm[EKG[n]]}]//Timing