Merge numbers to a new number and find digit on position $$n$$

I'm trying to construct a 'Mathematica solution' for the following 'puzzle'

The natural numbers are placed in a row;

12345678910111213...

What digit is the 10,000th digit?

I don't know the syntax how to form this number, or to extract digit $$n$$ (in the example $$n=10000$$) in Mathematica. Anybody that can help? TIA.

• Take a look at the documentation of IntegerDigits, that should solve your problem. To get enough digits, you can either try to work out exactly how many numbers you need to concatenate, or you could also just take enough (i.e. 10000) to make sure – Lukas Lang Oct 16 at 18:16
• Flatten[IntegerDigits /@ Range[5000]][[10000]] – OkkesDulgerci Oct 16 at 19:47

The number you are constructing is related to the base 10 Champernowne constant, except that the Champernowne is a real number that starts with 0.123... while your "number" is an integer with an infinite number of digits.

In Mathematica, the Champernowne constant in base 10 is given by ChampernowneNumber[]. To get the 10,000 digit, just use RealDigits:

RealDigits[ChampernowneNumber[], 10, 1, -10000][[1, 1]]


7

A (much slower) procedural method.

First we find the number of digits of 123...(n-1)n.

numlength[n_] := With[
{pow = Floor@N@Log10[n]},
Range[pow].(9*10^Range[0, pow - 1]) + (pow + 1) (n - 10^pow + 1)
]


Here pow = Floor@N@Log10[n] gives the order of magnitude (OoM) of n, Range[pow] and (pow + 1) gives the number of digits in each OoM and the last OoM, respectively, 9*10^Range[0, pow - 1] and (n - 10^pow + 1) gives the number of numbers in each OoM and the last OoM. So the final output is the number of digits in the number 123...(n-1)n.

Then, because I couldn't think of a better way,

proc[limit_] := Block[
{n = 1},
While[numlength[n] <= limit, n++];
If[numlength[n - 1] == limit, Mod[n - 1, 10], IntegerDigits[n][[limit - numlength[n - 1]]]]
]


While it's much slower than @CarlWoll's method, and definitely not the best method, it still works.

proc[10^4] // RepeatedTiming
RealDigits[ChampernowneNumber[], 10, 1, -10^4][[1, 1]] // RepeatedTiming


{0.032, 7}

{0.000086, 7}