Making the number 12345...n

Well, I am trying to write a code that makes the number:

$$123456\dots n\tag1$$

So, when $$n=10$$ we get:

$$12345678910$$

And when $$n=15$$ we get:

$$123456789101112131415$$

And when $$n=4$$ we get:

$$1234$$

• Maybe not very practical for construction, but it may be noteworthy that ChampernowneNumber[] is related to this. Commented Dec 24, 2021 at 18:31
• ^ e.g IntegerPart[ChampernowneNumber[10] 10^31] Commented Dec 24, 2021 at 21:53
• @flinty The messy part is the exponent of the multiplier... Commented Dec 25, 2021 at 7:55
• @kirma If you are curious about it, the exponent is a combination of Log[10, ...]s and Floor[...]s, see my answer below. Commented Dec 25, 2021 at 13:36

FromDigits@Flatten[IntegerDigits /@ Range[15]]

123456789101112131415


A function to do it:

numberFromRange[n_] := FromDigits@Flatten[IntegerDigits /@ Range@n]

f1 = FromDigits @ StringRiffle[Range[#], ""] &;

f1 /@ {4, 10, 15}

{1234, 12345678910, 123456789101112131415}


And

f2 = FromDigits @* StringJoin @* IntegerString @* Range;

f2 /@ {4, 10, 15}

{1234, 12345678910, 123456789101112131415}


f3 = Array[IntegerString, #, 1, FromDigits @* StringJoin] &;

f3 /@ {5, 10, 15}

{12345, 12345678910, 123456789101112131415}


Without using IntegerDigits or string processing:

f[x_] := Last@NestWhile[#[[1]]+{1,#[[2]]*10^IntegerLength@#[[1]]}&,{1,0},#[[1]]<=x&]

f[105]
(* 1234567891011121314151617181920212223242526272829303132333435363738394
0414243444546474849505152535455565758596061626364656667686970717273747
5767778798081828384858687888990919293949596979899100101102103104105 *)

ToExpression[
StringJoin[
ToString /@ Range[15]
]
]


For fun, here's some more options, which are quite distinct from the already existing ones.

First, a recursive definition:

f[1] = 1;
f[n_] := f[n] = f[n - 1]*10^Floor[Log[10, 10*n]] + n


And, second, one using kirma's and flinty's suggestion, i.e., the Champernowne constant:

f[n_] := IntegerPart[ChampernowneNumber[10] 10^((n + 1) Floor[Log[10, 10*n]] - (10^Floor[Log[10, 10*n]] - 1)/(10 - 1))]


They both yield the same answer as other posts, naturally.

• Thanks, I like them! Merry Christmas Commented Dec 25, 2021 at 13:38

Timings for all the methods (g1 : murray, g2 : flinty, g3/g4 : AccidentalFourierTransform, g5/g6 : Syed, g7 : David Reiss, g8 : user1066, g9/g10/g11 : kglr) posted so far:

ClearAll[g1, g2, g3, g4, g5, g6, g7, g8, g9, g10, g11, funcs]

g1 = FromDigits @ Flatten[IntegerDigits /@ Range[#]] &;

g2[x_] := Last @ NestWhile[#[[1]] + {1, #[[2]]*10^IntegerLength@#[[1]]} &, {1,
0}, #[[1]] <= x &]

g3[1] = 1;
g3[n_] := Block[{$RecursionLimit = 10^6}, g3[n] = g3[n - 1]*10^Floor[Log[10, 10*n]] + n] g4 = IntegerPart[ChampernowneNumber[10] 10^((# + 1) Floor[Log[10, 10*#]] - (10^Floor[Log[10, 10*#]] - 1)/(10 - 1))] &; g5 = FromDigits @* Flatten @* IntegerDigits @* Range @ # &; g6 = FromDigits @ Flatten @ Last @ Reap @ Scan[Sow[IntegerDigits[#]] &] @ Range[#] &; g7 = ToExpression[StringJoin[ToString /@ Range[#]]] &; g8 = ToExpression @ StringJoin @ Array[IntegerString, #] &; g9 = FromDigits @* StringJoin @* IntegerString @* Range; g10 = Array[IntegerString, #, 1, FromDigits @* StringJoin] &; g11 = FromDigits @ StringRiffle[Range[#], ""] &; funcs = {g1, g2, g3, g4, g5, g6, g7, g8, g9, g10, g11};  Timings: ClearAll[res, timing] Do[timing[i] = First[RepeatedTiming[ res[i] = funcs[[i]] /@ {5, 15, 55, 105, 1005, 10005}]], {i, 1, 11}] Equal @@ (res /@ Range[11])  True  replace = {g2 -> "Last@NestWhile[#[[1]]+{1,#[[2]]*10^IntegerLength@#[[1]]}&,{1,0},#[[1]]\[LessEqual]x&]", g3 -> "g3[1]=1; g3[n_]:=Block[{$RecursionLimit=10^6},g3[n]=g3[n-1]*10^Floor[Log[10,10*n]]+n]"};

MapIndexed[{"g" <> ToString@#2[[1]], # /. replace, timing[#2[[1]]]} &][funcs] //
SortBy[Last] //
Prepend[{"function", "definition", "timing"}] //
Grid[#, Alignment -> {{Center, Left, "."}, Center}, Dividers -> All] &


• Thanks, for the tremendous effort. I really like it and it gave me a ton of insight into the problem. Merry Christmas Commented Dec 26, 2021 at 9:39

Identical to the solution by @murray but written as a composition:

f = FromDigits@*
Flatten@*
IntegerDigits@*
Range@
# &

f /@ Range[8, 15]


Using Reap/Sow:

g = FromDigits@
Flatten@Last@Reap@Scan[Sow[IntegerDigits[#]] & ]@Range[#] &

g /@ Range[8, 15]


Result:

{12345678, 123456789, 12345678910, 1234567891011, 123456789101112, \
12345678910111213, 1234567891011121314, 123456789101112131415}

ToExpression@StringJoin@Array[IntegerString,15]
(* 123456789101112131415 *)

• Thanks, I like it! Merry Christmas Commented Dec 25, 2021 at 23:03