In[]:=
ClearAll["`*"](*kthrepdigitinbaseb*)kthRepDigit[k_,b_]:=-1(*nReps[n,b]isthenumberofrepdigitsnRinbasebthatare≤n*)nReps[n_,b_]:=Module{nLen,leadingDigit,nR},(*digitlengthofninbaseb*)nLen=IntegerLength[n,b];(*leadingdigitofninbaseb*)leadingDigit=Floor;(*thereareb-1repdigitsoflengthLinbaseb,sothereare(nLen-1)*(b-1)repdigitswithlengthlessthannLen,andthenatleastleadingDigit-1morewiththesamelengthasn*)nR=(nLen-1)*(b-1)+(leadingDigit-1);(*finallycheckiftheverynextrepdigitis≤n*)If[kthRepDigit[nR+1,b]≤n,nR++];nR(*generatesallrepdigitsinbaseboflengthatleast3andlessthann*)generateUpToN[n_,b_]:=Table[kthRepDigit[k,b],{k,2b-1,nReps[n,b]}](*generatesallrepdigitsinallbasesthatareoflengthatleast3andlessthann*)getAll[n_]:=Flatten@Table[generateUpToN[n,b],{b,2,Floor@Sqrt[n]}]
Mod[k,b-1,1]
b-1
Ceiling
k
b-1
b
n
b^(nLen-1)
In[]:=
(*thistakesabout20sonmylaptoptocalculateupto10^10*)AbsoluteTiming[nMax=10^10;sequence=Module[{repsList,tallies,repeatedReps},(*calculateallrepdigitsuptonMax*)repsList=getAll[nMax];(*tallyhowmanytimestheyappearinthelist*)tallies=Tally[repsList];(*selecttherepdigitsthatappearmorethanonceandsort*)Select[tallies,#[[2]]>1&][[All,1]]//Sort];]
Out[]=
{21.101,Null}
In[]:=
(*plot*)ListLinePlot[sequence,Frame->True,FrameLabel->{n,a[n]},LabelStyle->Directive[Bold,Medium]]
Out[]=
