5
$\begingroup$

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$$

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

8 Answers 8

14
$\begingroup$
FromDigits@Flatten[IntegerDigits /@ Range[15]]

123456789101112131415

A function to do it:

numberFromRange[n_] := FromDigits@Flatten[IntegerDigits /@ Range@n]
$\endgroup$
10
$\begingroup$
f1 = FromDigits @ StringRiffle[Range[#], ""] &;

f1 /@ {4, 10, 15}
{1234, 12345678910, 123456789101112131415}

And

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

f2 /@ {4, 10, 15}
{1234, 12345678910, 123456789101112131415}

A variation on @user1066's answer:

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

f3 /@ {5, 10, 15}
{12345, 12345678910, 123456789101112131415}
$\endgroup$
8
$\begingroup$

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 *)
$\endgroup$
5
$\begingroup$
ToExpression[
  StringJoin[
    ToString /@ Range[15]
  ]
]
$\endgroup$
5
$\begingroup$

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.

For more info, see OEIS.

$\endgroup$
1
  • 2
    $\begingroup$ Thanks, I like them! Merry Christmas $\endgroup$ Commented Dec 25, 2021 at 13:38
5
$\begingroup$

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] &

enter image description here

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

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}
$\endgroup$
2
$\begingroup$
ToExpression@StringJoin@Array[IntegerString,15]
(* 123456789101112131415 *)
$\endgroup$
1
  • 1
    $\begingroup$ Thanks, I like it! Merry Christmas $\endgroup$ Commented Dec 25, 2021 at 23:03

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.