Evil Number

Author

Eric W. Weisstein
January 13, 2005

This notebook downloaded from http://mathworld.wolfram.com/notebooks/Numbers/EvilNumber.nb.

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

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

Additional Authors

Beastly evil numbers found by
Mark Hudson
November 2004

Code

EvilNumber[c_,max_:200]:=Module[{d=RealDigits[c,10,max,-1][[1]],p},
p=Position[FoldList[Plus,0,d],666,1,1];
If[p=={},p,p[[1,1]]-1]
]
EvilCF[c_,max_:200]:=Module[{d=ContinuedFraction[c,max],p},
p=Position[FoldList[Plus,0,d],666,1,1];
If[p=={},p,p[[1,1]]-1]
]
EvilQ[n_Integer?NonNegative]:=Mod[DigitCount[n,2,1],2]==0

Enumeration (Binary-Type)

Select[Range[0,100],EvilQ]

<<Utilities`Plot`

Show[PixelPerfect[NaryPlot[Select[Range[0,512],EvilQ]],BlockSize->2]]

Enumeration (Pegg-Type)

<<Utilities`Typesetting`

Sort[{Short[#,1],EvilNumber[#]}&/@{
Pi,
GoldenRatio,
E^(Pi Sqrt[163]),
(Sqrt[3]),
(2^(1/3)),
Glaisher,
4-π,

(1/105) (4+17 (Sqrt[2])-6 (Sqrt[3])-7 π+21 ArcSinh[1]+42 Log[2+(Sqrt[3])]),
N[StieltjesGamma[1],200],
Root[-32751691810479015985152+97143135277377575190528 ((#1)^4)-73347491183630103871488 ((#1)^6)-71220809441400405884928 ((#1)^8)+107155448150443388043264 ((#1)^10)-72405670285649161617408 ((#1)^12)+2958015038376958230528 ((#1)^14)+7449488310131083100160 ((#1)^16)+797726698866658379776 ((#1)^18)+2505062311720673792 ((#1)^20)+2013290651222784 ((#1)^22)+25937424601 ((#1)^24)&,2],
(3^(1/5)),(Sqrt[6])
},(#1[[2]]<#2[[2]]&)]//TableForm//TraditionalForm

{#,EvilNumber[#]}&/@DeleteCases[Flatten[Table[n^(1/k),{n,7},{k,2,5}]],_Integer]

{#,EvilNumber[#]}&/@{Pi,GoldenRatio,E,Glaisher,Catalan}

Powers of Pi

Block[{$MaxExtraPrecision=10^3},
Position[Pi^Range[10^3],_?(EvilNumber[#]>0&),{1},Heads->False]
]//Flatten//Timing

Beastly Evil

v5.1

Block[{$MaxExtraPrecision=7000},Sort[{Short[#,1],EvilNumber[ReleaseHold[#],3000]}&/@{
(π^666),
(GoldenRatio^666),
Cos[666],
HoldForm[(666^(1/666))],
HoldForm[666^(1/3^666)],
HoldForm[(Sqrt[(Sqrt[666])])],
HoldForm[(Sqrt[(Sqrt[(Sqrt[666])])])],
HoldForm[(666^(Sqrt[666]))],
HoldForm[(666^(1/9))],
Tanh[666],
HoldForm[666^(1/6^666)],
HoldForm[666^(1/666^6)],
HoldForm[666^(1/666^666)],
HoldForm[((Sqrt[666])^(Log[666]))]
},(#1[[2]]<#2[[2]]&)]
]//TableForm//TraditionalForm

Block[{$MaxExtraPrecision=10^4},EvilNumber[Tanh[666],550]]

Block[{$MaxExtraPrecision=10^4},EvilNumber[Tanh[666],600]]

Block[{$MaxExtraPrecision=10^6},EvilNumber[666^(1/666^666),10^4]]

Block[{$MaxExtraPrecision=10^6},EvilNumber[666^(1/666^666),10^6]]//Timing

EvilNumber[N[666^(1/666^666),10^6],10^4]//Timing

EvilNumber[N[666^(1/666^666),5 10^6],10^6]//Timing

RealDigits[666^(1/666^666),10,100]

Probability

p[1]:=1/9
p[k_/;k<10]:= p[k]=(1+Plus@@p/@Range[k-1])/9
p[k_/;k>9]:= p[k]=Plus@@(p[k-#]&/@Range[9])/9

p/@Range[11]

Through[{Numerator,Denominator}[%]]

<<Utilities`Plot`

With[{ϵ=(10^(-1))},
IntegerListPlot[p/@Range[100],PlotRange->.2+{-ϵ,ϵ},Prolog->{{Blue,Dashing[{.02}],Line[{{0,.2},{1000,.2}}]}},
AxesLabel->TraditionalForm/@{n,P[n]}]
]

Length/@IntegerDigits/@Through[{Numerator,Denominator}[p]]

N[p-1/5,10]

Series[((1-(t^9))/((t^10)-10t+9)),{t,0,10}]

Exact Expression

<<DiscreteMath`RSolve`

(term=SeriesTerm[((1-(t^9))/((t^10)-10t+9)),{t,0,n}])//Timing

RootReduce[term]//Timing

Evil Continued Fractions

Sort[{Short[#,2],EvilCF[#]}&/@{
Pi,
(1/105) (4+17 (Sqrt[2])-6 (Sqrt[3])-7 π+21 ArcSinh[1]+42 Log[2+(Sqrt[3])]),
(1/(Sqrt[1+Sqrt[3]]))((Gamma[1/3]Gamma[11/12])/(Gamma[1/4])),
((Sqrt[2])/π)EllipticK[(1/2)],
Gamma[1/3]Gamma[5/6]/Gamma[1/6],
(Sqrt[5])
},(#1[[2]]<#2[[2]]&)]//TableForm//TraditionalForm

DeleteCases[Flatten[Table[n^(1/k),{n,7},{k,2,5}]],_Integer]

EvilCF/@%

EvilCF/@{Pi,GoldenRatio,E,Glaisher,Catalan}