Using the findSubsequence
function from the linked answer:
https://mathematica.stackexchange.com/a/942/2079
findSubsequence[list_, {ss__}] :=
ReplaceList[list, {pre___, ss, ___} :> Length[{pre}] + 1]
suppose we have b:
b = {8, 4, 9, 1, 2}
In principle you search the full sequence:
findSubsequence[Flatten[IntegerDigits[Range@#] & /@ Range[FromDigits[b]] ,b]
(*huge, dont do it*)
Find the first subsequence long enough to contain b:
i = 1; While[ Length@Flatten[IntegerDigits[Range@i] ] < Length@b,
i++]; i
5
check if b occurs early..
findSubsequence[Flatten[IntegerDigits[Range@#] & /@ Range[i]] , b]
{}
beyond here we need only look in adjacent pairs:
While[
findSubsequence[
Flatten[Join[IntegerDigits[Range[i]],
IntegerDigits[Range[i + 1]]]], b] == {}, ++i]; i
49
now a manageable* full search up to that i
:
findSubsequence[Flatten[IntegerDigits[Range@#] & /@ Range[i + 1]] , b]
{2043}
*manageable because I picked a sequence I knew occurred pretty early..You can readily eliminate that last search by keeping a cumulative tally of all the sub-sequence lengths.
Edit: a little cleaner version tracking the lengths...
b = {8, 4, 9, 1, 2}
i = 1; While[ Length@Flatten[IntegerDigits[Range@i] ] < Length@b,
i++]; i
early = Flatten[IntegerDigits[Range@#] & /@ Range[i]];
findSubsequence[early , b]
res = NestWhile[ {
z = Flatten@IntegerDigits[Range[#[[2]] + 1]],
#[[2]] + 1, #[[3]] + Length@z } & ,
{Flatten@IntegerDigits[Range[i]], i , Length@early} ,
findSubsequence[ Flatten[Join[#1[[1]], #2[[1]]]], b] == {} &,
2 ];
lastseq = Flatten@IntegerDigits[Range[res[[2]] - 1]]~Join~
Flatten@IntegerDigits[Range[res[[2]]]];
res[[3]] - Length@lastseq + First@findSubsequence[ lastseq, b]
2043
Flatten[ IntegerDigits[ Range@# ] & /@ Range[ n ] ]
$\endgroup$